From f493d46fd683a4395d68d60be35cb3d69b8c6717 Mon Sep 17 00:00:00 2001 From: Jonathan Jenne Date: Wed, 16 Feb 2022 15:24:37 +0100 Subject: [PATCH] Windows: Fix Outlook drop, add DroppedFile class --- Windows/FileDrop.vb | 105 ++++++++++++++---------- Windows/FileDrop/DroppedFile.vb | 57 +++++++++++++ Windows/FileDrop/TobitDavid.vb | 139 ++++++++++++++++++++++++++++++++ Windows/Windows.vbproj | 2 + 4 files changed, 260 insertions(+), 43 deletions(-) create mode 100644 Windows/FileDrop/DroppedFile.vb create mode 100644 Windows/FileDrop/TobitDavid.vb diff --git a/Windows/FileDrop.vb b/Windows/FileDrop.vb index bb97b8b2..0c0e38f6 100644 --- a/Windows/FileDrop.vb +++ b/Windows/FileDrop.vb @@ -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,50 +24,34 @@ 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 + Private _TempFileSubDirectory As String = "FileDrop" - 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 + Public Sub New(pLogConfig As LogConfig) + MyBase.New(pLogConfig) + End Sub - Case "|MSGONLY|" - FileFormat = FileFormat.MailWithoutAttachments + Public Sub New(pLogConfig As LogConfig, pTempFileSubDirectory As String) + MyClass.New(pLogConfig) + _TempFileSubDirectory = pTempFileSubDirectory + End Sub - 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 + Public Function GetFileFormats(pEvent As DragEventArgs) As List(Of String) + Dim oFormats As New List(Of String) - End Select - End Sub - End Class + For Each oFormat As String In pEvent.Data.GetFormats(False) + oFormats.Add(oFormat) + Next - Public Sub New(pLogConfig As LogConfig) - MyBase.New(pLogConfig) - End Sub + Return oFormats + End Function Public Function GetFileFormat(pEvent As DragEventArgs) As FileFormat If IsThunderbird(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 diff --git a/Windows/FileDrop/DroppedFile.vb b/Windows/FileDrop/DroppedFile.vb new file mode 100644 index 00000000..a843329f --- /dev/null +++ b/Windows/FileDrop/DroppedFile.vb @@ -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 + + + + + diff --git a/Windows/FileDrop/TobitDavid.vb b/Windows/FileDrop/TobitDavid.vb new file mode 100644 index 00000000..e2a397a2 --- /dev/null +++ b/Windows/FileDrop/TobitDavid.vb @@ -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 diff --git a/Windows/Windows.vbproj b/Windows/Windows.vbproj index 7629066a..f7f619dd 100644 --- a/Windows/Windows.vbproj +++ b/Windows/Windows.vbproj @@ -85,7 +85,9 @@ + +