AppStd/RecordOrganizer
8
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Release für ewa

Browse Source
This commit is contained in:
Developer01
2026-03-24 12:42:53 +01:00
parent 1469063ad7
commit e9cb352674
18 changed files with 1585 additions and 314 deletions
Download Patch File Download Diff File Expand all files Collapse all files

166
app/DD-Record-Organizer/Classes/ClassDragDrop.vb
View File

@@ -5,6 +5,131 @@ Imports Microsoft.Office.Interop.Outlook
Public Class ClassDragDrop
Public Shared files_dropped As String()
Public Shared Event FilesDroppedReady(ByVal files As String())
''' <summary>
''' Eindeutiges Drag-Format für DocID-Transfers zwischen frmNodeNavigation-Instanzen.
''' Muss mit frmNodeNavigation.DRAGDROP_FORMAT_DOCID identisch sein.
''' </summary>
Public Shared ReadOnly DRAGDROP_FORMAT_DOCID As String = "DD_RecordOrganizer_DocID"
''' <summary>
''' Zeichen, die im Dateinamen Probleme bei DB-Import und Dateihandling verursachen können.
''' </summary>
Private Shared ReadOnly ProblematicChars As Char() = {
"'"c, "`"c, ";"c, "%"c, "&"c, "+"c, "#"c, "~"c,
"{"c, "}"c, "["c, "]"c, "^"c, "="c, "@"c
}
Private Shared Function CheckAndSanitizeFilename(filePath As String) As String
Try
Dim dir As String = Path.GetDirectoryName(filePath)
Dim originalName As String = Path.GetFileNameWithoutExtension(filePath)
Dim ext As String = Path.GetExtension(filePath)
' ── 1) Unicode-Normalisierung NFD → NFC ──────────────────────────────
Dim normalizedName As String = originalName.Normalize(System.Text.NormalizationForm.FormC)
Dim hadNormalizationIssue As Boolean = (normalizedName <> originalName)
If hadNormalizationIssue Then
LOGGER?.Warn($"CheckAndSanitizeFilename: NFD-Encoding erkannt in [{originalName}{ext}]")
Dim normMsg As String
If USER_LANGUAGE <> "de-DE" Then
normMsg = $"The filename contains Unicode characters in decomposed form (NFD encoding)." &
vbCrLf & vbCrLf &
$"File: {originalName}{ext}" & vbCrLf & vbCrLf &
"This causes garbled characters in the database (e.g. ü → Ru¨ckbau)." & vbCrLf & vbCrLf &
"Please rename the file and try again." & vbCrLf &
"The import of this file has been aborted."
Else
normMsg = $"Der Dateiname enthält nicht sichtbare Unicode-Zeichen in dekomponiierter Form (NFD-Kodierung)." &
vbCrLf & vbCrLf &
$"Datei: {originalName}{ext}" & vbCrLf & vbCrLf &
"Dies kann zu kryptischen Zeichen in der Datenbank (z.B. ü → Ru¨ckbau) oder Problemen beim Import nach windream führen." & vbCrLf & vbCrLf &
"Ursache dafür kann sein, das die Datei aus einer NICHT Windows Umgebung erstellt wurde. (MacOS, Linux etc)" & vbCrLf &
"Bitte benennen Sie die Datei um und versuchen Sie es erneut." & vbCrLf &
"Der Import dieser Datei wurde abgebrochen."
End If
Dim normCaption As String = If(USER_LANGUAGE <> "de-DE", "Invalid Filename", "Ungültiger Dateiname")
MessageBox.Show(normMsg, normCaption, MessageBoxButtons.OK, MessageBoxIcon.Warning)
LOGGER?.Warn($"CheckAndSanitizeFilename: Import abgebrochen wegen NFD-Problem [{originalName}{ext}].")
Return Nothing
End If
' ── 2) Leerzeichen-Probleme prüfen (führend, abschließend, doppelt) ──
Dim hasLeadingOrTrailingSpace As Boolean = (originalName <> originalName.Trim())
Dim hasDoubleSpace As Boolean = originalName.Contains(" ") ' zwei aufeinanderfolgende Leerzeichen
If hasLeadingOrTrailingSpace OrElse hasDoubleSpace Then
LOGGER?.Warn($"CheckAndSanitizeFilename: Leerzeichen-Problem in [{originalName}{ext}]")
Dim spaceMsg As String
If USER_LANGUAGE <> "de-DE" Then
spaceMsg = $"The filename contains leading, trailing or consecutive spaces:" &
vbCrLf & vbCrLf &
$"File: ""{originalName}{ext}""" & vbCrLf & vbCrLf &
"This can cause problems during database import or file comparisons." & vbCrLf & vbCrLf &
"Please rename the file (remove extra spaces) and try again." & vbCrLf &
"The import of this file has been aborted."
Else
spaceMsg = $"Der Dateiname enthält führende, abschließende oder doppelte Leerzeichen:" &
vbCrLf & vbCrLf &
$"Datei: ""{originalName}{ext}""" & vbCrLf & vbCrLf &
"Dies kann beim Datenbankimport oder Dateivergleichen zu Problemen führen." & vbCrLf & vbCrLf &
"Bitte benennen Sie die Datei um (Leerzeichen entfernen) und versuchen Sie es erneut." & vbCrLf &
"Der Import dieser Datei wurde abgebrochen."
End If
Dim spaceCaption As String = If(USER_LANGUAGE <> "de-DE", "Invalid Filename", "Ungültiger Dateiname")
MessageBox.Show(spaceMsg, spaceCaption, MessageBoxButtons.OK, MessageBoxIcon.Warning)
LOGGER?.Warn($"CheckAndSanitizeFilename: Import abgebrochen wegen Leerzeichen-Problem [{originalName}{ext}].")
Return Nothing
End If
' ── 3) Problematische Sonderzeichen prüfen ───────────────────────────
Dim found As New System.Text.StringBuilder()
For Each c As Char In ProblematicChars
If originalName.IndexOf(c) >= 0 Then
If found.Length > 0 Then found.Append(" ")
found.Append($"'{c}'")
End If
Next
If found.Length = 0 Then
Return filePath
End If
LOGGER?.Warn($"CheckAndSanitizeFilename: Problematische Zeichen in [{originalName}{ext}]: {found}")
Dim msg As String
If USER_LANGUAGE <> "de-DE" Then
msg = $"The filename contains characters that cause problems during database import or file handling:" &
vbCrLf & vbCrLf &
$"File: {originalName}{ext}" & vbCrLf &
$"Problematic chars: {found}" & vbCrLf & vbCrLf &
"Please rename the file and try again." & vbCrLf &
"The import of this file has been aborted."
Else
msg = $"Der Dateiname enthält nicht sichtbare Zeichen, die beim Datenbankimport oder späteren Dateihandling in windream Probleme verursachen:" &
vbCrLf & vbCrLf &
$"Datei: {originalName}{ext}" & vbCrLf &
$"Problematische Zeichen: {found}" & vbCrLf & vbCrLf &
"Ursache dafür kann sein, das die Datei aus einer NICHT Windows Umgebung erstellt wurde. (MacOS, Linux etc)" & vbCrLf &
"Bitte benennen Sie die Datei um und versuchen Sie es erneut." & vbCrLf &
"Der Import dieser Datei wurde abgebrochen."
End If
Dim caption As String = If(USER_LANGUAGE <> "de-DE", "Invalid Filename", "Ungültiger Dateiname")
MessageBox.Show(msg, caption, MessageBoxButtons.OK, MessageBoxIcon.Warning)
LOGGER?.Warn($"CheckAndSanitizeFilename: Import abgebrochen für [{originalName}{ext}].")
Return Nothing
Catch ex As System.Exception
LOGGER?.Warn("CheckAndSanitizeFilename Fehler: " & ex.Message)
Return filePath
End Try
End Function
Public Shared Function Drop_File(e As DragEventArgs)
Try
LOGGER.Debug("In Drop_File....")
@@ -12,10 +137,6 @@ Public Class ClassDragDrop
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")
@@ -30,16 +151,14 @@ Public Class ClassDragDrop
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.
Return True
End If
'3) Outlook Mail (.msg): Descriptor ohne Contents ODER Chromium/WebView2 Indikatoren – nur wenn KEIN FileDrop vorhanden
@@ -70,7 +189,6 @@ Public Class ClassDragDrop
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())
@@ -116,13 +234,11 @@ CheckFileDrop:
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
@@ -133,7 +249,6 @@ CheckFileDrop:
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
@@ -151,11 +266,21 @@ CheckFileDrop:
Return False
End Try
End Function
Private Shared Sub AppendDroppedFile(prefix As String, filePath As String)
''' <summary>
''' Hängt eine Datei an files_dropped an – mit vorheriger Sonderzeichen-Prüfung.
''' Gibt False zurück wenn der Dateiname ungültig ist.
''' </summary>
Private Shared Function AppendDroppedFile(prefix As String, filePath As String) As Boolean
Dim checkedPath As String = CheckAndSanitizeFilename(filePath)
If checkedPath Is Nothing Then
Return False
End If
Dim idx As Integer = files_dropped.Length
ReDim Preserve files_dropped(idx)
files_dropped(idx) = prefix & filePath
End Sub
files_dropped(idx) = prefix & checkedPath
Return True
End Function
Private Shared Sub SaveMailItemToTemp(ByVal mailObj As Object)
Dim subj As String = ""
@@ -197,7 +322,6 @@ CheckFileDrop:
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(
@@ -209,7 +333,6 @@ CheckFileDrop:
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
@@ -270,6 +393,12 @@ CheckFileDrop:
Public Shared Sub Drag_enter(e As DragEventArgs)
Try
My.Settings.WD_INDEXDOKART_SAVE = ""
' ✅ DocID-Format hat Vorrang – Early Exit
If e.Data.GetDataPresent(DRAGDROP_FORMAT_DOCID) Then
e.Effect = DragDropEffects.Copy
LOGGER?.Debug("DragEnter ... DocID-Format erkannt (Inter-Instance Transfer)")
Return
End If
Dim hasOutlookUnicode As Boolean = e.Data.GetDataPresent("FileGroupDescriptorW")
Dim hasOutlookAnsi As Boolean = e.Data.GetDataPresent("FileGroupDescriptor")
@@ -297,5 +426,4 @@ CheckFileDrop:
End Try
End Sub
End Class
End Class