Files
RecordOrganizer/app/DD-Record-Organizer/frmWM_IndexFile.vb
2026-03-18 15:31:59 +01:00

1521 lines
78 KiB
VB.net

Imports System.IO
Imports System.Security.AccessControl
Imports System.Security.Principal
Imports System.Data.SqlClient
Imports Oracle.ManagedDataAccess.Client
Imports DigitalData.Modules.Windream
Imports System.ComponentModel
Public Class frmWM_IndexFile
Dim droptype As String
Dim aktFiledropped As String
Dim MULTIFILES As Integer = 0
Dim formloaded As Boolean = False
Dim DTVWPMO_DOKUMENTTYPES As DataTable
Dim FILE_WORKED As Boolean = False
Dim FILE_HASH As String = ""
Public Class SW
Public label As String
Public stopwatch As Stopwatch
Public Sub New(label As String)
Me.label = label
stopwatch = New Stopwatch()
stopwatch.Start()
End Sub
Public Function Done() As Long
stopwatch.Stop()
Dim message = String.Format("{0, 5}ms || {1}", stopwatch.ElapsedMilliseconds, label)
Console.WriteLine(message)
LOGGER.Debug(message)
Return stopwatch.ElapsedMilliseconds
End Function
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
LOGGER.Debug($" WORK_FILE aufgerufen: CURRENT_FILEID={CURRENT_FILEID}, Datei={Me.txtFilepath.Text}")
LOGGER.Debug($"=== WORK_FILE START: multiindex={multiindex} ===")
LOGGER.Debug($" Datei: {ImportFilePath}")
LOGGER.Debug($" Flags: _multiIndexDecisionMade={_multiIndexDecisionMade}, _multiIndexOverwriteExisting={_multiIndexOverwriteExisting}")
CURRENT_DOC_ID = Nothing
Dim odeleteRights As Boolean = True
If CURRENT_FILEID = 0 OrElse CURRENT_FILEID = Nothing Then
LOGGER.Error("WORK_FILE: CURRENT_FILEID ist ungültig (0 oder Nothing)!")
Return False
End If
CURRENT_DOKARTSTRING = vDokart
Dim err As Boolean = False
'#################################################################
'Name und ZielPfad generieren
'#################################################################
Dim sw As New SW("GetUse Nameconvention ID: " & DOCTYPE_IDTextBox.Text)
If ClassImport_Windream.Name_Generieren(DOCTYPE_IDTextBox.Text) = False Then
'swWORK_FILE.Done()
Return False
End If
sw.Done()
sw = New SW("CheckFileExists")
If WMMOD.TestFileExists(CURRENT_NEWFILENAME) = True Then
' ── Multi-Index-Logik: Entscheidung nur einmal fragen ─────────
Dim shouldOverwrite As Boolean
If multiindex = True Then
If _multiIndexDecisionMade = False Then
LOGGER.Debug(" ZEIGE DIALOG für Multi-Index-Entscheidung")
' 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.Debug($" Benutzer-Entscheidung: {If(_multiIndexOverwriteExisting, "OVERWRITE", "VERSION")}")
LOGGER.Debug($" Flags NACH Dialog: _multiIndexDecisionMade={_multiIndexDecisionMade}, _multiIndexOverwriteExisting={_multiIndexOverwriteExisting}")
Else
LOGGER.Debug($" Verwende GESPEICHERTE Entscheidung: {If(_multiIndexOverwriteExisting, "OVERWRITE", "VERSION")}")
End If
shouldOverwrite = _multiIndexOverwriteExisting
Else
' Einzeldatei → wie bisher
LOGGER.Debug(" Einzeldatei: Zeige Dialog")
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)
LOGGER.Debug($" Einzeldatei-Entscheidung: {If(shouldOverwrite, "OVERWRITE", "VERSION")}")
End If
' ── Entscheidung ausführen ────────────────────────────────────
If shouldOverwrite Then
LOGGER.Debug(" Führe OVERWRITE aus")
If WMMOD.RemoveFile(CURRENT_NEWFILENAME) = False Then
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 oDT As DataTable = MYDB_ECM.GetDatatable(oGetDoc)
For Each oRow As DataRow In oDT.Rows
Dim oDoc = New With {
.DocId = oRow("DOC_ID"),
.RecordId = oRow("RECORD_ID")
}
ClassFileResult.Delete_ResultFile(oDoc.DocId, oDoc.RecordId, 1)
Next
End If
Else
LOGGER.Debug(" Führe VERSIONIERUNG aus")
CURRENT_NEWFILENAME = ClassHelper.Versionierung_Datei(CURRENT_NEWFILENAME)
LOGGER.Debug($" Neuer Dateiname: {CURRENT_NEWFILENAME}")
End If
Else
LOGGER.Debug(" Datei existiert NICHT, kein Konflikt")
End If
sw.Done()
'#################################################################
'Stream File to windream
'#################################################################
sw = New SW("File Stream")
Dim streamresult = WMMOD.NewFileStream(ImportFilePath, CURRENT_NEWFILENAME, OBJECT_TYPETextBox.Text)
sw.Done()
'#################################################################
If streamresult = True Then
sw = New SW("File Indexing")
CURRENT_FILEIN_WD = CURRENT_NEWFILENAME
Dim DOCID
DOCID = WMMOD.GetIndexValue(CURRENT_FILEIN_WD, "Dokument-ID")
If Not IsNothing(DOCID) Then
CURRENT_DOC_ID = DOCID(0)
Else
DOCID = WMMOD.GetIndexValue(CURRENT_FILEIN_WD, "Document-ID")
If Not IsNothing(DOCID) Then
CURRENT_DOC_ID = DOCID(0)
End If
End If
Dim sql = "SELECT * FROM TBDD_INDEX_AUTOM WHERE ACTIVE = 1 AND UPPER(INDEXNAME) NOT LIKE UPPER('%ONLY %') AND SQL_ACTIVE = 0 AND LEN(INDEXNAME) > 1 AND DOCTYPE_ID = " & vDokart_ID
Dim DT_AUTO_INDEXE As DataTable = MYDB_ECM.GetDatatable(sql)
Try
sql = "SELECT * FROM VWCUST_DOCTYPE_CONFIG WHERE DOCTYPE_ID = " & vDokart_ID
Dim DTVWCUST_DOCTYPE_CONFIG As DataTable = MYDB_ECM.GetDatatable(sql)
If Not IsNothing(DTVWCUST_DOCTYPE_CONFIG) Then
If DTVWCUST_DOCTYPE_CONFIG.Rows.Count = 1 Then
odeleteRights = CBool(DTVWCUST_DOCTYPE_CONFIG.Rows(0).Item("DELETE_RIGHTS"))
End If
End If
Catch ex As Exception
LOGGER.Warn($"Unexpected error in VWCUST_DOCTYPE_CONFIG Area: {ex.Message}")
End Try
Dim indexierung_erfolgreich As Boolean = True
LOGGER.Debug("Doctype: " & vDokart.ToString)
indexierung_erfolgreich = WMMOD.SetFileIndex(CURRENT_FILEIN_WD, WMINDEX_DOCTYPE, vDokart, WMOBJECTTYPE)
If indexierung_erfolgreich = False Then
err = True
ClassHelper.MSGBOX_Handler("ERROR", "Unexpected Error: ", "Unexpected Error in WorkFile-indexing Doctype '" & WMINDEX_DOCTYPE & "') - Check logfile!")
sw.Done()
'swWORK_FILE.Done()
Return False
End If
indexierung_erfolgreich = WMMOD.SetFileIndex(CURRENT_FILEIN_WD, WMINDEX_RELATION, "ADDI-RELATION", WMOBJECTTYPE)
If indexierung_erfolgreich = False Then
err = True
ClassHelper.MSGBOX_Handler("ERROR", "Unexpected Error: ", "Unexpected Error in WorkFile-indexing AddiRelation '" & WMINDEX_RELATION & "') - Check logfile!")
sw.Done()
'swWORK_FILE.Done()
Return False
End If
sw.Done()
If DT_AUTO_INDEXE Is Nothing = False Then 'CHECK DD
If DT_AUTO_INDEXE.Rows.Count > 0 Then
Dim Count As Integer = 0
For Each row As DataRow In DT_AUTO_INDEXE.Rows
Dim oAutoIndexname = row.Item("INDEXNAME").ToString
Dim oAutoIndexValue = row.Item("VALUE")
If oAutoIndexValue.ToString.StartsWith("@") Then
Select Case oAutoIndexValue.ToString.ToUpper
Case "@RECORD-ID"
oAutoIndexValue = oAutoIndexValue.ToString.Replace("@Record-ID", CURRENT_RECORD_ID)
Case "@DOKART"
oAutoIndexValue = oAutoIndexValue.ToString.Replace("@Dokart", vDokart)
End Select
Else 'Es wird nicht über einen @PAttern indexiert
' Regulären Ausdruck zum Auslesen der Indexe definieren
Dim preg As String = "\[%{1}[a-zA-Z0-9\!\$\&\/\(\)\=\?\,\.\-\;\:_öÖüÜäÄ\#\'\+\*\~\{\}\@\€\<\>\ ]+]{1}"
' einen Regulären Ausdruck laden
Dim regulärerAusdruck As System.Text.RegularExpressions.Regex = New System.Text.RegularExpressions.Regex(preg)
' die Vorkommen im SQL-String auslesen
Dim elemente As System.Text.RegularExpressions.MatchCollection = regulärerAusdruck.Matches(oAutoIndexValue)
'####
' alle Vorkommen innerhalbd er Namenkonvention durchlaufen
For Each element As System.Text.RegularExpressions.Match In elemente
LOGGER.Debug("element in RegeX: " & element.Value)
Select Case element.Value.Substring(2, 1).ToUpper
'Nur automatische Indizes auswerten
Case "A"
Dim APattern = element.Value.Substring(3, element.Value.Length - 4)
If APattern.Contains("#") Then
LOGGER.Debug("element filled with Record-Data.......: ")
Dim split() As String = APattern.Split("#")
If split.Length = 2 Then
Dim CONTROL_ID = split(1)
LOGGER.Debug("CONTROL_ID: " & CONTROL_ID)
If IsNumeric(CONTROL_ID) Then
Dim CONTROLVALUE = ClassControlValues.Get_Control_Value_for_ID(CONTROL_ID, CURRENT_RECORD_ID)
If IsNothing(CONTROLVALUE) Then
LOGGER.Warn("Index should be filled with value of Control-ID '" & CONTROL_ID & "', but result was nothing.")
LOGGER.Warn("SQL-Command: " & CURRENT_LAST_SQL)
oAutoIndexValue = ""
Else
If IsDBNull(CONTROLVALUE) Then
LOGGER.Warn("Index should be filled with value of Control-ID '" & CONTROL_ID & "', but result was DBNULL.")
LOGGER.Warn("SQL-Command: " & CURRENT_LAST_SQL)
oAutoIndexValue = ""
Else
oAutoIndexValue = CONTROLVALUE
End If
End If
Else
End If
End If
End If
End Select
Next
End If
LOGGER.Debug($"Autovalue used for Indexing: '" & oAutoIndexValue.ToString & "'")
Count += 1
indexierung_erfolgreich = WMMOD.SetFileIndex(CURRENT_FILEIN_WD, oAutoIndexname, oAutoIndexValue, WMOBJECTTYPE)
If indexierung_erfolgreich = False Then
MsgBox("Unexpected Error in indexing file - See log", MsgBoxStyle.Critical)
err = True
Exit For
End If
_processedFileIds.Add(CURRENT_FILEID)
Next
If err = True Then
'swWORK_FILE.Done()
Return False
End If
Else
'MsgBox("Attention in Work-File:" & vBCrlf & "No indices were defined (1)!", MsgBoxStyle.Critical)
'Return False
End If
Else
'swWORK_FILE.Done()
MsgBox("Attention in Work-File:" & vbCrLf & "No indices were defined (0)!", MsgBoxStyle.Critical)
Return False
End If
'Nun alles aufrüumen und die neue DocID holen
If indexierung_erfolgreich = True Then
LOGGER.Info("File was correctly imported and indexed: " & CURRENT_FILEIN_WD)
Dim oReldocpath = ClassHelper.GetRelPath(CURRENT_FILEIN_WD)
LOGGER.Info("oReldocpath: " & oReldocpath)
CURRENT_WM_OBJECT = WMMOD.GetFileByPath(oReldocpath)
If IsNothing(CURRENT_WM_OBJECT) Then
MsgBox("Attention in Work-File:" & vbCrLf & "Could not create final windream-object!", MsgBoxStyle.Critical)
Return False
End If
LOGGER.Info("...CURRENT_WM_OBJECT created: " & oReldocpath)
Dim stg As String = "Datei erfolgreich nach windream übertragen"
Dim stg1 As String = "Erfolgsmeldung"
If USER_LANGUAGE <> "de-DE" Then
stg = "File was successfully transfered to windream"
stg1 = "Success:"
End If
If multiindex = False Then CURRENT_NOTIFICATION_MSG = stg
' Neu - NUR wenn NICHT im Multi-Index-Modus:
If multiindex = False Then
MYDB_ECM.ExecuteNonQuery("UPDATE TBPMO_FILES_USER SET WORKED = 1 WHERE GUID = " & CURRENT_FILEID)
LOGGER.Debug($" Einzeldatei als WORKED markiert: GUID={CURRENT_FILEID}")
' ✅ DEBUG: Was steht JETZT in der DB?
Dim debugSQL = $"SELECT GUID, WORKED, FILENAME_ONLY FROM TBPMO_FILES_USER WHERE USER_WORK = '{USER_USERNAME}' ORDER BY GUID DESC"
Dim debugDT = MYDB_ECM.GetDatatable(debugSQL)
LOGGER.Debug($" ═══ DEBUG NACH UPDATE ═══")
LOGGER.Debug($" Anzahl Dateien in DB: {debugDT.Rows.Count}")
For Each row As DataRow In debugDT.Rows
LOGGER.Debug($" - GUID={row("GUID")}, WORKED={row("WORKED")}, Datei={row("FILENAME_ONLY")}")
Next
LOGGER.Debug($" ═══════════════════════")
End If
If IsNothing(CURRENT_DOC_ID) Then
sw = New SW("GettingDocID")
sql = String.Format("SELECT DocID FROM VWPMO_DOC_SYNC WHERE FULL_FILENAME = '{0}' AND CONVERT(DATE,Change_DateTime) = CONVERT(DATE,GETDATE())", CURRENT_FILEIN_WD)
CURRENT_DOC_ID = MYDB_ECM.GetScalarValue(sql)
sw.Done()
End If
If Not IsNothing(CURRENT_DOC_ID) Then
ClassHelper.InsertEssential_Log(CURRENT_DOC_ID, "DOC_ID", "File was imported and indexed!")
LOGGER.Info(String.Format("File-Import was finished - DocID: {0} ", CURRENT_DOC_ID))
Dim delete = False
'Die Originaldatei löschen
If droptype = "dragdrop file" And indexierung_erfolgreich = True Then
If chkdelete_origin.Checked = True Then
'Die temporäre Datei löschen
File.Delete(aktFiledropped)
End If
ElseIf (droptype = "@ATTMNTEXTRACTED@" Or droptype = "SCAN") And indexierung_erfolgreich = True Then
'Die temporäre Datei löschen
delete = True
ElseIf droptype = "dragdrop message" And indexierung_erfolgreich = True Then
'Die temporäre Datei löschen
delete = True
End If
If delete = True Then
For Each row As DataRow In CURRENT_TBPMO_FILES_USER.Rows
If row.Item("GUID") = CURRENT_FILEID Then
row.Item("DELETE_FILE") = True
End If
Next
End If
If WMMOD.SessionLoggedin = False Then
MsgBox("Could not create a windream-session!", MsgBoxStyle.Critical)
Else
FAU_AD_USER = ""
ClassFileResult.DocID = CURRENT_DOC_ID
ClassFileResult.SET_DOCID_INDICES()
If ClassDOC_SEARCH.PROF_DOC_CREATE_UPDATE(CURRENT_DOC_ID, CURRENT_RECORD_ID, FILE_HASH) = False Then
stg = "Unerwarteter Fehler: Der Record-Link konnte nicht erzeugt werden! Überprüfen Sie das Log."
If USER_LANGUAGE <> "de-DE" Then
stg = "Unexpected Error: Could not create the recordlink! Please check the log."
End If
MsgBox(stg, MsgBoxStyle.Critical, stg1)
Else
sw = New SW("Setting_Rights")
If ClassDOC_SEARCH.SET_WD_RIGHTS(CURRENT_WM_OBJECT, CURRENT_DOC_ID, CURRENT_FILEIN_WD, odeleteRights) = False Then
MsgBox("The rights for the new file could not be created! Please check the logfile!" & vbCrLf &
"orgFLOW will try to give You at least reading rights!", MsgBoxStyle.Exclamation)
DD_Rights.ClassRights.SetRightExplicit(CURRENT_DOC_ID, CURRENT_FILEIN_WD, USER_USERNAME, 1)
ClassHelper.InsertEssential_Log(CURRENT_DOC_ID, "DOC-ID", "NEW FILE INDEXING - RIGHTS COULD NOT BE SET!!")
End If
sw.Done()
End If
End If
Else
stg = "Unerwarteter Fehler: Es konnte keine DocID für die übertragene Datei erzeugt werden!"
If USER_LANGUAGE <> "de-DE" Then
stg = "Unexpected Error: Could not get a docId for transmitted file!"
End If
LOGGER.Warn(stg)
MsgBox(stg, MsgBoxStyle.Critical, stg1)
End If
Else
MsgBox("An unexpected error occured while indexing file. Please check the log!", MsgBoxStyle.Exclamation)
' swWORK_FILE.Done()
Return False
End If
'swWORK_FILE.Done()
Return True
Else
'swWORK_FILE.Done()
Return False
End If
Catch ex As Exception
MsgBox("Unexpected error in Work-File:" & vbCrLf & ex.Message, MsgBoxStyle.Critical)
'swWORK_FILE.Done()
Return False
End Try
End Function
Private Sub btnindex_Click(sender As Object, e As EventArgs) Handles btnindex.Click
Try
If CURRENT_RECORD_ID = 0 Then
MsgBox("No Record chosen or the documenttype was not chosen!", MsgBoxStyle.Information)
Exit Sub
End If
'If lvwIndices.Items.Count = 0 Then
' MsgBox("Please choose a documenttxpe!", MsgBoxStyle.Information)
' Exit Sub
'End If
If Not IsNothing(CURRENT_TBPMO_INDEX_MAN) Then
If CURRENT_TBPMO_INDEX_MAN.Rows.Count > 0 Then
If ClassFileResult.CheckWrite_IndexeMan(grbxControls) = False Then
Exit Sub
End If
End If
End If
If cmbDokumentart.SelectedIndex <> -1 Then
My.Settings.WD_INDEXDOKART_SAVE = cmbDokumentart.Text
My.Settings.Save()
If WMMOD.SessionLoggedin = True Then
Handle_File(cmbDokumentart.SelectedValue)
Else
MsgBox("Could not create a windream-session! Please contact Your admin!", MsgBoxStyle.Critical)
End If
End If
Catch ex As Exception
MsgBox("Unexpected Error in Prepare indexing: " & ex.Message, MsgBoxStyle.Critical)
End Try
End Sub
Private Function Handle_File(doctype_id As Integer) As Boolean
Try
Me.Cursor = Cursors.WaitCursor
SaveMySettingsValue("WD_IndexDeleteDocs", WD_IndexDeleteDocs, "ConfigMain")
LOGGER.Debug("=== HANDLE_FILE START ===")
LOGGER.Debug($" Flags VOR Reset: _multiIndexDecisionMade={_multiIndexDecisionMade}, _multiIndexOverwriteExisting={_multiIndexOverwriteExisting}")
_multiIndexDecisionMade = False
_multiIndexOverwriteExisting = False
LOGGER.Debug($" Flags NACH Reset: _multiIndexDecisionMade={_multiIndexDecisionMade}, _multiIndexOverwriteExisting={_multiIndexOverwriteExisting}")
LOGGER.Debug($" chkMultiIndexer: Visible={chkMultiIndexer.Visible}, Checked={chkMultiIndexer.Checked}")
If chkMultiIndexer.Visible = True And chkMultiIndexer.Checked = True Then
LOGGER.Debug("=== MULTI-INDEXING MODUS AKTIV ===")
' ── Erste Datei: FILE_HASH und CURRENT_FILEID sicherstellen ───
Dim firstFileId As Integer = CURRENT_FILEID
Dim firstFileName As String = CURRENT_FILENAME
For Each oRow As DataRow In CURRENT_TBPMO_FILES_USER.Rows
If oRow.Item("GUID") = CURRENT_FILEID Then
FILE_HASH = oRow.Item("FILE_HASH")
firstFileName = oRow.Item("FILENAME2WORK")
Exit For
End If
Next
LOGGER.Debug($" Verarbeite erste Datei (CURRENT_FILEID={firstFileId}): {firstFileName}")
If WORK_FILE(firstFileName, Me.PATHTextBox.Text, doctype_id, My.Settings.WD_INDEXDOKART_SAVE, True) = False Then
Me.Cursor = Cursors.Default
LOGGER.Warn(" Erste Datei fehlgeschlagen!")
Return False
End If
LOGGER.Debug(" Erste Datei erfolgreich verarbeitet")
' ── WICHTIG: Erste Datei als WORKED markieren UND DataTable neu laden ──
LOGGER.Debug($" Markiere erste Datei als WORKED: GUID={firstFileId}")
MYDB_ECM.ExecuteNonQuery($"UPDATE TBPMO_FILES_USER SET WORKED = 1 WHERE GUID = {firstFileId}")
LOGGER.Debug(" Lade aktualisierte Dateiliste aus Datenbank...")
' ✅ SCHRITT 1: Prüfe mit COUNT(*), wie viele Dateien in der DB sind
Dim countSQL = $"SELECT COUNT(*) FROM TBPMO_FILES_USER WHERE USER_WORK = '{USER_USERNAME}' AND WORKED = 0"
Dim remainingCount = CInt(MYDB_ECM.GetScalarValue(countSQL))
LOGGER.Debug($" SQL COUNT ergab: {remainingCount} verbleibende Dateien")
' ✅ SCHRITT 2: Nur wenn COUNT > 0, dann DataTable laden
If remainingCount > 0 Then
CURRENT_TBPMO_FILES_USER = MYDB_ECM.GetDatatable("SELECT *, CONVERT(BIT,0) AS DELETE_FILE FROM TBPMO_FILES_USER " &
"WHERE USER_WORK = '" & USER_USERNAME & "' AND WORKED = 0")
If CURRENT_TBPMO_FILES_USER Is Nothing Then
LOGGER.Error(" WARNUNG: GetDatatable gab Nothing zurück, obwohl COUNT > 0!")
CURRENT_TBPMO_FILES_USER = New DataTable()
Else
LOGGER.Debug($" DataTable geladen: {CURRENT_TBPMO_FILES_USER.Rows.Count} Zeilen")
End If
Else
LOGGER.Info(" SQL COUNT ergab 0 Dateien")
CURRENT_TBPMO_FILES_USER = New DataTable()
End If
' ── Folgedateien aus aktualierter DataTable verarbeiten ──
If CURRENT_TBPMO_FILES_USER Is Nothing OrElse CURRENT_TBPMO_FILES_USER.Rows.Count = 0 Then
LOGGER.Info(" Keine weiteren Dateien vorhanden")
NEW_FILES_ADDED = True
FILE_WORKED = True
Me.Cursor = Cursors.Default
Me.Close()
Return True
End If
LOGGER.Debug($" Weitere Dateien gefunden: {CURRENT_TBPMO_FILES_USER.Rows.Count}")
LOGGER.Debug($" Flags VOR Schleife: _multiIndexDecisionMade={_multiIndexDecisionMade}, _multiIndexOverwriteExisting={_multiIndexOverwriteExisting}")
Dim err As Boolean = False
Dim fileCount As Integer = 0
For Each filerow As DataRow In CURRENT_TBPMO_FILES_USER.Rows
fileCount += 1
Dim currentFileId As Integer = filerow.Item("GUID")
Dim currentFileName As String = filerow.Item("FILENAME2WORK")
Dim currentFileHash As String = filerow.Item("FILE_HASH")
CURRENT_FILEID = currentFileId
CURRENT_FILENAME = currentFileName
FILE_HASH = currentFileHash
aktFiledropped = currentFileName
LOGGER.Debug($" [{fileCount}/{CURRENT_TBPMO_FILES_USER.Rows.Count}] Verarbeite Datei: {currentFileName}, FILEID={currentFileId}")
LOGGER.Debug($" Flags: _multiIndexDecisionMade={_multiIndexDecisionMade}, _multiIndexOverwriteExisting={_multiIndexOverwriteExisting}")
Dim handleType As String = filerow.Item("HANDLE_TYPE")
Select Case handleType
Case "@DROPFROMFSYSTEM@"
droptype = "dragdrop file"
Case "@OUTLOOK_ATTMNT@"
droptype = "dragdrop attachment"
Case "@OUTLOOKMESSAGE@"
droptype = "dragdrop message"
Case Else
droptype = handleType
End Select
If WORK_FILE(currentFileName, Me.PATHTextBox.Text, doctype_id, My.Settings.WD_INDEXDOKART_SAVE, True) = False Then
err = True
LOGGER.Warn($" Datei fehlgeschlagen!")
Exit For
End If
LOGGER.Debug($" Datei erfolgreich verarbeitet")
LOGGER.Debug($" Markiere Datei als WORKED: GUID={currentFileId}")
MYDB_ECM.ExecuteNonQuery($"UPDATE TBPMO_FILES_USER SET WORKED = 1 WHERE GUID = {currentFileId}")
Next
Me.Cursor = Cursors.Default
If err = False Then
NEW_FILES_ADDED = True
FILE_WORKED = True
Dim stg As String = "Alle Dateien wurden mit Multiindexing erfolgreich nach windream übertragen!"
Dim stg1 As String = "Erfolgsmeldung"
If USER_LANGUAGE <> "de-DE" Then
stg = "All files were transferred via Multiindexing to windream"
stg1 = "Success:"
End If
LOGGER.Info("=== MULTI-INDEXING ERFOLGREICH ABGESCHLOSSEN ===")
MsgBox(stg, MsgBoxStyle.Information, stg1)
Me.Close()
Return True
End If
Return False
Else
' ✅ EINZELDATEI MODUS
LOGGER.Debug("=== EINZELDATEI MODUS ===")
' ✅ WICHTIG: CURRENT_FILEID VOR WORK_FILE setzen!
For Each oRow As DataRow In CURRENT_TBPMO_FILES_USER.Rows
If oRow.Item("FILENAME2WORK") = Me.txtFilepath.Text Then
CURRENT_FILEID = CInt(oRow("GUID"))
FILE_HASH = oRow("FILE_HASH").ToString()
LOGGER.Debug($" Datei gefunden in CURRENT_TBPMO_FILES_USER: FILEID={CURRENT_FILEID}")
Exit For
End If
Next
' ✅ Validierung NACH Schleife
If CURRENT_FILEID = 0 Then
LOGGER.Error($" Datei nicht gefunden in CURRENT_TBPMO_FILES_USER: {Me.txtFilepath.Text}")
Me.Cursor = Cursors.Default
MessageBox.Show("Die Datei konnte nicht in der Verarbeitungsliste gefunden werden!",
"Fehler:", MessageBoxButtons.OK, MessageBoxIcon.Error)
Return False
End If
If WORK_FILE(Me.txtFilepath.Text, Me.PATHTextBox.Text, doctype_id, My.Settings.WD_INDEXDOKART_SAVE, False) = False Then
Me.Cursor = Cursors.Default
MessageBox.Show("Import to windream was not successful." & vbCrLf &
"Check the log for further information!",
"Unexpected Error in windream-Stream:",
MessageBoxButtons.OK, MessageBoxIcon.Error)
Return False
End If
' ── Datei erfolgreich verarbeitet ──
NEW_FILES_ADDED = True
FILE_WORKED = True
LOGGER.Debug(" Einzeldatei erfolgreich verarbeitet")
' ✅ Prüfen, ob weitere Dateien vorhanden sind
LOGGER.Debug(" Lade aktualisierte Dateiliste für Einzeldatei-Check...")
' ✅ SCHRITT 1: Prüfe mit COUNT(*), wie viele Dateien in der DB sind
Dim countSQL = $"SELECT COUNT(*) FROM TBPMO_FILES_USER WHERE USER_WORK = '{USER_USERNAME}' AND WORKED = 0"
Dim remainingCount = CInt(MYDB_ECM.GetScalarValue(countSQL))
LOGGER.Debug($" ═══ SQL COUNT NACH WORK_FILE ═══")
LOGGER.Debug($" COUNT(*) ergab: {remainingCount} verbleibende Dateien")
' ✅ SCHRITT 2: Dateiliste laden UND vergleichen
ClassHelper.Create_USER_FILE_TABLE()
If CURRENT_TBPMO_FILES_USER Is Nothing Then
LOGGER.Error($" ❌ KRITISCHER FEHLER: Create_USER_FILE_TABLE gab Nothing zurück!")
ElseIf CURRENT_TBPMO_FILES_USER.Rows.Count <> remainingCount Then
LOGGER.Error($" ❌ KRITISCHER FEHLER: COUNT ergab {remainingCount}, aber DataTable hat {CURRENT_TBPMO_FILES_USER.Rows.Count} Zeilen!")
LOGGER.Error($" ❌ VERDACHT: Race-Condition oder Transaction-Problem!")
Else
LOGGER.Debug($" ✅ OK: COUNT und DataTable stimmen überein ({remainingCount} Dateien)")
End If
LOGGER.Debug($" ═══════════════════════════════")
If CURRENT_TBPMO_FILES_USER IsNot Nothing AndAlso CURRENT_TBPMO_FILES_USER.Rows.Count > 0 Then
LOGGER.Info($" Einzeldatei-Modus: Weitere {CURRENT_TBPMO_FILES_USER.Rows.Count} Dateien vorhanden - aktualisiere Formular")
' ── Lade ERSTE Datei aus der NEUEN Liste ──
Dim nextFile = CURRENT_TBPMO_FILES_USER.Rows(0)
CURRENT_FILEID = CInt(nextFile("GUID"))
CURRENT_FILENAME = nextFile("FILENAME2WORK").ToString()
FILE_HASH = nextFile("FILE_HASH").ToString()
aktFiledropped = CURRENT_FILENAME
txtFilepath.Text = CURRENT_FILENAME
LOGGER.Debug($" Nächste Datei geladen: FILEID={CURRENT_FILEID}, Datei={CURRENT_FILENAME}")
' ── Update MULTIFILES-Anzeige ──
MULTIFILES = CURRENT_TBPMO_FILES_USER.Rows.Count - 1
If MULTIFILES > 0 Then
chkMultiIndexer.Text = "Multi-Indexing - Alle nachfolgenden Dateien (" & MULTIFILES & ") identisch indexieren"
chkMultiIndexer.Visible = True
chkMultiIndexer.Checked = False
Else
chkMultiIndexer.Visible = False
End If
' ── Handle-Type setzen ──
Dim handleType As String = nextFile("HANDLE_TYPE").ToString()
Select Case handleType
Case "@DROPFROMFSYSTEM@"
droptype = "dragdrop file"
chkdelete_origin.Visible = True
Case "@OUTLOOK_ATTMNT@"
droptype = "dragdrop attachment"
chkdelete_origin.Visible = True
Case "@OUTLOOKMESSAGE@"
droptype = "dragdrop message"
chkdelete_origin.Visible = True
Case "SCAN"
droptype = "scan"
chkdelete_origin.Visible = False
Case Else
droptype = handleType
chkdelete_origin.Visible = False
End Select
Me.Cursor = Cursors.Default
LOGGER.Debug(" Formular bleibt offen für nächste Datei")
Return True ' ← Formular bleibt offen!
Else
' ✅ Keine weiteren Dateien → Formular schließen
LOGGER.Info(" Einzeldatei-Modus: Keine weiteren Dateien - schließe Formular")
Me.Cursor = Cursors.Default
Me.Close()
Return True
End If
End If
Catch ex As Exception
MsgBox("Error in Indexing_File:" & vbCrLf & ex.Message, MsgBoxStyle.Critical)
LOGGER.Error($"Handle_File Exception: {ex.Message}{vbCrLf}{ex.StackTrace}")
Return False
Finally
Me.Cursor = Cursors.Default
End Try
End Function
Private Sub cmbDokumentart_SelectedIndexChanged(sender As Object, e As EventArgs) Handles cmbDokumentart.SelectedIndexChanged
Try
CURRENT_DOKARTID = 0
If cmbDokumentart.SelectedIndex <> -1 Then
CURRENT_DOKARTID = cmbDokumentart.SelectedValue
CURRENT_DOKARTSTRING = cmbDokumentart.Text
Refresh_indices()
Refresh_Indices_Manual()
Check_Subfolder()
End If
Catch ex As Exception
MsgBox("Error in cmbDokumentart SelectedIndex:" & vbCrLf & ex.Message, MsgBoxStyle.Critical)
End Try
End Sub
Sub Refresh_Indices_Manual()
Try
ClassFileResult.GET_DATATABLE_INDICES_PMO()
If CURRENT_TBPMO_INDEX_MAN.Rows.Count > 0 Then
'Der Tabelle eine Splate für den idnexwert hinzufügen
Dim MAN_VALUE As DataColumn = CURRENT_TBPMO_INDEX_MAN.Columns.Add("MAN_VALUE", Type.GetType("System.String"))
grbxControls.Visible = True
grbxControls.Controls.Clear()
Me.Size = New Size(605, 700)
Dim anz As Integer = 1
Dim ylbl As Integer = 20
Dim y As Integer = 38
For Each DR As DataRow In CURRENT_TBPMO_INDEX_MAN.Rows
Dim type = DR.Item("DATATYPE")
If type <> "BOOLEAN" Then
addLabel(DR.Item("GUID"), DR.Item("NAME"), DR.Item("COMMENT").ToString, ylbl)
End If
Dim DefaultValue = DR.Item("DEFAULT_VALUE")
Select Case type
Case "BOOLEAN"
Dim VORBELGUNG As Integer = DefaultValue
'nur eine Textbox
Dim chk As CheckBox = ClassControls_Manual.AddCheckBox(DR.Item("GUID"), DR.Item("NAME"), y, VORBELGUNG, DR.Item("COMMENT").ToString)
If Not IsNothing(chk) Then
grbxControls.Controls.Add(chk)
End If
Case "INTEGER"
If DR.Item("SUGGESTION") = True And DR.Item("SQL_RESULT").ToString.Length > 0 Then
AddVorschlag_ComboBox(DR.Item("GUID"), DR.Item("NAME"), y, DR.Item("CONNECTION_ID"), DR.Item("SQL_RESULT"), DefaultValue)
'AddAutoSuggest_Textbox(DR.Item("NAME"), y, DR.Item("CONNECTION_ID"), DR.Item("SQL_RESULT"), DefaultValue)
Else
Dim VORBELGUNG As Integer = DefaultValue
'nur eine Textbox
AddTextBox(DR.Item("GUID"), DR.Item("NAME"), y, VORBELGUNG)
End If
Case "FOLDERSELECT"
AddFOLDERSELECTBUTTON(DR.Item("GUID"), DR.Item("NAME"), y)
Case "VARCHAR"
If DR.Item("SUGGESTION") = True And DR.Item("SQL_RESULT").ToString.Length > 0 Then
AddVorschlag_ComboBox(DR.Item("GUID"), DR.Item("NAME"), y, DR.Item("CONNECTION_ID"), DR.Item("SQL_RESULT"), DefaultValue)
'AddAutoSuggest_Textbox(DR.Item("NAME"), y, DR.Item("CONNECTION_ID"), DR.Item("SQL_RESULT"), DefaultValue)
Else
If DR.Item("NAME").ToString.ToLower = "dateiname" Then
'Übergibt den Dateinamen um diesen Vorzuschlagen
AddTextBox(DR.Item("GUID"), DR.Item("NAME"), y, System.IO.Path.GetFileNameWithoutExtension(txtFilepath.Text))
Else
Dim VORBELGUNG As String = DefaultValue
'nur eine Textbox
AddTextBox(DR.Item("GUID"), DR.Item("NAME"), y, VORBELGUNG)
End If
End If
Case "DATE"
AddDateTimePicker(DR.Item("GUID"), DR.Item("NAME"), y)
Case Else
MsgBox($"Please check the datatype of manual index ({ DR.Item("NAME")} - {type} - Refresh_Indices_Manual (frmWMIndexFile)", MsgBoxStyle.Critical, "Achtung:")
LOGGER.Warn(" - Datentyp nicht hinterlegt - LoadIndexe_Man")
End Select
anz += 1
ylbl += 60
y += 60
Next
SendKeys.Send("{TAB}")
Else
grbxControls.Visible = False
Me.Size = New Size(605, 430)
End If
Catch ex As Exception
MsgBox("Error in Refresh_Indices_Manual:" & vbCrLf & ex.Message, MsgBoxStyle.Critical)
End Try
End Sub
Sub Check_Subfolder()
Try
Dim sel
If CURRENT_REDUNDANT_FORM_ID <> 0 Then
sel = "select MANUAL_SUBFOLDER FROM TBPMO_WD_FORMVIEW_DOKTYPES WHERE FORMVIEW_ID = (SELECT GUID FROM TBPMO_FORM_VIEW WHERE FORM_ID = " & CURRENT_REDUNDANT_FORM_ID & " and SCREEN_ID = " & CURRENT_SCREEN_ID & ")"
Else
sel = "select MANUAL_SUBFOLDER FROM TBPMO_WD_FORMVIEW_DOKTYPES WHERE FORMVIEW_ID = (SELECT GUID FROM TBPMO_FORM_VIEW WHERE FORM_ID = " & CURRENT_ENTITY_ID & " and SCREEN_ID = " & CURRENT_SCREEN_ID & ")"
End If
Dim chk = MYDB_ECM.GetScalarValue(sel)
If Not IsNothing(chk) Then
If CBool(chk) = True Then
lblSubfolder.Visible = True
txtSubfolder.Visible = True
CURRENT_CHECK_SUBFOLDER = True
CURRENT_SUBFOLDER = ""
Else
lblSubfolder.Visible = False
txtSubfolder.Visible = False
CURRENT_CHECK_SUBFOLDER = False
End If
End If
Catch ex As Exception
MsgBox("Error in Check_Subfolder:" & vbCrLf & ex.Message, MsgBoxStyle.Critical)
lblSubfolder.Visible = False
txtSubfolder.Visible = False
CURRENT_CHECK_SUBFOLDER = False
End Try
End Sub
Sub addLabel(ID As Integer, indexname As String, hinweis As String, ylbl As Integer)
Dim lbl As New Label
lbl.Name = "lbl" & indexname
lbl.Size = New Size(CInt(hinweis.Length * 15), 18) 'CInt(hinweis.Length * 9)
lbl.Text = hinweis
lbl.Tag = ID
grbxControls.Controls.Add(lbl)
lbl.Location = New Point(11, ylbl)
End Sub
Sub AddComboBoxValue(cmbName As ComboBox, Value As String)
cmbName.Items.Add(Value)
End Sub
' <STAThread()> _
Function addCombobox(ID As Integer, indexname As String, y As Integer)
Dim cmb As New ComboBox
cmb.Name = "cmb" & indexname
cmb.AutoSize = True
cmb.Size = New Size(300, 27)
cmb.Tag = ID
grbxControls.Controls.Add(cmb)
cmb.Location = New Point(11, y)
'cmb.AutoCompleteMode = AutoCompleteMode.SuggestAppend
'cmb.AutoCompleteSource = AutoCompleteSource.ListItems
'AddHandler cmb.KeyUp, AddressOf AutoCompleteCombo_KeyUp
AddHandler cmb.SelectedIndexChanged, AddressOf OncmbSIndexChanged
AddHandler cmb.GotFocus, AddressOf OncmbGotFocus
AddHandler cmb.LostFocus, AddressOf OncmbLostFocus
Return cmb
End Function
Public Sub OncmbGotFocus(sender As System.Object, e As System.EventArgs)
Dim cmb As ComboBox = sender
cmb.BackColor = Color.Lime
End Sub
' <STAThread()> _
Public Sub OncmbLostFocus(sender As System.Object, e As System.EventArgs)
Dim cmb As ComboBox = sender
cmb.BackColor = Color.White
End Sub
Function AddFOLDERSELECTBUTTON(ID As Integer, indexname As String, y As Integer)
Dim btn As New Button
btn.Name = "btn" & indexname
If USER_LANGUAGE <> "de-DE" Then
btn.Text = "Select the folder"
Else
btn.Text = "Wählen Sie einen Ordner"
End If
btn.Size = New Size(260, 27)
btn.Tag = ID
grbxControls.Controls.Add(btn)
btn.Location = New Point(11, y)
AddHandler btn.Click, AddressOf OnbtnClick
Return btn
End Function
Public Sub OnbtnClick(sender As System.Object, e As System.EventArgs)
Dim btn As Button = sender
Dim folderBrowserDialog1 As New FolderBrowserDialog
If USER_LANGUAGE <> "de-DE" Then
folderBrowserDialog1.Description =
"Select the directory:"
Else
folderBrowserDialog1.Description =
"Wählen Sie einen Ordner:"
End If
' Do not allow the user to create New files via the FolderBrowserDialog.
folderBrowserDialog1.ShowNewFolderButton = True
Try
folderBrowserDialog1.RootFolder = PATHTextBox.Text
Catch ex As Exception
End Try
Try
folderBrowserDialog1.SelectedPath = PATHTextBox.Text
Catch ex As Exception
End Try
Dim result As DialogResult = folderBrowserDialog1.ShowDialog()
If (result = DialogResult.OK) Then
ClassFileResult.SET_CURRENT_TBPMO_INDEX_MAN_VALUE(btn.Tag, folderBrowserDialog1.SelectedPath)
PATHTextBox.Text = folderBrowserDialog1.SelectedPath
txtSubfolder.Text = folderBrowserDialog1.SelectedPath
End If
End Sub
Function AddTextBox(ID As Integer, indexname As String, y As Integer, text As String)
Dim txt As New TextBox
txt.Name = "txt" & indexname
txt.Size = New Size(260, 27)
'txt.AutoSize = True
txt.Tag = ID
grbxControls.Controls.Add(txt)
txt.Location = New Point(11, y)
If text <> "" Then
txt.Text = text
txt.Size = New Size(CInt(text.Length * 15), 27)
txt.SelectAll()
End If
AddHandler txt.GotFocus, AddressOf OnTextBoxFocus
AddHandler txt.LostFocus, AddressOf OnTextBoxLostFocus
AddHandler txt.KeyUp, AddressOf OnTextBoxKeyUp
AddHandler txt.TextChanged, AddressOf OnTextBoxTextChanged
Return txt
End Function
Public Sub OnTextBoxFocus(sender As System.Object, e As System.EventArgs)
Dim box As TextBox = sender
box.BackColor = Color.Lime
box.SelectAll()
End Sub
Public Sub OnTextBoxTextChanged(sender As System.Object, e As System.EventArgs)
Dim box As TextBox = sender
'If box.Text.Length > 15 Then
Dim g As Graphics = box.CreateGraphics
box.Width = g.MeasureString(box.Text, box.Font).Width + 15
g.Dispose()
' End If
End Sub
Public Sub OnTextBoxLostFocus(sender As System.Object, e As System.EventArgs)
Dim box As TextBox = sender
box.BackColor = Color.White
End Sub
Public Sub OnTextBoxKeyUp(sender As System.Object, e As System.Windows.Forms.KeyEventArgs)
Dim box As TextBox = sender
If (e.KeyCode = Keys.Return) Then
SendKeys.Send("{TAB}")
End If
End Sub
Sub AddDateTimePicker(ID As Integer, indexname As String, y As Integer)
Dim dtp As New DateTimePicker
dtp.Name = "dtp" & indexname
dtp.Format = DateTimePickerFormat.Short
dtp.Size = New Size(133, 27)
dtp.Tag = ID
dtp.Location = New Point(11, y)
grbxControls.Controls.Add(dtp)
AddHandler dtp.ValueChanged, AddressOf OndtpChanged
End Sub
Sub OndtpChanged()
'offen was hier zu tun ist
End Sub
Public Sub OncmbSIndexChanged(sender As System.Object, e As System.EventArgs)
If formloaded = False Then
Exit Sub
End If
Dim cmb As ComboBox = sender
If cmb.SelectedIndex <> -1 Then
If cmb.Text.Length > 15 Then
Dim g As Graphics = cmb.CreateGraphics
cmb.Width = g.MeasureString(cmb.Text, cmb.Font).Width + 30
g.Dispose()
End If
Get_NextComboBoxResults(cmb)
SendKeys.Send("{TAB}")
End If
End Sub
Sub Get_NextComboBoxResults(cmb As ComboBox)
Try
Dim indexname = cmb.Name.Replace("cmb", "")
Dim sql = "SELECT GUID,NAME,SQL_RESULT FROM TBPMO_INDEX_MAN where ACTIVE = 1 AND SUGGESTION = 1 AND SQL_RESULT like '%@" & indexname & "%' and DOCTYPE_ID = " & CURRENT_DOKARTID & " ORDER BY SEQUENCE"
Dim DT As DataTable = MYDB_ECM.GetDatatable(sql)
If Not IsNothing(DT) Then
If DT.Rows.Count > 0 Then
Dim cmbname = "cmb" & DT.Rows(0).Item("NAME")
Renew_ComboboxResults(DT.Rows(0).Item("GUID"), indexname, cmb.Text)
End If
End If
Catch ex As Exception
MsgBox("Error in Get_NextComboBoxResults:" & vbCrLf & ex.Message, MsgBoxStyle.Critical)
End Try
End Sub
Private Sub Renew_ComboboxResults(INDEX_GUID As Integer, SearchString As String, Resultvalue As String)
Try
Dim connectionString As String
Dim sqlCnn As SqlConnection
Dim sqlCmd As SqlCommand
Dim adapter As New SqlDataAdapter
Dim oracleConn As OracleConnection
Dim oracleCmd As OracleCommand
Dim oracleadapter As New OracleDataAdapter
Dim NewDataset As New DataSet
Dim i As Integer
Dim conid = ClassMoreMetadata.Return_CURRENT_TBPMO_INDEX_MAN_VALUE(INDEX_GUID, "CONNECTION_ID")
Dim sql_result = ClassMoreMetadata.Return_CURRENT_TBPMO_INDEX_MAN_VALUE(INDEX_GUID, "SQL_RESULT")
Dim NAME = ClassMoreMetadata.Return_CURRENT_TBPMO_INDEX_MAN_VALUE(INDEX_GUID, "NAME")
If Not IsNothing(conid) And Not IsNothing(sql_result) And Not IsNothing(NAME) Then
For Each ctrl As Control In Me.grbxControls.Controls
If ctrl.Name = "cmb" & NAME.ToString Then
Dim cmb As ComboBox = ctrl
Dim sql As String = sql_result.ToString.ToUpper.Replace("@" & SearchString.ToUpper, Resultvalue)
connectionString = MYDB_ECM.CurrentConnectionString
If connectionString Is Nothing = False Then
'SQL Befehl füllt die Auswahlliste
If connectionString.Contains("Server=") And connectionString.Contains("Database=") Then
sqlCnn = New SqlConnection(connectionString)
sqlCnn.Open()
sqlCmd = New SqlCommand(sql, sqlCnn)
adapter.SelectCommand = sqlCmd
adapter.Fill(NewDataset)
ElseIf connectionString.StartsWith("Data Source=") And connectionString.Contains("SERVICE_NAME") Then
oracleConn = New OracleConnection(connectionString)
oracleConn.Open()
oracleCmd = New OracleCommand(sql, oracleConn)
oracleadapter.SelectCommand = oracleCmd
oracleadapter.Fill(NewDataset)
End If
If NewDataset.Tables(0).Rows.Count > 0 Then
cmb.Items.Clear()
'Die Standargrösse definieren
Dim newWidth As Integer = 300
For i = 0 To NewDataset.Tables(0).Rows.Count - 1
'MsgBox(NewDataset.Tables(0).Rows(i).Item(0))
AddComboBoxValue(cmb, NewDataset.Tables(0).Rows(i).Item(0))
Try
Dim text As String = NewDataset.Tables(0).Rows(i).Item(0)
If text.Length > 15 Then
Dim g As Graphics = cmb.CreateGraphics
If g.MeasureString(text, cmb.Font).Width + 30 > newWidth Then
newWidth = g.MeasureString(text, cmb.Font).Width + 30
End If
g.Dispose()
End If
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Anpassung Breite ComboBox:")
End Try
Next
cmb.Size = New Size(newWidth, 27)
cmb.AutoCompleteSource = AutoCompleteSource.ListItems
cmb.AutoCompleteMode = AutoCompleteMode.Suggest
End If
If connectionString.Contains("Server=") And connectionString.Contains("Database=") Then
Try
adapter.Dispose()
sqlCmd.Dispose()
sqlCnn.Close()
Catch ex As Exception
End Try
Else
Try
oracleadapter.Dispose()
oracleCmd.Dispose()
oracleConn.Close()
Catch ex As Exception
End Try
End If
End If
End If
Next
End If
Catch ex As Exception
LOGGER.Warn(" - Unvorhergesehener Unexpected error in Renew_ComboboxResults - Fehler: " & vbCrLf & ex.Message)
MsgBox(ex.Message, MsgBoxStyle.Critical, "Unvorhergesehener Unexpected error in Renew_ComboboxResults:")
End Try
End Sub
Private Sub AddVorschlag_ComboBox(ID As Integer, indexname As String, y As Integer, conid As Integer, sql_Vorschlag As String, Optional Vorgabe As String = "")
Try
Dim connectionString As String
Dim sqlCnn As SqlConnection
Dim sqlCmd As SqlCommand
Dim adapter As New SqlDataAdapter
Dim oracleConn As OracleConnection
Dim oracleCmd As OracleCommand
Dim oracleadapter As New OracleDataAdapter
Dim NewDataset As New DataSet
Dim i As Integer
Dim sql As String
Dim runinLZ As Boolean = False
connectionString = MYDB_ECM.CurrentConnectionString ' ClassDatabase.GetConnectionString(conid)
If connectionString Is Nothing = False Then
'SQL Befehl füllt die Auswahlliste
sql = sql_Vorschlag
If Not sql.Contains("@") Then
If connectionString.Contains("Server=") And connectionString.Contains("Database=") Then
sqlCnn = New SqlConnection(connectionString)
sqlCnn.Open()
sqlCmd = New SqlCommand(sql, sqlCnn)
adapter.SelectCommand = sqlCmd
adapter.Fill(NewDataset)
ElseIf connectionString.StartsWith("Data Source=") And connectionString.Contains("SERVICE_NAME") Then
oracleConn = New OracleConnection(connectionString)
oracleConn.Open()
oracleCmd = New OracleCommand(sql_Vorschlag, oracleConn)
oracleadapter.SelectCommand = oracleCmd
oracleadapter.Fill(NewDataset)
End If
Else
runinLZ = True
LOGGER.Debug(" >>sql enthält Platzhalter und wird erst während der Laufzeit gefüllt!")
End If
Dim newCMB As ComboBox
If runinLZ = True Then
'Die Standardcombobox anlegen
newCMB = addCombobox(ID, indexname, y)
newCMB.Size = New Size(300, 27)
Else
If NewDataset.Tables(0).Rows.Count > 0 Then
'Die Standardcombobox anlegen
newCMB = addCombobox(ID, indexname, y)
'Die Standargrösse definieren
Dim newWidth As Integer = 300
For i = 0 To NewDataset.Tables(0).Rows.Count - 1
'MsgBox(NewDataset.Tables(0).Rows(i).Item(0))
AddComboBoxValue(newCMB, NewDataset.Tables(0).Rows(i).Item(0))
Try
Dim text As String = NewDataset.Tables(0).Rows(i).Item(0)
If text.Length > 15 Then
Dim g As Graphics = newCMB.CreateGraphics
If g.MeasureString(text, newCMB.Font).Width + 30 > newWidth Then
newWidth = g.MeasureString(text, newCMB.Font).Width + 30
End If
g.Dispose()
End If
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Anpassung Breite ComboBox:")
End Try
Next
newCMB.Size = New Size(newWidth, 27)
newCMB.AutoCompleteSource = AutoCompleteSource.ListItems
newCMB.AutoCompleteMode = AutoCompleteMode.Suggest
newCMB.DropDownHeight = (newCMB.ItemHeight + 0.2) * 25
If Vorgabe <> "" Then
newCMB.SelectedIndex = newCMB.FindStringExact(Vorgabe)
newCMB.Text = Vorgabe
Get_NextComboBoxResults(newCMB)
End If
Else
End If
If connectionString.Contains("Server=") And connectionString.Contains("Database=") Then
Try
adapter.Dispose()
sqlCmd.Dispose()
sqlCnn.Close()
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical)
End Try
Else
Try
oracleadapter.Dispose()
oracleCmd.Dispose()
oracleConn.Close()
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical)
End Try
End If
End If
End If
Catch ex As Exception
LOGGER.Warn(" - Unvorhergesehener Unexpected error in AddVorschlag_ComboBox - Indexname: " & indexname & " - Fehler: " & vbCrLf & ex.Message)
MsgBox(ex.Message, MsgBoxStyle.Critical, "Unvorhergesehener Unexpected error in AddVorschlag_ComboBox:")
End Try
End Sub
Sub Refresh_indices()
Try
If CURRENT_DOKARTID > 0 Then
Dim sql = "SELECT * FROM TBDD_DOKUMENTART WHERE GUID = " & CURRENT_DOKARTID
Dim DTDOKART As DataTable = MYDB_ECM.GetDatatable(sql)
If DTDOKART.Rows.Count = 1 Then
OBJECT_TYPETextBox.Text = DTDOKART.Rows(0).Item("OBJEKTTYP")
DOCTYPE_IDTextBox.Text = CURRENT_DOKARTID
PATHTextBox.Text = DTDOKART.Rows(0).Item("ZIEL_PFAD")
Dim dt As DataTable
'sql = "SELECT * FROM TBDD_INDEX_AUTOM WHERE DOCTYPE_ID = " & CURRENT_DOKARTID
'Dim dt As DataTable = MYDB_ECM.GetDatatable(sql)
'Dim Count As Integer = 0
'lvwIndices.Items.Clear()
'If dt.Rows.Count > 0 Then
' For Each row As DataRow In dt.Rows
' lvwIndices.Items.Add(row.Item("INDEXNAME").ToString)
' Dim Value As String
' Dim _case = row.Item("VALUE").ToString.ToUpper
' Select Case row.Item("VALUE").ToString.ToUpper
' Case "@DOKART"
' Value = CURRENT_DOKARTSTRING
' Case "@RECORD-ID"
' Value = CURRENT_RECORD_ID
' End Select
' lvwIndices.Items(Count).SubItems.Add(Value)
' Count += 1
' Next
'End If
'den Entity-Key auslesen
sql = "Select Top 1 * from TBPMO_WD_OBJECTTYPE where Upper(object_type) = Upper('" & OBJECT_TYPETextBox.Text & "')"
dt = MYDB_ECM.GetDatatable(sql)
If Not dt Is Nothing Then
If dt.Rows.Count = 1 Then
'lvwIndices.Items.Add(dt.Rows(0).Item("IDXNAME_ENTITYID").ToString)
'lvwIndices.Items(Count).SubItems.Add(CURRENT_ENTITY_ID)
'Count = Count + 1
'lvwIndices.Items.Add(dt.Rows(0).Item("IDXNAME_PARENTID").ToString)
'If CURRENT_REDUNDANT_FORM_ID <> 0 Then
' sql = "SELECT TOP 1 PARENT_ID FROM TBPMO_FORM WHERE GUID = " & CURRENT_REDUNDANT_FORM_ID
'Else
' sql = "SELECT TOP 1 PARENT_ID FROM TBPMO_FORM WHERE GUID = " & CURRENT_ENTITY_ID
'End If
'Dim ParentID = MYDB_ECM.GetScalarValue(sql)
'Try
' If IsNumeric(ParentID) And ParentID > 0 Then
' lvwIndices.Items(Count).SubItems.Add(ParentID)
' End If
'Catch ex As Exception
' MsgBox("Unexpected Error in Setting Parent-ID" & vBCrlf & ex.Message, MsgBoxStyle.Critical)
'End Try
'Count = Count + 1
''den Record-Key auslesen
'lvwIndices.Items.Add(dt.Rows(0).Item("IDXNAME_RECORDID").ToString)
'lvwIndices.Items(Count).SubItems.Add(CURRENT_RECORD_ID)
'Count = Count + 1
'lvwIndices.Items.Add(dt.Rows(0).Item("IDXNAME_DOCTYPE").ToString)
'lvwIndices.Items(Count).SubItems.Add(CURRENT_DOKARTSTRING)
End If
End If
End If
End If
Catch ex As Exception
MsgBox("Error in Refresh Indices for Indexing:" & vbCrLf & ex.Message, MsgBoxStyle.Critical)
End Try
End Sub
Private Sub frmWD_Index_Dokart_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing
My.Settings.Save()
End Sub
Private Sub frmWD_Index_Dokart_Load(sender As Object, e As EventArgs) Handles Me.Load
Try
CURRENT_FILENAME = ""
Me.VWDDINDEX_AUTOMTableAdapter.Connection.ConnectionString = MYDB_ECM.CurrentConnectionString
chkMultiIndexer.Checked = False
' ── Multi-Indexing-Flags beim Formular-Load zurücksetzen ──
LOGGER.Debug("=== FORM LOAD: Flags zurücksetzen ===")
LOGGER.Debug($" VOR Reset: _multiIndexDecisionMade = {_multiIndexDecisionMade}, _multiIndexOverwriteExisting = {_multiIndexOverwriteExisting}")
_multiIndexDecisionMade = False
_multiIndexOverwriteExisting = False
_processedFileIds.Clear()
LOGGER.Debug($" NACH Reset: _multiIndexDecisionMade = {_multiIndexDecisionMade}, _multiIndexOverwriteExisting = {_multiIndexOverwriteExisting}")
LOGGER.Debug($" ProcessedFileIds Count: {_processedFileIds.Count}")
LOGGER.Debug("frmWD_Index_Dokart_Load")
chkdelete_origin.Checked = False
chkdelete_origin.Visible = False
Dim oReconnect = WMMOD.SessionReconnect
' ── WICHTIG: Prüfen, ob überhaupt Dateien vorhanden sind ──
If CURRENT_TBPMO_FILES_USER Is Nothing OrElse CURRENT_TBPMO_FILES_USER.Rows.Count = 0 Then
LOGGER.Info("frmWD_Index_Dokart_Load: Keine Dateien vorhanden - Formular wird geschlossen")
Me.Close()
Exit Sub
End If
Dim oHandleType As String
For Each oRow As DataRow In CURRENT_TBPMO_FILES_USER.Rows
If oRow.Item("GUID") = CURRENT_FILEID Then
CURRENT_FILENAME = oRow.Item("FILENAME2WORK")
oHandleType = oRow.Item("HANDLE_TYPE")
FILE_HASH = oRow.Item("FILE_HASH")
Exit For ' ← Hinzugefügt: Schleife verlassen, wenn gefunden
End If
Next
If CURRENT_FILENAME = "" Then
LOGGER.Warn("Check the Temp Files Table, as it seems to be empty or CURRENT_FILEID not found!")
MsgBox("Check the Temp Files Table, as it seems to be empty!", MsgBoxStyle.Exclamation)
Me.Close() ' ← Formular schließen statt Exit Sub
Exit Sub
End If
' ── KORREKTUR: Zähle alle Dateien außer der aktuellen ──
MULTIFILES = CURRENT_TBPMO_FILES_USER.Rows.Count - 1
LOGGER.Debug($" MULTIFILES berechnet: Gesamt={CURRENT_TBPMO_FILES_USER.Rows.Count}, MULTIFILES={MULTIFILES}")
If MULTIFILES > 0 Then
chkMultiIndexer.Text = "Multi-Indexing - Alle nachfolgenden Dateien (" & MULTIFILES & ") identisch indexieren"
chkMultiIndexer.Visible = True
LOGGER.Debug($" chkMultiIndexer: Visible=True, Text={chkMultiIndexer.Text}")
Else
chkMultiIndexer.Visible = False
LOGGER.Debug(" chkMultiIndexer: Visible=False (keine weiteren Dateien)")
End If
aktFiledropped = CURRENT_FILENAME
txtFilepath.Text = aktFiledropped
If oHandleType = "@DROPFROMFSYSTEM@" Then
droptype = "dragdrop file"
chkdelete_origin.Visible = True
chkdelete_origin.Checked = WD_IndexDeleteDocs
ElseIf oHandleType = "@OUTLOOK_ATTMNT@" Then
droptype = "dragdrop attachment"
chkdelete_origin.Visible = True
chkdelete_origin.Checked = WD_IndexDeleteDocs
ElseIf oHandleType = "@OUTLOOKMESSAGE@" Then
droptype = "dragdrop message"
chkdelete_origin.Visible = True
chkdelete_origin.Checked = WD_IndexDeleteDocs
ElseIf oHandleType = "SCAM" Then
droptype = "scan"
End If
Dim sql = String.Format("SELECT FORMVIEW_ID, FORM_ID, FORM_TITLE, DOKUMENTTYPE_ID, DOKUMENTTYPE, PATH, SHORTNAME, OBJECT_TYPE, FW_DOCTYPE_ID FROM VWPMO_DOKUMENTTYPES WHERE (FORMVIEW_ID = {0}) " &
"ORDER BY SEQUENCE, DOKUMENTTYPE", CURRENT_FORMVIEW_ID)
DTVWPMO_DOKUMENTTYPES = MYDB_ECM.GetDatatable(sql)
CURRENT_REDUNDANT_FORM_ID = 0
CURRENT_REDUNDANT_FORMVIEW_ID = 0
If DTVWPMO_DOKUMENTTYPES.Rows.Count = 0 Then
If CURRENT_ENTITY_REDUNDANT_ID <> 0 Then
Dim FVID = MYDB_ECM.GetScalarValue(String.Format("SELECT GUID FROM TBPMO_FORM_VIEW WHERE FORM_ID = {0} and SCREEN_ID = 1", CURRENT_ENTITY_REDUNDANT_ID), True)
If DTVWPMO_DOKUMENTTYPES.Rows.Count = 0 Then
MsgBox("No documenttypes for the redundant entity configured either! Indexing is not possible!" & vbCrLf & "Please check the configuration!", MsgBoxStyle.Exclamation)
Me.Close()
Exit Sub
Else
LOGGER.Debug("Redundant EntityID: " & CURRENT_ENTITY_REDUNDANT_ID)
CURRENT_REDUNDANT_FORM_ID = CURRENT_ENTITY_REDUNDANT_ID
CURRENT_REDUNDANT_FORMVIEW_ID = FVID
CURRENT_ENTITY_ID = CURRENT_ENTITY_REDUNDANT_ID
CURRENT_FORMVIEW_ID = FVID
End If
Else
MsgBox("No documenttypes for this entity configured! Indexing is not possible!" & vbCrLf & "Please check the configuration!", MsgBoxStyle.Exclamation)
Me.Close()
Exit Sub
End If
End If
Catch ex As Exception
LOGGER.Error($"Error in frmWD_Index_Dokart_Load: {ex.Message}")
MsgBox("Error in frmWD_Index_Dokart_Load:" & vbCrLf & ex.Message, MsgBoxStyle.Critical)
Me.Close()
End Try
End Sub
Private Sub chkdelete_origin_CheckedChanged(sender As Object, e As EventArgs) Handles chkdelete_origin.CheckedChanged
WD_IndexDeleteDocs = chkdelete_origin.Checked
SaveMySettingsValue("WD_IndexDeleteDocs", WD_IndexDeleteDocs, "ConfigMain")
End Sub
Private Sub frmWD_Index_Dokart_Shown(sender As Object, e As EventArgs) Handles Me.Shown
Try
If My.Settings.WD_INDEXDOKART_SAVE <> String.Empty Then
Me.cmbDokumentart.SelectedItem = Me.cmbDokumentart.Items.IndexOf(My.Settings.WD_INDEXDOKART_SAVE)
' cmbDokumentart.SelectedIndex = cmbDokumentart.FindStringExact(My.Settings.WD_INDEXDOKART_SAVE)
End If
If DTVWPMO_DOKUMENTTYPES.Rows.Count >= 1 Then
cmbDokumentart.DataSource = DTVWPMO_DOKUMENTTYPES
cmbDokumentart.DisplayMember = DTVWPMO_DOKUMENTTYPES.Columns(4).ColumnName
cmbDokumentart.ValueMember = DTVWPMO_DOKUMENTTYPES.Columns(3).ColumnName
If DTVWPMO_DOKUMENTTYPES.Rows.Count = 1 Then
cmbDokumentart.SelectedIndex = 0
CURRENT_DOKARTID = cmbDokumentart.SelectedValue
CURRENT_DOKARTSTRING = cmbDokumentart.Text
Refresh_indices()
End If
End If
Me.Hide()
Me.Visible = True
Me.Activate()
Me.BringToFront()
If CURRENT_CONTROL_DOCTYPE_MATCH <> "" Then
'Me.cmbDokumentart.SelectedItem = Me.cmbDokumentart.Items.IndexOf(CURRENT_CONTROL_DOCTYPE_MATCH)
cmbDokumentart.SelectedIndex = cmbDokumentart.FindStringExact(CURRENT_CONTROL_DOCTYPE_MATCH)
If cmbDokumentart.SelectedIndex = 0 And CURRENT_CONTROL_DOCTYPE_MATCH = cmbDokumentart.Text Then
CURRENT_DOKARTID = cmbDokumentart.SelectedValue
CURRENT_DOKARTSTRING = cmbDokumentart.Text
Refresh_indices()
End If
End If
Catch ex As Exception
MsgBox("Error in Form Shown:" & vbCrLf & ex.Message, MsgBoxStyle.Critical)
End Try
formloaded = True
End Sub
Private Sub txtSubfolder_TextChanged(sender As Object, e As EventArgs) Handles txtSubfolder.TextChanged
CURRENT_SUBFOLDER = txtSubfolder.Text
End Sub
Private Sub frmWM_IndexFile_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing
Try
' ── Multi-Indexing-Flags zurücksetzen ──
_multiIndexDecisionMade = False
_multiIndexOverwriteExisting = False
' ✅ WICHTIG: Liste NEU LADEN, bevor wir zählen!
LOGGER.Debug("=== CLOSING: Lade aktuelle Dateiliste ===")
ClassHelper.Create_USER_FILE_TABLE() ' ← Lädt CURRENT_TBPMO_FILES_USER NEU!
' ── Prüfen, ob noch Dateien zu verarbeiten sind ──
If CURRENT_TBPMO_FILES_USER IsNot Nothing AndAlso CURRENT_TBPMO_FILES_USER.Rows.Count > 0 Then
' Es gibt noch nicht verarbeitete Dateien → Benutzer fragen
LOGGER.Debug($"TBPMO_FILES_USER: Formular wird geschlossen, aber {CURRENT_TBPMO_FILES_USER.Rows.Count} Dateien sind noch vorhanden.")
Dim msg As String
Dim title As String
If USER_LANGUAGE <> "de-DE" Then
msg = $"There are still {CURRENT_TBPMO_FILES_USER.Rows.Count} unprocessed file(s)!" & vbCrLf & vbCrLf &
"Do you really want to cancel the import?" & vbCrLf & vbCrLf &
"YES → Cancel import and delete all pending files" & vbCrLf &
"NO → Continue indexing"
title = "Cancel Import?"
Else
msg = $"Es sind noch {CURRENT_TBPMO_FILES_USER.Rows.Count} nicht verarbeitete Datei(en) vorhanden!" & vbCrLf & vbCrLf &
"Möchten Sie den Import wirklich abbrechen?" & vbCrLf & vbCrLf &
"JA → Import abbrechen und alle ausstehenden Dateien löschen" & vbCrLf &
"NEIN → Indexierung fortsetzen"
title = "Import abbrechen?"
End If
Dim result As MsgBoxResult = MessageBox.Show(msg, title, MessageBoxButtons.YesNo, MessageBoxIcon.Warning)
If result = MsgBoxResult.No Then
' Benutzer will NICHT abbrechen → Formular-Schließen verhindern
LOGGER.Info("Benutzer hat Abbruch verhindert - Formular bleibt offen")
e.Cancel = True
Exit Sub
Else
' Benutzer will abbrechen → Alle Dateien löschen
LOGGER.Info("Benutzer hat Abbruch bestätigt - Lösche alle ausstehenden Dateien")
Dim oDelete = $"DELETE FROM TBPMO_FILES_USER WHERE USER_WORK = '{USER_USERNAME}' AND WORKED = 0"
MYDB_ECM.ExecuteNonQuery(oDelete)
LOGGER.Info($"TBPMO_FILES_USER: {CURRENT_TBPMO_FILES_USER.Rows.Count} nicht-verarbeitete Einträge wurden gelöscht (User: {USER_USERNAME})")
' ── WICHTIG: DataTable leeren, damit Load-Event korrekt reagiert ──
CURRENT_TBPMO_FILES_USER.Clear()
LOGGER.Debug("CURRENT_TBPMO_FILES_USER wurde geleert")
End If
Else
' Keine Dateien mehr vorhanden → Normal schließen, aufräumen
LOGGER.Debug("Keine ausstehenden Dateien mehr vorhanden ")
End If
Catch ex As Exception
LOGGER.Warn($"Fehler beim Bereinigen von TBPMO_FILES_USER (Closing): {ex.Message}")
End Try
End Sub
Private Sub frmWM_IndexFile_Closed(sender As Object, e As EventArgs) Handles Me.Closed
Try
Cursor = Cursors.Default
Catch ex As Exception
End Try
End Sub
Private Sub chkMultiIndexer_CheckedChanged(sender As Object, e As EventArgs) Handles chkMultiIndexer.CheckedChanged
LOGGER.Debug($"chkMultiIndexer.CheckedChanged: {chkMultiIndexer.Checked}")
End Sub
End Class