AppStd/Modules
8
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Windows: Fix Outlook drop, add DroppedFile class

Browse Source
This commit is contained in:
Jonathan Jenne 2022-02-16 15:24:37 +01:00
parent c2b81af556
commit f493d46fd6
4 changed files with 263 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

111
Windows/FileDrop.vb
View File

@ -3,9 +3,9 @@ Imports DigitalData.Modules.Base
Imports DigitalData.Modules.Logging Imports DigitalData.Modules.Logging
Imports DigitalData.Modules.Language.Utils Imports DigitalData.Modules.Language.Utils
Imports Microsoft.Office.Interop Imports Microsoft.Office.Interop
Imports System.Windows Imports System.Windows.Forms
Public Class FileDrop Partial Public Class FileDrop
Inherits BaseClass Inherits BaseClass
Public Enum FileFormat Public Enum FileFormat
@ -24,51 +24,35 @@ Public Class FileDrop
Attachment Attachment
End Enum End Enum
Public Class DroppedFile Public ReadOnly Property TempFileSubDirectory
Public ReadOnly Property FilePath As String Get
Public Property FileFormat As FileFormat Return _TempFileSubDirectory
Public Property FileSource As FileSource = FileSource.DragDrop End Get
End Property
Public Sub New(pFilePath As String) Private _TempFileSubDirectory As String = "FileDrop"
FilePath = pFilePath
End Sub
Public Sub New(pFilePath As String, pDropType As String)
MyClass.New(pFilePath)
Select Case pDropType
Case "LOCAL_FILE" ' "|DROPFROMFSYSTEM|"
FileFormat = FileFormat.LocalFile
Case "OUTLOOK_ATTACHMENT" ' "|OUTLOOK_ATTACHMENT|"
FileFormat = FileFormat.OutlookAttachment
Case "OUTLOOK_MAIL" ' "|OUTLOOK_MESSAGE|"
FileFormat = FileFormat.OutlookMail
Case "|MSGONLY|"
FileFormat = FileFormat.MailWithoutAttachments
Case "|FW_OUTLOOK_MESSAGE|"
FileFormat = FileFormat.OutlookMail
FileSource = FileSource.FolderWatch
Case "|FW_SIMPLEINDEXER|"
FileFormat = FileFormat.LocalFile
FileSource = FileSource.FolderWatch
Case "|ATTMNTEXTRACTED|"
FileFormat = FileFormat.LocalFile
FileSource = FileSource.Attachment
End Select
End Sub
End Class
Public Sub New(pLogConfig As LogConfig) Public Sub New(pLogConfig As LogConfig)
MyBase.New(pLogConfig) MyBase.New(pLogConfig)
End Sub End Sub
Public Sub New(pLogConfig As LogConfig, pTempFileSubDirectory As String)
MyClass.New(pLogConfig)
_TempFileSubDirectory = pTempFileSubDirectory
End Sub
Public Function GetFileFormats(pEvent As DragEventArgs) As List(Of String)
Dim oFormats As New List(Of String)
For Each oFormat As String In pEvent.Data.GetFormats(False)
oFormats.Add(oFormat)
Next
Return oFormats
End Function
Public Function GetFileFormat(pEvent As DragEventArgs) As FileFormat Public Function GetFileFormat(pEvent As DragEventArgs) As FileFormat
If IsThunderbird(pEvent) Then If IsThunderbird(pEvent) Then
If IsThunderbirdAttachment(pEvent) Then If IsThunderbirdAttachment(pEvent) Then
@ -102,7 +86,7 @@ Public Class FileDrop
End If End If
End Function End Function
Public Function GetFilePaths(pEvent As DragEventArgs) As List(Of DroppedFile) Public Function GetFiles(pEvent As DragEventArgs) As List(Of DroppedFile)
Try Try
Dim oFormat = GetFileFormat(pEvent) Dim oFormat = GetFileFormat(pEvent)
Dim oFiles As New List(Of DroppedFile) Dim oFiles As New List(Of DroppedFile)
@ -119,6 +103,7 @@ Public Class FileDrop
Case Else Case Else
Dim oDroppedFiles As String() = GetFormat(pEvent, "FileDrop") Dim oDroppedFiles As String() = GetFormat(pEvent, "FileDrop")
Dim oTempPath As String = GetTempPathWithSubdirectory()
If oDroppedFiles IsNot Nothing Then If oDroppedFiles IsNot Nothing Then
For Each oPath In oDroppedFiles For Each oPath In oDroppedFiles
@ -140,7 +125,7 @@ Public Class FileDrop
End Function End Function
Private Function GetOutlookFilePath(pEvent As DragEventArgs) As List(Of String) Private Function GetOutlookFilePath(pEvent As DragEventArgs) As List(Of String)
Dim oTempPath As String = IO.Path.GetTempPath() Dim oTempPath As String = GetTempPathWithSubdirectory()
Dim oFileName As String = GetOutlookFileName(pEvent) Dim oFileName As String = GetOutlookFileName(pEvent)
Dim oFilePath As String = IO.Path.Combine(oTempPath, oFileName) Dim oFilePath As String = IO.Path.Combine(oTempPath, oFileName)
Dim oContentsList As List(Of Byte()) = GetOutlookFileContents_FromInterop(pEvent) Dim oContentsList As List(Of Byte()) = GetOutlookFileContents_FromInterop(pEvent)
@ -221,7 +206,7 @@ Public Class FileDrop
Logger.Info("Subject Slug: [{0}]", oSubject) Logger.Info("Subject Slug: [{0}]", oSubject)
Dim oFileName As String = $"{oSubject}.msg" Dim oFileName As String = $"{oSubject}.msg"
Dim oTempPath As String = IO.Path.GetTempPath() Dim oTempPath As String = GetTempPathWithSubdirectory()
Dim oFilePath As String = IO.Path.Combine(oTempPath, oFileName) Dim oFilePath As String = IO.Path.Combine(oTempPath, oFileName)
oMailItem.SaveAs(oFilePath) oMailItem.SaveAs(oFilePath)
@ -262,7 +247,12 @@ Public Class FileDrop
End Function End Function
Public Function CheckFor(pEvent As DragEventArgs, pFormat As String, pAutoConvert As Boolean) As Boolean Public Function CheckFor(pEvent As DragEventArgs, pFormat As String, pAutoConvert As Boolean) As Boolean
Dim oFormatExists = pEvent.Data.GetDataPresent(pFormat) Dim oFormats = pEvent.Data.GetFormats(pAutoConvert).ToList()
Dim oFormatExists = oFormats.Any(Function(format) format = pFormat)
' This does not work with locally created outlook mails
'Dim oFormatExists = pEvent.Data.GetDataPresent(pFormat)
Logger.Debug("Format exists: [{0}]/[{1}]", pFormat, oFormatExists) Logger.Debug("Format exists: [{0}]/[{1}]", pFormat, oFormatExists)
Return oFormatExists Return oFormatExists
End Function End Function
@ -276,12 +266,41 @@ Public Class FileDrop
End Function End Function
Public Function IsOutlook(e As DragEventArgs) As Boolean Public Function IsOutlook(e As DragEventArgs) As Boolean
Return CheckFor(e, "FileGroupDescriptor") AndAlso CheckFor(e, "FileDrop") Return CheckFor(e, "FileGroupDescriptor") AndAlso CheckFor(e, "FileContents")
End Function End Function
Public Function IsThunderbird(e As DragEventArgs) As Boolean Public Function IsThunderbird(e As DragEventArgs) As Boolean
Return CheckFor(e, "text/x-moz-url") AndAlso CheckFor(e, "FileDrop") Return CheckFor(e, "text/x-moz-url") AndAlso CheckFor(e, "FileDrop")
End Function End Function
Public Sub RemoveTempDirectory()
Dim oTempPath As String = IO.Path.Combine(IO.Path.GetTempPath(), _TempFileSubDirectory)
If IO.Directory.Exists(oTempPath) Then
Try
IO.Directory.Delete(oTempPath, recursive:=True)
Catch ex As Exception
Logger.Warn("Could not delete Temp Subdirectory [{0}].", oTempPath)
Logger.Error(ex)
End Try
End If
End Sub
Private Function GetTempPathWithSubdirectory() As String
Dim oTempPath As String = IO.Path.Combine(IO.Path.GetTempPath(), _TempFileSubDirectory)
If IO.Directory.Exists(oTempPath) = False Then
Try
IO.Directory.CreateDirectory(oTempPath)
Catch ex As Exception
Logger.Warn("Could not create Temp Subdirectory [{0}]. Returning default Temp Path.", oTempPath)
Logger.Error(ex)
Return IO.Path.GetTempPath()
End Try
End If
Return oTempPath
End Function
#Region "Thunderbird" #Region "Thunderbird"
Private Function IsOutlookMail(e As DragEventArgs) As Boolean Private Function IsOutlookMail(e As DragEventArgs) As Boolean

57
Windows/FileDrop/DroppedFile.vb Normal file
View File

@ -0,0 +1,57 @@
Imports System.Text
Imports DigitalData.Modules.Logging
Imports DigitalData.Modules.Language.Utils
Imports Microsoft.Office.Interop
Imports System.Windows
Partial Class FileDrop
Public Class DroppedFile
Public ReadOnly Property FilePath As String
Public ReadOnly Property DropType As String = "|DROPFROMFSYSTEM|"
Public Property FileFormat As FileFormat = FileFormat.LocalFile
Public Property FileSource As FileSource = FileSource.DragDrop
Public Sub New(pFilePath As String)
FilePath = pFilePath
End Sub
Public Sub New(pFilePath As String, pDropType As String)
MyClass.New(pFilePath)
DropType = pDropType
Select Case pDropType
Case "|DROPFROMFSYSTEM|"
FileFormat = FileFormat.LocalFile
Case "OUTLOOK_ATTACHMENT"
FileFormat = FileFormat.OutlookAttachment
Case "|OUTLOOK_MESSAGE|"
FileFormat = FileFormat.OutlookMail
Case "|MSGONLY|"
FileFormat = FileFormat.MailWithoutAttachments
Case "|FW_OUTLOOK_MESSAGE|"
FileFormat = FileFormat.OutlookMail
FileSource = FileSource.FolderWatch
Case "|FW_SIMPLEINDEXER|"
FileFormat = FileFormat.LocalFile
FileSource = FileSource.FolderWatch
Case "|ATTMNTEXTRACTED|"
FileFormat = FileFormat.LocalFile
FileSource = FileSource.Attachment
End Select
End Sub
End Class
End Class

139
Windows/FileDrop/TobitDavid.vb Normal file
View File

@ -0,0 +1,139 @@
Public Class TobitDavid
' Tobit David Drag Drop: https://www.david-forum.de/thread/12671-drag-and-drop-von-faxen-und-mails-in-net-anwendung/
'Private Declare Function DVEmlFromMailItem Lib "DvApi32" (ByVal oMailItem As MailItem, ByVal strFileName As String) As Long
'Private Sub DragDrop_HandleTobit(e As DragEventArgs)
' If e.Data.GetDataPresent("#TobitMsgData") Then
' Dim Quellpfad As String = ""
' Dim Dateinamen As String()
' 'Quellpfad zu den David Dateien auslesen
' Using ms As MemoryStream = e.Data.GetData("#TobitMsgData")
' Dim bytes As Byte() = ms.ToArray()
' Dim n As Integer = 0
' Dim c As Char
' Do While True
' c = Convert.ToChar(bytes(n))
' If bytes(n) <> 0 Then
' Quellpfad &= c
' n += 1
' Else
' Exit Do
' End If
' Loop
' End Using
' 'Dateinamen der gedroppten Emails auslesen
' Using ms As MemoryStream = e.Data.GetData("FileGroupDescriptor")
' 'Header sind 4B
' 'Jeder Datensatz ist 332B
' 'Bei Index 72 des Datensatzes beginnt das "Dateiname.eml"
' Dim bytes As Byte() = ms.ToArray()
' ReDim Dateinamen(Int(bytes.Count / 332) - 1)
' ' Array mit so vielen Elementen wie Datensätze im FileGroupDescriptor sind
' Dim AnzahlMails As Integer = bytes(0)
' Dim Dateiname As String
' Dim n As Integer
' For i = 0 To AnzahlMails - 1
' Dateiname = ""
' n = 0
' Do While True
' 'Solange die Bytes auslesen, bis man einen vbNullChar liest
' If bytes(i * 332 + 4 + 72 + n) <> 0 Then
' Dateiname = Dateiname & Convert.ToChar(bytes(i * 332 + 4 + 72 + n))
' n += 1
' Else
' Exit Do
' End If
' Loop
' Dateinamen(i) = Dateiname
' Next
' End Using
' Using EntryDataEx As MemoryStream = e.Data.GetData("#TobitEntryDataEx")
' Dim bytes As Byte() = EntryDataEx.ToArray()
' 'Die Größe des Headers steht im ersten Byte
' Dim HeadExSize As Integer = bytes(0)
' 'Die Anzahl der Datensätze steht im 8. - 11. Byte
' Dim nCountEntries As Integer = BitConverter.ToInt32(bytes, 8)
' Dim nPositions(nCountEntries - 1) As Integer
' For i = 0 To nCountEntries - 1
' 'Datensätze in der #TobitEntryDataEx sind 269 Byte groß.
' 'In den ersten 4 Bytes steht die QID aus der archive.dat
' nPositions(i) = BitConverter.ToInt32(bytes, HeadExSize + i * 269)
' Next
' Using fs As New FileStream(Quellpfad & "\archive.dat", FileMode.Open, FileAccess.Read)
' 'archive.dat als MemoryStream kopieren
' Using ms As New MemoryStream
' fs.CopyTo(ms)
' 'MemoryStream in ein Byte-Array konvertieren
' Dim archiveBytes As Byte() = ms.ToArray()
' 'Datensätze in der archive.dat sind 430 Byte groß
' For i = 16 To archiveBytes.Length - 1 Step 430
' 'Das 17.-20. Byte ist die QID die wir suchen
' Dim QID As Integer = BitConverter.ToInt32(archiveBytes, i)
' 'Wenn die QID übereinstimmt mit einer der David-Mails, dann lies den Dateinamen im Archiv aus
' If nPositions.Contains(QID) Then
' 'Der Index der QID (0, ..., nCountEntries - 1)
' Dim nPosIndex As Integer = -1
' For j = 0 To nPositions.Length - 1
' If QID = nPositions(j) Then
' nPosIndex = j
' Exit For
' End If
' Next
' 'Alle Bytes ab dem 17. bis zum Ende des Datensatzes aus der archive.bat auslesen und als String konvertieren
' Dim byteString As String = ""
' For j = 0 To 429 - 17
' byteString &= Convert.ToChar(archiveBytes(i + j))
' Next
' 'Index der Id herausfinden (Index des Quellpfads im byteString + Länge des Quellpfads + 1 "\")
' Dim IdIndex As Integer = byteString.IndexOf(Quellpfad, StringComparison.OrdinalIgnoreCase) + Quellpfad.Length + 1
' 'Die Id sind dann die 8 Zeichen ab dem IdIndex
' Dim Id As String = byteString.Substring(IdIndex, 8)
' 'EML speichern
' DavidEmlSpeichern(Quellpfad, Dateinamen(nPosIndex), QID, Id)
' End If
' Next
' End Using
' End Using
' End Using
' End If
'End Sub
'Private Sub DavidEmlSpeichern(ArchivePfad As String, Dateiname As String, ID As String, FaxID As String)
' Dim oApp As DavidAPIClass
' Dim oAcc As Account
' Dim oArchive As Archive
' Dim oMessageItems As MessageItems
' Dim oMailItem As MailItem
' oApp = New DavidAPIClass()
' oApp.LoginOptions = DvLoginOptions.DvLoginForceAsyncDuplicate
' oAcc = oApp.Logon("DavidServer", "", "", "", "", "NOAUTH")
' oArchive = oAcc.ArchiveFromID(ArchivePfad)
' If FaxID.First() = "M" Then
' 'Faxe beginnen mit M
' 'Bei Faxen kann man einfach die .001 Datei kopieren und als TIF speichern
' File.Copy(ArchivePfad & "\" & FaxID & ".001", "C:\Temp\" & Dateiname, True)
' ListeAktualisieren()
' ElseIf FaxID.First() = "I" Then
' 'Emails beginnen mit I
' 'Bei Emails muss man die DVEmlFromMailItem mit dem richtigen oMailItem aufrufen
' oMessageItems = oArchive.MailItems
' For Each oMailItem In oMessageItems
' If oMailItem._ID = ID Then
' Dim fileName As String = Space(260)
' If DVEmlFromMailItem(oMailItem, fileName) <> 0 Then
' fileName = Trim(fileName)
' fileName = fileName.Substring(0, fileName.Length - 1)
' File.Copy(fileName, "C:\Temp\" & Dateiname, True)
' ListeAktualisieren()
' End If
' Exit For
' End If
' Next
' End If
'End Sub
End Class

2
Windows/Windows.vbproj
View File

@ -85,7 +85,9 @@
</Compile> </Compile>
<Compile Include="Drawing.vb" /> <Compile Include="Drawing.vb" />
<Compile Include="File.vb" /> <Compile Include="File.vb" />
<Compile Include="FileDrop\DroppedFile.vb" />
<Compile Include="FileDrop.vb" /> <Compile Include="FileDrop.vb" />
<Compile Include="FileDrop\TobitDavid.vb" />
<Compile Include="Hotkey.vb" /> <Compile Include="Hotkey.vb" />
<Compile Include="NativeMethods.vb" /> <Compile Include="NativeMethods.vb" />
<Compile Include="Screen.vb" /> <Compile Include="Screen.vb" />