Windows: Fix Outlook drop, add DroppedFile class

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

View File

@ -3,9 +3,9 @@ Imports DigitalData.Modules.Base
Imports DigitalData.Modules.Logging
Imports DigitalData.Modules.Language.Utils
Imports Microsoft.Office.Interop
Imports System.Windows
Imports System.Windows.Forms
Public Class FileDrop
Partial Public Class FileDrop
Inherits BaseClass
Public Enum FileFormat
@ -24,51 +24,35 @@ Public Class FileDrop
Attachment
End Enum
Public Class DroppedFile
Public ReadOnly Property FilePath As String
Public Property FileFormat As FileFormat
Public Property FileSource As FileSource = FileSource.DragDrop
Public ReadOnly Property TempFileSubDirectory
Get
Return _TempFileSubDirectory
End Get
End Property
Public Sub New(pFilePath As String)
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
Private _TempFileSubDirectory As String = "FileDrop"
Public Sub New(pLogConfig As LogConfig)
MyBase.New(pLogConfig)
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
If IsThunderbird(pEvent) Then
If IsThunderbirdAttachment(pEvent) Then
@ -102,7 +86,7 @@ Public Class FileDrop
End If
End Function
Public Function GetFilePaths(pEvent As DragEventArgs) As List(Of DroppedFile)
Public Function GetFiles(pEvent As DragEventArgs) As List(Of DroppedFile)
Try
Dim oFormat = GetFileFormat(pEvent)
Dim oFiles As New List(Of DroppedFile)
@ -119,6 +103,7 @@ Public Class FileDrop
Case Else
Dim oDroppedFiles As String() = GetFormat(pEvent, "FileDrop")
Dim oTempPath As String = GetTempPathWithSubdirectory()
If oDroppedFiles IsNot Nothing Then
For Each oPath In oDroppedFiles
@ -140,7 +125,7 @@ Public Class FileDrop
End Function
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 oFilePath As String = IO.Path.Combine(oTempPath, oFileName)
Dim oContentsList As List(Of Byte()) = GetOutlookFileContents_FromInterop(pEvent)
@ -221,7 +206,7 @@ Public Class FileDrop
Logger.Info("Subject Slug: [{0}]", oSubject)
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)
oMailItem.SaveAs(oFilePath)
@ -262,7 +247,12 @@ Public Class FileDrop
End Function
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)
Return oFormatExists
End Function
@ -276,12 +266,41 @@ Public Class FileDrop
End Function
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
Public Function IsThunderbird(e As DragEventArgs) As Boolean
Return CheckFor(e, "text/x-moz-url") AndAlso CheckFor(e, "FileDrop")
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"
Private Function IsOutlookMail(e As DragEventArgs) As Boolean

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

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

View File

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