Imports System.Text Imports DigitalData.Modules.Base Imports DigitalData.Modules.Logging Imports DigitalData.Modules.Language.Utils Imports Microsoft.Office.Interop Imports System.Windows.Forms Partial Public Class FileDrop Inherits BaseClass Public Enum FileFormat OutlookAttachment OutlookMail ThunderbirdAttachment ThunderbirdMail MailWithoutAttachments LocalFile Unknown End Enum Public Enum FileSource DragDrop FolderWatch Attachment End Enum Public ReadOnly Property TempFileSubDirectory Get Return _TempFileSubDirectory End Get End Property 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 Return FileFormat.ThunderbirdAttachment ElseIf IsThunderbirdMail(pEvent) Then Return FileFormat.ThunderbirdMail Else Return FileFormat.Unknown End If End If If IsOutlook(pEvent) Then If IsOutlookAttachment(pEvent) Then Return FileFormat.OutlookAttachment ElseIf IsOutlookMail(pEvent) Then Return FileFormat.OutlookMail Else Return FileFormat.Unknown End If End If If IsNormalFile(pEvent) Then Return FileFormat.LocalFile Else Return FileFormat.Unknown End If End Function Public Function GetFiles(pEvent As DragEventArgs) As List(Of DroppedFile) Try Dim oFormat = GetFileFormat(pEvent) Dim oFiles As New List(Of DroppedFile) Select Case oFormat Case FileFormat.OutlookAttachment, FileFormat.OutlookMail Dim oFilePaths = GetOutlookFilePath(pEvent) For Each oPath In oFilePaths oFiles.Add(New DroppedFile(oPath) With { .FileFormat = oFormat }) Next Case Else Dim oDroppedFiles As String() = GetFormat(pEvent, "FileDrop") Dim oTempPath As String = GetTempPathWithSubdirectory() If oDroppedFiles IsNot Nothing Then For Each oPath In oDroppedFiles oFiles.Add(New DroppedFile(oPath) With { .FileFormat = oFormat }) Next End If End Select Return oFiles Catch ex As Exception Logger.Error(ex) Return Nothing End Try End Function Private Function GetOutlookFilePath(pEvent As DragEventArgs) As List(Of String) 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) If oContentsList Is Nothing Then Return Nothing End If Dim oPathList As New List(Of String) For Each oContents In oContentsList Using oFileStream As IO.FileStream = New IO.FileStream(oFilePath, IO.FileMode.Create) oFileStream.Write(oContents, 0, oContents.Length) oFileStream.Close() End Using oPathList.Add(oFilePath) Next Return oPathList End Function Private Function GetOutlookFileName(pEvent As DragEventArgs) As String Dim oFileDescriptorSize = 512 Dim oIndex As Integer = 76 Dim oBuilder As New StringBuilder() Using oStream As IO.MemoryStream = GetFormat(pEvent, "FileGroupDescriptor") Dim oFileGroupDescriptor As Byte() = New Byte(oFileDescriptorSize) {} oStream.Read(oFileGroupDescriptor, 0, oFileDescriptorSize) While oFileGroupDescriptor(oIndex) <> 0 Dim oChar = Convert.ToChar(oFileGroupDescriptor(oIndex)) oBuilder.Append(oChar) oIndex += 1 End While End Using Return oBuilder.ToString End Function Private Function GetOutlookFileContents_FromDragEvent(pEvent As DragEventArgs) As List(Of Byte()) Using oStream As IO.MemoryStream = pEvent.Data.GetData("FileContents", True) If oStream Is Nothing Then Return Nothing End If Dim oContentLength = Convert.ToInt32(oStream.Length) Dim oContents As Byte() = New Byte(oContentLength) {} oStream.Position = 0 oStream.Read(oContents, 0, Convert.ToInt32(oContentLength)) Return New List(Of Byte()) From {oContents} End Using End Function Private Function GetOutlookFileContents_FromInterop(pEvent As DragEventArgs) As List(Of Byte()) Dim oApp As Outlook.Application Try oApp = New Outlook.Application() Catch ex As Exception Logger.Error(ex) Return Nothing End Try Dim oResults As New List(Of Byte()) Dim oMailItem As Outlook.MailItem For oIndex As Integer = 1 To oApp.ActiveExplorer.Selection.Count Try oMailItem = oApp.ActiveExplorer.Selection.Item(oIndex) Dim oSubject As String = ConvertTextToSlug(oMailItem.Subject) If oSubject = "" Then oSubject = "NO_SUBJECT" End If Logger.Info("Subject Slug: [{0}]", oSubject) Dim oFileName As String = $"{oSubject}.msg" Dim oTempPath As String = GetTempPathWithSubdirectory() Dim oFilePath As String = IO.Path.Combine(oTempPath, oFileName) oMailItem.SaveAs(oFilePath) Using oFileStream As New IO.FileStream(oFilePath, IO.FileMode.Open) Dim oContents As Byte() = New Byte(oFileStream.Length) {} oFileStream.Read(oContents, 0, oFileStream.Length) oResults.Add(oContents) End Using Try IO.File.Delete(oFilePath) Catch ex As Exception Logger.Warn("Temp file [{0}] could not be deleted!", oFilePath) Logger.Error(ex) End Try Return oResults Catch ex As Exception Logger.Error(ex) End Try Next End Function Public Function GetFormat(pEvent As DragEventArgs, pFormat As String, pAutoConvert As Boolean) As Object If CheckFor(pEvent, pFormat) Then Dim oValue = pEvent.Data.GetData(pFormat, pAutoConvert) Return oValue Else Return Nothing End If End Function Public Function GetFormat(pEvent As DragEventArgs, pFormat As String) As Object Return GetFormat(pEvent, pFormat, False) End Function Public Function CheckFor(pEvent As DragEventArgs, pFormat As String, pAutoConvert As Boolean) As Boolean 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 Public Function CheckFor(pEvent As DragEventArgs, pFormat As String) As Boolean Return CheckFor(pEvent, pFormat, False) End Function Public Function IsNormalFile(e As DragEventArgs) As Boolean Return CheckFor(e, DataFormats.FileDrop, False) End Function Public Function IsOutlook(e As DragEventArgs) As Boolean 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 Return Not IsOutlookAttachment(e) AndAlso CheckFor(e, "RenPrivateSourceFolder") End Function Private Function IsOutlookAttachment(e As DragEventArgs) As Boolean Return IsOutlook(e) AndAlso CheckFor(e, "RenPrivateItem") AndAlso CheckFor(e, "ZoneIdentifier") End Function #End Region #Region "Outlook" Private Function IsThunderbirdMail(e As DragEventArgs) As Boolean Return Not IsThunderbirdAttachment(e) End Function Private Function IsThunderbirdAttachment(e As DragEventArgs) As Boolean Return IsThunderbird(e) AndAlso CheckFor(e, "text/x-moz-url-data") AndAlso CheckFor(e, "text/x-moz-url-desc") End Function #End Region End Class