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