Monorepo/Windows/FileDrop/TobitDavid.vb
2022-02-16 15:24:37 +01:00

140 lines
7.3 KiB
VB.net

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