300 lines
14 KiB
VB.net
300 lines
14 KiB
VB.net
Imports System.IO
|
||
Imports Microsoft.Office.Interop
|
||
Imports Microsoft.Office.Interop.Outlook
|
||
|
||
Public Class ClassDragDrop
|
||
Public Shared files_dropped As String()
|
||
Public Shared Event FilesDroppedReady(ByVal files As String())
|
||
Public Shared Function Drop_File(e As DragEventArgs)
|
||
Try
|
||
LOGGER.Debug("In Drop_File....")
|
||
files_dropped = New String() {}
|
||
|
||
' WICHTIG: DB-Löschung NICHT im UI-Thread erzwingen.
|
||
' => Verschiebe in aufrufenden Code per BeginInvoke/Task.Run (siehe Kommentar unten).
|
||
' MYDB_ECM?.ExecuteNonQuery(Sql)
|
||
|
||
Dim hasOutlookUnicode As Boolean = e.Data.GetDataPresent("FileGroupDescriptorW")
|
||
Dim hasOutlookAnsi As Boolean = e.Data.GetDataPresent("FileGroupDescriptor")
|
||
Dim hasOutlookContents As Boolean = e.Data.GetDataPresent("FileContents")
|
||
Dim hasChromiumMime As Boolean = e.Data.GetDataPresent("Chromium Web Custom MIME Data Format")
|
||
Dim hasFileNameW As Boolean = e.Data.GetDataPresent("FileNameW") OrElse e.Data.GetDataPresent("FileName")
|
||
Dim hasFileDrop As Boolean = e.Data.GetDataPresent(DataFormats.FileDrop)
|
||
|
||
'1) Klassische Outlook-Attachments: Descriptor + Contents
|
||
If (hasOutlookUnicode OrElse hasOutlookAnsi) AndAlso hasOutlookContents Then
|
||
' ... dein bestehender Descriptor/Contents-Code ...
|
||
' Return True wenn erfolgreich
|
||
End If
|
||
|
||
'2) ATTACHMENT oder komplette Mail aus Outlook/WebView2: KEIN Descriptor+Contents, ABER FileDrop vorhanden
|
||
' => zuerst FileDrop verarbeiten. Wenn leer (delayed rendering), dann Fallback über Outlook COM Selection/Inspector
|
||
If hasFileDrop AndAlso (hasChromiumMime OrElse hasFileNameW) AndAlso Not hasOutlookContents Then
|
||
LOGGER?.Debug("WebView2/Outlook Attachment or Mail: try FileDrop, skip Outlook COM initially")
|
||
Dim ok As Boolean = HandleFileDrop(e)
|
||
If ok Then Return True
|
||
|
||
' FileDrop leer -> Fallback: versuche ausgewählte Mail via Outlook COM zu speichern
|
||
LOGGER?.Warn("FileDrop vorhanden, aber leer. Fallback auf Outlook COM für komplette Mail.")
|
||
ScheduleOutlookComFallback()
|
||
Return True ' Wichtig: UI-Thread nicht blockieren; wir verarbeiten asynchron.
|
||
End If
|
||
|
||
'3) Outlook Mail (.msg): Descriptor ohne Contents ODER Chromium/WebView2 Indikatoren – nur wenn KEIN FileDrop vorhanden
|
||
If Not hasFileDrop AndAlso ((hasOutlookAnsi OrElse hasOutlookUnicode) OrElse hasChromiumMime OrElse hasFileNameW) Then
|
||
Try
|
||
Dim oApp As Outlook.Application = Nothing
|
||
Try
|
||
oApp = New Outlook.Application()
|
||
Catch ex As System.Exception
|
||
MsgBox("Fehler beim Initialisieren der Outlook-API:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
|
||
GoTo CheckFileDrop
|
||
End Try
|
||
|
||
Dim explorer = oApp.ActiveExplorer
|
||
If explorer IsNot Nothing AndAlso explorer.Selection IsNot Nothing AndAlso explorer.Selection.Count > 0 Then
|
||
LOGGER?.Debug("Drop of msg (Outlook Explorer Selection)")
|
||
For i As Integer = 1 To explorer.Selection.Count
|
||
Dim myobj As Object = explorer.Selection.Item(i)
|
||
If myobj Is Nothing Then Continue For
|
||
SaveMailItemToTemp(myobj)
|
||
Next
|
||
Return True
|
||
Else
|
||
Dim inspector = oApp.ActiveInspector
|
||
If inspector IsNot Nothing AndAlso inspector.CurrentItem IsNot Nothing Then
|
||
LOGGER?.Debug("Drop of msg (ActiveInspector.CurrentItem) Fallback")
|
||
SaveMailItemToTemp(inspector.CurrentItem)
|
||
Return True
|
||
Else
|
||
LOGGER?.Warn("Outlook: Keine Auswahl im Explorer und kein ActiveInspector.CurrentItem verfügbar.")
|
||
' Namen loggen – aber zurück zum FileDrop-Fallback
|
||
If hasFileNameW Then
|
||
Dim namesObj As Object = e.Data.GetData(If(e.Data.GetDataPresent("FileNameW"), "FileNameW", "FileName"), True)
|
||
Dim names As String() = TryCast(namesObj, String())
|
||
If names Is Nothing Then
|
||
Dim nameSingle As String = TryCast(namesObj, String)
|
||
If Not String.IsNullOrWhiteSpace(nameSingle) Then
|
||
LOGGER?.Warn("Vorgeschlagener Name (ohne Inhalt): " & nameSingle)
|
||
End If
|
||
Else
|
||
LOGGER?.Warn("Vorgeschlagene Namen (ohne Inhalt): " & String.Join("; ", names))
|
||
End If
|
||
End If
|
||
GoTo CheckFileDrop
|
||
End If
|
||
End If
|
||
Catch ex As System.Exception
|
||
LOGGER?.Warn("Outlook MSG-Drop Fehler: " & ex.Message)
|
||
End Try
|
||
End If
|
||
|
||
CheckFileDrop:
|
||
'4) Filesystem FileDrop (klassisch ODER WebView2 delayed rendering)
|
||
If hasFileDrop Then
|
||
If HandleFileDrop(e) Then Return True
|
||
ScheduleOutlookComFallback()
|
||
Return True
|
||
End If
|
||
|
||
'5) SCAN-StringFormat
|
||
If e.Data.GetDataPresent(DataFormats.StringFormat) Then
|
||
Dim Wert As String = TryCast(e.Data.GetData(DataFormats.StringFormat), String)
|
||
If Not String.IsNullOrEmpty(Wert) Then
|
||
Dim idx As Integer = files_dropped.Length
|
||
ReDim Preserve files_dropped(idx)
|
||
files_dropped(idx) = "@SCAN@" & Wert
|
||
Return True
|
||
End If
|
||
End If
|
||
|
||
Catch ex As System.Exception
|
||
MsgBox("Unexpected Error in Drop_File: " & ex.Message, MsgBoxStyle.Critical)
|
||
End Try
|
||
|
||
LOGGER?.Warn("Drop_File: Kein extrahierbarer Inhalt. Bitte Attachment aus der Nachrichtenliste ziehen oder zunächst speichern.")
|
||
Return False
|
||
|
||
|
||
End Function
|
||
' FileDrop defensiv behandeln – erst ohne, dann mit autoConvert
|
||
Private Shared Function HandleFileDrop(e As DragEventArgs) As Boolean
|
||
Try
|
||
' Versuch1: ohne AutoConvert
|
||
Dim rawObj As Object = e.Data.GetData(DataFormats.FileDrop)
|
||
Dim rawFiles As String() = TryCast(rawObj, String())
|
||
If Not (rawFiles Is Nothing OrElse rawFiles.Length = 0) Then
|
||
For Each f In rawFiles
|
||
LOGGER?.Info("FileDrop (raw) - File: " & f)
|
||
AppendDroppedFile("@DROPFROMFSYSTEM@", f)
|
||
Next
|
||
Return True
|
||
End If
|
||
|
||
' Versuch2: mit AutoConvert (delayed rendering)
|
||
Dim convObj As Object = e.Data.GetData(DataFormats.FileDrop, True)
|
||
Dim convFiles As String() = TryCast(convObj, String())
|
||
If Not (convFiles Is Nothing OrElse convFiles.Length = 0) Then
|
||
For Each f In convFiles
|
||
LOGGER?.Info("FileDrop (autoConvert) - File: " & f)
|
||
AppendDroppedFile("@DROPFROMFSYSTEM@", f)
|
||
Next
|
||
Return True
|
||
End If
|
||
|
||
LOGGER?.Warn("FileDrop vorhanden, aber keine Dateien (raw/autoConvert leer).")
|
||
Return False
|
||
Catch ex As System.Exception
|
||
LOGGER?.Warn("HandleFileDrop Fehler: " & ex.Message)
|
||
Return False
|
||
End Try
|
||
End Function
|
||
Private Shared Sub AppendDroppedFile(prefix As String, filePath As String)
|
||
Dim idx As Integer = files_dropped.Length
|
||
ReDim Preserve files_dropped(idx)
|
||
files_dropped(idx) = prefix & filePath
|
||
End Sub
|
||
|
||
Private Shared Sub SaveMailItemToTemp(ByVal mailObj As Object)
|
||
Dim subj As String = ""
|
||
Try
|
||
subj = mailObj.Subject
|
||
Catch
|
||
subj = "NO_SUBJECT"
|
||
End Try
|
||
If String.IsNullOrWhiteSpace(subj) Then subj = "NO_SUBJECT"
|
||
|
||
Dim safeName = subj.Replace("\", "-").Replace("/", "-").Replace(":", "") _
|
||
.Replace("?", "").Replace("!", "").Replace("%", "").Replace("$", "")
|
||
Dim strFile As String = IO.Path.Combine(Path.GetTempPath(), safeName & ".msg")
|
||
LOGGER?.Info("Drop of msg - File:" & strFile)
|
||
Try
|
||
mailObj.SaveAs(strFile)
|
||
AppendDroppedFile("@OUTLOOK_MESSAGE@", strFile)
|
||
Catch ex As System.Exception
|
||
MsgBox("Error in Save Email2Tempfile" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
|
||
End Try
|
||
End Sub
|
||
|
||
Private Shared Sub ScheduleOutlookComFallback()
|
||
Try
|
||
Dim t As New Threading.Thread(
|
||
Sub()
|
||
Try
|
||
Threading.Thread.Sleep(200)
|
||
Dim maxRetries As Integer = 10
|
||
Dim saved As Boolean = False
|
||
For attempt As Integer = 1 To maxRetries
|
||
If TrySaveSelectedMailViaOutlook() Then
|
||
LOGGER?.Info("Outlook COM Fallback: Mail gespeichert. Versuch " & attempt)
|
||
saved = True
|
||
Exit For
|
||
End If
|
||
LOGGER?.Debug("Outlook COM Fallback: Keine Auswahl, Retry " & attempt)
|
||
Threading.Thread.Sleep(200)
|
||
Next
|
||
|
||
If saved Then
|
||
' UI-Thread benachrichtigen
|
||
Dim uiForm = If(System.Windows.Forms.Application.OpenForms.Count > 0, System.Windows.Forms.Application.OpenForms(0), Nothing)
|
||
If uiForm IsNot Nothing Then
|
||
uiForm.BeginInvoke(
|
||
Sub()
|
||
Try
|
||
RaiseEvent FilesDroppedReady(files_dropped)
|
||
Catch ex2 As System.Exception
|
||
LOGGER?.Warn("FilesDroppedReady Invoke Fehler: " & ex2.Message)
|
||
End Try
|
||
End Sub)
|
||
Else
|
||
' Falls kein Form verfügbar, zumindest Event auslösen (Listener müssen ggf. selbst marshalen)
|
||
RaiseEvent FilesDroppedReady(files_dropped)
|
||
End If
|
||
Else
|
||
LOGGER?.Warn("Outlook COM Fallback: Nach Retries keine Mail gespeichert.")
|
||
End If
|
||
Catch ex As System.Exception
|
||
LOGGER?.Warn("Outlook COM Fallback Thread Fehler: " & ex.Message)
|
||
End Try
|
||
End Sub
|
||
)
|
||
t.IsBackground = True
|
||
t.SetApartmentState(Threading.ApartmentState.STA)
|
||
t.Start()
|
||
Catch ex As System.Exception
|
||
LOGGER?.Warn("ScheduleOutlookComFallback Fehler: " & ex.Message)
|
||
End Try
|
||
End Sub
|
||
|
||
Private Shared Function TrySaveSelectedMailViaOutlook() As Boolean
|
||
Try
|
||
Dim oApp As Outlook.Application = Nothing
|
||
Try
|
||
oApp = New Outlook.Application()
|
||
Catch ex As System.Exception
|
||
LOGGER?.Warn("Outlook COM Init fehlgeschlagen: " & ex.Message)
|
||
Return False
|
||
End Try
|
||
|
||
Dim savedAny As Boolean = False
|
||
|
||
Dim inspector = oApp.ActiveInspector
|
||
If inspector IsNot Nothing AndAlso inspector.CurrentItem IsNot Nothing Then
|
||
LOGGER?.Debug("Fallback: ActiveInspector.CurrentItem speichern")
|
||
SaveMailItemToTemp(inspector.CurrentItem)
|
||
savedAny = True
|
||
End If
|
||
|
||
If Not savedAny Then
|
||
Dim explorer = oApp.ActiveExplorer
|
||
If explorer IsNot Nothing AndAlso explorer.Selection IsNot Nothing AndAlso explorer.Selection.Count > 0 Then
|
||
LOGGER?.Debug("Fallback: Explorer.Selection speichern")
|
||
For i As Integer = 1 To explorer.Selection.Count
|
||
Dim myobj As Object = explorer.Selection.Item(i)
|
||
If myobj Is Nothing Then Continue For
|
||
SaveMailItemToTemp(myobj)
|
||
savedAny = True
|
||
Next
|
||
End If
|
||
End If
|
||
|
||
Return savedAny
|
||
Catch ex As System.Exception
|
||
LOGGER?.Warn("TrySaveSelectedMailViaOutlook Fehler: " & ex.Message)
|
||
Return False
|
||
End Try
|
||
End Function
|
||
|
||
Public Shared Sub Drag_enter(e As DragEventArgs)
|
||
Try
|
||
My.Settings.WD_INDEXDOKART_SAVE = ""
|
||
|
||
Dim hasOutlookUnicode As Boolean = e.Data.GetDataPresent("FileGroupDescriptorW")
|
||
Dim hasOutlookAnsi As Boolean = e.Data.GetDataPresent("FileGroupDescriptor")
|
||
Dim hasOutlookDescriptor As Boolean = hasOutlookUnicode OrElse hasOutlookAnsi
|
||
|
||
Dim hasChromiumMime As Boolean = e.Data.GetDataPresent("Chromium Web Custom MIME Data Format")
|
||
Dim hasFileNameW As Boolean = e.Data.GetDataPresent("FileNameW") OrElse e.Data.GetDataPresent("FileName")
|
||
Dim hasOutlookLike As Boolean = hasOutlookDescriptor OrElse hasChromiumMime OrElse hasFileNameW
|
||
|
||
Dim hasFileDrop As Boolean = e.Data.GetDataPresent(DataFormats.FileDrop)
|
||
|
||
If hasOutlookLike Then
|
||
e.Effect = DragDropEffects.Copy
|
||
LOGGER?.Debug("DragEnter ... Outlook/WebView2 erkannt (Descriptor/Chromium/FileNameW)")
|
||
ElseIf hasFileDrop Then
|
||
e.Effect = DragDropEffects.Copy
|
||
LOGGER?.Debug("DragEnter ... SimpleFileDrop")
|
||
Else
|
||
e.Effect = DragDropEffects.None
|
||
LOGGER?.Debug("DragEnter ... Other FileFormat")
|
||
End If
|
||
|
||
LOGGER?.Debug("DragEnter Formats: " & String.Join(", ", e.Data.GetFormats()))
|
||
Catch ex As System.Exception
|
||
|
||
End Try
|
||
End Sub
|
||
|
||
End Class
|