Drag and Drop Outlook und NodeNavigation Testbutton entfernt

This commit is contained in:
Developer01
2025-12-18 16:25:09 +01:00
parent 5dfa7d1421
commit 93645962a6
3 changed files with 356 additions and 287 deletions

View File

@@ -1,181 +1,299 @@
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 = Nothing
files_dropped = New String() {}
Dim Sql As String = "DELETE FROM TBPMO_FILES_USER WHERE HANDLE_TYPE <> 'SCAN' AND USER_WORK = '" & USER_USERNAME & "'"
MYDB_ECM.ExecuteNonQuery(sql)
' 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)
If e.Data.GetDataPresent(DataFormats.FileDrop) Then
LOGGER.Debug("Simple File Drop")
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()
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() & stbFileName.ToString()
'// 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
LOGGER.Debug("Drag of Outlook Attachment")
'// 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 = ClassHelper.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.Debug("Drop an Attachment - File: " & strOutFile)
Return True
Else
LOGGER.Warn("Attachment File from Outlook could not be created")
End If
Else
LOGGER.Warn("No simple drag and drop.", True)
For Each fmt As String In e.Data.GetFormats()
' Output format name and type
LOGGER.Warn("e.Data is: " & fmt + " (" +
e.Data.GetData(fmt).ToString() + ")", True)
Next
End If
'1) Klassische Outlook-Attachments: Descriptor + Contents
If (hasOutlookUnicode OrElse hasOutlookAnsi) AndAlso hasOutlookContents Then
' ... dein bestehender Descriptor/Contents-Code ...
' Return True wenn erfolgreich
End If
If e.Data.GetDataPresent("FileGroupDescriptor") Then
Dim oApp
'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
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")
Return False
End Try
LOGGER.Debug("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
'hardcode a destination path for testing
Dim strFile As String = IO.Path.Combine(Path.GetTempPath, (subj + ".msg").Replace(":", ""))
strFile = strFile.Replace("?", "")
strFile = strFile.Replace("!", "")
strFile = strFile.Replace("%", "")
strFile = strFile.Replace("$", "")
LOGGER.Info("Drop of msg - File:" & strFile)
Dim oApp As Outlook.Application = Nothing
Try
myobj.SaveAs(strFile)
Catch ex As Exception
MsgBox("Error in Save Email2Tempfile" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
Return False
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
ReDim Preserve files_dropped(i)
files_dropped(i) = "@OUTLOOK_MESSAGE@" & strFile
Next
Return True
'Drop eines Outlook Attachments
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
Catch ex As Exception
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
If e.Data.GetDataPresent(DataFormats.StringFormat) Then
Dim Wert As String = CType(e.Data.GetData(DataFormats.StringFormat), Object)
Console.WriteLine(Wert)
ReDim Preserve files_dropped(0)
files_dropped(0) = "@SCAN@" & Wert
Return True
End If
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 = ""
If e.Data.GetDataPresent(DataFormats.FileDrop) Then
e.Effect = DragDropEffects.All
LOGGER.Debug("DragEnter ... SimpleFileDrop")
'frmForm_Constructor_Main_2.tslblStatusMain_show(True, "DragEnter ... SimpleFileDrop")
ElseIf (e.Data.GetDataPresent("FileGroupDescriptor")) AndAlso (e.Data.GetDataPresent("FileContents")) Then
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
'frmForm_Constructor_Main_2.tslblStatusMain_show(True, "DragEnter ... Attachment from Outlook")
LOGGER.Debug("DragEnter ... Attachment from Outlook")
ElseIf e.Data.GetDataPresent("FileGroupDescriptor") Then
'handle a message dragged from Outlook
LOGGER?.Debug("DragEnter ... Outlook/WebView2 erkannt (Descriptor/Chromium/FileNameW)")
ElseIf hasFileDrop Then
e.Effect = DragDropEffects.Copy
'frmForm_Constructor_Main_2.tslblStatusMain_show(True, "DragEnter ... OutlookMessage")
LOGGER.Debug("DragEnter ... OutlookMessage")
LOGGER?.Debug("DragEnter ... SimpleFileDrop")
Else
'otherwise, do not handle
e.Effect = DragDropEffects.Copy
'frmForm_Constructor.tslblStatusMain_show(True, "DragEnter ... Other FileFormat")
LOGGER.Debug("DragEnter ... Other FileFormat")
e.Effect = DragDropEffects.None
LOGGER?.Debug("DragEnter ... Other FileFormat")
End If
Catch ex As Exception
LOGGER?.Debug("DragEnter Formats: " & String.Join(", ", e.Data.GetFormats()))
Catch ex As System.Exception
End Try
End Sub
End Class