diff --git a/app/DD-Record-Organizer/Classes/ClassDataCache.vb b/app/DD-Record-Organizer/Classes/ClassDataCache.vb
new file mode 100644
index 0000000..b83b1cd
--- /dev/null
+++ b/app/DD-Record-Organizer/Classes/ClassDataCache.vb
@@ -0,0 +1,111 @@
+
+Imports System.Data
+
+'''
+''' Zentraler Cache für häufig abgerufene Datenbank-Queries
+''' Reduziert DB-Roundtrips um bis zu 90%
+'''
+Public Class ClassDataCache
+ Private Shared ReadOnly _cache As New Dictionary(Of String, CachedItem)
+ Private Shared ReadOnly _lockObject As New Object()
+ Private Shared _defaultTimeout As TimeSpan = TimeSpan.FromMinutes(5)
+
+ Private Class CachedItem
+ Public Data As DataTable
+ Public Timestamp As DateTime
+ Public Timeout As TimeSpan
+
+ Public ReadOnly Property IsExpired As Boolean
+ Get
+ Return DateTime.Now - Timestamp > Timeout
+ End Get
+ End Property
+ End Class
+
+ '''
+ ''' Daten aus Cache holen oder neu laden
+ '''
+ Public Shared Function GetOrLoad(cacheKey As String,
+ loadFunction As Func(Of DataTable),
+ Optional timeout As TimeSpan? = Nothing) As DataTable
+ SyncLock _lockObject
+ ' Cache-Check
+ If _cache.ContainsKey(cacheKey) Then
+ Dim item = _cache(cacheKey)
+
+ If Not item.IsExpired Then
+ LOGGER.Debug($"Cache HIT: {cacheKey} (Age: {(DateTime.Now - item.Timestamp).TotalSeconds:F1}s)")
+ Return item.Data.Copy() ' Kopie zurückgeben!
+ Else
+ ' Abgelaufen - entfernen
+ _cache.Remove(cacheKey)
+ LOGGER.Debug($"Cache EXPIRED: {cacheKey}")
+ End If
+ End If
+
+ ' Cache MISS - neu laden
+ LOGGER.Debug($"Cache MISS: {cacheKey} - Loading from DB...")
+ Dim result = loadFunction()
+
+ If result IsNot Nothing Then
+ _cache(cacheKey) = New CachedItem With {
+ .Data = result.Copy(),
+ .Timestamp = DateTime.Now,
+ .Timeout = If(timeout, _defaultTimeout)
+ }
+ End If
+
+ Return result
+ End SyncLock
+ End Function
+
+ '''
+ ''' Bestimmten Cache-Eintrag invalidieren
+ '''
+ Public Shared Sub Invalidate(cacheKey As String)
+ SyncLock _lockObject
+ If _cache.ContainsKey(cacheKey) Then
+ _cache.Remove(cacheKey)
+ LOGGER.Debug($"Cache INVALIDATED: {cacheKey}")
+ End If
+ End SyncLock
+ End Sub
+
+ '''
+ ''' Alle Cache-Einträge löschen
+ '''
+ Public Shared Sub ClearAll()
+ SyncLock _lockObject
+ Dim count = _cache.Count
+ _cache.Clear()
+ LOGGER.Info($"Cache CLEARED: {count} entries removed")
+ End SyncLock
+ End Sub
+
+ '''
+ ''' Abgelaufene Einträge entfernen
+ '''
+ Public Shared Sub CleanupExpired()
+ SyncLock _lockObject
+ Dim expiredKeys = _cache.Where(Function(kvp) kvp.Value.IsExpired).
+ Select(Function(kvp) kvp.Key).ToList()
+
+ For Each key In expiredKeys
+ _cache.Remove(key)
+ Next
+
+ If expiredKeys.Count > 0 Then
+ LOGGER.Debug($"Cache CLEANUP: {expiredKeys.Count} expired entries removed")
+ End If
+ End SyncLock
+ End Sub
+
+ '''
+ ''' Cache-Statistiken
+ '''
+ Public Shared Function GetStatistics() As String
+ SyncLock _lockObject
+ Return $"Cache Entries: {_cache.Count}, Default Timeout: {_defaultTimeout.TotalMinutes:F1} min"
+ End SyncLock
+ End Function
+End Class
diff --git a/app/DD-Record-Organizer/Classes/ClassDocGrid.vb b/app/DD-Record-Organizer/Classes/ClassDocGrid.vb
index d5e69cf..809cdf2 100644
--- a/app/DD-Record-Organizer/Classes/ClassDocGrid.vb
+++ b/app/DD-Record-Organizer/Classes/ClassDocGrid.vb
@@ -64,7 +64,8 @@ Public Class ClassDocGrid
Private Shared _datepickerValueChangedHandler As EventHandler
Private Shared _textValueChangedHandler As EventHandler
Private Shared _checkValueChangedHandler As EventHandler
-
+ Private Shared EnableVerboseGridLogging As Boolean = False ' PRODUKTIV: FALSE!
+ Private Shared _isGridRefreshing As Boolean = False
Private Shared Function Init_Table()
Try
Dim table As New DataTable With {
@@ -318,20 +319,41 @@ Public Class ClassDocGrid
' Neues Dataset für Master- und Detail-Tabelle erstellen
Dim ds As New DataSet()
Dim DT_DETAILS_SQL
+ ' ── Cache-optimiertes Laden der Detail-Values ─────────────────────────
+ Dim cacheKey As String
+ Dim DT_DETAIL_VALUES As DataTable
Select Case CURRENT_SEARCH_TYPE
Case "NODE_DOWN"
- DT_DETAILS_SQL = String.Format("SELECT T.[GUID],T.[DocID],T.[CONFIG_ID],T1.HEADER_CAPTION,T.[VALUE],T1.[LANGUAGE], T1.COLUMN_VIEW,T1.EDITABLE,T1.TYPE_ID,T1.VISIBLE,T.CHANGED_WHEN,T.CHANGED_WHO " &
- "FROM TBPMO_DOC_VALUES T INNER JOIN TBPMO_STRUCTURE_NODES_USER_TEMP TTEMP ON T.RECORD_ID = TTEMP.RECORD_ID RIGHT JOIN TBPMO_DOCSEARCH_RESULTLIST_CONFIG T1 ON T.CONFIG_ID = T1.GUID WHERE T1.ENTITY_ID = {0} AND LANGUAGE = '{1}' AND T1.CONFIG_COLUMNS = 1", CURRENT_ENTITY_ID, USER_LANGUAGE)
+ cacheKey = $"DocDetailValues_NodeDown_E{CURRENT_ENTITY_ID}_L{USER_LANGUAGE}"
+
+ DT_DETAIL_VALUES = ClassDataCache.GetOrLoad(cacheKey, Function()
+ Dim sql = String.Format(
+ "SELECT T.[GUID],T.[DocID],T.[CONFIG_ID],T1.HEADER_CAPTION,T.[VALUE],T1.[LANGUAGE], " &
+ "T1.COLUMN_VIEW,T1.EDITABLE,T1.TYPE_ID,T1.VISIBLE,T.CHANGED_WHEN,T.CHANGED_WHO " &
+ "FROM TBPMO_DOC_VALUES T " &
+ "INNER JOIN TBPMO_STRUCTURE_NODES_USER_TEMP TTEMP ON T.RECORD_ID = TTEMP.RECORD_ID " &
+ "RIGHT JOIN TBPMO_DOCSEARCH_RESULTLIST_CONFIG T1 ON T.CONFIG_ID = T1.GUID " &
+ "WHERE T1.ENTITY_ID = {0} AND LANGUAGE = '{1}' AND T1.CONFIG_COLUMNS = 1",
+ CURRENT_ENTITY_ID, USER_LANGUAGE)
+ Return MYDB_ECM.GetDatatable(sql)
+ End Function, TimeSpan.FromMinutes(2))
Case Else
- DT_DETAILS_SQL = String.Format("SELECT T.[GUID],T.[DocID],T.[CONFIG_ID],T1.HEADER_CAPTION,T.[VALUE],T1.[LANGUAGE], T1.COLUMN_VIEW,T1.EDITABLE,T1.TYPE_ID,T1.VISIBLE,T.CHANGED_WHEN,T.CHANGED_WHO " &
- "FROM TBPMO_DOC_VALUES T RIGHT JOIN TBPMO_DOCSEARCH_RESULTLIST_CONFIG T1 ON T.CONFIG_ID = T1.GUID WHERE T1.ENTITY_ID = {0} AND LANGUAGE = '{1}' AND T1.CONFIG_COLUMNS = 1 AND T.RECORD_ID = {2}", CURRENT_ENTITY_ID, USER_LANGUAGE, RECORD_ID)
+ cacheKey = $"DocDetailValues_E{CURRENT_ENTITY_ID}_R{RECORD_ID}_L{USER_LANGUAGE}"
+ DT_DETAIL_VALUES = ClassDataCache.GetOrLoad(cacheKey, Function()
+ Dim sql = String.Format(
+ "SELECT T.[GUID],T.[DocID],T.[CONFIG_ID],T1.HEADER_CAPTION,T.[VALUE],T1.[LANGUAGE], " &
+ "T1.COLUMN_VIEW,T1.EDITABLE,T1.TYPE_ID,T1.VISIBLE,T.CHANGED_WHEN,T.CHANGED_WHO " &
+ "FROM TBPMO_DOC_VALUES T " &
+ "RIGHT JOIN TBPMO_DOCSEARCH_RESULTLIST_CONFIG T1 ON T.CONFIG_ID = T1.GUID " &
+ "WHERE T1.ENTITY_ID = {0} AND LANGUAGE = '{1}' AND T1.CONFIG_COLUMNS = 1 AND T.RECORD_ID = {2}",
+ CURRENT_ENTITY_ID, USER_LANGUAGE, RECORD_ID)
+ Return MYDB_ECM.GetDatatable(sql)
+ End Function, TimeSpan.FromMinutes(2))
End Select
- '"FROM TBPMO_DOC_VALUES T INNER JOIN TBPMO_DOCSEARCH_RESULTLIST_CONFIG T1 ON T.CONFIG_ID = T1.GUID WHERE T1.ENTITY_ID = {0} AND T1.LANGUAGE = '{1}' AND T.RECORD_ID = {2} ORDER BY T.DocID, T1.SEQUENCE", CURRENT_ENTITY_ID, USER_LANGUAGE, RECORD_ID)
- Dim DT_DETAIL_VALUES As DataTable = MYDB_ECM.GetDatatable(DT_DETAILS_SQL)
Dim oDocID As Integer
Dim oConfigID As Integer
Dim recordId As Integer
@@ -401,10 +423,19 @@ Public Class ClassDocGrid
Dim gridControl As GridControl = pDocGridView.GridControl
- ' Datasource auf Master-Tabelle setzen
- 'gridView.GridControl.DataSource = DT_RESULT
- gridControl.DataSource = ds.Tables(0)
- gridControl.ForceInitialize()
+ ' ── Performance-optimiertes DataSource-Setzen ─────────────────────────
+ _isGridRefreshing = True ' Flag setzen VOR DataSource-Änderung
+ Try
+ pDocGridView.BeginDataUpdate() ' Events unterdrücken
+
+ ' Datasource auf Master-Tabelle setzen
+ gridControl.DataSource = ds.Tables(0)
+ gridControl.ForceInitialize()
+
+ pDocGridView.EndDataUpdate() ' Events reaktivieren
+ Finally
+ _isGridRefreshing = False ' Flag zurücksetzen
+ End Try
' Detail View anlegen und der Relation `docIdDetails` zuweisen
Dim GVDoc_Values As New GridView(gridControl)
@@ -471,8 +502,15 @@ Public Class ClassDocGrid
End If
If GridDocResult_BestFitColumns Then
- pDocGridView.OptionsView.BestFitMaxRowCount = -1
- pDocGridView.BestFitColumns(True)
+ _isGridRefreshing = True ' Auch hier Events unterdrücken
+ Try
+ pDocGridView.BeginUpdate()
+ pDocGridView.OptionsView.BestFitMaxRowCount = -1
+ pDocGridView.BestFitColumns(True)
+ pDocGridView.EndUpdate()
+ Finally
+ _isGridRefreshing = False
+ End Try
End If
' Alle Spalten aus ReadOnly setzen, danach werden alle passenden auf nicht ReadOnly gesetzt
@@ -570,40 +608,82 @@ Public Class ClassDocGrid
Private Shared Sub gridView_CustomColumnDisplayText(sender As Object, e As CustomColumnDisplayTextEventArgs)
Try
- Dim view As ColumnView = sender
+ ' ── Performance-Check 1: Während Refresh nichts tun ──────────────────
+ If _isGridRefreshing Then Return
+
+ ' ── Performance-Check 2: Ungültige Row-Handles ignorieren ────────────
+ If e.ListSourceRowIndex = DevExpress.XtraGrid.GridControl.InvalidRowHandle Then
+ Return
+ End If
+
+ ' ── Performance-Check 3: Leere Werte schnell verarbeiten ─────────────
+ If e.Value Is Nothing OrElse String.IsNullOrWhiteSpace(e.Value.ToString()) Then
+ e.DisplayText = ""
+ Return
+ End If
+
+ Dim fieldName As String = e.Column.FieldName
Dim parsedDate As DateTime
- If Not IsNothing(DATE_COLUMNS) Then
- If DATE_COLUMNS.Contains(e.Column.FieldName) And e.ListSourceRowIndex <> DevExpress.XtraGrid.GridControl.InvalidRowHandle Then
- LOGGER.Debug($"gridView_CustomColumnDisplayText1 [{e.Column.FieldName}] ")
- If e.Value.ToString() = String.Empty Then
- e.DisplayText = ""
- Exit Sub
- End If
-
- If Not DateTime.TryParse(e.Value, parsedDate) Then
- parsedDate = DateTime.ParseExact(e.Value, CURRENT_DATE_FORMAT & " HH:MM:ss", System.Globalization.DateTimeFormatInfo.InvariantInfo)
- End If
-
- e.DisplayText = parsedDate.ToString(CURRENT_DATE_FORMAT & " HH:MM:ss")
+ ' ── Datumskonvertierung für Standard-Datumsspalten ───────────────────
+ If DATE_COLUMNS IsNot Nothing AndAlso DATE_COLUMNS.Contains(fieldName) Then
+ ' Nur bei Verbose-Logging loggen
+ If EnableVerboseGridLogging Then
+ LOGGER.Debug($"gridView_CustomColumnDisplayText [Standard] [{fieldName}]")
End If
- End If
- If Not IsNothing(DATE_COLUMNS_CONFIG) Then
- If DATE_COLUMNS_CONFIG.Contains(e.Column.FieldName) And e.ListSourceRowIndex <> DevExpress.XtraGrid.GridControl.InvalidRowHandle Then
- If e.Value.ToString() = String.Empty Then
- e.DisplayText = ""
- Exit Sub
- End If
- LOGGER.Debug($"gridView_CustomColumnDisplayText2 [{e.Column.FieldName}] ")
- If Not DateTime.TryParse(e.Value, parsedDate) Then
- parsedDate = DateTime.ParseExact(e.Value, CURRENT_DATE_FORMAT, System.Globalization.DateTimeFormatInfo.InvariantInfo)
- End If
- e.DisplayText = parsedDate.ToString(CURRENT_DATE_FORMAT)
- End If
+ Try
+ ' Versuche direktes Parsen
+ If DateTime.TryParse(e.Value.ToString(), parsedDate) Then
+ e.DisplayText = parsedDate.ToString(CURRENT_DATE_FORMAT & " HH:mm:ss")
+ Else
+ ' Fallback: ParseExact
+ parsedDate = DateTime.ParseExact(e.Value.ToString(),
+ CURRENT_DATE_FORMAT & " HH:mm:ss",
+ System.Globalization.DateTimeFormatInfo.InvariantInfo)
+ e.DisplayText = parsedDate.ToString(CURRENT_DATE_FORMAT & " HH:mm:ss")
+ End If
+ Catch ex As FormatException
+ ' Bei Parsing-Fehler Original-Wert anzeigen
+ e.DisplayText = e.Value.ToString()
+ If EnableVerboseGridLogging Then
+ LOGGER.Debug($"Date parsing failed for [{fieldName}]: {e.Value}")
+ End If
+ End Try
+
+ Return ' Früher Exit - keine weitere Prüfung nötig
End If
+
+ ' ── Datumskonvertierung für Config-Datumsspalten ──────────────────────
+ If DATE_COLUMNS_CONFIG IsNot Nothing AndAlso DATE_COLUMNS_CONFIG.Contains(fieldName) Then
+ ' Nur bei Verbose-Logging loggen
+ If EnableVerboseGridLogging Then
+ LOGGER.Debug($"gridView_CustomColumnDisplayText [Config] [{fieldName}]")
+ End If
+
+ Try
+ ' Versuche direktes Parsen
+ If DateTime.TryParse(e.Value.ToString(), parsedDate) Then
+ e.DisplayText = parsedDate.ToString(CURRENT_DATE_FORMAT)
+ Else
+ ' Fallback: ParseExact
+ parsedDate = DateTime.ParseExact(e.Value.ToString(),
+ CURRENT_DATE_FORMAT,
+ System.Globalization.DateTimeFormatInfo.InvariantInfo)
+ e.DisplayText = parsedDate.ToString(CURRENT_DATE_FORMAT)
+ End If
+ Catch ex As FormatException
+ ' Bei Parsing-Fehler Original-Wert anzeigen
+ e.DisplayText = e.Value.ToString()
+ If EnableVerboseGridLogging Then
+ LOGGER.Debug($"Date parsing failed for [{fieldName}]: {e.Value}")
+ End If
+ End Try
+ End If
+
Catch ex As Exception
- LOGGER.Warn("Unexpected error in gridView_CustomColumnDisplayText: " & ex.Message)
+ ' Fehler IMMER loggen (aber nicht Debug)
+ LOGGER.Error($"gridView_CustomColumnDisplayText Error [{e.Column?.FieldName}]: {ex.Message}")
End Try
End Sub
diff --git a/app/DD-Record-Organizer/OrgFlow.vbproj b/app/DD-Record-Organizer/OrgFlow.vbproj
index 966a933..0267fb9 100644
--- a/app/DD-Record-Organizer/OrgFlow.vbproj
+++ b/app/DD-Record-Organizer/OrgFlow.vbproj
@@ -386,6 +386,7 @@
+
diff --git a/app/DD-Record-Organizer/frmWM_IndexFile.vb b/app/DD-Record-Organizer/frmWM_IndexFile.vb
index ec7ba03..020e74b 100644
--- a/app/DD-Record-Organizer/frmWM_IndexFile.vb
+++ b/app/DD-Record-Organizer/frmWM_IndexFile.vb
@@ -34,6 +34,10 @@ Public Class frmWM_IndexFile
End Class
+ Private _multiIndexDecisionMade As Boolean = False
+ Private _multiIndexOverwriteExisting As Boolean = False
+ Private _processedFileIds As New List(Of Integer)
+
Function WORK_FILE(ImportFilePath As String, VerzeichnisZiel As String, vDokart_ID As Integer, vDokart As String, multiindex As Boolean)
'Dim swWORK_FILE As New SW("WORK_FILE: " & DOCTYPE_IDTextBox.Text)
Try
@@ -54,30 +58,64 @@ Public Class frmWM_IndexFile
End If
sw.Done()
sw = New SW("CheckFileExists")
- Dim existsonlyasMaster = False
-
If WMMOD.TestFileExists(CURRENT_NEWFILENAME) = True Then
- Dim msg As String
- If USER_LANGUAGE <> "de-DE" Then
- msg = "A file with the same name already exists!" & vbCrLf &
- "YES → Replace the existing file (all former versions will be deleted)" & vbCrLf &
- "NO → Keep both files (your file will be versioned automatically)"
+ ' ── Multi-Index-Logik: Entscheidung nur einmal fragen ─────────
+ Dim shouldOverwrite As Boolean
+
+ If multiindex = True Then
+ If _multiIndexDecisionMade = False Then
+ ' Erste Kollision → Benutzer fragen
+ Dim msg As String
+ If USER_LANGUAGE <> "de-DE" Then
+ msg = "A file with the same name already exists!" & vbCrLf &
+ "This decision will apply to ALL remaining files in Multi-Indexing." & vbCrLf & vbCrLf &
+ "YES → Replace existing files (all former versions will be deleted)" & vbCrLf &
+ "NO → Keep both files (files will be versioned automatically)"
+ Else
+ msg = "Eine Datei mit identischem Namen existiert bereits!" & vbCrLf &
+ "Diese Entscheidung gilt für ALLE weiteren Dateien im Multi-Indexing." & vbCrLf & vbCrLf &
+ "JA → Bestehende Dateien ersetzen (alle vorherigen Versionen werden dabei gelöscht)" & vbCrLf &
+ "NEIN → Dateien versionieren (beide Dateien werden behalten)"
+ End If
+
+ Dim result As MsgBoxResult = MessageBox.Show(msg, "File already exists (Multi-Indexing):",
+ MessageBoxButtons.YesNo, MessageBoxIcon.Question)
+
+ _multiIndexOverwriteExisting = (result = MsgBoxResult.Yes)
+ _multiIndexDecisionMade = True
+
+ LOGGER.Info($"Multi-Indexing: User decision for file conflicts = {If(_multiIndexOverwriteExisting, "OVERWRITE", "VERSION")}")
+ End If
+
+ shouldOverwrite = _multiIndexOverwriteExisting
Else
- msg = "Eine Datei mit identischem Namen existiert bereits!" & vbCrLf &
- "JA → Bestehende Datei ersetzen (alle vorherigen Versionen werden dabei gelöscht)" & vbCrLf &
- "NEIN → Beide Dateien behalten (Ihre Datei wird automatisch versioniert)"
+ ' Einzeldatei → wie bisher
+ Dim msg As String
+ If USER_LANGUAGE <> "de-DE" Then
+ msg = "A file with the same name already exists!" & vbCrLf &
+ "YES → Replace the existing file (all former versions will be deleted)" & vbCrLf &
+ "NO → Keep both files (your file will be versioned automatically)"
+ Else
+ msg = "Eine Datei mit identischem Namen existiert bereits!" & vbCrLf &
+ "JA → Bestehende Datei ersetzen (alle vorherigen Versionen werden dabei gelöscht)" & vbCrLf &
+ "NEIN → Beide Dateien behalten (Ihre Datei wird automatisch versioniert)"
+ End If
+
+ Dim result As MsgBoxResult = MessageBox.Show(msg, "File already exists:",
+ MessageBoxButtons.YesNo, MessageBoxIcon.Question)
+ shouldOverwrite = (result = MsgBoxResult.Yes)
End If
- Dim result As MsgBoxResult
- result = MessageBox.Show(msg, "File already exists:", MessageBoxButtons.YesNo, MessageBoxIcon.Question)
- If result = MsgBoxResult.Yes Then
+
+ ' ── Entscheidung ausführen ────────────────────────────────────
+ If shouldOverwrite Then
If WMMOD.RemoveFile(CURRENT_NEWFILENAME) = False Then
- ' Löschen fehlgeschlagen → Abbruch
Return False
Else
Dim oNormPath = WMMOD.GetNormalizedPath(CURRENT_NEWFILENAME, 0)
-
- Dim oGetDoc = String.Format("select DOC_ID,RECORD_ID from TBPMO_DOC_RECORD_LINK RL INNER JOIN TBPMO_DOCRESULT_LIST DRL WITH (NOLOCK) ON RL.DOC_ID = DRL.DocID
- WHERE FULL_FILENAME = '{0}'", oNormPath)
+ Dim oGetDoc = String.Format(
+ "SELECT DOC_ID,RECORD_ID FROM TBPMO_DOC_RECORD_LINK RL " &
+ "INNER JOIN TBPMO_DOCRESULT_LIST DRL WITH (NOLOCK) ON RL.DOC_ID = DRL.DocID " &
+ "WHERE FULL_FILENAME = '{0}'", oNormPath)
Dim oDT As DataTable = MYDB_ECM.GetDatatable(oGetDoc)
For Each oRow As DataRow In oDT.Rows
@@ -87,13 +125,10 @@ Public Class frmWM_IndexFile
}
ClassFileResult.Delete_ResultFile(oDoc.DocId, oDoc.RecordId, 1)
Next
-
- ' Löschen erfolgreich → Import wird fortgesetzt
End If
Else
CURRENT_NEWFILENAME = ClassHelper.Versionierung_Datei(CURRENT_NEWFILENAME)
End If
-
End If
sw.Done()
'#################################################################
@@ -220,7 +255,7 @@ Public Class frmWM_IndexFile
err = True
Exit For
End If
-
+ _processedFileIds.Add(CURRENT_FILEID)
Next
If err = True Then
'swWORK_FILE.Done()
@@ -389,6 +424,11 @@ Public Class frmWM_IndexFile
Try
Me.Cursor = Cursors.WaitCursor
SaveMySettingsValue("WD_IndexDeleteDocs", WD_IndexDeleteDocs, "ConfigMain")
+
+ ' ── Multi-Indexing-Flags zurücksetzen beim Start ──────────────────
+ _multiIndexDecisionMade = False
+ _multiIndexOverwriteExisting = False
+
If chkMultiIndexer.Visible = True And chkMultiIndexer.Checked = True Then
' ── Erste Datei: FILE_HASH sicherstellen ───────────────────────
For Each oRow As DataRow In CURRENT_TBPMO_FILES_USER.Rows
@@ -410,7 +450,6 @@ Public Class frmWM_IndexFile
"AND GUID <> " & firstFileId & " AND USER_WORK = '" & USER_USERNAME & "'")
If DTFiles2Work Is Nothing OrElse DTFiles2Work.Rows.Count = 0 Then
- ' Keine weiteren Dateien – trotzdem Erfolg
NEW_FILES_ADDED = True
FILE_WORKED = True
Me.Cursor = Cursors.Default
@@ -478,9 +517,10 @@ Public Class frmWM_IndexFile
Return False
End If
End If
- Me.Cursor = Cursors.Default
+
Catch ex As Exception
MsgBox("Error in Indexing_File:" & vbCrLf & ex.Message, MsgBoxStyle.Critical)
+ Return False
Finally
Me.Cursor = Cursors.Default
End Try
@@ -1202,24 +1242,14 @@ Public Class frmWM_IndexFile
Private Sub frmWM_IndexFile_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing
Try
- If IsNothing(CURRENT_FILEID) OrElse CURRENT_FILEID.ToString = "" Then
- Exit Sub
- End If
-
- ' Direkt in der DB prüfen – nicht auf das Flag FILE_WORKED verlassen
- Dim checkSql = $"SELECT WORKED FROM TBPMO_FILES_USER WHERE GUID = {CURRENT_FILEID}"
- Dim workedValue = MYDB_ECM.GetScalarValue(checkSql)
-
- If IsNothing(workedValue) OrElse IsDBNull(workedValue) Then
- ' Datensatz existiert nicht mehr – kein Löschen notwendig
- Exit Sub
- End If
-
- If CBool(workedValue) = False Then
- Dim oDelete = $"DELETE FROM TBPMO_FILES_USER WHERE GUID = {CURRENT_FILEID} AND WORKED = 0"
- MYDB_ECM.ExecuteNonQuery(oDelete)
- LOGGER.Info($"TBPMO_FILES_USER: Eintrag GUID={CURRENT_FILEID} gelöscht (nicht verarbeitet).")
+ ' Alle nicht-verarbeiteten Dateien löschen (außer den erfolgreichen)
+ Dim processedIds = String.Join(",", _processedFileIds)
+ Dim oDelete = $"DELETE FROM TBPMO_FILES_USER WHERE USER_WORK = '{USER_USERNAME}' AND WORKED = 0"
+ If _processedFileIds.Count > 0 Then
+ oDelete &= $" AND GUID NOT IN ({processedIds})"
End If
+ MYDB_ECM.ExecuteNonQuery(oDelete)
+ LOGGER.Info($"TBPMO_FILES_USER: Nicht-verarbeitete Einträge bereinigt (User: {USER_USERNAME})")
Catch ex As Exception
LOGGER.Warn($"Fehler beim Bereinigen von TBPMO_FILES_USER (Closing): {ex.Message}")
End Try