Imports System.IO Imports Microsoft.Office.Interop Public Class ClassFileDrop 'Public Shared Property FilesDropped As String() Public Shared Property FilesDropped As New List(Of String) ' 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 Public Shared Function Drop_File(e As DragEventArgs) Try LOGGER.Info("Drop_File") FilesDropped.Clear() If e.Data.GetDataPresent(DataFormats.FileDrop) Then Dim oFilesFromEvent() As String Dim oIndex As Integer ' Assign the files to an array. oFilesFromEvent = e.Data.GetData(DataFormats.FileDrop) ' Loop through the array and add the files to the list. For oIndex = 0 To oFilesFromEvent.Length - 1 LOGGER.Info("Simple FileDrop - File: " & oFilesFromEvent(oIndex)) FilesDropped.Add("|DROPFROMFSYSTEM|" & oFilesFromEvent(oIndex)) 'ReDim Preserve FilesDropped(oIndex) 'FilesDropped(oIndex) = "|DROPFROMFSYSTEM|" & oFilesFromEvent(oIndex) ' ListBox1.Items.Add(MyFiles(i)) Next Return True ElseIf (e.Data.GetDataPresent("FileGroupDescriptor")) AndAlso (e.Data.GetDataPresent("FileContents")) Then '// the first step here is to get the stbFileName '// of the attachment and '// build a full-path name so we can store it '// in the temporary folder '// '// set up to obtain the aryFileGroupDescriptor '// and extract the file name Dim oStream As IO.Stream = CType(e.Data.GetData("FileGroupDescriptor"), IO.Stream) Dim aryFileGroupDescriptor(512) As Byte ' = new byte[512] oStream.Read(aryFileGroupDescriptor, 0, 512) '// used to build the stbFileName from the aryFileGroupDescriptor block Dim stbFileName As System.Text.StringBuilder = New System.Text.StringBuilder("") '// this trick gets the stbFileName of the passed attached file Dim intCnt As Integer = 76 Do While aryFileGroupDescriptor(intCnt) <> 0 stbFileName.Append(Convert.ToChar(aryFileGroupDescriptor(intCnt), System.Globalization.CultureInfo.CreateSpecificCulture("de-DE"))) intCnt += 1 Loop oStream.Close() 'Sonderzeichen entfernen Dim oTempFileName = DigitalData.Modules.Language.Utils.RemoveInvalidCharacters(stbFileName.ToString) Dim oAttachments = e.Data.GetDataPresent("FileContents") Dim strOutFile As String = Path.Combine(Path.GetTempPath(), oTempFileName) '// create the full-path name '// '// Second step: we have the file name. '// Now we need to get the actual raw '// data for the attached file and copy it to disk so we work on it. '// '// get the actual raw file into memory Dim oMemoryStreamInput As IO.MemoryStream = CType(e.Data.GetData("FileContents", True), IO.MemoryStream) 'This returns nothing for an Email If oMemoryStreamInput Is Nothing = False Then '// allocate enough bytes to hold the raw date Dim aryFileBytes(CType(oMemoryStreamInput.Length, Int32)) As Byte '// set starting position at first byte and read in the raw data oMemoryStreamInput.Position = 0 oMemoryStreamInput.Read(aryFileBytes, 0, CType(oMemoryStreamInput.Length, Int32)) '// create a file and save the raw zip file to it Dim fsOutput As IO.FileStream = New IO.FileStream(strOutFile, IO.FileMode.Create) '; fsOutput.Write(aryFileBytes, 0, aryFileBytes.Length) fsOutput.Close() ' // close the file Dim resultVersion = ClassFilehandle.Versionierung_Datei(strOutFile) If resultVersion <> "" Then strOutFile = resultVersion End If Dim finTemp As IO.FileInfo = New IO.FileInfo(strOutFile) '// always good to make sure we actually created the file If (finTemp.Exists = True) Then LOGGER.Info("Drop an Attachment - File: " & strOutFile) FilesDropped.Add("|OUTLOOK_ATTACHMENT|" & strOutFile) 'ReDim Preserve FilesDropped(0) 'FilesDropped(0) = "|OUTLOOK_ATTACHMENT|" & strOutFile Return True Else LOGGER.Info("Attachment File from Outlook could not be created") End If End If End If If e.Data.GetDataPresent("FileGroupDescriptor") Then Dim oApp As Outlook.Application Try oApp = New Outlook.Application() Catch ex As Exception LOGGER.Error(ex) MsgBox("Unexpected error in Initialisieren von Outlook-API:" & vbNewLine & ex.Message & vbNewLine & vbNewLine & "Evtl ist Outlook nicht in der dafür vorgesehenen For") Return False End Try LOGGER.Info(" Drop of msg") 'supports a drop of a Outlook message Dim myobj As Outlook.MailItem For i As Integer = 1 To oApp.ActiveExplorer.Selection.Count myobj = oApp.ActiveExplorer.Selection.Item(i) Dim subj As String = myobj.Subject If subj = "" Then subj = "NO_SUBJECT" End If 'Sonderzeichen entfernen subj = DigitalData.Modules.Language.Utils.RemoveInvalidCharacters(subj) 'hardcode a destination path for testing Dim oFilename As String = IO.Path.Combine(Path.GetTempPath, subj + ".msg") oFilename = oFilename.Replace("?", "") oFilename = oFilename.Replace("!", "") oFilename = oFilename.Replace("%", "") oFilename = oFilename.Replace("$", "") LOGGER.Info("Drop of msg - File:" & oFilename) Try myobj.SaveAs(oFilename) Catch ex As Exception LOGGER.Error(ex) MsgBox("Die Email konnte aufgrund einer Sicherheitseinstellung im Outlook nicht abgelegt werden! " & "Bitte wenden Sie sich an Ihren Administrator, " & "um den programmatischen Zugriff auf Outlook zuzulassen. " & "Weitere Informationen finden Sie im Log.", MsgBoxStyle.Critical, "Global Indexer") End Try FilesDropped.Add("|OUTLOOK_MESSAGE|" & oFilename) 'ReDim Preserve FilesDropped(i) 'FilesDropped(i) = "|OUTLOOK_MESSAGE|" & oFilename Next Return True 'Drop eines Outlook Attachments End If Catch ex As Exception MsgBox("Error in Drop-File" & vbNewLine & ex.Message, MsgBoxStyle.Critical) Return False End Try End Function '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