3.7.2 Optimierungen und Button Knoten hinzufügen

This commit is contained in:
Developer01
2026-03-16 09:49:12 +01:00
parent 570d1161f8
commit 3a44abf77b
26 changed files with 1051 additions and 4761 deletions

View File

@@ -13,7 +13,7 @@ Public Class frmWM_IndexFile
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
@@ -57,32 +57,43 @@ Public Class frmWM_IndexFile
Dim existsonlyasMaster = False
If WMMOD.TestFileExists(CURRENT_NEWFILENAME) = True Then
Dim msg = "Eine Datei mit identischem Namen existiert bereits! Wollen Sie die bestehende Datei ersetzen? (KEINE VERSIONIERUNG)" & vbNewLine & "Beachten Sie das vorhandene Versionen beim Ersetzen mit gelöscht werden!"
Dim msg As String
If USER_LANGUAGE <> "de-DE" Then
msg = "There is already a file with the same name! Would You like to replace the file?" & vbNewLine & "All versions will also be deleted!"
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
result = MessageBox.Show(msg, "File already exists:", MessageBoxButtons.YesNo, MessageBoxIcon.Question)
If result = MsgBoxResult.Yes Then
If WMMOD.RemoveFile(CURRENT_NEWFILENAME) Then
'swWORK_FILE.Done()
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 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
' Löschen erfolgreich → Import wird fortgesetzt
End If
Else
CURRENT_NEWFILENAME = ClassHelper.Versionierung_Datei(CURRENT_NEWFILENAME)
End If
Else
If WMMOD.TestFileExists(CURRENT_NEWFILENAME) = True Then
ClassHelper.InsertEssential_Log(CURRENT_RECORD_ID, "RECORD-ID", "FILE ALREADY EXISTED WITH NON-USER RIGHTS: " & CURRENT_NEWFILENAME)
CURRENT_NEWFILENAME = ClassHelper.Versionierung_Datei(CURRENT_NEWFILENAME)
existsonlyasMaster = True
Dim msg = "Eine Datei mit identischem Namen existiert bereits!" & vbNewLine & "Sie besitzen allerdings nicht die Rechte diese Datei zu bearbeiten." & vbNewLine & "Aus diesem Grund wird Ihre Datei versioniert!"
If USER_LANGUAGE <> "de-DE" Then
msg = "There is already a file with the same name!" & vbNewLine & "But You do not own the rights to work it." & vbNewLine & "Therefore Your file will be versioned!"
End If
MsgBox(msg, MsgBoxStyle.Information)
End If
End If
sw.Done()
'#################################################################
@@ -217,12 +228,12 @@ Public Class frmWM_IndexFile
End If
Else
'MsgBox("Attention in Work-File:" & vbNewLine & "No indices were defined (1)!", MsgBoxStyle.Critical)
'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:" & vbNewLine & "No indices were defined (0)!", MsgBoxStyle.Critical)
MsgBox("Attention in Work-File:" & vbCrLf & "No indices were defined (0)!", MsgBoxStyle.Critical)
Return False
End If
@@ -234,7 +245,7 @@ Public Class frmWM_IndexFile
LOGGER.Info("oReldocpath: " & oReldocpath)
CURRENT_WM_OBJECT = WMMOD.GetFileByPath(oReldocpath)
If IsNothing(CURRENT_WM_OBJECT) Then
MsgBox("Attention in Work-File:" & vbNewLine & "Could not create final windream-object!", MsgBoxStyle.Critical)
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)
@@ -293,7 +304,7 @@ Public Class frmWM_IndexFile
FAU_AD_USER = ""
ClassFileResult.DocID = CURRENT_DOC_ID
ClassFileResult.SET_DOCID_INDICES()
If ClassDOC_SEARCH.CREATE_DOC_RELATED_LINKS(CURRENT_DOC_ID, CURRENT_RECORD_ID) = False Then
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
@@ -303,7 +314,7 @@ Public Class frmWM_IndexFile
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!" & vbNewLine &
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!!")
@@ -333,7 +344,7 @@ Public Class frmWM_IndexFile
Return False
End If
Catch ex As Exception
MsgBox("Unexpected error in Work-File:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
MsgBox("Unexpected error in Work-File:" & vbCrLf & ex.Message, MsgBoxStyle.Critical)
'swWORK_FILE.Done()
Return False
End Try
@@ -378,67 +389,100 @@ Public Class frmWM_IndexFile
Try
Me.Cursor = Cursors.WaitCursor
SaveMySettingsValue("WD_IndexDeleteDocs", WD_IndexDeleteDocs, "ConfigMain")
' clsWM.MY_WDOBJECTTYPE = Me.OBJECT_TYPETextBox.Text
'Multi-Indexer ist aktiv
If chkMultiIndexer.Visible = True And chkMultiIndexer.Checked = True Then
'Die erste Datei indexieren
If WORK_FILE(Me.txtFilepath.Text, Me.PATHTextBox.Text, doctype_id, My.Settings.WD_INDEXDOKART_SAVE, True) = True Then
'Und nun die folgenden
Dim DTFiles2Work As DataTable = MYDB_ECM.GetDatatable("SELECT * FROM TBPMO_FILES_USER WHERE WORKED = 0
AND GUID <> " & CURRENT_FILEID & " AND UPPER(USER_WORK) = UPPER('" & USER_USERNAME & "')")
If Not DTFiles2Work Is Nothing Then
Dim err = False
For Each filerow As DataRow In DTFiles2Work.Rows
FILE_WORKED = False
CURRENT_FILEID = filerow.Item("GUID")
CURRENT_FILENAME = filerow.Item("FILENAME2WORK")
Dim HandleType As String = filerow.Item("HANDLE_TYPE")
aktFiledropped = CURRENT_FILENAME
If HandleType = "@DROPFROMFSYSTEM@" Then
droptype = "dragdrop file"
ElseIf HandleType = "@OUTLOOK_ATTMNT@" Then
droptype = "dragdrop attachment"
ElseIf HandleType = "@OUTLOOKMESSAGE@" Then
droptype = "dragdrop message"
Else
droptype = filerow.Item("HANDLE_TYPE")
End If
If WORK_FILE(CURRENT_FILENAME, Me.PATHTextBox.Text, doctype_id, My.Settings.WD_INDEXDOKART_SAVE, True) = False Then
err = True
Exit For
Else
FILE_WORKED = True
End If
Next
Me.Cursor = Cursors.Default
If err = False Then
NEW_FILES_ADDED = 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
MsgBox(stg, MsgBoxStyle.Information, stg1)
FILE_WORKED = True
Me.Close()
End If
' ── Erste Datei: FILE_HASH sicherstellen ───────────────────────
For Each oRow As DataRow In CURRENT_TBPMO_FILES_USER.Rows
If oRow.Item("GUID") = CURRENT_FILEID Then
FILE_HASH = oRow.Item("FILE_HASH")
Exit For
End If
Next
If WORK_FILE(Me.txtFilepath.Text, Me.PATHTextBox.Text, doctype_id, My.Settings.WD_INDEXDOKART_SAVE, True) = False Then
Me.Cursor = Cursors.Default
Return False
End If
Else 'No MULTI INDEX
' ── Erste Datei erfolgreich: GUID merken, Folgedateien laden ──
Dim firstFileId = CURRENT_FILEID
Dim DTFiles2Work As DataTable = MYDB_ECM.GetDatatable(
"SELECT * FROM TBPMO_FILES_USER WHERE WORKED = 0 " &
"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
Me.Close()
Return True
End If
Dim err As Boolean = False
For Each filerow As DataRow In DTFiles2Work.Rows
CURRENT_FILEID = filerow.Item("GUID")
CURRENT_FILENAME = filerow.Item("FILENAME2WORK")
FILE_HASH = filerow.Item("FILE_HASH")
aktFiledropped = CURRENT_FILENAME
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(CURRENT_FILENAME, Me.PATHTextBox.Text, doctype_id, My.Settings.WD_INDEXDOKART_SAVE, True) = False Then
err = True
Exit For
End If
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
MsgBox(stg, MsgBoxStyle.Information, stg1)
Me.Close()
Return True
End If
Return False
Else
' ── Einzeldatei ───────────────────────────────────────────────
If WORK_FILE(Me.txtFilepath.Text, Me.PATHTextBox.Text, doctype_id, My.Settings.WD_INDEXDOKART_SAVE, False) = True Then
NEW_FILES_ADDED = True
FILE_WORKED = True
Me.Cursor = Cursors.Default
Me.Close()
Return True
Else
MessageBox.Show("Import to windream was not successful." & vbNewLine & "Check the log for further information!", "Unexpected Error in windream-Stream:", MessageBoxButtons.OK, MessageBoxIcon.Error)
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
End If
Me.Cursor = Cursors.Default
Catch ex As Exception
MsgBox("Error in Indexing_File:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
MsgBox("Error in Indexing_File:" & vbCrLf & ex.Message, MsgBoxStyle.Critical)
Finally
Me.Cursor = Cursors.Default
End Try
End Function
Private Sub cmbDokumentart_SelectedIndexChanged(sender As Object, e As EventArgs) Handles cmbDokumentart.SelectedIndexChanged
@@ -453,7 +497,7 @@ Public Class frmWM_IndexFile
End If
Catch ex As Exception
MsgBox("Error in cmbDokumentart SelectedIndex:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
MsgBox("Error in cmbDokumentart SelectedIndex:" & vbCrLf & ex.Message, MsgBoxStyle.Critical)
End Try
End Sub
Sub Refresh_Indices_Manual()
@@ -528,7 +572,7 @@ Public Class frmWM_IndexFile
Me.Size = New Size(605, 430)
End If
Catch ex As Exception
MsgBox("Error in Refresh_Indices_Manual:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
MsgBox("Error in Refresh_Indices_Manual:" & vbCrLf & ex.Message, MsgBoxStyle.Critical)
End Try
End Sub
@@ -554,7 +598,7 @@ Public Class frmWM_IndexFile
End If
End If
Catch ex As Exception
MsgBox("Error in Check_Subfolder:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
MsgBox("Error in Check_Subfolder:" & vbCrLf & ex.Message, MsgBoxStyle.Critical)
lblSubfolder.Visible = False
txtSubfolder.Visible = False
CURRENT_CHECK_SUBFOLDER = False
@@ -739,7 +783,7 @@ Public Class frmWM_IndexFile
End If
Catch ex As Exception
MsgBox("Error in Get_NextComboBoxResults:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
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)
@@ -835,7 +879,7 @@ Public Class frmWM_IndexFile
Next
End If
Catch ex As Exception
LOGGER.Warn(" - Unvorhergesehener Unexpected error in Renew_ComboboxResults - Fehler: " & vbNewLine & ex.Message)
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
@@ -947,7 +991,7 @@ Public Class frmWM_IndexFile
End If
Catch ex As Exception
LOGGER.Warn(" - Unvorhergesehener Unexpected error in AddVorschlag_ComboBox - Indexname: " & indexname & " - Fehler: " & vbNewLine & ex.Message)
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
@@ -1001,7 +1045,7 @@ Public Class frmWM_IndexFile
' lvwIndices.Items(Count).SubItems.Add(ParentID)
' End If
'Catch ex As Exception
' MsgBox("Unexpected Error in Setting Parent-ID" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
' MsgBox("Unexpected Error in Setting Parent-ID" & vBCrlf & ex.Message, MsgBoxStyle.Critical)
'End Try
'Count = Count + 1
''den Record-Key auslesen
@@ -1017,7 +1061,7 @@ Public Class frmWM_IndexFile
End If
Catch ex As Exception
MsgBox("Error in Refresh Indices for Indexing:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
MsgBox("Error in Refresh Indices for Indexing:" & vbCrLf & ex.Message, MsgBoxStyle.Critical)
End Try
End Sub
@@ -1034,11 +1078,12 @@ Public Class frmWM_IndexFile
chkdelete_origin.Visible = False
Dim oReconnect = WMMOD.SessionReconnect
'= New Windream(LOGCONFIG, False, WMDriveLetter, WMPATH_PREFIX, True, WM_SERVER, WM_USER, WM_USER_PW, WM_DOMAIN)
Dim HandleType As String
For Each row As DataRow In CURRENT_TBPMO_FILES_USER.Rows
If row.Item("GUID") = CURRENT_FILEID Then
CURRENT_FILENAME = row.Item("FILENAME2WORK")
HandleType = row.Item("HANDLE_TYPE")
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")
End If
Next
If CURRENT_FILENAME = "" Then
@@ -1059,19 +1104,19 @@ Public Class frmWM_IndexFile
End If
aktFiledropped = CURRENT_FILENAME
txtFilepath.Text = aktFiledropped
If HandleType = "@DROPFROMFSYSTEM@" Then
If oHandleType = "@DROPFROMFSYSTEM@" Then
droptype = "dragdrop file"
chkdelete_origin.Visible = True
chkdelete_origin.Checked = WD_IndexDeleteDocs
ElseIf HandleType = "@OUTLOOK_ATTMNT@" Then
ElseIf oHandleType = "@OUTLOOK_ATTMNT@" Then
droptype = "dragdrop attachment"
chkdelete_origin.Visible = True
chkdelete_origin.Checked = WD_IndexDeleteDocs
ElseIf HandleType = "@OUTLOOKMESSAGE@" Then
ElseIf oHandleType = "@OUTLOOKMESSAGE@" Then
droptype = "dragdrop message"
chkdelete_origin.Visible = True
chkdelete_origin.Checked = WD_IndexDeleteDocs
ElseIf HandleType = "SCAM" Then
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}) " &
@@ -1088,7 +1133,7 @@ Public Class frmWM_IndexFile
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)
'Me.VWPMO_DOKUMENTTYPESTableAdapter.Fill(Me.DD_DMSDataSet.VWPMO_DOKUMENTTYPES, FVID)
If DTVWPMO_DOKUMENTTYPES.Rows.Count = 0 Then 'DD_DMSDataSet.VWPMO_DOKUMENTTYPES.Rows.Count = 0 Then
MsgBox("No documenttypes for the redundant entity configured either! Indexing is not possible!" & vbNewLine & "Please check the configuration!", MsgBoxStyle.Exclamation)
MsgBox("No documenttypes for the redundant entity configured either! Indexing is not possible!" & vbCrLf & "Please check the configuration!", MsgBoxStyle.Exclamation)
Exit Sub
Else
LOGGER.Debug("Redundant EntityID: " & CURRENT_ENTITY_REDUNDANT_ID)
@@ -1098,13 +1143,13 @@ Public Class frmWM_IndexFile
CURRENT_FORMVIEW_ID = FVID
End If
Else
MsgBox("No documenttypes for this entity configured! Indexing is not possible!" & vbNewLine & "Please check the configuration!", MsgBoxStyle.Exclamation)
MsgBox("No documenttypes for this entity configured! Indexing is not possible!" & vbCrLf & "Please check the configuration!", MsgBoxStyle.Exclamation)
Exit Sub
End If
End If
Catch ex As Exception
MsgBox("Error in frmWD_Index_Dokart_Load:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
MsgBox("Error in frmWD_Index_Dokart_Load:" & vbCrLf & ex.Message, MsgBoxStyle.Critical)
End Try
End Sub
@@ -1146,7 +1191,7 @@ Public Class frmWM_IndexFile
End If
End If
Catch ex As Exception
MsgBox("Error in Form Shown:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
MsgBox("Error in Form Shown:" & vbCrLf & ex.Message, MsgBoxStyle.Critical)
End Try
formloaded = True
End Sub
@@ -1156,9 +1201,35 @@ Public Class frmWM_IndexFile
End Sub
Private Sub frmWM_IndexFile_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing
If FILE_WORKED = False Then
Dim oDelete = "DELETE FROM TBPMO_FILES_USER WHERE GUID = " & CURRENT_FILEID
MYDB_ECM.ExecuteNonQuery(oDelete)
End If
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).")
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
End Class