285 lines
14 KiB
VB.net
285 lines
14 KiB
VB.net
Imports System.IO
|
|
Imports Microsoft.Office.Interop
|
|
|
|
|
|
|
|
Public Class ClassFileDrop
|
|
Public Shared files_dropped As 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("Available Drop Formats:")
|
|
|
|
For Each oFormat As String In e.Data.GetFormats()
|
|
LOGGER.Info(oFormat)
|
|
Next
|
|
|
|
LOGGER.Info(">> Drop_File")
|
|
files_dropped = Nothing
|
|
If e.Data.GetDataPresent(DataFormats.FileDrop) Then
|
|
Dim MyFiles() As String
|
|
Dim i As Integer
|
|
' Assign the files to an array.
|
|
MyFiles = e.Data.GetData(DataFormats.FileDrop)
|
|
' Loop through the array and add the files to the list.
|
|
For i = 0 To MyFiles.Length - 1
|
|
LOGGER.Info(">> Simple FileDrop - File: " & MyFiles(i))
|
|
ReDim Preserve files_dropped(i)
|
|
files_dropped(i) = "|DROPFROMFSYSTEM|" & MyFiles(i)
|
|
' 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 stmInput As IO.Stream = CType(e.Data.GetData("FileGroupDescriptor"), IO.Stream)
|
|
Dim aryFileGroupDescriptor(512) As Byte ' = new byte[512]
|
|
stmInput.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
|
|
stmInput.Close()
|
|
'Sonderzeichen entfernen
|
|
Dim Tempfilename = ClassFilehandle.InvalidCharacters(stbFileName.ToString)
|
|
Dim anhaenge = e.Data.GetDataPresent("FileContents")
|
|
'Dim path As String = "C:\VBProjekte\Dateien"
|
|
'// put the zip file into the temp directory
|
|
Dim strOutFile As String = Path.GetTempPath() & Tempfilename
|
|
'// 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 msInput As IO.MemoryStream = CType(e.Data.GetData("FileContents", True), IO.MemoryStream) 'This returns nothing for an Email
|
|
If msInput Is Nothing = False Then
|
|
'// allocate enough bytes to hold the raw date
|
|
Dim aryFileBytes(CType(msInput.Length, Int32)) As Byte
|
|
'// set starting position at first byte and read in the raw data
|
|
msInput.Position = 0
|
|
msInput.Read(aryFileBytes, 0, CType(msInput.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
|
|
ReDim Preserve files_dropped(0)
|
|
files_dropped(0) = "|OUTLOOK_ATTACHMENT|" & strOutFile
|
|
LOGGER.Info(">> Drop an Attachment - File: " & 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
|
|
Try
|
|
oApp = New Outlook.Application()
|
|
Catch ex As Exception
|
|
MsgBox("Unexpected error in Initialisieren von Outlook-API:" & vbNewLine & ex.Message & vbNewLine & vbNewLine & "Evtl ist Outlook nicht in der dafür vorgesehenen For")
|
|
End Try
|
|
|
|
LOGGER.Info(">> Drop of msg")
|
|
'supports a drop of a Outlook message
|
|
Dim myobj As Object
|
|
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
|
|
If subj.Contains("\") Then
|
|
subj = subj.Replace("\", "-")
|
|
End If
|
|
If subj.Contains("/") Then
|
|
subj = subj.Replace("/", "-")
|
|
End If
|
|
'Sonderzeichen entfernen
|
|
subj = ClassFilehandle.InvalidCharacters(subj)
|
|
'hardcode a destination path for testing
|
|
Dim strFile As String = IO.Path.Combine(Path.GetTempPath, subj + ".msg")
|
|
strFile = strFile.Replace("?", "")
|
|
strFile = strFile.Replace("!", "")
|
|
strFile = strFile.Replace("%", "")
|
|
strFile = strFile.Replace("$", "")
|
|
LOGGER.Info(">> Drop of msg - File:" & strFile)
|
|
Try
|
|
myobj.SaveAs(strFile)
|
|
Catch ex As Exception
|
|
MsgBox("Error in Save Email2Tempfile" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
|
|
Return False
|
|
End Try
|
|
|
|
ReDim Preserve files_dropped(i)
|
|
files_dropped(i) = "|OUTLOOK_MESSAGE|" & strFile
|
|
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
|