3731 lines
188 KiB
VB.net
3731 lines
188 KiB
VB.net
Imports System.IO
|
||
Imports System.Security.AccessControl
|
||
Imports System.Text
|
||
Imports System.Text.RegularExpressions
|
||
Imports DevExpress.XtraEditors
|
||
Imports DevExpress.XtraEditors.Controls
|
||
Imports DevExpress.XtraSpreadsheet.TileLayout
|
||
Imports DigitalData.Controls.LookupGrid
|
||
Imports DigitalData.GUIs.Common
|
||
Imports DigitalData.GUIs.GlobalIndexer
|
||
Imports DigitalData.Modules.Base
|
||
'Imports System.Security.Principal
|
||
Imports DigitalData.Modules.Logging
|
||
Imports DigitalData.Modules.Windream
|
||
Imports GdPicture.Internal.MSOfficeBinary.translator.Spreadsheet.XlsFileFormat.Records
|
||
Imports Limilabs.Mail
|
||
'Imports DevExpress.DataAccess.Native.Json
|
||
'Imports GdPicture.Internal.MSOfficeBinary.translator.Spreadsheet.XlsFileFormat.Records
|
||
|
||
Public Class frmIndex
|
||
#Region "+++++ Variablen ++++++"
|
||
Public vPathFile As String
|
||
Private MULTIFILES As Integer
|
||
Private ReadOnly akttxtbox As TextBox
|
||
Dim DT_INDEXEMAN As DataTable
|
||
Public FormLoaded As Boolean = False
|
||
Private Shared ReadOnly _Instance As frmIndex = Nothing
|
||
Dim DropType As String
|
||
Private Shared WMDirect As Boolean = False
|
||
|
||
Dim sql_history_INSERT_INTO As String
|
||
Dim sql_history_Index_Values As String
|
||
|
||
Private NewFileString As String
|
||
Private CancelAttempts As Integer = 0
|
||
Private Const MaxCancelAttempts = 2
|
||
|
||
Private Property ViewerString As String
|
||
|
||
Private Const TEXT_MISSING_INPUT_DE = "Bitte vervollständigen Sie die Eingaben!"
|
||
Private Const TEXT_MISSING_INPUT_EN = "Please complete your entries!"
|
||
|
||
Private Const TEXT_CHECK_MANUAL_INDEXES_DE = "Die Überprüfung der manuellen Indexe ist fehlerhaft. Bitte informieren Sie Ihrenm Systembetreuer."
|
||
Private Const TEXT_CHECK_MANUAL_INDEXES_EN = "There is an error in the validation settings of the manual indexes. Please inform your administrator."
|
||
|
||
Private Const TEXT_CATCH_BLOCK_DE = "Unvorhergesehener Fehler in {0}: Fehlermeldung {1}"
|
||
Private Const TEXT_CATCH_BLOCK_EN = "Unexpected Error in {0}: Errormessage {1}"
|
||
|
||
Private Const LANG_DE = "de-DE"
|
||
|
||
Private Property DocTypes As New List(Of DocType)
|
||
|
||
Private ReadOnly _Logger As Logger
|
||
Private ReadOnly _FormHelper As FormHelper
|
||
Private ReadOnly _PostProcessing As ClassPostprocessing
|
||
|
||
#End Region
|
||
|
||
Public Class DocType
|
||
Public Property Guid
|
||
Public Property Name
|
||
|
||
Public Overrides Function ToString() As String
|
||
Return Name
|
||
End Function
|
||
End Class
|
||
Private Sub ShowErrorMessage(Exception As Exception, MethodTitle As String, Optional MoreInfo As String = "")
|
||
Dim oMessage As String
|
||
Dim oMoreInfo As String = IIf(MoreInfo = "", "", "(" & MoreInfo & ")")
|
||
|
||
If USER_LANGUAGE = LANG_DE Then
|
||
oMessage = String.Format(TEXT_CATCH_BLOCK_DE, MethodTitle, Exception.Message) & oMoreInfo
|
||
Else
|
||
oMessage = String.Format(TEXT_CATCH_BLOCK_EN, MethodTitle, Exception.Message) & oMoreInfo
|
||
End If
|
||
|
||
_Logger.Warn(oMessage)
|
||
_Logger.Error(Exception)
|
||
|
||
MsgBox(oMessage, MsgBoxStyle.Critical, Text)
|
||
End Sub
|
||
|
||
Public Sub New()
|
||
' Dieser Aufruf ist für den Designer erforderlich.
|
||
InitializeComponent()
|
||
' Fügen Sie Initialisierungen nach dem InitializeComponent()-Aufruf hinzu.
|
||
_Logger = LOGCONFIG.GetLogger()
|
||
_Logger.Debug("frmIndex Logger initialized ...")
|
||
_FormHelper = New FormHelper(LOGCONFIG, Me)
|
||
_Logger.Debug("frmIndex FormHelper initialized ...")
|
||
_PostProcessing = New ClassPostprocessing(LOGCONFIG)
|
||
_Logger.Debug("frmIndex ClassPostprocessing initialized ...")
|
||
|
||
Localizer.Active = New LookupGridLocalizer()
|
||
_Logger.Debug("frmIndex LookupGridLocalizer initialized ...")
|
||
End Sub
|
||
|
||
Public Sub CloseViewer()
|
||
If DocumentViewer1 Is Nothing Then
|
||
LOGGER.Warn("DocumentViewer is already closed!")
|
||
End If
|
||
|
||
Try
|
||
LOGGER.Debug("Calling CloseDocument on Viewer")
|
||
DocumentViewer1.CloseDocument()
|
||
Catch ex As Exception
|
||
LOGGER.Warn("Calling CloseDocument on Viewer FAILED")
|
||
LOGGER.Error(ex)
|
||
End Try
|
||
|
||
Try
|
||
LOGGER.Debug("Calling Done on Viewer")
|
||
DocumentViewer1?.Done()
|
||
Catch ex As Exception
|
||
LOGGER.Warn("Calling Done on Viewer FAILED")
|
||
LOGGER.Error(ex)
|
||
End Try
|
||
End Sub
|
||
|
||
Public Sub DisposeViewer()
|
||
DocumentViewer1.Dispose()
|
||
End Sub
|
||
|
||
'#Region "+++++ Allgemeine Funktionen ++++++"
|
||
Sub ShowError(text As String)
|
||
'lblerror.Visible = True
|
||
'lblerror.Text = text
|
||
'lblerror.ForeColor = Color.Red
|
||
labelError.Visibility = DevExpress.XtraBars.BarItemVisibility.Always
|
||
labelError.Caption = text
|
||
End Sub
|
||
|
||
Sub ClearError()
|
||
labelError.Visibility = DevExpress.XtraBars.BarItemVisibility.Never
|
||
labelError.Caption = String.Empty
|
||
End Sub
|
||
|
||
Sub ShowNotice(text As String)
|
||
'lblhinweis.Visible = True
|
||
'lblhinweis.Text = text
|
||
labelNotice.Visibility = DevExpress.XtraBars.BarItemVisibility.Always
|
||
labelNotice.Caption = text
|
||
End Sub
|
||
|
||
Sub ClearNotice()
|
||
labelNotice.Visibility = DevExpress.XtraBars.BarItemVisibility.Never
|
||
labelNotice.Caption = String.Empty
|
||
End Sub
|
||
|
||
Private Sub SetFilePreview(ShowPreview As Boolean)
|
||
If ShowPreview Then
|
||
SplitContainer1.Panel2Collapsed = False
|
||
PreviewFile()
|
||
checkItemPreview.Checked = True
|
||
Else
|
||
SplitContainer1.Panel2Collapsed = True
|
||
checkItemPreview.Checked = False
|
||
End If
|
||
End Sub
|
||
|
||
Sub addLabel(indexname As String, hinweis As String, ylbl As Integer, anz As String)
|
||
Dim lbl As New Windows.Forms.Label With {
|
||
.Name = "lbl" & indexname,
|
||
.AutoSize = True,
|
||
.Text = hinweis,
|
||
.Location = New Point(11, ylbl)
|
||
}
|
||
|
||
pnlIndex.Controls.Add(lbl)
|
||
End Sub
|
||
|
||
Private Sub AddLabelAndControl(labelText As String, ctrl As Control, indexName As String)
|
||
|
||
'--- Label vorbereiten ------------------------------------
|
||
Dim lbl As New Windows.Forms.Label With {
|
||
.Name = $"lbl_{indexName}",
|
||
.Text = labelText,
|
||
.AutoSize = True,
|
||
.Anchor = AnchorStyles.Left,
|
||
.Margin = New Padding(4, 4, 4, 4)
|
||
}
|
||
|
||
'--- Control vorbereiten ----------------------------------
|
||
ctrl.Anchor = AnchorStyles.Left Or AnchorStyles.Right
|
||
ctrl.Margin = New Padding(4, 4, 4, 4)
|
||
ctrl.Width = 300 'falls AutoSize=False
|
||
ctrl.Dock = DockStyle.Fill
|
||
|
||
'--- Zeile dynamisch anlegen ------------------------------
|
||
tlpIndex.RowCount += 1
|
||
tlpIndex.RowStyles.Add(New RowStyle(SizeType.AutoSize))
|
||
|
||
tlpIndex.Controls.Add(lbl, 0, tlpIndex.RowCount - 1) 'Spalte 0 = Label
|
||
tlpIndex.Controls.Add(ctrl, 1, tlpIndex.RowCount - 1) 'Spalte 1 = Control
|
||
End Sub
|
||
|
||
Function Indexwert_checkValueDB(indexname As String, wert As String)
|
||
Try
|
||
Dim DR As DataRow
|
||
'DT = DD_DMSLiteDataSet.VWINDEX_MAN
|
||
For Each DR In DT_INDEXEMAN.Rows
|
||
If DR.Item("NAME") = indexname Then
|
||
If DR.Item("SQL_CHECK").ToString <> String.Empty Then
|
||
Dim connectionString As String
|
||
Dim sql As String
|
||
connectionString = DATABASE_ECM.Get_ConnectionStringforID(DR.Item("CONNECTION_ID"))
|
||
If connectionString <> "" Then
|
||
Dim sqlscalar = DR.Item("SQL_CHECK")
|
||
Select Case DR.Item("DATENTYP")
|
||
Case ClassConstants.INDEX_TYPE_INTEGER
|
||
sqlscalar = sqlscalar.ToString.Replace("@manValue", wert)
|
||
Case Else
|
||
sqlscalar = sqlscalar.ToString.Replace("@manValue", "'" & wert & "'")
|
||
End Select
|
||
|
||
sql = sqlscalar
|
||
Dim ergebnis As Integer
|
||
If DR.Item("SQL_PROVIDER") = "Oracle" Then
|
||
|
||
' ergebnis = ClassDatabase.OracleExecute_Scalar(sql, connectionString)
|
||
LOGGER.Warn("Oracle is not supported")
|
||
Else
|
||
'MSQL
|
||
ergebnis = DATABASE_ECM.GetScalarValueWithConnection(sql, connectionString)
|
||
End If
|
||
|
||
Select Case ergebnis
|
||
Case 1
|
||
Return True
|
||
Case 2
|
||
ShowNotice("Indexwert nicht eindeutig: " & sql)
|
||
Return False
|
||
Case 99
|
||
Return False
|
||
End Select
|
||
|
||
End If
|
||
Else
|
||
Return True
|
||
End If
|
||
|
||
End If
|
||
Next
|
||
Catch ex As Exception
|
||
ShowErrorMessage(ex, "Indexwert_checkValue")
|
||
Return False
|
||
End Try
|
||
End Function
|
||
|
||
Function GetManIndex_Value(indexname As String, RequestFor As String, opt As Boolean)
|
||
Try
|
||
Dim DT As DataTable
|
||
Dim DR As DataRow
|
||
DT = MyDataset.VWDDINDEX_MAN
|
||
For Each DR In DT.Rows
|
||
If DR.Item("INDEXNAME").ToString.ToLower = indexname.ToLower Then
|
||
If DR.Item("Indexiert") = True Then
|
||
_Logger.Info("## Manueller Index: " & indexname)
|
||
Select Case RequestFor
|
||
Case "FILE"
|
||
If DR.Item("Indexwert_File").ToString <> String.Empty Then
|
||
_Logger.Info(" >>Es liegt ein separater nachbearbeiteter Wert für die Dateibenennung vor: " & DR.Item("Indexwert_File").ToString)
|
||
_Logger.Info(" >>Zurückgegebener NachbearbeitungsWert: " & DR.Item("Indexwert_File"))
|
||
Return DR.Item("Indexwert_File")
|
||
Else
|
||
If DR.Item("Indexwert").ToString <> String.Empty Then
|
||
_Logger.Info("Zurückgegebener manueller Indexwert: " & DR.Item("Indexwert"))
|
||
Return DR.Item("Indexwert")
|
||
Else
|
||
If opt = False Then
|
||
_Logger.Info("Achtung, der Indexwert des manuellen Indexes '" & indexname & "' ist String.empty!")
|
||
ShowNotice("Indexiert = True - Der Index: " & DR.Item("INDEXNAME") & " wurde nicht ordnungsgemäss indexiert! - Automatischer Index konnte nicht gesetzt werden!")
|
||
Return Nothing
|
||
Else
|
||
Return ""
|
||
End If
|
||
|
||
End If
|
||
End If
|
||
Case Else
|
||
If DR.Item("Indexwert").ToString <> String.Empty Then
|
||
_Logger.Info(" >>Zurückgegebener manueller Indexwert: " & DR.Item("Indexwert"))
|
||
Return DR.Item("Indexwert")
|
||
Else
|
||
If opt = False Then
|
||
_Logger.Info("Achtung, der Indexwert des manuellen Indexes '" & indexname & "' ist String.empty!")
|
||
ShowNotice("Indexiert = True - Der Index: " & DR.Item("INDEXNAME") & " wurde nicht ordnungsgemäss indexiert! - Automatischer Index konnte nicht gesetzt werden!")
|
||
Return Nothing
|
||
Else
|
||
Return ""
|
||
End If
|
||
End If
|
||
End Select
|
||
Else
|
||
ShowNotice("Der Index: " & DR.Item("INDEXNAME") & " wurde nicht ordnungsgemäss indexiert! - Automatischer Index konnte nicht gesetzt werden!")
|
||
Return Nothing
|
||
End If
|
||
Exit For
|
||
End If
|
||
Next
|
||
Catch ex As Exception
|
||
ShowErrorMessage(ex, "GetManIndex_Value")
|
||
Return Nothing
|
||
End Try
|
||
End Function
|
||
Function GetAutoIndex_Value(indexname As String)
|
||
Try
|
||
Dim oDataTable As DataTable
|
||
|
||
oDataTable = MyDataset.VWDDINDEX_AUTOM
|
||
For Each oDataRow As DataRow In oDataTable.Rows
|
||
If oDataRow.Item("INDEXNAME").ToString.ToLower = indexname.ToLower Then
|
||
Dim oIndexWert = oDataRow.Item("Indexwert")
|
||
Dim oIsIndexed = oDataRow.Item("Indexiert")
|
||
|
||
If oIsIndexed = True Then
|
||
If oIndexWert.ToString <> String.Empty Then
|
||
oIndexWert = oIndexWert.ToString
|
||
|
||
' If Index is a vectorfield (read: Value contains the VECTORSEPARATOR character), use the first value
|
||
If oIndexWert.Contains(ClassConstants.VECTORSEPARATOR) Then
|
||
Return oIndexWert.ToString.Split(ClassConstants.VECTORSEPARATOR).FirstOrDefault()
|
||
Else
|
||
' Else just return the normal value
|
||
Return oIndexWert
|
||
End If
|
||
Else
|
||
ShowNotice("Der Automatische Index: " & oDataRow.Item("INDEXNAME") & " wurde nicht ordnungsgemäss indexiert!")
|
||
Return ""
|
||
End If
|
||
Else
|
||
ShowNotice("Der Automatische Index: " & oDataRow.Item("INDEXNAME") & " wurde nicht ordnungsgemäss indexiert!")
|
||
Return ""
|
||
End If
|
||
Exit For
|
||
End If
|
||
Next
|
||
Catch ex As Exception
|
||
ShowErrorMessage(ex, "GetAutoIndex_Value")
|
||
Return ""
|
||
End Try
|
||
End Function
|
||
|
||
Function GetAutomaticIndexSQLValue(SQLCommand As String, vconnectionID As Integer, vProvider As String) As String
|
||
Try
|
||
Dim oConnectionString As String
|
||
oConnectionString = DATABASE_ECM.Get_ConnectionStringforID(vconnectionID)
|
||
If oConnectionString <> "" Then
|
||
'NEU
|
||
Dim oErgebnis
|
||
'Welcher Provider?
|
||
If vProvider.ToLower = "oracle" Then
|
||
'oErgebnis = ClassDatabase.OracleExecute_Scalar(SQLCommand, oConnectionString)
|
||
LOGGER.Warn("Oracle Database Queries are not supported")
|
||
Else 'im Moment nur SQL-Server
|
||
oErgebnis = DATABASE_ECM.GetScalarValueWithConnection(SQLCommand, oConnectionString)
|
||
End If
|
||
|
||
If LogErrorsOnly = False Then
|
||
_Logger.Info(" >>SQL-ConnectionString: " & oConnectionString.Substring(0, oConnectionString.LastIndexOf("=")))
|
||
End If
|
||
|
||
If oErgebnis Is Nothing Then
|
||
'showlblhinweis("Kein Ergebnis für automatisches SQL: " & vsqlstatement)
|
||
Return ""
|
||
Else
|
||
Return oErgebnis
|
||
End If
|
||
End If
|
||
|
||
Catch ex As Exception
|
||
ShowErrorMessage(ex, "GetAutomaticIndexSQLValue")
|
||
Return ""
|
||
End Try
|
||
End Function
|
||
|
||
'#End Region
|
||
'#Region "+++++ Funktionen bei OK - schliessen ++++++"
|
||
'Function CheckWrite_IndexeMan(oDocumentTypeId As Integer)
|
||
' '#### Zuerst manuelle Werte indexieren ####
|
||
|
||
' Try
|
||
' _Logger.Info("In CheckWrite_IndexeMan")
|
||
|
||
' DxErrorProvider1.ClearErrors()
|
||
|
||
' Dim oResult As Boolean = False
|
||
' For Each oControl As Control In Me.pnlIndex.Controls
|
||
' ' MsgBox(ctrl.Name)
|
||
' If oControl.Name.StartsWith("txt") Then
|
||
' Dim box As DevExpress.XtraEditors.TextEdit = oControl
|
||
' If box.Text = "" Then
|
||
' Dim optional_index As Boolean = DATABASE_ECM.GetScalarValue("SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = " & oDocumentTypeId & " AND NAME = '" & Replace(box.Name, "txt", "") & "'")
|
||
' If optional_index = False Then
|
||
|
||
' If USER_LANGUAGE = LANG_DE Then
|
||
' 'MsgBox(TEXT_MISSING_INPUT_DE, MsgBoxStyle.Exclamation, "Fehlende Eingabe:")
|
||
' DxErrorProvider1.SetError(box, TEXT_MISSING_INPUT_DE)
|
||
' Else
|
||
' 'MsgBox(TEXT_MISSING_INPUT_EN, MsgBoxStyle.Exclamation, "Missing Input:")
|
||
' DxErrorProvider1.SetError(box, TEXT_MISSING_INPUT_EN)
|
||
' End If
|
||
|
||
' box.Focus()
|
||
' Return False
|
||
' Else
|
||
' DxErrorProvider1.SetError(box, "")
|
||
' Indexwert_Postprocessing(Replace(box.Name, "txt", ""), "")
|
||
' oResult = True
|
||
' End If
|
||
' Else
|
||
' If Indexwert_checkValueDB(Replace(box.Name, "txt", ""), box.Text) = False Then
|
||
' Dim oMessage, oTitle As String
|
||
|
||
' If USER_LANGUAGE = LANG_DE Then
|
||
' oTitle = "Fehlerhafte Indexierung:"
|
||
' oMessage = "Der eingegebene Wert wurde nicht in der Datenbank gefunden!"
|
||
' Else
|
||
' oTitle = "Erroneous Indexing:"
|
||
' oMessage = "The value was not found in the Database!"
|
||
' End If
|
||
|
||
' _Logger.Info(oMessage)
|
||
' DxErrorProvider1.SetError(box, oMessage)
|
||
' box.Focus()
|
||
' Return False
|
||
' Else
|
||
' DxErrorProvider1.SetError(box, "")
|
||
' Indexwert_Postprocessing(Replace(box.Name, "txt", ""), box.Text)
|
||
' oResult = True
|
||
' End If
|
||
' End If
|
||
' End If
|
||
|
||
' If oControl.Name.StartsWith("cmbMulti") Then
|
||
' Dim oLookup = DirectCast(oControl, DigitalData.Controls.LookupGrid.LookupControl3)
|
||
' Dim oValues As List(Of String) = oLookup.Properties.SelectedValues
|
||
|
||
' If oValues.Count = 0 Then
|
||
' Dim oIsOptionalIndex As Boolean = DATABASE_ECM.GetScalarValue("SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = " & oDocumentTypeId & " AND NAME = '" & Replace(oLookup.Name, "cmbMulti", "") & "'")
|
||
|
||
' If oIsOptionalIndex = False Then
|
||
' If USER_LANGUAGE = LANG_DE Then
|
||
' 'MsgBox(TEXT_MISSING_INPUT_DE, MsgBoxStyle.Exclamation, Text)
|
||
' DxErrorProvider1.SetError(oLookup, TEXT_MISSING_INPUT_DE)
|
||
' Else
|
||
' 'MsgBox(TEXT_MISSING_INPUT_EN, MsgBoxStyle.Exclamation, Text)
|
||
' DxErrorProvider1.SetError(oLookup, TEXT_MISSING_INPUT_EN)
|
||
' End If
|
||
|
||
' oLookup.Focus()
|
||
' Return False
|
||
' Else
|
||
' DxErrorProvider1.SetError(oLookup, "")
|
||
' Indexwert_Postprocessing(Replace(oLookup.Name, "cmbMulti", ""), "")
|
||
' oResult = True
|
||
' End If
|
||
' Else
|
||
' DxErrorProvider1.SetError(oLookup, "")
|
||
' Dim vectorValue = String.Join(ClassConstants.VECTORSEPARATOR, oValues)
|
||
' Indexwert_Postprocessing(Replace(oLookup.Name, "cmbMulti", ""), vectorValue)
|
||
' oResult = True
|
||
' End If
|
||
' ElseIf oControl.Name.StartsWith("cmbSingle") Then
|
||
' Dim cmbSingle As TextBox = oControl
|
||
|
||
' If cmbSingle.Text = "" Then
|
||
' Dim optional_index As Boolean = DATABASE_ECM.GetScalarValue("SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = " & oDocumentTypeId & " AND NAME = '" & Replace(cmbSingle.Name, "cmbSingle", "") & "'")
|
||
|
||
' If optional_index = False Then
|
||
' If USER_LANGUAGE = LANG_DE Then
|
||
' 'MsgBox(TEXT_MISSING_INPUT_DE, MsgBoxStyle.Exclamation, Text)
|
||
' DxErrorProvider1.SetError(cmbSingle, TEXT_MISSING_INPUT_DE)
|
||
' Else
|
||
' 'MsgBox(TEXT_MISSING_INPUT_EN, MsgBoxStyle.Exclamation, Text)
|
||
' DxErrorProvider1.SetError(cmbSingle, TEXT_MISSING_INPUT_EN)
|
||
' End If
|
||
' cmbSingle.Focus()
|
||
' Return False
|
||
' Else
|
||
' DxErrorProvider1.SetError(cmbSingle, "")
|
||
' Indexwert_Postprocessing(Replace(cmbSingle.Name, "cmbSingle", ""), "")
|
||
' oResult = True
|
||
' End If
|
||
' Else
|
||
' Indexwert_Postprocessing(Replace(cmbSingle.Name, "cmbSingle", ""), cmbSingle.Text)
|
||
' oResult = True
|
||
' End If
|
||
' ElseIf oControl.Name.StartsWith("cmb") Then
|
||
' Dim cmb As ComboBox = oControl
|
||
' If cmb.Text = "" Then
|
||
' Dim optional_index As Boolean = DATABASE_ECM.GetScalarValue("SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = " & oDocumentTypeId & " AND NAME = '" & Replace(cmb.Name, "cmb", "") & "'")
|
||
' If optional_index = False Then
|
||
' If USER_LANGUAGE = LANG_DE Then
|
||
' 'MsgBox(TEXT_MISSING_INPUT_DE, MsgBoxStyle.Exclamation, Text)
|
||
' DxErrorProvider1.SetError(cmb, TEXT_MISSING_INPUT_DE)
|
||
' Else
|
||
' 'MsgBox(TEXT_MISSING_INPUT_EN, MsgBoxStyle.Exclamation, Text)
|
||
' DxErrorProvider1.SetError(cmb, TEXT_MISSING_INPUT_EN)
|
||
' End If
|
||
' cmb.Focus()
|
||
' Return False
|
||
' Else
|
||
' DxErrorProvider1.SetError(cmb, "")
|
||
' Indexwert_Postprocessing(Replace(cmb.Name, "cmb", ""), "")
|
||
' oResult = True
|
||
' End If
|
||
' Else
|
||
' DxErrorProvider1.SetError(cmb, "")
|
||
' Indexwert_Postprocessing(Replace(cmb.Name, "cmb", ""), cmb.Text)
|
||
' oResult = True
|
||
' End If
|
||
' End If
|
||
' If oControl.Name.StartsWith("dtp") Then
|
||
' Dim dtp As DevExpress.XtraEditors.DateEdit = oControl
|
||
' Dim oIndexName As String = Replace(dtp.Name, "dtp", "")
|
||
|
||
' If dtp.Text = String.Empty Then
|
||
' Dim optional_index As Boolean = DATABASE_ECM.GetScalarValue($"SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = {oDocumentTypeId} AND NAME = '{oIndexName}'")
|
||
|
||
' If optional_index = False Then
|
||
' If USER_LANGUAGE = LANG_DE Then
|
||
' 'MsgBox(TEXT_MISSING_INPUT_DE, MsgBoxStyle.Exclamation, Text)
|
||
' DxErrorProvider1.SetError(dtp, TEXT_MISSING_INPUT_DE)
|
||
' Else
|
||
' 'MsgBox(TEXT_MISSING_INPUT_EN, MsgBoxStyle.Exclamation, Text)
|
||
' DxErrorProvider1.SetError(dtp, TEXT_MISSING_INPUT_EN)
|
||
' End If
|
||
' dtp.Focus()
|
||
' Return False
|
||
' Else
|
||
' DxErrorProvider1.SetError(dtp, "")
|
||
' Indexwert_Postprocessing(oIndexName, "")
|
||
' oResult = True
|
||
' End If
|
||
' Else
|
||
' DxErrorProvider1.SetError(dtp, "")
|
||
' Indexwert_Postprocessing(Replace(dtp.Name, "dtp", ""), dtp.Text)
|
||
' oResult = True
|
||
' End If
|
||
' End If
|
||
' If oControl.Name.StartsWith("chk") Then
|
||
' Dim chk As CheckEdit = oControl
|
||
' DxErrorProvider1.SetError(chk, "")
|
||
' Indexwert_Postprocessing(Replace(chk.Name, "chk", ""), chk.Checked)
|
||
' oResult = True
|
||
' End If
|
||
' If TypeOf (oControl) Is Button Then
|
||
' Continue For
|
||
' End If
|
||
' If oControl.Name.StartsWith("lbl") = False And oResult = False Then
|
||
' _Logger.Info(TEXT_CHECK_MANUAL_INDEXES_EN)
|
||
' Return False
|
||
' End If
|
||
' Next
|
||
|
||
' Return True
|
||
' Catch ex As Exception
|
||
' ShowErrorMessage(ex, "CheckWrite_IndexeMan")
|
||
' Return False
|
||
' End Try
|
||
'End Function
|
||
|
||
'Function CheckWrite_IndexeMan(oDocumentTypeId As Integer) As Boolean
|
||
' _Logger.Info("In CheckWrite_IndexeMan")
|
||
|
||
' DxErrorProvider1.ClearErrors()
|
||
' Dim oResult As Boolean = False
|
||
|
||
' For Each oControl As Control In Me.pnlIndex.Controls
|
||
' ' Uninteressante Controls überspringen
|
||
' If TypeOf oControl Is System.Windows.Forms.Label OrElse
|
||
' TypeOf oControl Is Button OrElse
|
||
' TypeOf oControl Is Panel Then
|
||
' Continue For
|
||
' End If
|
||
|
||
' ' Textfelder (TextEdit)
|
||
' If oControl.Name.StartsWith("txt") Then
|
||
' Dim txt = TryCast(oControl, DevExpress.XtraEditors.TextEdit)
|
||
' If txt IsNot Nothing AndAlso DxErrorProvider1.GetError(txt) = "" Then
|
||
' oResult = True
|
||
' End If
|
||
|
||
' ' Kombinationsfelder (Multi oder Single Select)
|
||
' ElseIf oControl.Name.StartsWith("cmbMulti") OrElse oControl.Name.StartsWith("cmbSingle") OrElse oControl.Name.StartsWith("cmb") Then
|
||
' Dim cmb = TryCast(oControl, DevExpress.XtraEditors.LookUpEdit)
|
||
' If cmb IsNot Nothing AndAlso DxErrorProvider1.GetError(cmb) = "" Then
|
||
' oResult = True
|
||
' End If
|
||
|
||
' ' Datumsauswahl
|
||
' ElseIf oControl.Name.StartsWith("dtp") Then
|
||
' Dim dtp = TryCast(oControl, DevExpress.XtraEditors.DateEdit)
|
||
' If dtp IsNot Nothing AndAlso DxErrorProvider1.GetError(dtp) = "" Then
|
||
' oResult = True
|
||
' End If
|
||
|
||
' ' Checkboxen
|
||
' ElseIf oControl.Name.StartsWith("chk") Then
|
||
' Dim chk = TryCast(oControl, CheckBox)
|
||
' If chk IsNot Nothing AndAlso DxErrorProvider1.GetError(chk) = "" Then
|
||
' oResult = True
|
||
' End If
|
||
|
||
' ' Sonstiges Control (Debug-Ausgabe)
|
||
' Else
|
||
' _Logger.Warn($"Unbekanntes oder nicht unterstütztes Steuerelement gefunden: {oControl.Name} ({oControl.GetType().Name})")
|
||
' End If
|
||
' Next
|
||
|
||
' If Not oResult Then
|
||
' _Logger.Info(TEXT_CHECK_MANUAL_INDEXES_EN)
|
||
' Return False
|
||
' End If
|
||
|
||
' Return True
|
||
'End Function
|
||
|
||
'Function CheckWrite_IndexeMan(oDocumentTypeId As Integer) As Boolean
|
||
' Try
|
||
' _Logger.Info("In CheckWrite_IndexeMan")
|
||
|
||
' DxErrorProvider1.ClearErrors()
|
||
|
||
' Dim oResult As Boolean = False
|
||
|
||
' For Each oControl As Control In Me.pnlIndex.Controls
|
||
|
||
' ' Labels ignorieren
|
||
' If TypeOf oControl Is System.Windows.Forms.Label Then
|
||
' Continue For
|
||
' End If
|
||
|
||
' ' Textfelder (TextEdit)
|
||
' If oControl.Name.StartsWith("txt") Then
|
||
' Dim box As DevExpress.XtraEditors.TextEdit = DirectCast(oControl, DevExpress.XtraEditors.TextEdit)
|
||
' Dim indexName As String = Replace(box.Name, "txt", "")
|
||
' If box.Text = "" Then
|
||
' Dim optional_index As Boolean = DATABASE_ECM.GetScalarValue($"SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = {oDocumentTypeId} AND NAME = '{indexName}'")
|
||
' If Not optional_index Then
|
||
' DxErrorProvider1.SetError(box, If(USER_LANGUAGE = LANG_DE, TEXT_MISSING_INPUT_DE, TEXT_MISSING_INPUT_EN))
|
||
' box.Focus()
|
||
' Return False
|
||
' End If
|
||
' Indexwert_Postprocessing(indexName, "")
|
||
' Else
|
||
' If Not Indexwert_checkValueDB(indexName, box.Text) Then
|
||
' Dim msg As String = If(USER_LANGUAGE = LANG_DE, "Der eingegebene Wert wurde nicht in der Datenbank gefunden!", "The value was not found in the Database!")
|
||
' _Logger.Info(msg)
|
||
' DxErrorProvider1.SetError(box, msg)
|
||
' box.Focus()
|
||
' Return False
|
||
' End If
|
||
' Indexwert_Postprocessing(indexName, box.Text)
|
||
' End If
|
||
' oResult = True
|
||
' Continue For
|
||
' End If
|
||
|
||
' ' Multi-Combo (LookupControl3)
|
||
' If oControl.Name.StartsWith("cmbMulti") Then
|
||
' Dim oLookup = DirectCast(oControl, DigitalData.Controls.LookupGrid.LookupControl3)
|
||
' Dim oValues As List(Of String) = oLookup.Properties.SelectedValues
|
||
' Dim indexName As String = Replace(oLookup.Name, "cmbMulti", "")
|
||
|
||
' If oValues.Count = 0 Then
|
||
' Dim optional_index As Boolean = DATABASE_ECM.GetScalarValue($"SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = {oDocumentTypeId} AND NAME = '{indexName}'")
|
||
' If Not optional_index Then
|
||
' DxErrorProvider1.SetError(oLookup, If(USER_LANGUAGE = LANG_DE, TEXT_MISSING_INPUT_DE, TEXT_MISSING_INPUT_EN))
|
||
' oLookup.Focus()
|
||
' Return False
|
||
' End If
|
||
' Indexwert_Postprocessing(indexName, "")
|
||
' Else
|
||
' Dim vectorValue As String = String.Join(ClassConstants.VECTORSEPARATOR, oValues)
|
||
' Indexwert_Postprocessing(indexName, vectorValue)
|
||
' End If
|
||
' oResult = True
|
||
' Continue For
|
||
' End If
|
||
|
||
' ' Single-Combo (TextBox als Dropdown?)
|
||
' If oControl.Name.StartsWith("cmbSingle") Then
|
||
' Dim cmbSingle As System.Windows.Forms.TextBox = DirectCast(oControl, System.Windows.Forms.TextBox)
|
||
' Dim indexName As String = Replace(cmbSingle.Name, "cmbSingle", "")
|
||
' If cmbSingle.Text = "" Then
|
||
' Dim optional_index As Boolean = DATABASE_ECM.GetScalarValue($"SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = {oDocumentTypeId} AND NAME = '{indexName}'")
|
||
' If Not optional_index Then
|
||
' DxErrorProvider1.SetError(cmbSingle, If(USER_LANGUAGE = LANG_DE, TEXT_MISSING_INPUT_DE, TEXT_MISSING_INPUT_EN))
|
||
' cmbSingle.Focus()
|
||
' Return False
|
||
' End If
|
||
' Indexwert_Postprocessing(indexName, "")
|
||
' Else
|
||
' Indexwert_Postprocessing(indexName, cmbSingle.Text)
|
||
' End If
|
||
' oResult = True
|
||
' Continue For
|
||
' End If
|
||
|
||
' ' Standard-ComboBox
|
||
' If oControl.Name.StartsWith("cmb") Then
|
||
' Dim cmb As System.Windows.Forms.ComboBox = DirectCast(oControl, System.Windows.Forms.ComboBox)
|
||
' Dim indexName As String = Replace(cmb.Name, "cmb", "")
|
||
' If cmb.Text = "" Then
|
||
' Dim optional_index As Boolean = DATABASE_ECM.GetScalarValue($"SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = {oDocumentTypeId} AND NAME = '{indexName}'")
|
||
' If Not optional_index Then
|
||
' DxErrorProvider1.SetError(cmb, If(USER_LANGUAGE = LANG_DE, TEXT_MISSING_INPUT_DE, TEXT_MISSING_INPUT_EN))
|
||
' cmb.Focus()
|
||
' Return False
|
||
' End If
|
||
' Indexwert_Postprocessing(indexName, "")
|
||
' Else
|
||
' Indexwert_Postprocessing(indexName, cmb.Text)
|
||
' End If
|
||
' oResult = True
|
||
' Continue For
|
||
' End If
|
||
|
||
' ' DatePicker
|
||
' If oControl.Name.StartsWith("dtp") Then
|
||
' Dim dtp As DevExpress.XtraEditors.DateEdit = DirectCast(oControl, DevExpress.XtraEditors.DateEdit)
|
||
' Dim indexName As String = Replace(dtp.Name, "dtp", "")
|
||
' If dtp.Text = "" Then
|
||
' Dim optional_index As Boolean = DATABASE_ECM.GetScalarValue($"SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = {oDocumentTypeId} AND NAME = '{indexName}'")
|
||
' If Not optional_index Then
|
||
' DxErrorProvider1.SetError(dtp, If(USER_LANGUAGE = LANG_DE, TEXT_MISSING_INPUT_DE, TEXT_MISSING_INPUT_EN))
|
||
' dtp.Focus()
|
||
' Return False
|
||
' End If
|
||
' Indexwert_Postprocessing(indexName, "")
|
||
' Else
|
||
' Indexwert_Postprocessing(indexName, dtp.Text)
|
||
' End If
|
||
' oResult = True
|
||
' Continue For
|
||
' End If
|
||
|
||
' ' Checkbox
|
||
' If oControl.Name.StartsWith("chk") Then
|
||
' Dim chk As DevExpress.XtraEditors.CheckEdit = DirectCast(oControl, DevExpress.XtraEditors.CheckEdit)
|
||
' Dim indexName As String = Replace(chk.Name, "chk", "")
|
||
' Indexwert_Postprocessing(indexName, chk.Checked)
|
||
' oResult = True
|
||
' Continue For
|
||
' End If
|
||
|
||
' ' Buttons ignorieren
|
||
' If TypeOf oControl Is System.Windows.Forms.Button Then
|
||
' Continue For
|
||
' End If
|
||
' Next
|
||
|
||
' Return True
|
||
|
||
' Catch ex As Exception
|
||
' ShowErrorMessage(ex, "CheckWrite_IndexeMan")
|
||
' Return False
|
||
' End Try
|
||
'End Function
|
||
|
||
Function CheckWrite_IndexeMan(oDocumentTypeId As Integer) As Boolean
|
||
Try
|
||
_Logger.Info("In CheckWrite_IndexeMan")
|
||
|
||
DxErrorProvider1.ClearErrors()
|
||
Dim oResult As Boolean = False
|
||
|
||
For Each oControl As Control In Me.pnlIndex.Controls
|
||
' Labels überspringen
|
||
If TypeOf oControl Is System.Windows.Forms.Label Then
|
||
Continue For
|
||
End If
|
||
|
||
' Textboxen (TextEdit)
|
||
If oControl.Name.StartsWith("txt") Then
|
||
Dim box As DevExpress.XtraEditors.TextEdit = DirectCast(oControl, DevExpress.XtraEditors.TextEdit)
|
||
Dim indexName = Replace(box.Name, "txt", "")
|
||
Dim optionalIndex As Boolean = DATABASE_ECM.GetScalarValue($"SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = {oDocumentTypeId} AND NAME = '{indexName}'")
|
||
|
||
If String.IsNullOrWhiteSpace(box.Text) Then
|
||
If Not optionalIndex Then
|
||
DxErrorProvider1.SetError(box, If(USER_LANGUAGE = LANG_DE, TEXT_MISSING_INPUT_DE, TEXT_MISSING_INPUT_EN))
|
||
box.Focus()
|
||
Return False
|
||
End If
|
||
Indexwert_Postprocessing(indexName, "")
|
||
Else
|
||
If Not Indexwert_checkValueDB(indexName, box.Text) Then
|
||
Dim msg = If(USER_LANGUAGE = LANG_DE,
|
||
"Der eingegebene Wert wurde nicht in der Datenbank gefunden!",
|
||
"The value was not found in the Database!")
|
||
DxErrorProvider1.SetError(box, msg)
|
||
box.Focus()
|
||
Return False
|
||
End If
|
||
Indexwert_Postprocessing(indexName, box.Text)
|
||
End If
|
||
oResult = True
|
||
Continue For
|
||
End If
|
||
|
||
' Mehrfachauswahl (LookupControl3)
|
||
If oControl.Name.StartsWith("cmbMulti") Then
|
||
Dim lookup = DirectCast(oControl, DigitalData.Controls.LookupGrid.LookupControl3)
|
||
Dim values = lookup.Properties.SelectedValues
|
||
Dim indexName = Replace(lookup.Name, "cmbMulti", "")
|
||
Dim optionalIndex As Boolean = DATABASE_ECM.GetScalarValue($"SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = {oDocumentTypeId} AND NAME = '{indexName}'")
|
||
|
||
If values.Count = 0 Then
|
||
If Not optionalIndex Then
|
||
DxErrorProvider1.SetError(lookup, If(USER_LANGUAGE = LANG_DE, TEXT_MISSING_INPUT_DE, TEXT_MISSING_INPUT_EN))
|
||
lookup.Focus()
|
||
Return False
|
||
End If
|
||
Indexwert_Postprocessing(indexName, "")
|
||
Else
|
||
Dim valueJoined = String.Join(ClassConstants.VECTORSEPARATOR, values)
|
||
Indexwert_Postprocessing(indexName, valueJoined)
|
||
End If
|
||
oResult = True
|
||
Continue For
|
||
End If
|
||
|
||
' Einfachauswahl (TextBox)
|
||
If oControl.Name.StartsWith("cmbSingle") Then
|
||
Dim cmbSingle = DirectCast(oControl, TextBox)
|
||
Dim indexName = Replace(cmbSingle.Name, "cmbSingle", "")
|
||
Dim optionalIndex As Boolean = DATABASE_ECM.GetScalarValue($"SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = {oDocumentTypeId} AND NAME = '{indexName}'")
|
||
|
||
If String.IsNullOrWhiteSpace(cmbSingle.Text) Then
|
||
If Not optionalIndex Then
|
||
DxErrorProvider1.SetError(cmbSingle, If(USER_LANGUAGE = LANG_DE, TEXT_MISSING_INPUT_DE, TEXT_MISSING_INPUT_EN))
|
||
cmbSingle.Focus()
|
||
Return False
|
||
End If
|
||
Indexwert_Postprocessing(indexName, "")
|
||
Else
|
||
Indexwert_Postprocessing(indexName, cmbSingle.Text)
|
||
End If
|
||
oResult = True
|
||
Continue For
|
||
End If
|
||
|
||
' ComboBox
|
||
If oControl.Name.StartsWith("cmb") Then
|
||
Dim cmb = DirectCast(oControl, ComboBox)
|
||
Dim indexName = Replace(cmb.Name, "cmb", "")
|
||
Dim optionalIndex As Boolean = DATABASE_ECM.GetScalarValue($"SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = {oDocumentTypeId} AND NAME = '{indexName}'")
|
||
|
||
If String.IsNullOrWhiteSpace(cmb.Text) Then
|
||
If Not optionalIndex Then
|
||
DxErrorProvider1.SetError(cmb, If(USER_LANGUAGE = LANG_DE, TEXT_MISSING_INPUT_DE, TEXT_MISSING_INPUT_EN))
|
||
cmb.Focus()
|
||
Return False
|
||
End If
|
||
Indexwert_Postprocessing(indexName, "")
|
||
Else
|
||
Indexwert_Postprocessing(indexName, cmb.Text)
|
||
End If
|
||
oResult = True
|
||
Continue For
|
||
End If
|
||
|
||
' DateTimePicker
|
||
If oControl.Name.StartsWith("dtp") Then
|
||
Dim dtp = DirectCast(oControl, DevExpress.XtraEditors.DateEdit)
|
||
Dim indexName = Replace(dtp.Name, "dtp", "")
|
||
Dim optionalIndex As Boolean = DATABASE_ECM.GetScalarValue($"SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = {oDocumentTypeId} AND NAME = '{indexName}'")
|
||
|
||
If String.IsNullOrWhiteSpace(dtp.Text) Then
|
||
If Not optionalIndex Then
|
||
DxErrorProvider1.SetError(dtp, If(USER_LANGUAGE = LANG_DE, TEXT_MISSING_INPUT_DE, TEXT_MISSING_INPUT_EN))
|
||
dtp.Focus()
|
||
Return False
|
||
End If
|
||
Indexwert_Postprocessing(indexName, "")
|
||
Else
|
||
Indexwert_Postprocessing(indexName, dtp.Text)
|
||
End If
|
||
oResult = True
|
||
Continue For
|
||
End If
|
||
|
||
' Checkbox
|
||
If oControl.Name.StartsWith("chk") Then
|
||
Dim chk = DirectCast(oControl, DevExpress.XtraEditors.CheckEdit)
|
||
Dim indexName = Replace(chk.Name, "chk", "")
|
||
Indexwert_Postprocessing(indexName, chk.Checked)
|
||
oResult = True
|
||
Continue For
|
||
End If
|
||
|
||
' Buttons ignorieren
|
||
If TypeOf oControl Is Button Then
|
||
Continue For
|
||
End If
|
||
Next
|
||
|
||
If Not oResult Then
|
||
_Logger.Info(TEXT_CHECK_MANUAL_INDEXES_EN)
|
||
End If
|
||
|
||
Return oResult
|
||
Catch ex As Exception
|
||
ShowErrorMessage(ex, "CheckWrite_IndexeMan")
|
||
Return False
|
||
End Try
|
||
End Function
|
||
|
||
Sub Indexwert_Postprocessing(indexname As String, wert_in As String)
|
||
Try
|
||
Dim DT As DataTable
|
||
Dim DR As DataRow
|
||
DT = MyDataset.VWDDINDEX_MAN
|
||
Dim value_post As String = ""
|
||
For Each DR In DT.Rows
|
||
If DR.Item("INDEXNAME") = indexname Then
|
||
Dim idxid As Integer = DR.Item("GUID")
|
||
If idxid > 0 Then
|
||
' In jedem Fall schon mal den Wert einfügen
|
||
DR.Item("Indexwert") = wert_in
|
||
'Die Nachbearbeitungsschritte laden
|
||
'FILE AND INDEX
|
||
'Zuerst nur die Fälle für die Variante ONLY FILE/FOLDER
|
||
Dim DTNB As DataTable = DATABASE_ECM.GetDatatable("SELECT * FROM TBDD_INDEX_MAN_POSTPROCESSING WHERE IDXMAN_ID = " & idxid & " AND VARIANT = 'ONLY FILE/FOLDER' ORDER BY SEQUENCE")
|
||
If DTNB Is Nothing = False Then
|
||
If DTNB.Rows.Count > 0 Then
|
||
value_post = _PostProcessing.Get_Nachbearbeitung_Wert(wert_in, DTNB)
|
||
DR.Item("Indexwert") = wert_in
|
||
DR.Item("Indexwert_File") = value_post
|
||
End If
|
||
End If
|
||
'Jetzt die Fälle für die Variante FILE AND INDEX
|
||
DTNB = Nothing
|
||
DTNB = DATABASE_ECM.GetDatatable("SELECT * FROM TBDD_INDEX_MAN_POSTPROCESSING WHERE IDXMAN_ID = " & idxid & " AND VARIANT = 'FILE AND INDEX' ORDER BY SEQUENCE")
|
||
If DTNB Is Nothing = False Then
|
||
If DTNB.Rows.Count > 0 Then
|
||
value_post = _PostProcessing.Get_Nachbearbeitung_Wert(wert_in, DTNB)
|
||
DR.Item("Indexwert") = value_post
|
||
End If
|
||
End If
|
||
End If
|
||
DR.Item("Indexiert") = True
|
||
End If
|
||
Next
|
||
Catch ex As Exception
|
||
ShowErrorMessage(ex, "Indexwert_Postprocessing")
|
||
End Try
|
||
End Sub
|
||
|
||
Function Name_Generieren()
|
||
Try
|
||
_Logger.Debug("#### Name_Generieren ####")
|
||
Dim sql As String = "select VERSION_DELIMITER, FILE_DELIMITER FROM TBDD_MODULES WHERE GUID = 1"
|
||
Dim DT1 As DataTable = DATABASE_ECM.GetDatatable(sql)
|
||
For Each row As DataRow In DT1.Rows
|
||
FILE_DELIMITER = row.Item("FILE_DELIMITER")
|
||
VERSION_DELIMITER = row.Item("VERSION_DELIMITER")
|
||
Next
|
||
|
||
Dim err As Boolean = False
|
||
Dim folder_Created As Boolean = False
|
||
Dim oRAWZielordner As String
|
||
Dim extension As String = System.IO.Path.GetExtension(CURRENT_WORKFILE)
|
||
Dim DT As DataTable = DATABASE_ECM.GetDatatable("SELECT * FROM TBDD_DOKUMENTART WHERE GUID = " & CURRENT_DOKART_ID)
|
||
sql_history_INSERT_INTO = "INSERT INTO TBGI_HISTORY (FILENAME_ORIGINAL,FILENAME_NEW"
|
||
sql_history_Index_Values = ""
|
||
Dim AnzahlIndexe As Integer = 1
|
||
CURR_DOKART_WD_DIRECT = DT.Rows(0).Item("WINDREAM_DIRECT")
|
||
CURR_DOKART_OBJECTTYPE = DT.Rows(0).Item("OBJEKTTYP")
|
||
CURR_WORKFILE_EXTENSION = extension
|
||
|
||
oRAWZielordner = WINDREAM.GetNormalizedPath(DT.Rows(0).Item("ZIEL_PFAD"), True)
|
||
oRAWZielordner = WINDREAM_BASEPATH & oRAWZielordner
|
||
|
||
'####
|
||
' Regulären Ausdruck zum Auslesen der Indexe definieren
|
||
Dim preg As String = "\[%{1}[a-zA-Z0-9ß\!\$\&\/\(\)\=\?\,\.\-\;\:_öÖüÜäÄ\#\'\+\*\~\{\}\@\€\<\>\ ]+]{1}"
|
||
'schonmal den gesamten Pfad laden
|
||
Dim oNamenkonvention As String = DT.Rows(0).Item("NAMENKONVENTION") & CURR_WORKFILE_EXTENSION 'oRAWZielordner & "\" & DT.Rows(0).Item("NAMENKONVENTION")
|
||
NewFileString = oNamenkonvention
|
||
' 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 oMatchelements As System.Text.RegularExpressions.MatchCollection = regulärerAusdruck.Matches(oNamenkonvention)
|
||
'####
|
||
If oMatchelements.Count = 0 Then
|
||
_Logger.Debug("No RegularExpression Files on Nameconvention!")
|
||
End If
|
||
' alle Vorkommen innerhalbd er Namenkonvention durchlaufen
|
||
For Each oElement As System.Text.RegularExpressions.Match In oMatchelements
|
||
Select Case oElement.Value.Substring(2, 1).ToUpper
|
||
'Manueller Indexwert
|
||
Case "M"
|
||
_Logger.Debug("NameGenerieren: Manueller Index wird geprüft...")
|
||
Dim Indexname = oElement.Value.Substring(3, oElement.Value.Length - 4)
|
||
Dim optional_index As Boolean = DATABASE_ECM.GetScalarValue($"SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = {CURRENT_DOKART_ID} AND UPPER(NAME) = UPPER('{Indexname}')")
|
||
Dim oManValue As String = GetManIndex_Value(Indexname, "FILE", optional_index)
|
||
If oManValue <> String.Empty Then
|
||
Dim firstVectorValue = oManValue.Split(ClassConstants.VECTORSEPARATOR).First()
|
||
|
||
oNamenkonvention = oNamenkonvention.Replace(oElement.Value, firstVectorValue)
|
||
NewFileString = oNamenkonvention
|
||
sql_history_INSERT_INTO = sql_history_INSERT_INTO & ", INDEX" & AnzahlIndexe.ToString
|
||
AnzahlIndexe += 1
|
||
sql_history_Index_Values = sql_history_Index_Values & ", '" & oManValue.Replace("'", "''") & "'"
|
||
Else
|
||
|
||
If optional_index = True Then
|
||
oNamenkonvention = oNamenkonvention.Replace("-" & oElement.Value & "-", "-")
|
||
oNamenkonvention = oNamenkonvention.Replace("_" & oElement.Value & "_", "_")
|
||
oNamenkonvention = oNamenkonvention.Replace("_" & oElement.Value & "-", "_")
|
||
oNamenkonvention = oNamenkonvention.Replace("-" & oElement.Value & "_", "-")
|
||
|
||
oNamenkonvention = oNamenkonvention.Replace("-" & oElement.Value, "-")
|
||
oNamenkonvention = oNamenkonvention.Replace("_" & oElement.Value, "_")
|
||
oNamenkonvention = oNamenkonvention.Replace(oElement.Value & "-", "-")
|
||
oNamenkonvention = oNamenkonvention.Replace(oElement.Value & "_", "_")
|
||
|
||
oNamenkonvention = oNamenkonvention.Replace(oElement.Value, oManValue)
|
||
|
||
Dim oFilenameWithoutExtension = Path.GetFileNameWithoutExtension(oNamenkonvention)
|
||
Dim oExtension = Path.GetExtension(oNamenkonvention)
|
||
|
||
If oFilenameWithoutExtension.EndsWith("-") Or oFilenameWithoutExtension.EndsWith("_") Then
|
||
oFilenameWithoutExtension = oFilenameWithoutExtension.Substring(0, oFilenameWithoutExtension.Count - 1)
|
||
End If
|
||
|
||
NewFileString = oFilenameWithoutExtension & oExtension
|
||
sql_history_INSERT_INTO = sql_history_INSERT_INTO & ", INDEX" & AnzahlIndexe.ToString
|
||
AnzahlIndexe += 1
|
||
sql_history_Index_Values = sql_history_Index_Values & ", '" & oManValue.Replace("'", "''") & "'"
|
||
Else
|
||
_Logger.Debug("Der Indexvalue für Index '" & Indexname & "' ist String.Empty")
|
||
err = True
|
||
End If
|
||
|
||
End If
|
||
Case "A"
|
||
Dim value As String = GetAutoIndex_Value(oElement.Value.Substring(3, oElement.Value.Length - 4))
|
||
If value <> String.Empty Then
|
||
If value = "EMPTY_OI" Then
|
||
oNamenkonvention = oNamenkonvention.Replace(oElement.Value, "")
|
||
NewFileString = oNamenkonvention
|
||
Else
|
||
oNamenkonvention = oNamenkonvention.Replace(oElement.Value, value)
|
||
NewFileString = oNamenkonvention
|
||
sql_history_INSERT_INTO = sql_history_INSERT_INTO & ", INDEX" & AnzahlIndexe.ToString
|
||
AnzahlIndexe += 1
|
||
sql_history_Index_Values = sql_history_Index_Values & ", '" & value.Replace("'", "''") & "'"
|
||
End If
|
||
Else
|
||
err = True
|
||
End If
|
||
Case "V"
|
||
Dim datetemp As String
|
||
Dim _Month As String = My.Computer.Clock.LocalTime.Month
|
||
If _Month.Length = 1 Then
|
||
_Month = "0" & _Month
|
||
End If
|
||
Dim _day As String = My.Computer.Clock.LocalTime.Day
|
||
If _day.Length = 1 Then
|
||
_day = "0" & _day
|
||
End If
|
||
Dim type = oElement.Value '.ToUpper.Replace("[v%", "")
|
||
type = type.Replace("[%v_", "")
|
||
type = type.Replace("[%v", "")
|
||
type = type.Replace("]", "")
|
||
Select Case type
|
||
Case "YY_MM_DD"
|
||
datetemp = My.Computer.Clock.LocalTime.Year.ToString.Substring(2) & "_" & _Month & "_" & _day
|
||
Case "YYYY_MM_DD"
|
||
datetemp = My.Computer.Clock.LocalTime.Year & "_" & _Month & "_" & _day
|
||
Case "DD_MM_YY"
|
||
datetemp = _day & "_" & _Month & "_" & My.Computer.Clock.LocalTime.Year.ToString.Substring(2)
|
||
Case "DD_MM_YYYY"
|
||
datetemp = _day & "_" & _Month & "_" & My.Computer.Clock.LocalTime.Year
|
||
Case "YYMMDD"
|
||
datetemp = My.Computer.Clock.LocalTime.Year.ToString.Substring(2) & _Month & _day
|
||
Case "YYYYMMDD"
|
||
datetemp = My.Computer.Clock.LocalTime.Year & _Month & _day
|
||
Case "DDMMYY"
|
||
datetemp = _day & _Month & My.Computer.Clock.LocalTime.Year.ToString.Substring(2)
|
||
Case "DDMMYYYY"
|
||
datetemp = _day & _Month & My.Computer.Clock.LocalTime.Year
|
||
Case "OFilename"
|
||
oNamenkonvention = oNamenkonvention.Replace(oElement.Value, System.IO.Path.GetFileNameWithoutExtension(CURRENT_WORKFILE))
|
||
Case "Username".ToUpper
|
||
oNamenkonvention = oNamenkonvention.Replace(oElement.Value, Environment.UserName)
|
||
Case "Usercode".ToUpper
|
||
oNamenkonvention = oNamenkonvention.Replace(oElement.Value, USER_SHORTNAME)
|
||
Case ""
|
||
End Select
|
||
If datetemp <> "" Then
|
||
oNamenkonvention = oNamenkonvention.Replace(oElement.Value, datetemp)
|
||
End If
|
||
NewFileString = oNamenkonvention
|
||
Case "[%Version]".ToUpper
|
||
Try
|
||
Dim version As Integer = 1
|
||
Dim Stammname As String = oRAWZielordner & "\" & oNamenkonvention.Replace(oElement.Value, "")
|
||
Dim _neuername As String = oRAWZielordner & "\" & oNamenkonvention.Replace(oElement.Value, "")
|
||
Stammname = _neuername.Replace(VERSION_DELIMITER, "")
|
||
_neuername = _neuername.Replace(VERSION_DELIMITER, "")
|
||
'Dim MoveFilename As String = DATEINAME.Replace(element.Value, "")
|
||
'Überprüfen ob File existiert
|
||
If File.Exists(_neuername) = False Then
|
||
NewFileString = _neuername
|
||
Else
|
||
Do While File.Exists(_neuername)
|
||
version += 1
|
||
_neuername = Stammname.Replace(extension, "") & VERSION_DELIMITER & version & extension
|
||
NewFileString = _neuername
|
||
Loop
|
||
End If
|
||
Catch ex As Exception
|
||
_Logger.Warn(" - Unexpected error in NameGenerieren - Fehler: " & vbNewLine & ex.Message)
|
||
_Logger.Error(ex.Message)
|
||
MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Umbenennnen der Datei:")
|
||
err = True
|
||
End Try
|
||
Case Else
|
||
_Logger.Info(" - Achtung - in der Namenkonvention wurde ein Element gefunden welches nicht zugeordnet werden kann!" & vbNewLine & "Elementname: " & oElement.Value.ToUpper)
|
||
MsgBox("Achtung - in der Namenkonvention wurde ein Element gefunden welches nicht zugeordnet werden kann!" & vbNewLine & "Elementname: " & oElement.Value.ToUpper, MsgBoxStyle.Exclamation, "Unexpected error in Name generieren:")
|
||
End Select
|
||
Next
|
||
|
||
CURRENT_NEWFILENAME = FILESYSTEM.GetCleanFilename(NewFileString)
|
||
'CURRENT_NEWFILENAME = ClassFilehandle.CleanFilename(NewFileString, "")
|
||
CURRENT_NEWFILENAME = Path.Combine(oRAWZielordner, CURRENT_NEWFILENAME)
|
||
|
||
_Logger.Debug("#### ENDE Name_Generieren ####")
|
||
_Logger.Debug("")
|
||
If err = False Then
|
||
Return True
|
||
Else
|
||
Return False
|
||
End If
|
||
|
||
Catch ex As Exception
|
||
ShowErrorMessage(ex, "Name_Generieren")
|
||
Return False
|
||
End Try
|
||
|
||
End Function
|
||
Private Function Write_Indizes() As Boolean
|
||
Try
|
||
|
||
_Logger.Info("Indexing file [{0}]", CURRENT_NEWFILENAME)
|
||
|
||
Dim indexierung_erfolgreich As Boolean = False
|
||
'Manuelle Indexe Indexieren
|
||
Dim DTMan As DataTable = MyDataset.VWDDINDEX_MAN
|
||
If DTMan.Rows.Count > 0 Then
|
||
Dim Count As Integer = 0
|
||
For Each row As DataRow In DTMan.Rows
|
||
Dim idxvalue = row.Item("Indexwert")
|
||
Dim indexname = row.Item("WD_INDEX").ToString
|
||
_Logger.Debug($"Write_Indizes - Index [{indexname}]...")
|
||
Dim optional_Index = CBool(row.Item("OPTIONAL"))
|
||
Dim indexiert = CBool(row.Item("Indexiert"))
|
||
If indexiert And idxvalue.ToString <> "" And idxvalue <> "EMPTY_OI" Then
|
||
If indexname <> String.Empty Then
|
||
If row.Item("SAVE_VALUE") = True Then
|
||
'Den Indexwert zwischenspeichern
|
||
Dim DTTemp As DataTable = MyDataset.TBTEMP_INDEXRESULTS
|
||
Dim rowexists As Boolean = False
|
||
For Each rowTemp As DataRow In DTTemp.Rows
|
||
'Wenn bereits ein Eintrag existiert.....
|
||
If rowTemp.Item("Dokumentart") = row.Item("DOKUMENTART") And rowTemp.Item("Indexname") = row.Item("INDEXNAME") Then
|
||
rowexists = True
|
||
'......überschreiben
|
||
rowTemp.Item("Value") = row.Item("Indexwert")
|
||
End If
|
||
Next
|
||
'.....ansonsten neu anlegen
|
||
If rowexists = False Then
|
||
Dim newRow As DataRow = DTTemp.NewRow()
|
||
newRow("Dokumentart") = row.Item("DOKUMENTART").ToString
|
||
newRow("Indexname") = row.Item("INDEXNAME").ToString
|
||
newRow("Value") = row.Item("Indexwert")
|
||
DTTemp.Rows.Add(newRow)
|
||
End If
|
||
End If
|
||
|
||
_Logger.Debug($"Manueller Indexvalue [{idxvalue}]...NOW THE INDEXING...")
|
||
Count += 1
|
||
|
||
|
||
' den Typ des Zielindexes auslesen
|
||
Dim oIndexType As Integer = WINDREAM.GetIndexType(indexname)
|
||
_Logger.Debug($"oIndexType [{oIndexType}]...")
|
||
If oIndexType = 0 Then
|
||
MsgBox("Could not get the windream-indextype. Check Your Configuration", MsgBoxStyle.Information, "Attention")
|
||
Return False
|
||
End If
|
||
If oIndexType > 4095 Then
|
||
_Logger.Debug($"Indexing Vektor - oIndexType [{oIndexType}] ...")
|
||
Dim oSplitArray = Split(idxvalue, ClassConstants.VECTORSEPARATOR)
|
||
Dim oListofString As New List(Of String)
|
||
'If oSplitArray.Length <= 1 Then
|
||
' indexierung_erfolgreich = WINDREAM.SetFileIndex(CURRENT_NEWFILENAME, indexname, idxvalue, CURR_DOKART_OBJECTTYPE)
|
||
'Else
|
||
For Each oStr In oSplitArray
|
||
oListofString.Add(oStr)
|
||
Next
|
||
indexierung_erfolgreich = WINDREAM.SetFileIndexLoS(CURRENT_NEWFILENAME, indexname, oListofString, CURR_DOKART_OBJECTTYPE)
|
||
'End If
|
||
|
||
Else
|
||
indexierung_erfolgreich = WINDREAM.SetFileIndex(CURRENT_NEWFILENAME, indexname, idxvalue, CURR_DOKART_OBJECTTYPE)
|
||
End If
|
||
|
||
'indexierung_erfolgreich = ClassWindream.DateiIndexieren(CURRENT_NEWFILENAME, indexname, idxvalue)
|
||
If indexierung_erfolgreich = False Then
|
||
MsgBox("Error in Indexing file - See log", MsgBoxStyle.Critical)
|
||
Return False
|
||
Exit For
|
||
End If
|
||
Else
|
||
|
||
_Logger.Debug("No Indexing: indexname: " & indexname)
|
||
_Logger.Debug("No Indexing: is optional? " & optional_Index.ToString)
|
||
End If
|
||
Else
|
||
_Logger.Debug("Indexvalue is empty or field is not indexed - Indexname: " & indexname)
|
||
_Logger.Info("Indexvalue is empty or field is not indexed - Indexname: " & indexname)
|
||
End If
|
||
Next
|
||
|
||
End If
|
||
'Automatische Indexe Indexieren
|
||
Dim DTAut As DataTable = MyDataset.VWDDINDEX_AUTOM
|
||
If DTAut.Rows.Count > 0 Then
|
||
_Logger.Debug(" #### Es gibt automatische Atrribute - Anzahl: " & DTAut.Rows.Count.ToString & " #####")
|
||
Dim Count As Integer = 0
|
||
For Each row As DataRow In DTAut.Rows
|
||
Dim oIsIndexed = CBool(row.Item("Indexiert"))
|
||
Dim oIndexValue = row.Item("Indexwert").ToString
|
||
Dim oIndexName = row.Item("INDEXNAME").ToString
|
||
Dim oOverwrite As Boolean = row.ItemEx("VKT_OVERWRITE", False)
|
||
Dim oPreventMultipleValues As Boolean = row.ItemEx("VKT_PREVENT_MULTIPLE_VALUES", False)
|
||
|
||
If oIsIndexed = True And oIndexValue <> "" Then
|
||
If oIndexValue <> "EMPTY_OI" Then
|
||
_Logger.Info("Auto Indexname: " & oIndexName.ToString)
|
||
_Logger.Info("Indexvalue: " & oIndexValue.ToString)
|
||
Count += 1
|
||
|
||
' den Typ des Zielindexes auslesen
|
||
Dim oIndexType As Integer = WINDREAM.GetIndexType(oIndexName)
|
||
_Logger.Debug("WMIndexType: " & oIndexType.ToString)
|
||
If oIndexType > 4095 Then
|
||
_Logger.Debug("Es Handelt sich um einen VektorIndex...")
|
||
Dim oExistingItems = WINDREAM.GetIndexValue(CURRENT_NEWFILENAME, oIndexName)
|
||
|
||
Dim oSplitArray = Split(oIndexValue, ClassConstants.VECTORSEPARATOR)
|
||
Dim oListofString As New List(Of String)
|
||
If oSplitArray.Length = 0 Then
|
||
_Logger.Debug("oSplitArray.Length = 0")
|
||
oListofString.Add(oIndexValue)
|
||
Else
|
||
_Logger.Debug("oSplitArray is > 0 ...")
|
||
For Each oStr In oSplitArray
|
||
_Logger.Debug("oSplitArray - oStr: {0}", oStr)
|
||
oListofString.Add(oStr)
|
||
Next
|
||
End If
|
||
|
||
'If oSplitArray.Length <= 1 Then
|
||
' indexierung_erfolgreich = WINDREAM.SetFileIndex(CURRENT_NEWFILENAME, oIndexName, oIndexValue, CURR_DOKART_OBJECTTYPE)
|
||
'Else
|
||
If oOverwrite = False And oExistingItems.Count > 0 And oIndexType <> 4100 Then
|
||
_Logger.Debug("oOverwrite = False and WMObject already contains [{0}] values in attribute,Values will be concatted", oExistingItems.Count)
|
||
oListofString = oExistingItems.Concat(oListofString).ToList()
|
||
End If
|
||
If oPreventMultipleValues = True Then
|
||
_Logger.Debug("Preventing multiple values in Vektor")
|
||
oListofString = oListofString.Distinct().ToList()
|
||
End If
|
||
indexierung_erfolgreich = WINDREAM.SetFileIndexLoS(CURRENT_NEWFILENAME, oIndexName, oListofString, CURR_DOKART_OBJECTTYPE)
|
||
'End If
|
||
|
||
Else
|
||
indexierung_erfolgreich = WINDREAM.SetFileIndex(CURRENT_NEWFILENAME, oIndexName, oIndexValue, CURR_DOKART_OBJECTTYPE)
|
||
End If
|
||
|
||
'indexierung_erfolgreich = WINDREAM.SetFileIndex(CURRENT_NEWFILENAME, indexname, Indexvalue, CURR_DOKART_OBJECTTYPE)
|
||
If indexierung_erfolgreich = False Then
|
||
MsgBox("Error in indexing file - See log", MsgBoxStyle.Critical)
|
||
Return False
|
||
Exit For
|
||
End If
|
||
End If
|
||
End If
|
||
Next
|
||
End If
|
||
If DropType = "|OUTLOOK_MESSAGE|" Or DropType = "|FW_MSGONLY|" Or DropType = "|MSGONLY|" Or CURRENT_NEWFILENAME.ToUpper.EndsWith(".MSG") Or CURRENT_NEWFILENAME.ToUpper.EndsWith(".EML") Then
|
||
indexierung_erfolgreich = SetEmailIndicies(False)
|
||
If indexierung_erfolgreich = False Then
|
||
MsgBox("Error in SetEmailIndices - See log", MsgBoxStyle.Critical)
|
||
Return False
|
||
End If
|
||
ElseIf DropType = "|ATTMNTEXTRACTED|" Or DropType = "|OUTLOOK_ATTACHMENT|" Then
|
||
indexierung_erfolgreich = SetEmailIndicies(True)
|
||
If indexierung_erfolgreich = False Then
|
||
MsgBox("Error in SetEmailIndices - See log", MsgBoxStyle.Critical)
|
||
Return False
|
||
End If
|
||
End If
|
||
Catch ex As Exception
|
||
ShowErrorMessage(ex, "Write_Indizes")
|
||
Return False
|
||
Finally
|
||
|
||
End Try
|
||
Return True
|
||
End Function
|
||
Private Function WriteIndex2File(pIndexName As String, pIndexValue As String)
|
||
Try
|
||
_Logger.Info($"Indexing with Name {pIndexName} and Value: {pIndexValue}")
|
||
Return WINDREAM.SetFileIndex(CURRENT_NEWFILENAME, pIndexName, pIndexValue, CURR_DOKART_OBJECTTYPE)
|
||
Catch ex As Exception
|
||
ShowErrorMessage(ex, "WriteIndex2File")
|
||
Return False
|
||
End Try
|
||
End Function
|
||
|
||
Private Function SetEmailIndicies(pIndexAttachment As Boolean) As Boolean
|
||
Try
|
||
Dim oIndexNames As Dictionary(Of String, Object)
|
||
|
||
Dim oSQL As String = $"SELECT * FROM TBGI_OBJECTTYPE_EMAIL_INDEX WHERE OBJECTTYPE = '{CURR_DOKART_OBJECTTYPE}'"
|
||
Dim oTable As DataTable = DATABASE_ECM.GetDatatable(oSQL)
|
||
|
||
If IsNothing(oTable) Then
|
||
_Logger.Info("Could not get Email Indicies for OBJECTTYPE = [{0}]. Exiting.", CURR_DOKART_OBJECTTYPE)
|
||
Return False
|
||
End If
|
||
|
||
If oTable.Rows.Count = 0 Then
|
||
LOGGER.Warn("Could not get Email Indicies for OBJECTTYPE = [{0}]. Exiting.", CURR_DOKART_OBJECTTYPE)
|
||
MsgBox($"Definition von Email Indizes für den Objekttyp [{oTable}] fehlt." + vbNewLine + "Bitte informieren Sie Ihren Systembetreuer.", MsgBoxStyle.Critical)
|
||
Return False
|
||
End If
|
||
|
||
If oTable.Rows.Count > 1 Then
|
||
LOGGER.Warn("Got multiple rows for Email Indicies for OBJECTTYPE = [{0}]. Exiting.", CURR_DOKART_OBJECTTYPE)
|
||
Return False
|
||
End If
|
||
|
||
Dim oRow As DataRow = oTable.Rows.Item(0)
|
||
|
||
' If file is an email files (eml,msg) parse it to extract email data and save for later
|
||
' If file is an attachment, rely on the previously extracted value
|
||
|
||
|
||
|
||
If pIndexAttachment = False Then
|
||
LOGGER.Debug("Indexing Email File: [{0}]", CURRENT_NEWFILENAME)
|
||
|
||
' This cannot use Path.Combine, otherwise the WINDREAM_BASEPATH will be swallowed... lol
|
||
'Dim oMsgFilePath As String = Path.Combine(WINDREAM_BASEPATH, CURRENT_NEWFILENAME)
|
||
|
||
Dim oMsgFilePath As String = CURRENT_NEWFILENAME
|
||
If CURRENT_NEWFILENAME.StartsWith(WINDREAM_BASEPATH) = False Then
|
||
oMsgFilePath = WINDREAM_BASEPATH & oMsgFilePath
|
||
End If
|
||
|
||
Dim oMail As IMail = EMAIL.Load_Email(oMsgFilePath)
|
||
|
||
Dim oMessageId As String = oMail.MessageID
|
||
LOGGER.Debug("MessageId: [{0}]", oMessageId)
|
||
|
||
Dim oMessageFrom As String = EMAIL.Get_MessageSender(oMail)
|
||
Dim oMessageTo As String = EMAIL.Get_MessageReceiver(oMail)
|
||
LOGGER.Debug("oMessageTo: [{0}]", oMessageTo.ToString)
|
||
Dim oDateIn As Date = EMAIL.Get_MessageDate(oMail)
|
||
LOGGER.Debug("oDateIn: [{0}]", oDateIn.ToString)
|
||
Dim oSubject As String = oMail.Subject
|
||
LOGGER.Debug("oSubject: [{0}]", oSubject)
|
||
|
||
CURRENT_MESSAGEID = oMessageId
|
||
CURRENT_MESSAGEDATE = oDateIn
|
||
|
||
If oSubject IsNot Nothing Then
|
||
CURRENT_MESSAGESUBJECT = oSubject
|
||
Else
|
||
CURRENT_MESSAGESUBJECT = "<No Subject>"
|
||
LOGGER.Info("No subject - Default <No Subject> will be used!")
|
||
End If
|
||
|
||
oIndexNames = New Dictionary(Of String, Object) From {
|
||
{"IDX_EMAIL_ID", oMessageId},
|
||
{"IDX_EMAIL_FROM", oMessageFrom},
|
||
{"IDX_EMAIL_TO", oMessageTo},
|
||
{"IDX_EMAIL_SUBJECT", CURRENT_MESSAGESUBJECT},
|
||
{"IDX_EMAIL_DATE_IN", oDateIn}
|
||
}
|
||
Else
|
||
oIndexNames = New Dictionary(Of String, Object) From {
|
||
{"IDX_EMAIL_ID", CURRENT_MESSAGEID},
|
||
{"IDX_EMAIL_SUBJECT", CURRENT_MESSAGESUBJECT},
|
||
{"IDX_EMAIL_DATE_IN", CURRENT_MESSAGEDATE},
|
||
{"IDX_CHECK_ATTACHMENT", True}
|
||
}
|
||
End If
|
||
|
||
|
||
For Each oIndex In oIndexNames
|
||
Try
|
||
If oIndex.Value Is Nothing Then
|
||
LOGGER.Warn("Value for Index [{0}] was empty. Skipping.", oIndex.Key)
|
||
Continue For
|
||
|
||
End If
|
||
|
||
If TypeOf oIndex.Value Is String AndAlso oIndex.Value = String.Empty Then
|
||
LOGGER.Warn("Value for Index [{0}] was empty. Skipping.", oIndex.Key)
|
||
Continue For
|
||
|
||
End If
|
||
|
||
Dim oIndexingSuccessful = WriteIndex2File(oRow.Item(oIndex.Key), oIndex.Value)
|
||
|
||
If oIndexingSuccessful = False Then
|
||
MsgBox($"Error while Indexing Email at Index [{oIndex.Key}]", MsgBoxStyle.Critical)
|
||
Return False
|
||
|
||
End If
|
||
Catch ex As Exception
|
||
LOGGER.Warn("Error while Indexing Email at Index [{0}]", oIndex.Key)
|
||
LOGGER.Error(ex)
|
||
Return False
|
||
End Try
|
||
Next
|
||
|
||
Return True
|
||
Catch ex As Exception
|
||
LOGGER.Error(ex)
|
||
Return False
|
||
End Try
|
||
End Function
|
||
|
||
'Private Function SetEmailIndicesOld()
|
||
' Dim indexierung_erfolgreich As Boolean = False
|
||
' Dim _step As String = "1"
|
||
|
||
' Try
|
||
' Dim oTempPath As String = Path.Combine(WINDREAM_BASEPATH, CURRENT_NEWFILENAME)
|
||
' Dim msg As Msg.Message = New Msg.Message(oTempPath)
|
||
' Dim msgDisplayTo = msg.DisplayTo
|
||
' Dim msgInternetAccountName = msg.InternetAccountName
|
||
' If LogErrorsOnly = False Then
|
||
' _Logger.Info("")
|
||
' _Logger.Info("msgInternetAccountName: " & msgInternetAccountName)
|
||
' _Logger.Info("SenderName: " & msg.SenderName)
|
||
' _Logger.Info("SenderEmailAddress: " & msg.SenderEmailAddress)
|
||
' _Logger.Info("ReceivedByName: " & msg.ReceivedByName)
|
||
' _Logger.Info("ReceivedByEmailAddress: " & msg.ReceivedByEmailAddress)
|
||
' _Logger.Info("")
|
||
' End If
|
||
' _step = "2"
|
||
|
||
' 'Console.WriteLine("Subject: " + msg.Subject)
|
||
' 'Console.WriteLine("MessageDeliveryTime:" & msg.MessageDeliveryTime)
|
||
' 'Console.WriteLine("SenderName: " + msg.SenderName)
|
||
' 'Console.WriteLine("SenderEmailAddress: " + msg.SenderEmailAddress)
|
||
' 'Console.WriteLine("ReceivedByName: " + msg.ReceivedByName)
|
||
' 'Console.WriteLine("ReceivedByEmailAddress: " + msg.ReceivedByEmailAddress)
|
||
' 'Console.WriteLine("DisplayTo: " + msg.DisplayTo)
|
||
' 'Console.WriteLine("DisplayCc: " + msg.DisplayCc)
|
||
' 'Console.WriteLine("Body: " + msg.Body)
|
||
' 'Console.WriteLine("-----------------------------------------------------------------------")
|
||
' 'Console.WriteLine("BodyHtmlText: " + msg.BodyHtmlText)
|
||
' Dim fromPattern As String = ""
|
||
' Dim toPattern As String = ""
|
||
' Dim messageIDPattern As String = ""
|
||
' Dim finalize_pattern As String = ""
|
||
|
||
' ' Email Header auslesen
|
||
' Dim headers As String = ClassEmailHeaderExtractor.getMessageHeaders(msg)
|
||
|
||
' For Each rowregex As DataRow In CURRENT_DT_REGEX.Rows
|
||
' If rowregex.Item("FUNCTION_NAME") = "FROM_EMAIL_HEADER" Then
|
||
' fromPattern = rowregex.Item("REGEX")
|
||
' ElseIf rowregex.Item("FUNCTION_NAME") = "TO_EMAIL_HEADER" Then
|
||
' toPattern = rowregex.Item("REGEX")
|
||
' ElseIf rowregex.Item("FUNCTION_NAME") = "MESSAGE_ID" Then
|
||
' messageIDPattern = rowregex.Item("REGEX")
|
||
' ElseIf rowregex.Item("FUNCTION_NAME") = "FINALIZE" Then
|
||
' finalize_pattern = rowregex.Item("REGEX")
|
||
' End If
|
||
' Next
|
||
' Dim DT As DataTable = DATABASE_ECM.GetDatatable("SELECT * FROM TBGI_OBJECTTYPE_EMAIL_INDEX WHERE OBJECTTYPE = '" & CURR_DOKART_OBJECTTYPE & "'")
|
||
' If IsNothing(DT) Then
|
||
' _Logger.Info("SELECT * FROM TBGI_OBJECTTYPE_EMAIL_INDEX WHERE OBJECTTYPE = '" & CURR_DOKART_OBJECTTYPE & "' RESULTED in NOTHING")
|
||
' Return False
|
||
' End If
|
||
' If DT.Rows.Count = 1 Then
|
||
' _step = "3"
|
||
' CURRENT_MESSAGEDATE = ""
|
||
' CURRENT_MESSAGESUBJECT = ""
|
||
' 'Message-ID nur auswerten wenn vorher nicht gestzt wurde!
|
||
' If CURRENT_MESSAGEID = "" Then
|
||
' If Not msg.InternetMessageId Is Nothing Then
|
||
' indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_ID").ToString, msg.InternetMessageId)
|
||
' 'Die aktuelle Message-ID zwischenspeichern
|
||
' CURRENT_MESSAGEID = msg.InternetMessageId
|
||
' If indexierung_erfolgreich = False Then
|
||
' MsgBox("Error in SetEmailIndices-EmailID - See log", MsgBoxStyle.Critical)
|
||
' Return False
|
||
' End If
|
||
' Else
|
||
' If messageIDPattern = String.Empty Then
|
||
' _Logger.Info("A messageID could not be read!")
|
||
' Else
|
||
' If Not IsNothing(headers) Then
|
||
' CURRENT_MESSAGEID = ClassEmailHeaderExtractor.extractFromHeader(headers, messageIDPattern)
|
||
' If IsNothing(CURRENT_MESSAGEID) Then
|
||
' CURRENT_MESSAGEID = ""
|
||
' End If
|
||
' Else
|
||
' _Logger.Info("A messageID could not be read - messageheader nothing/messagIDpattern value!")
|
||
' End If
|
||
' End If
|
||
|
||
' End If
|
||
' Else
|
||
' indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_ID").ToString, CURRENT_MESSAGEID)
|
||
' If indexierung_erfolgreich = False Then
|
||
' MsgBox("Error in SetEmailIndices-EmailID - See log", MsgBoxStyle.Critical)
|
||
' Return False
|
||
' End If
|
||
' End If
|
||
' _step = "4"
|
||
' ' Regular Expressions vorbereiten
|
||
|
||
' If fromPattern <> "" And toPattern <> "" Then
|
||
' _step = "4.1"
|
||
' Dim FromRegexList As New List(Of Regex)
|
||
' Dim ToRegexList As New List(Of Regex)
|
||
' Dim fromRegex As New Regex(fromPattern, RegexOptions.IgnoreCase)
|
||
' Dim toRegex As New Regex(toPattern, RegexOptions.IgnoreCase)
|
||
|
||
' FromRegexList.Add(fromRegex)
|
||
' ToRegexList.Add(toRegex)
|
||
|
||
|
||
' Dim emailFrom
|
||
' Dim emailTo
|
||
' ' Email Absender und Empfänger
|
||
' If headers Is Nothing Then
|
||
' _step = "4.2"
|
||
' If IsNothing(msgDisplayTo) Then
|
||
' _step = "4.3"
|
||
' _Logger.Info("DisplayTo in email is nothing - default will be set")
|
||
' emailTo = "NO RECIPIENT"
|
||
' Else
|
||
' _step = "4.4"
|
||
' emailTo = msgDisplayTo.ToString.Replace("'", "")
|
||
' End If
|
||
' If IsNothing(msgInternetAccountName) Then
|
||
' _step = "4.5"
|
||
' _Logger.Info("InternetAccountName in email is nothing - default will be set")
|
||
' emailFrom = ""
|
||
' Else
|
||
' _step = "4.6"
|
||
' emailFrom = msgInternetAccountName.ToString.Replace("'", "")
|
||
' End If
|
||
' Else
|
||
' _step = "5"
|
||
' _Logger.Info("emailTo and From Extraction via messageheader.")
|
||
' emailFrom = ClassEmailHeaderExtractor.extractFromHeader(headers, fromPattern) 'FromRegexList)
|
||
' emailTo = ClassEmailHeaderExtractor.extractFromHeader(headers, toPattern) ' extractToAddress(headers, ToRegexList)
|
||
|
||
' 'Handler für leere emailTo-Adresse
|
||
' If IsNothing(emailTo) Then
|
||
' _step = "5.1"
|
||
' _Logger.Info("emailTo couldn't be extracted from messageheader...")
|
||
' If (headers.Contains("exc") Or headers.Contains("exchange")) Then
|
||
' _step = "5.2"
|
||
' _Logger.Info("...try with LDAP-option")
|
||
' Dim _email = GetUserEmailfromLDAP(msgDisplayTo)
|
||
' _step = "5.3"
|
||
' If _email <> "" Then
|
||
' emailTo = _email
|
||
' Else
|
||
' _Logger.Info(">> email-adress couldn't be read from LDAP with name '" & msgDisplayTo & "'")
|
||
' MsgBox("Could't get 'emailto' from messageHeader and later on with LDAP-Option." & vbNewLine & "Please check the dropped email and Configuration of Email-Indexing!", MsgBoxStyle.Exclamation)
|
||
' Return False
|
||
' End If
|
||
' Else
|
||
' _step = "5.4"
|
||
' CURR_MISSING_PATTERN_NAME = "Email To"
|
||
' CURR_MISSING_SEARCH_STRING = headers
|
||
' CURR_MISSING_MANUAL_VALUE = String.Empty
|
||
' frmMissingInput.ShowDialog()
|
||
' _step = "5.4.1"
|
||
' If CURR_MISSING_MANUAL_VALUE <> String.Empty Then
|
||
' _step = "5.4.2"
|
||
' emailTo = CURR_MISSING_MANUAL_VALUE
|
||
' Else
|
||
' _step = "5.4.3"
|
||
' _Logger.Info("no exchange patterns found in headers!")
|
||
' MsgBox("Could't get 'emailto' from messageHeader and exhange-Patterns weren't found." & vbNewLine & "Please check the dropped email and Configuration of Email-Indexing!", MsgBoxStyle.Exclamation)
|
||
' Return False
|
||
' End If
|
||
|
||
' End If
|
||
' End If
|
||
' _step = "6"
|
||
' emailTo = ClassEmailHeaderExtractor.extractFromHeader(emailTo, finalize_pattern)
|
||
' emailFrom = ClassEmailHeaderExtractor.extractFromHeader(emailFrom, finalize_pattern)
|
||
' _step = "6.1"
|
||
|
||
' If Not IsNothing(emailFrom) Then
|
||
' emailFrom = emailFrom.Replace("<", "")
|
||
' emailFrom = emailFrom.Replace(">", "")
|
||
' Else
|
||
' _step = "6.1.x"
|
||
' _Logger.Info("emailFrom is Nothing?!")
|
||
' End If
|
||
|
||
' If Not IsNothing(emailTo) Then
|
||
' _step = "6.1.1 " & emailTo.ToString
|
||
' emailTo = emailTo.Replace("<", "")
|
||
' emailTo = emailTo.Replace(">", "")
|
||
' _step = "6.2"
|
||
' Dim _duplicatesCheck As List(Of String) = New List(Of String)
|
||
' _duplicatesCheck = emailTo.ToString.Split(";").ToList
|
||
' ' Filter distinct elements, and convert back into list.
|
||
' Dim result As List(Of String) = _duplicatesCheck.Distinct().ToList
|
||
' ' Display result.
|
||
' Dim i As Integer = 0
|
||
' For Each element As String In result
|
||
' If i = 0 Then
|
||
' emailTo = element
|
||
' Else
|
||
' emailTo = emailTo & ";" & element
|
||
' End If
|
||
' i += 1
|
||
' Next
|
||
' Else
|
||
' _step = "6.3"
|
||
' _Logger.Info("emailTo is Nothing?!")
|
||
' End If
|
||
|
||
' _Logger.Info("Headers-Content: ")
|
||
' _Logger.Info(headers.ToString)
|
||
' End If
|
||
' 'Handler für leere emailFrom-Adresse
|
||
' If IsNothing(emailFrom) Then
|
||
' _step = "7"
|
||
' _Logger.Info("emailFrom couldn't be extracted from messageheader...")
|
||
' If Not IsNothing(msg.SenderEmailAddress) Then
|
||
' If msg.SenderEmailAddress <> String.Empty Then
|
||
' _step = "7.1"
|
||
' _Logger.Info("emailFrom via msg.SenderEmailAddress will be used instead!")
|
||
' emailFrom = msg.SenderEmailAddress.ToString.Replace("'", "")
|
||
' End If
|
||
' End If
|
||
' End If
|
||
' If IsNothing(emailFrom) Or emailFrom = String.Empty Then
|
||
' _step = "7.2"
|
||
' CURR_MISSING_PATTERN_NAME = "Email From"
|
||
' CURR_MISSING_SEARCH_STRING = emailFrom
|
||
' CURR_MISSING_MANUAL_VALUE = String.Empty
|
||
' frmMissingInput.ShowDialog()
|
||
' If CURR_MISSING_MANUAL_VALUE <> String.Empty Then
|
||
' _step = "7.3"
|
||
' emailFrom = CURR_MISSING_MANUAL_VALUE
|
||
' Else
|
||
' MsgBox("Could't get 'emailfrom' from messageHeader." & vbNewLine & "Please check the dropped email and Configuration of Email-Indexing!", MsgBoxStyle.Exclamation)
|
||
' Return False
|
||
' End If
|
||
' End If
|
||
|
||
' _Logger.Info("emailFrom: " & emailFrom)
|
||
' _Logger.Info("emailTo: " & emailTo)
|
||
' 'FROM
|
||
' If Not IsNothing(emailFrom) Then
|
||
' indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_FROM").ToString, emailFrom)
|
||
' If indexierung_erfolgreich = False Then
|
||
' MsgBox("Error in SetEmailIndices [emailFrom] - See log", MsgBoxStyle.Critical)
|
||
' Return False
|
||
' End If
|
||
' Else
|
||
' _Logger.Info("emailFrom is still Nothing?!")
|
||
' _step = "7.4"
|
||
' End If
|
||
' 'TO
|
||
' If Not IsNothing(emailTo) Then
|
||
' indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_TO").ToString, emailTo)
|
||
' If indexierung_erfolgreich = False Then
|
||
' MsgBox("Error in SetEmailIndices [emailTo] - See log", MsgBoxStyle.Critical)
|
||
' Return False
|
||
' End If
|
||
' Else
|
||
' _Logger.Info("emailTo is still Nothing?!")
|
||
' _step = "7.5"
|
||
' End If
|
||
|
||
' ' Dim subj As String = ClassFormFunctions.CleanInput(msg.Subject)
|
||
' Dim subj As String = msg.Subject
|
||
' If IsNothing(subj) Or subj = "" Then
|
||
' _Logger.Info("msg subject is empty...DEFAULT will be set")
|
||
' subj = "No subject"
|
||
' MsgBox("Attention: Email was send without a subject - Default value 'No subject' will be used!", MsgBoxStyle.Exclamation)
|
||
' Else
|
||
' subj = ClassHelper.encode_utf8(msg.Subject)
|
||
' If IsNothing(subj) Then
|
||
' subj = msg.Subject
|
||
' End If
|
||
' End If
|
||
|
||
' _Logger.Info("Now all email-items will be indexed!")
|
||
|
||
' _Logger.Info("subj: " & subj)
|
||
' indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_SUBJECT").ToString, subj)
|
||
' CURRENT_MESSAGESUBJECT = subj
|
||
' If indexierung_erfolgreich = False Then
|
||
' MsgBox("Error in SetEmailIndices [Subject] - See log", MsgBoxStyle.Critical)
|
||
' Return False
|
||
' End If
|
||
' _Logger.Info("MessageDeliveryTime: " & msg.MessageDeliveryTime)
|
||
' indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_DATE_IN").ToString, msg.MessageDeliveryTime)
|
||
' CURRENT_MESSAGEDATE = msg.MessageDeliveryTime
|
||
' If indexierung_erfolgreich = False Then
|
||
' MsgBox("Error in SetEmailIndices [Datein] - See log", MsgBoxStyle.Critical)
|
||
' Return False
|
||
' End If
|
||
' Else
|
||
' indexierung_erfolgreich = False
|
||
' End If
|
||
|
||
' Return indexierung_erfolgreich
|
||
' End If
|
||
' Catch ex As Exception
|
||
' ShowErrorMessage(ex, "SetEmailIndices")
|
||
' Return False
|
||
' End Try
|
||
'End Function
|
||
|
||
'Public Function GetUserEmailfromLDAP(ByVal userName As String) As String
|
||
|
||
' Dim domainName As String = Environment.UserDomainName '"PutYourDomainNameHere" '< Change this value to your actual domain name. For example: "yahoo"
|
||
' Dim dommain As String = "com" '<change this value to your actual domain region. For example: "com" as in "yahoo.com"
|
||
|
||
' Dim path As String = String.Format("LDAP://CN=User,DC={0}", domainName)
|
||
' Dim userEmail As String = String.Empty
|
||
|
||
' Using search As DirectorySearcher = New DirectorySearcher(path)
|
||
' Dim result As SearchResult
|
||
' Try
|
||
' search.Filter = "(SAMAccountName=" & userName & ")"
|
||
' search.PropertiesToLoad.Add("mail")
|
||
' result = search.FindOne()
|
||
' Catch ex As Exception
|
||
' _Logger.Error(ex)
|
||
' search.Filter = ""
|
||
' search.Filter = "(GivenName=" & userName & ")"
|
||
' search.PropertiesToLoad.Add("mail")
|
||
' End Try
|
||
|
||
' Try
|
||
' result = search.FindOne()
|
||
' If result IsNot Nothing Then userEmail = result.Properties("mail").ToString
|
||
' Catch ex As Exception
|
||
' _Logger.Info(">> Unexpected Error in GetUserEmail from LDAP: " & ex.Message)
|
||
' _Logger.Error(ex)
|
||
' End Try
|
||
' End Using
|
||
|
||
' Return userEmail
|
||
|
||
'End Function
|
||
'Private Function SetAttachmentIndices()
|
||
' Dim indexierung_erfolgreich As Boolean = True
|
||
' Try
|
||
' Dim DT As DataTable = DATABASE_ECM.GetDatatable("SELECT * FROM TBGI_OBJECTTYPE_EMAIL_INDEX WHERE OBJECTTYPE = '" & CURR_DOKART_OBJECTTYPE & "'")
|
||
' If DT.Rows.Count = 1 Then
|
||
|
||
' If Not CURRENT_MESSAGEID Is Nothing Then
|
||
' If CURRENT_MESSAGEID <> "" Then
|
||
' indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_ID").ToString, CURRENT_MESSAGEID)
|
||
' If indexierung_erfolgreich = False Then
|
||
' MsgBox("Error in SetAttachmentIndices MESSAGE-ID - See log", MsgBoxStyle.Critical)
|
||
' Return False
|
||
' End If
|
||
' End If
|
||
' End If
|
||
' 'Das Subject speichern
|
||
' If CURRENT_MESSAGESUBJECT <> "" Then
|
||
' indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_SUBJECT").ToString, CURRENT_MESSAGESUBJECT)
|
||
' If indexierung_erfolgreich = False Then
|
||
' MsgBox("Error in SetAttachmentIndices SUBJECT - See log", MsgBoxStyle.Critical)
|
||
' Return False
|
||
' End If
|
||
' End If
|
||
' 'Das MesageDate speichern
|
||
' If CURRENT_MESSAGEDATE <> "" Then
|
||
' indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_DATE_IN").ToString, CURRENT_MESSAGEDATE)
|
||
' If indexierung_erfolgreich = False Then
|
||
' MsgBox("Error in SetAttachmentIndices DATE - See log", MsgBoxStyle.Critical)
|
||
' Return False
|
||
' End If
|
||
' End If
|
||
' 'Kennzeichnen das es ein Anhang war!
|
||
' indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_CHECK_ATTACHMENT").ToString, True)
|
||
' If indexierung_erfolgreich = False Then
|
||
' MsgBox("Error in SetAttachmentIndices ATTACHMENT Y/N - See log", MsgBoxStyle.Critical)
|
||
' Return False
|
||
' End If
|
||
' Return indexierung_erfolgreich
|
||
' End If
|
||
' Catch ex As Exception
|
||
' ShowErrorMessage(ex, "SetAttachmentIndices")
|
||
' Return False
|
||
' End Try
|
||
|
||
'End Function
|
||
|
||
Private Function SINGLEFILE_2_WINDREAM(_Objekttyp As String) As Boolean
|
||
Try
|
||
CURR_DOKART_OBJECTTYPE = _Objekttyp
|
||
Dim oWMCheckPath = WINDREAM.VersionWMFilename(CURRENT_NEWFILENAME, System.IO.Path.GetExtension(CURRENT_NEWFILENAME))
|
||
If CURRENT_NEWFILENAME.ToUpper <> oWMCheckPath.ToString.ToUpper Then
|
||
_Logger.Info($"Target [{CURRENT_NEWFILENAME}] already existed!! - NewWMFilename [{oWMCheckPath}]")
|
||
CURRENT_NEWFILENAME = oWMCheckPath
|
||
End If
|
||
|
||
Dim oStreamSuccessful = WINDREAM.NewFileStream(CURRENT_WORKFILE, CURRENT_NEWFILENAME, CURR_DOKART_OBJECTTYPE)
|
||
Dim oTempPath As String = WINDREAM_BASEPATH & CURRENT_NEWFILENAME
|
||
|
||
_Logger.Debug("Checks for file [{0}]", oTempPath)
|
||
_Logger.Debug("File streamed to Windream: {0}", oStreamSuccessful)
|
||
_Logger.Debug("File exists in Destination: {0}", File.Exists(oTempPath))
|
||
|
||
Return oStreamSuccessful
|
||
Catch ex As Exception
|
||
ShowErrorMessage(ex, "SINGLEFILE_2_WINDREAM")
|
||
Return False
|
||
End Try
|
||
End Function
|
||
Function Move_Rename_Only(Quelle As String, _NewFilename As String, extension As String, _versionTz As String)
|
||
'Überprüfen ob File existiert
|
||
If File.Exists(_NewFilename) = False Then
|
||
CURRENT_NEWFILENAME = _NewFilename
|
||
Else
|
||
'Versionieren
|
||
Dim version As Integer = 1
|
||
Dim Stammname As String = _NewFilename
|
||
Dim neuername As String = _NewFilename
|
||
Do While File.Exists(neuername)
|
||
version += 1
|
||
neuername = Stammname.Replace(extension, "") & _versionTz & version & extension
|
||
CURRENT_NEWFILENAME = neuername
|
||
Loop
|
||
End If
|
||
|
||
'Die Datei wird nun an den neuen Ort kopiert
|
||
My.Computer.FileSystem.MoveFile(CURRENT_WORKFILE, CURRENT_NEWFILENAME)
|
||
|
||
'If CURR_DELETE_ORIGIN = True Then
|
||
' My.Computer.FileSystem.MoveFile(CURRENT_WORKFILE, CURRENT_NEWFILENAME)
|
||
'Else
|
||
' My.Computer.FileSystem.CopyFile(CURRENT_WORKFILE, CURRENT_NEWFILENAME)
|
||
'End If
|
||
|
||
Dim Insert_String As String
|
||
Try
|
||
Dim oCurrentWorkfile = CURRENT_WORKFILE.Replace("'", "''")
|
||
Dim oCurrentNewFilename = CURRENT_NEWFILENAME.Replace("'", "''")
|
||
Dim oUser As String = $"{Environment.UserDomainName}\{Environment.UserName}"
|
||
|
||
Insert_String = sql_history_INSERT_INTO & $",ADDED_WHO, ADDED_WHERE, FILE_HASH) VALUES ('{oCurrentWorkfile}','{oCurrentNewFilename}'{sql_history_Index_Values},'{oUser}','{Environment.MachineName}','{CURRENT_WORKFILE_HASH}')"
|
||
If DATABASE_ECM.ExecuteNonQuery(Insert_String) = True Then
|
||
If CURRENT_MESSAGEID <> "" Then
|
||
Dim max As String = "SELECT MAX(GUID) FROM TBGI_HISTORY"
|
||
Dim GUID = DATABASE_ECM.GetScalarValue(max)
|
||
Try
|
||
If GUID > 0 Then
|
||
Dim sql As String
|
||
If CURRENT_ISATTACHMENT = True Then
|
||
sql = "Update TBGI_HISTORY SET ATTACHMENT = 1, MSG_ID = '" & CURRENT_MESSAGEID & "' WHERE GUID = " & GUID
|
||
DATABASE_ECM.GetScalarValue(sql)
|
||
Else
|
||
sql = "Update TBGI_HISTORY SET ATTACHMENT = 0, MSG_ID = '" & CURRENT_MESSAGEID & "' WHERE GUID = " & GUID
|
||
DATABASE_ECM.GetScalarValue(sql)
|
||
End If
|
||
End If
|
||
Catch ex As Exception
|
||
|
||
End Try
|
||
End If
|
||
End If
|
||
Return False
|
||
Catch ex As Exception
|
||
ShowErrorMessage(ex, "Move_Rename_Only")
|
||
Return True
|
||
End Try
|
||
End Function
|
||
'#End Region
|
||
|
||
Private Sub frmIndex_FormClosing(sender As Object, e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
|
||
If File.Exists(CURRENT_FILENAME) Then
|
||
Select Case CancelAttempts
|
||
Case 0
|
||
If USER_LANGUAGE = LANG_DE Then
|
||
MsgBox($"Bitte indexieren Sie die Datei vollständig!{vbNewLine}(Abbruch 1 des Indexierungsvorgangs)", MsgBoxStyle.Information)
|
||
Else
|
||
MsgBox($"Please Index file completely{vbNewLine}(Abort 1 of Indexdialog)", MsgBoxStyle.Information)
|
||
End If
|
||
CancelAttempts += 1
|
||
e.Cancel = True
|
||
Case 1
|
||
Dim result As MsgBoxResult
|
||
If USER_LANGUAGE = LANG_DE Then
|
||
result = MessageBox.Show($"Sie brechen nun zum zweiten Mal den Indexierungsvorgang ab!{vbNewLine}Wollen Sie die Indexierung aller Dateien abbrechen?", "Bestätigung erforderlich:", MessageBoxButtons.YesNo, MessageBoxIcon.Question)
|
||
Else
|
||
result = MessageBox.Show($"You abort the indexdialog for the 2nd time!{vbNewLine}Do You want to abort indexing?", "Confirmation needed:", MessageBoxButtons.YesNo, MessageBoxIcon.Question)
|
||
End If
|
||
|
||
If result = MsgBoxResult.Yes Then
|
||
Dim containsfw_file As Boolean = False
|
||
Try
|
||
ABORT_INDEXING = True
|
||
Dim sql As String = $"SELECT * FROM TBGI_FILES_USER WHERE WORKED = 0 AND UPPER(USER@WORK) = UPPER('{Environment.UserName}')"
|
||
Dim DT As DataTable = DATABASE_ECM.GetDatatable(sql)
|
||
|
||
Dim anz = DT.Rows.Count
|
||
For Each Filerow As DataRow In DT.Rows
|
||
Dim filestring As String = Filerow.Item("FILENAME2WORK")
|
||
Dim handletype As String = Filerow.Item("HANDLE_TYPE")
|
||
|
||
If handletype = "|MSGONLY|" Or handletype = "|ATTMNTEXTRACTED|" Then
|
||
Try
|
||
System.IO.File.Delete(filestring)
|
||
Catch ex As Exception
|
||
|
||
End Try
|
||
|
||
ElseIf handletype.StartsWith("|FW") Then
|
||
containsfw_file = True
|
||
End If
|
||
Next
|
||
'Zuerst die Daten des Ablaufs löschen
|
||
If DATABASE_ECM.ExecuteNonQuery("DELETE FROM TBGI_FILES_USER WHERE UPPER(USER@WORK) = UPPER('" & Environment.UserName & "')") = True Then
|
||
If containsfw_file = True Then
|
||
If USER_LANGUAGE = LANG_DE Then
|
||
MsgBox("Der Indexierungsprozess beinhaltete (auch) Dateien per Folderwatch!" & vbNewLine & "Diese Dateien wurden nicht gelöscht und verbleiben im Folderwatch-Verzeichnis!" & vbNewLine & "Bitte verschieben Sie die Dateien ggfls.", MsgBoxStyle.Information, "Achtung - Hinweis:")
|
||
Else
|
||
MsgBox("The Indexingprocess contained (also) files from folderwatch!" & vbNewLine & "These files weren't deleted and will stay in the folderwatch-folder!" & vbNewLine & "Please move these files manually.", MsgBoxStyle.Information, "Achtung - Hinweis:")
|
||
End If
|
||
|
||
End If
|
||
End If
|
||
|
||
|
||
Catch ex As Exception
|
||
_Logger.Error(ex)
|
||
MsgBox("Unexpected Error in Abort Indexing: " & vbNewLine & ex.Message, MsgBoxStyle.Critical)
|
||
End Try
|
||
|
||
Try
|
||
INDEXING_ACTIVE = False
|
||
CloseViewer()
|
||
|
||
ClassWindowLocation.SaveFormLocationSize(Me)
|
||
My.Settings.Save()
|
||
Catch ex As Exception
|
||
_Logger.Info(" - Unexpected error in Schliessen des Formulares - Fehler: " & vbNewLine & ex.Message)
|
||
_Logger.Error(ex.Message)
|
||
MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Schliessen des Formulares:")
|
||
End Try
|
||
|
||
e.Cancel = False
|
||
Else
|
||
e.Cancel = True
|
||
End If
|
||
Case Else
|
||
Try
|
||
INDEXING_ACTIVE = False
|
||
|
||
CloseViewer()
|
||
ClassWindowLocation.SaveFormLocationSize(Me)
|
||
My.Settings.Save()
|
||
Catch ex As Exception
|
||
ShowErrorMessage(ex, "Form Close")
|
||
End Try
|
||
End Select
|
||
Else
|
||
INDEXING_ACTIVE = False
|
||
End If
|
||
End Sub
|
||
|
||
|
||
|
||
Private Sub frmIndex_Load(sender As Object, e As System.EventArgs) Handles Me.Load
|
||
' Abbruchzähler zurücksetzen
|
||
CancelAttempts = 0
|
||
|
||
INDEXING_ACTIVE = True
|
||
|
||
Try
|
||
CURRENT_ISATTACHMENT = False
|
||
DropType = DATABASE_ECM.GetScalarValue("SELECT HANDLE_TYPE FROM TBGI_FILES_USER WHERE GUID = " & CURRENT_WORKFILE_GUID)
|
||
|
||
CURR_DELETE_ORIGIN = CONFIG.Config.DeleteOriginalFile
|
||
checkItemDeleteSource.Enabled = True
|
||
checkItemDeleteSource.Checked = CONFIG.Config.DeleteOriginalFile
|
||
|
||
DocumentViewer1.Init(LOGCONFIG, VIEWER_LICENSE)
|
||
|
||
If DropType Is Nothing Then
|
||
_Logger.Debug("File with Id [{0}] was not found in TBGI_FILES_USER. Exiting.", CURRENT_WORKFILE_GUID)
|
||
CancelAttempts = MaxCancelAttempts
|
||
Close()
|
||
Else
|
||
CURRENT_DROPTYPE = DropType.Replace("|", "")
|
||
|
||
If DropType.StartsWith("|FW") Then
|
||
' Eine Datei aus FolderWatch wird IMMER gelöscht, egal wie die Einstellung in der Config lautet
|
||
CURR_DELETE_ORIGIN = True
|
||
checkItemDeleteSource.Visibility = DevExpress.XtraBars.BarItemVisibility.Never
|
||
ElseIf DropType.Contains("|OUTLOOK_MESSAGE|") Then
|
||
' Eine (DragDrop)-Outlook Nachricht wird NIE gelöscht, egal wie die Einstellung in der Config lautet
|
||
CURR_DELETE_ORIGIN = False
|
||
checkItemDeleteSource.Visibility = DevExpress.XtraBars.BarItemVisibility.Never
|
||
Else
|
||
checkItemDeleteSource.Visibility = DevExpress.XtraBars.BarItemVisibility.Always
|
||
End If
|
||
|
||
If DropType = "|DROPFROMFSYSTEM|" Then
|
||
If USER_LANGUAGE <> LANG_DE Then
|
||
Me.Text = "Indexing of dropped file"
|
||
Else
|
||
Me.Text = "Indexierung der gedroppten Datei"
|
||
End If
|
||
ElseIf DropType = "|OUTLOOK_MESSAGE|" Or DropType = "|FW_MSGONLY|" Then
|
||
Select Case DropType
|
||
Case "|FW_MSGONLY|"
|
||
_Logger.Info(".msg-file from folderwatch")
|
||
If USER_LANGUAGE <> LANG_DE Then
|
||
Me.Text = "Indexing of msg-File (without Attachments) - from Folderwatch"
|
||
Else
|
||
Me.Text = "Indexierung der msg-Datei (ohne Anhang) - aus Folderwatch"
|
||
End If
|
||
Case "|OUTLOOK_MESSAGE|"
|
||
_Logger.Info(".msg-file through dragdrop")
|
||
If USER_LANGUAGE <> LANG_DE Then
|
||
Me.Text = "Indexing of msg-File (without Attachments)"
|
||
Else
|
||
Me.Text = "Indexierung der msg-Datei (ohne Anhang)"
|
||
End If
|
||
End Select
|
||
|
||
ElseIf DropType = "|MSGONLY|" Then
|
||
If USER_LANGUAGE = LANG_DE Then
|
||
Me.Text = "Indexierung der msg-Datei (ohne Anhang)"
|
||
Else
|
||
Me.Text = "Indexing of msg-File (without Attachments)"
|
||
End If
|
||
ElseIf DropType = "|ATTMNTEXTRACTED|" Or DropType = "|OUTLOOK_ATTACHMENT|" Then
|
||
CURRENT_ISATTACHMENT = True
|
||
|
||
If USER_LANGUAGE = LANG_DE Then
|
||
Me.Text = "Indexierung eines Email-Attachments"
|
||
Else
|
||
Me.Text = "Indexing of email-Attachment"
|
||
End If
|
||
ElseIf DropType = "|FW_SIMPLEINDEXER|" Then
|
||
|
||
If USER_LANGUAGE = LANG_DE Then
|
||
Me.Text = "Indexierung einer Folderwatch-Datei"
|
||
Else
|
||
Me.Text = "Indexing of Folderwatch-File"
|
||
End If
|
||
End If
|
||
|
||
labelFilePath.Caption = CURRENT_WORKFILE
|
||
|
||
ClassWindowLocation.LoadFormLocationSize(Me)
|
||
|
||
SetFilePreview(CONFIG.Config.FilePreview)
|
||
|
||
SplitContainer1.SplitterDistance = CONFIG.Config.SplitterDistanceViewer
|
||
|
||
Load_String()
|
||
|
||
DTTBGI_REGEX_DOCTYPE = DATABASE_ECM.GetDatatable("SELECT DISTINCT T1.DOCTYPE as DocType, T.* FROM TBGI_REGEX_DOCTYPE T, VWGI_DOCTYPE T1 WHERE T.DOCTYPE_ID = T1.DOCTYPE_ID")
|
||
MULTIFILES = DATABASE_ECM.GetScalarValue("SELECT COUNT(*) FROM TBGI_FILES_USER WHERE WORKED = 0 AND GUID <> " & CURRENT_WORKFILE_GUID & " AND UPPER(USER@WORK) = UPPER('" & Environment.UserName & "')")
|
||
Dim allFiles As Integer = MULTIFILES + 1
|
||
MULTIINDEXING_ACTIVE = False
|
||
'If allFiles > 1 Then
|
||
' If USER_LANGUAGE = LANG_DE Then
|
||
' 'BarCheckItem_MultiIndexing.Caption = "Multi-Indexing - Alle nachfolgenden Dateien (" & MULTIFILES & ") identisch indexieren"
|
||
' BarCheckItem_MultiIndexing.Caption = "Multi-Indexing - (" & allFiles & ") zu indexierende Dateien"
|
||
' Else
|
||
' 'BarCheckItem_MultiIndexing.Caption = "Multi-Indexing - All following files (" & MULTIFILES & ") will be indexed identically"
|
||
' BarCheckItem_MultiIndexing.Caption = "Multi-Indexing - (" & allFiles & ") files to be indexed"
|
||
' End If
|
||
|
||
' BarCheckItem_MultiIndexing.Checked = False
|
||
' BarCheckItem_MultiIndexing.Visibility = True
|
||
|
||
' BarButtonItem1.Visibility = DevExpress.XtraBars.BarItemVisibility.Always
|
||
'Else
|
||
' BarCheckItem_MultiIndexing.Visibility = False
|
||
|
||
' BarButtonItem1.Visibility = DevExpress.XtraBars.BarItemVisibility.Never
|
||
'End If
|
||
If allFiles < 2 Then
|
||
BarCheckItem_MultiIndexing.Caption = "Multi-Indexing"
|
||
BarCheckItem_MultiIndexing.Enabled = False
|
||
BarButtonItem1.Enabled = False
|
||
Else
|
||
If USER_LANGUAGE = LANG_DE Then
|
||
BarCheckItem_MultiIndexing.Caption = "Multi-Indexing - (" & allFiles & ") zu indexierende Dateien"
|
||
Else
|
||
BarCheckItem_MultiIndexing.Caption = "Multi-Indexing - (" & allFiles & ") files to be indexed"
|
||
End If
|
||
BarCheckItem_MultiIndexing.Checked = False
|
||
BarCheckItem_MultiIndexing.Enabled = True
|
||
BarButtonItem1.Enabled = True
|
||
End If
|
||
End If
|
||
|
||
|
||
Catch ex As Exception
|
||
ShowErrorMessage(ex, "Form Open")
|
||
End Try
|
||
End Sub
|
||
|
||
Sub Load_String()
|
||
Try
|
||
Me.VWDDINDEX_MANTableAdapter.Connection.ConnectionString = MyConnectionString
|
||
Me.VWINDEX_AUTOMTableAdapter.Connection.ConnectionString = MyConnectionString
|
||
Catch ex As Exception
|
||
_Logger.Warn(" - Unexpected error in Speichern der Verbindung - Fehler: " & vbNewLine & ex.Message)
|
||
_Logger.Error(ex.Message)
|
||
MsgBox("Unexpected error in Speichern der Verbindung: " & vbNewLine & ex.Message, MsgBoxStyle.Exclamation)
|
||
End Try
|
||
End Sub
|
||
|
||
Private Sub frmIndex_Shown(sender As Object, e As System.EventArgs) Handles Me.Shown
|
||
BringToFront()
|
||
Focus()
|
||
Cursor = Cursors.Default
|
||
Refresh_Dokart()
|
||
pnlIndex.Controls.Clear()
|
||
|
||
checkItemTopMost.Checked = CONFIG.Config.TopMost
|
||
TopMost = CONFIG.Config.TopMost
|
||
BringToFront()
|
||
|
||
FormLoaded = True
|
||
|
||
Try
|
||
_Logger.Info("Profile Preselected enabled: {0}", CONFIG.Config.ProfilePreselection)
|
||
' Letzte Auswahl merken überschreibt die automatische selektion
|
||
If CONFIG.Config.ProfilePreselection Then
|
||
checkItemPreselection.Checked = True
|
||
|
||
If CURRENT_LASTDOKART <> "" Then
|
||
_Logger.Info("Last Saved DocType: {0}", CURRENT_LASTDOKART)
|
||
|
||
Dim oDocTypes As List(Of DocType) = DocTypes
|
||
Dim oFoundDocType = oDocTypes.
|
||
Where(Function(dt) dt.Name = CURRENT_LASTDOKART).
|
||
FirstOrDefault()
|
||
|
||
If oFoundDocType IsNot Nothing Then
|
||
_Logger.Info("Setting Last Saved DocType: {0}", CURRENT_LASTDOKART)
|
||
|
||
ComboboxDoctype.EditValue = oFoundDocType
|
||
ComboboxDoctype.SelectNextControl(ComboboxDoctype, forward:=True, tabStopOnly:=True, nested:=True, wrap:=False)
|
||
End If
|
||
|
||
End If
|
||
End If
|
||
|
||
Dim oApplyRegex = ComboboxDoctype.EditValue Is Nothing And DTTBGI_REGEX_DOCTYPE.Rows.Count > 0
|
||
_Logger.Info("Applying Profile Selection Regex: [{0}]", oApplyRegex)
|
||
|
||
If oApplyRegex Then
|
||
For Each oRoW As DataRow In DTTBGI_REGEX_DOCTYPE.Rows
|
||
Dim oOnlyFilename = Path.GetFileName(CURRENT_WORKFILE)
|
||
If Regex.IsMatch(oOnlyFilename, oRoW.Item("Regex"), RegexOptions.IgnoreCase) Then
|
||
|
||
_Logger.Debug("There is a match on REGEX_DOCTYPE: [{0}]", oRoW.Item("DOCTYPE"))
|
||
_Logger.Debug("Regex: [{0}], FileName: [{1}]", oRoW.Item("Regex"), oOnlyFilename)
|
||
|
||
Dim oDoctypes As List(Of DocType) = DocTypes
|
||
Dim oFoundDocType As DocType = oDoctypes.
|
||
Where(Function(dt) dt.Guid = oRoW.Item("DOCTYPE_ID")).
|
||
FirstOrDefault()
|
||
|
||
If oFoundDocType IsNot Nothing Then
|
||
_Logger.Debug("DocType found: [{0}]", oFoundDocType)
|
||
ComboboxDoctype.EditValue = oFoundDocType
|
||
ComboboxDoctype.SelectNextControl(ComboboxDoctype, forward:=True, tabStopOnly:=True, nested:=True, wrap:=False)
|
||
|
||
Exit For
|
||
End If
|
||
End If
|
||
Next
|
||
End If
|
||
|
||
|
||
If ComboboxDoctype.EditValue Is Nothing Then
|
||
ComboboxDoctype.Select()
|
||
End If
|
||
Catch ex As Exception
|
||
ShowErrorMessage(ex, "Form Shown")
|
||
End Try
|
||
End Sub
|
||
Sub Refresh_Dokart()
|
||
Try
|
||
Dim sql = String.Format("SELECT DISTINCT DOCTYPE_ID, DOCTYPE, SEQUENCE FROM VWGI_DOCTYPE where USERNAME = '{0}' ORDER BY SEQUENCE", Environment.UserName)
|
||
_Logger.Info("SQL DoctypeList: " & sql)
|
||
Dim oDoctypes = DATABASE_ECM.GetDatatable(sql)
|
||
|
||
ComboboxDoctype.EditValue = Nothing
|
||
ComboboxDoctype.Properties.DataSource = Nothing
|
||
|
||
DocTypes.Clear()
|
||
For Each oRow As DataRow In oDoctypes.Rows
|
||
Dim oDocType = New DocType With {
|
||
.Guid = oRow.Item("DOCTYPE_ID"),
|
||
.Name = oRow.Item("DOCTYPE")
|
||
}
|
||
DocTypes.Add(oDocType)
|
||
Next
|
||
|
||
ComboboxDoctype.Properties.DataSource = DocTypes
|
||
Catch ex As Exception
|
||
ShowErrorMessage(ex, "Refresh_Dokart")
|
||
End Try
|
||
End Sub
|
||
|
||
Private Sub ComboBoxEdit1_SelectedIndexChanged(sender As Object, e As EventArgs) Handles ComboboxDoctype.EditValueChanged
|
||
If ComboboxDoctype.EditValue IsNot Nothing And FormLoaded = True Then
|
||
|
||
WINDREAM = New Windream(LOGCONFIG, False, WMDrive, WINDREAM_BASEPATH, True, "", "", "", "")
|
||
If Not IsNothing(WINDREAM) Then
|
||
If WINDREAM.SessionLoggedin Then
|
||
|
||
Dim oSelectedItem As DocType = ComboboxDoctype.EditValue
|
||
|
||
CURRENT_DOKART_ID = oSelectedItem.Guid
|
||
CURRENT_LASTDOKART = oSelectedItem.Name
|
||
|
||
'lblhinweis.Visible = False
|
||
ClearNotice()
|
||
|
||
'lblerror.Visible = False
|
||
ClearError()
|
||
|
||
pnlIndex.Controls.Clear()
|
||
Dim sql As String = "Select WINDREAM_DIRECT, ZIEL_PFAD, DUPLICATE_HANDLING from TBDD_DOKUMENTART WHERE GUID = " & oSelectedItem.Guid
|
||
Dim oDoctypes As DataTable = DATABASE_ECM.GetDatatable(sql)
|
||
|
||
Dim oDocType As DataRow = oDoctypes.Rows.Item(0)
|
||
WMDirect = oDocType.Item("WINDREAM_DIRECT")
|
||
Dim oDestination As String = oDocType.Item("ZIEL_PFAD")
|
||
Dim oNewDestination As String
|
||
If WMDirect Then
|
||
Dim oNormalized As String = WINDREAM.GetNormalizedPath(oDestination, False)
|
||
oNewDestination = Path.Combine(WINDREAM.ClientBasePath, oNormalized)
|
||
Else
|
||
oNewDestination = oDestination
|
||
End If
|
||
|
||
|
||
LOGGER.Debug("Path from Database is [{0}]", oDestination)
|
||
LOGGER.Debug("Checking for path [{0}]", oNewDestination)
|
||
Dim oPathExists As Boolean
|
||
If WMDirect Then
|
||
oPathExists = WINDREAM.TestFolderExists(oNewDestination)
|
||
Else
|
||
oPathExists = Directory.Exists(oNewDestination)
|
||
End If
|
||
|
||
If oPathExists = False Then
|
||
Dim oMessage As String
|
||
|
||
If USER_LANGUAGE = "de-DE" Then
|
||
oMessage = $"Der Pfad für das ausgewählte Profil ist nicht erreichbar:{vbNewLine}[{oNewDestination}].{vbNewLine}{vbNewLine}Bitte wählen Sie ein anderes Profil."
|
||
Else
|
||
oMessage = $"Profile Path is not available:{vbNewLine}[{oNewDestination}].{vbNewLine}{vbNewLine}Please select another profile."
|
||
End If
|
||
|
||
MsgBox(oMessage, MsgBoxStyle.Information, Text)
|
||
ComboboxDoctype.EditValue = Nothing
|
||
Else
|
||
|
||
CURRENT_DOKART_DUPLICATE_HANDLING = oDocType.Item("DUPLICATE_HANDLING")
|
||
Refresh_IndexeMan(oSelectedItem.Guid)
|
||
End If
|
||
|
||
Else
|
||
MsgBox("Es konnte keine Session aufgebaut werden.")
|
||
End If
|
||
Else
|
||
MsgBox("Es konnte keine Windream-Verbindung aufgebaut werden.")
|
||
End If
|
||
End If
|
||
End Sub
|
||
|
||
Private Sub Refresh_IndexeMan(dokartid As Integer)
|
||
Dim sql
|
||
Try
|
||
sql = "select T1.BEZEICHNUNG AS DOKUMENTART,T.* from TBDD_INDEX_MAN T, TBDD_DOKUMENTART T1 where T.ACTIVE = 1 AND T.DOK_ID = T1.GUID AND T.DOK_ID = " & dokartid & " ORDER BY T.SEQUENCE"
|
||
DT_INDEXEMAN = DATABASE_ECM.GetDatatable(sql)
|
||
pnlIndex.Visible = True
|
||
LoadIndexe_Man()
|
||
Catch ex As System.Exception
|
||
ShowErrorMessage(ex, "Refresh_IndexeMan", "DOKART-ID: " & dokartid)
|
||
End Try
|
||
End Sub
|
||
' <STAThread()> _
|
||
Function Check_HistoryValues(Indexname As String, Dokart As String) As String
|
||
Try
|
||
Dim result = Nothing
|
||
Dim DT As DataTable = MyDataset.TBTEMP_INDEXRESULTS
|
||
If DT.Rows.Count > 0 Then
|
||
For Each row As DataRow In DT.Rows
|
||
If row.Item("Indexname") = Indexname And row.Item("Dokumentart") = Dokart Then
|
||
result = row.Item("Value")
|
||
Return result
|
||
End If
|
||
Next
|
||
Else
|
||
Return Nothing
|
||
End If
|
||
Catch ex As Exception
|
||
ShowErrorMessage(ex, "Check_HistoryValues")
|
||
Return Nothing
|
||
End Try
|
||
End Function
|
||
|
||
'Private Sub LoadIndexe_Man()
|
||
' Try
|
||
|
||
' Dim oScreen As New DigitalData.Modules.Windows.Screen()
|
||
' Dim oDpiscale = oScreen.GetScreenScaling(Me)
|
||
|
||
' Dim oControlCount As Integer = 1
|
||
' Dim oLabelPosition As Integer = 11 * oDpiscale
|
||
' Dim oControlPosition As Integer = 33 * oDpiscale
|
||
|
||
' _Logger.Info("Loading Indicies for Screen Scaling Factor [{0}]", oDpiscale)
|
||
|
||
' Dim oControls As New ControlCreator(LOGCONFIG, pnlIndex, Me) With {
|
||
' .OnControlChanged = AddressOf PrepareDependingControl,
|
||
' .OnLookupData = AddressOf GetLookupData
|
||
' }
|
||
|
||
' 'Dim oControls As New ClassControls(pnlIndex, Me)
|
||
|
||
' If DT_INDEXEMAN.Rows.Count = 0 Then
|
||
' ' ShowError("Keine Manuellen Indizes für die " & vbNewLine & "Dokumentart " & cmbDokumentart.Text & " definiert")
|
||
' '_Logger.Info(" - Keine Manuellen Indizes für die " & vbNewLine & "Dokumentart " & cmbDokumentart.Text & " definiert")
|
||
|
||
' ShowError("Keine Manuellen Indizes für die " & vbNewLine & "Dokumentart " & ComboboxDoctype.Text & " definiert")
|
||
' _Logger.Info(" - Keine Manuellen Indizes für die " & vbNewLine & "Dokumentart " & ComboboxDoctype.Text & " definiert")
|
||
' End If
|
||
|
||
' For Each oRow As DataRow In DT_INDEXEMAN.Rows
|
||
' Dim oDataType = oRow.Item("DATATYPE")
|
||
' Dim MultiSelect As Boolean = oRow.Item("MULTISELECT")
|
||
' Dim AddNewItems As Boolean = oRow.Item("VKT_ADD_ITEM")
|
||
' Dim PreventDuplicates As Boolean = oRow.Item("VKT_PREVENT_MULTIPLE_VALUES")
|
||
' Dim oControlName As String = oRow.Item("NAME")
|
||
' Dim oConnectionId = oRow.ItemEx("CONNECTION_ID", 0)
|
||
' Dim oSQLSuggestion = oRow.Item("SUGGESTION")
|
||
' Dim oSQLResult = oRow.Item("SQL_RESULT")
|
||
|
||
' LOGGER.Debug("IndexName: {0}", oControlName)
|
||
' LOGGER.Debug("SQL: {0}", oSQLResult)
|
||
|
||
' If oDataType <> ClassConstants.INDEX_TYPE_BOOLEAN Then
|
||
' addLabel(oControlName, oRow.Item("COMMENT").ToString, oLabelPosition, oControlCount)
|
||
' End If
|
||
|
||
' Dim DefaultValue = Check_HistoryValues(oControlName, oRow.Item("DOKUMENTART"))
|
||
' If DefaultValue Is Nothing Then
|
||
' DefaultValue = GetPlaceholderValue(oRow.Item("DEFAULT_VALUE"), CURRENT_WORKFILE, USER_SHORTNAME)
|
||
' End If
|
||
|
||
' Select Case oDataType
|
||
' Case ClassConstants.INDEX_TYPE_BOOLEAN
|
||
' Dim chk As CheckEdit = oControls.AddCheckBox(oControlName, oControlPosition, DefaultValue, oRow.Item("COMMENT").ToString)
|
||
' If Not IsNothing(chk) Then
|
||
' pnlIndex.Controls.Add(chk)
|
||
' End If
|
||
' Case ClassConstants.INDEX_TYPE_INTEGER
|
||
' If (oSQLSuggestion = True And oSQLResult.ToString.Length > 0) Or MultiSelect = True Then
|
||
' Dim oControl = oControls.AddLookupControl(oControlName, oControlPosition, MultiSelect, oDataType, oSQLResult, oConnectionId, DefaultValue, AddNewItems, PreventDuplicates)
|
||
' If Not IsNothing(oControl) Then
|
||
' pnlIndex.Controls.Add(oControl)
|
||
' End If
|
||
' Else
|
||
' 'nur eine Textbox
|
||
' Dim oControl = oControls.AddTextBox(oControlName, oControlPosition, DefaultValue, oDataType)
|
||
' If Not IsNothing(oControl) Then
|
||
' pnlIndex.Controls.Add(oControl)
|
||
' End If
|
||
' End If
|
||
' Case ClassConstants.INDEX_TYPE_VARCHAR
|
||
' If (oSQLSuggestion = True And oSQLResult.ToString.Length > 0) Or MultiSelect = True Then
|
||
' Dim oControl = oControls.AddLookupControl(oControlName, oControlPosition, MultiSelect, oDataType, oSQLResult, oConnectionId, DefaultValue, AddNewItems, PreventDuplicates)
|
||
' If Not IsNothing(oControl) Then
|
||
' pnlIndex.Controls.Add(oControl)
|
||
' End If
|
||
' Else
|
||
' If oControlName.ToString.ToLower = "dateiname" Then
|
||
' Dim oControl = oControls.AddTextBox(oControlName, oControlPosition, System.IO.Path.GetFileNameWithoutExtension(CURRENT_WORKFILE), oDataType)
|
||
' If Not IsNothing(oControl) Then
|
||
' pnlIndex.Controls.Add(oControl)
|
||
' End If
|
||
' Else
|
||
' Dim VORBELGUNG As String = DefaultValue
|
||
' Dim oControl = oControls.AddTextBox(oControlName, oControlPosition, VORBELGUNG, oDataType)
|
||
' If Not IsNothing(oControl) Then
|
||
' pnlIndex.Controls.Add(oControl)
|
||
' End If
|
||
' End If
|
||
' End If
|
||
' Case "DATE"
|
||
' Dim oPicker = oControls.AddDateTimePicker(oControlName, oControlPosition, DefaultValue)
|
||
' pnlIndex.Controls.Add(oPicker)
|
||
|
||
' Case Else
|
||
' If USER_LANGUAGE = LANG_DE Then
|
||
' MsgBox("Bitte überprüfen Sie den Datentyp des hinterlegten Indexwertes!", MsgBoxStyle.Critical, "Achtung:")
|
||
' Else
|
||
' MsgBox("Please check Datatype of Indexvalue!", MsgBoxStyle.Critical, "Warning:")
|
||
' End If
|
||
|
||
' _Logger.Warn(" - Datentyp nicht hinterlegt - LoadIndexe_Man")
|
||
' End Select
|
||
|
||
' oControlCount += 1
|
||
' oLabelPosition += 50 * oDpiscale
|
||
' oControlPosition += 50 * oDpiscale
|
||
' 'make y as height in fom
|
||
' Next
|
||
' Dim oPanelHeight = oControlPosition - 30
|
||
|
||
' If pnlIndex.Height < oPanelHeight Then
|
||
' If (Me.Height - 315) < oPanelHeight Then
|
||
' Me.Height = (Me.Height - 315) + oPanelHeight
|
||
' End If
|
||
' pnlIndex.Height = oPanelHeight
|
||
' End If
|
||
|
||
' SendKeys.Send("{TAB}")
|
||
' Catch ex As Exception
|
||
' ShowErrorMessage(ex, "LoadIndexe_Man")
|
||
' End Try
|
||
'End Sub
|
||
|
||
Private Sub LoadIndexe_Man()
|
||
Try
|
||
Dim oScreen As New DigitalData.Modules.Windows.Screen()
|
||
Dim oDpiscale = oScreen.GetScreenScaling(Me)
|
||
|
||
Dim oRowTop As Integer = 20 * oDpiscale
|
||
Dim oLabelLeft As Integer = 20
|
||
Dim oControlLeft As Integer = 250
|
||
Dim oControlWidth As Integer = 420
|
||
Dim oZeilenhoehe As Integer = 30 * oDpiscale
|
||
|
||
_Logger.Info("Loading Indicies for Screen Scaling Factor [{0}]", oDpiscale)
|
||
|
||
Dim oControls As New ControlCreator(LOGCONFIG, pnlIndex, Me) With {
|
||
.OnControlChanged = AddressOf PrepareDependingControl,
|
||
.OnLookupData = AddressOf GetLookupData
|
||
}
|
||
|
||
If DT_INDEXEMAN.Rows.Count = 0 Then
|
||
ShowError("Keine Manuellen Indizes für die " & vbNewLine & "Dokumentart " & ComboboxDoctype.Text & " definiert")
|
||
_Logger.Info(" - Keine Manuellen Indizes für die " & vbNewLine & "Dokumentart " & ComboboxDoctype.Text & " definiert")
|
||
End If
|
||
|
||
For Each oRow As DataRow In DT_INDEXEMAN.Rows
|
||
Dim oDataType = oRow.Item("DATATYPE")
|
||
Dim MultiSelect As Boolean = oRow.Item("MULTISELECT")
|
||
Dim AddNewItems As Boolean = oRow.Item("VKT_ADD_ITEM")
|
||
Dim PreventDuplicates As Boolean = oRow.Item("VKT_PREVENT_MULTIPLE_VALUES")
|
||
Dim oControlName As String = oRow.Item("NAME")
|
||
Dim oConnectionId = oRow.ItemEx("CONNECTION_ID", 0)
|
||
Dim oSQLSuggestion = oRow.Item("SUGGESTION")
|
||
Dim oSQLResult = oRow.Item("SQL_RESULT")
|
||
|
||
LOGGER.Debug("IndexName: {0}", oControlName)
|
||
LOGGER.Debug("SQL: {0}", oSQLResult)
|
||
|
||
Dim DefaultValue = Check_HistoryValues(oControlName, oRow.Item("DOKUMENTART"))
|
||
If DefaultValue Is Nothing Then
|
||
DefaultValue = GetPlaceholderValue(oRow.Item("DEFAULT_VALUE"), CURRENT_WORKFILE, USER_SHORTNAME)
|
||
End If
|
||
|
||
Dim ctrl As Control = Nothing
|
||
|
||
Dim lbl As Windows.Forms.Label = Nothing
|
||
|
||
' Label nur anzeigen, wenn nicht BOOLEAN
|
||
If oDataType <> ClassConstants.INDEX_TYPE_BOOLEAN Then
|
||
lbl = New Windows.Forms.Label()
|
||
lbl.Text = oRow.Item("COMMENT").ToString()
|
||
lbl.Left = oLabelLeft
|
||
lbl.Top = oRowTop
|
||
lbl.Width = oControlLeft - oLabelLeft - 10
|
||
lbl.AutoSize = True
|
||
lbl.MaximumSize = New Size(lbl.Width, 0) ' Max Breite, Höhe unbegrenzt
|
||
lbl.Height = lbl.PreferredHeight
|
||
lbl.TextAlign = ContentAlignment.MiddleLeft
|
||
lbl.UseCompatibleTextRendering = True
|
||
pnlIndex.Controls.Add(lbl)
|
||
End If
|
||
|
||
' Control erzeugen und platzieren
|
||
Select Case oDataType
|
||
Case ClassConstants.INDEX_TYPE_BOOLEAN
|
||
Dim chk As CheckEdit = oControls.AddCheckBox(oControlName, oRowTop, DefaultValue, oRow.Item("COMMENT").ToString)
|
||
If chk IsNot Nothing Then
|
||
chk.Left = oControlLeft
|
||
chk.Top = oRowTop
|
||
chk.Width = oControlWidth
|
||
chk.Margin = New Padding(0, 4, 0, 4)
|
||
pnlIndex.Controls.Add(chk)
|
||
End If
|
||
Case ClassConstants.INDEX_TYPE_INTEGER, ClassConstants.INDEX_TYPE_VARCHAR
|
||
If (oSQLSuggestion = True AndAlso oSQLResult.ToString.Length > 0) OrElse MultiSelect = True Then
|
||
ctrl = oControls.AddLookupControl(oControlName, oRowTop, MultiSelect, oDataType, oSQLResult, oConnectionId, DefaultValue, AddNewItems, PreventDuplicates)
|
||
Else
|
||
If oControlName.ToLower() = "dateiname" Then
|
||
ctrl = oControls.AddTextBox(oControlName, oRowTop, System.IO.Path.GetFileNameWithoutExtension(CURRENT_WORKFILE), oDataType)
|
||
Else
|
||
ctrl = oControls.AddTextBox(oControlName, oRowTop, DefaultValue, oDataType)
|
||
End If
|
||
End If
|
||
Case "DATE"
|
||
ctrl = oControls.AddDateTimePicker(oControlName, oRowTop, DefaultValue)
|
||
Case Else
|
||
MsgBox("Bitte überprüfen Sie den Datentyp des hinterlegten Indexwertes!", MsgBoxStyle.Critical, "Achtung:")
|
||
_Logger.Warn(" - Datentyp nicht hinterlegt - LoadIndexe_Man")
|
||
End Select
|
||
|
||
If ctrl IsNot Nothing Then
|
||
ctrl.Left = oControlLeft
|
||
ctrl.Top = oRowTop
|
||
ctrl.Width = oControlWidth
|
||
pnlIndex.Controls.Add(ctrl)
|
||
|
||
If IsNotNullOrEmpty(DefaultValue) Then
|
||
|
||
Me.BeginInvoke(
|
||
Sub()
|
||
_Logger.Debug("Triggering PrepareDependingControl for [{0}] via BeginInvoke", ctrl.Name)
|
||
PrepareDependingControl(ctrl)
|
||
End Sub)
|
||
|
||
End If
|
||
End If
|
||
|
||
Dim zeilenhoeheAktuell As Integer
|
||
|
||
If oDataType <> ClassConstants.INDEX_TYPE_BOOLEAN Then
|
||
' Verwende die Höhe vom Label oder Mindesthöhe
|
||
zeilenhoeheAktuell = Math.Max(lbl.Height, 30 * oDpiscale)
|
||
Else
|
||
' Für Boolean Controls kannst du die Standardhöhe nehmen
|
||
zeilenhoeheAktuell = 30 * oDpiscale
|
||
End If
|
||
|
||
oRowTop += zeilenhoeheAktuell
|
||
Next
|
||
|
||
' Panel- und Formhöhe anpassen, wenn nötig
|
||
Dim oPanelHeight = oRowTop + 10
|
||
If pnlIndex.Height < oPanelHeight Then
|
||
If (Me.Height - 315) < oPanelHeight Then
|
||
Me.Height = (Me.Height - 315) + oPanelHeight
|
||
End If
|
||
pnlIndex.Height = oPanelHeight
|
||
End If
|
||
|
||
SendKeys.Send("{TAB}")
|
||
|
||
Catch ex As Exception
|
||
ShowErrorMessage(ex, "LoadIndexe_Man")
|
||
End Try
|
||
End Sub
|
||
|
||
Private Function GetLookupData(pLookup As LookupControl3, pSQLCommand As String, pConnectionId As Integer)
|
||
Dim oConnectionString = DATABASE_ECM.Get_ConnectionStringforID(pConnectionId)
|
||
|
||
If oConnectionString IsNot Nothing And pSQLCommand.Length > 0 Then
|
||
LOGGER.Debug("Connection String (redacted): [{0}]", oConnectionString.Substring(0, 30))
|
||
|
||
If ClassPatterns.HasComplexPatterns(pSQLCommand) Then
|
||
LOGGER.Debug(" >>sql enthält Platzhalter und wird erst während der Laufzeit gefüllt!", False)
|
||
Return Nothing
|
||
Else
|
||
pSQLCommand = ClassPatterns.ReplaceInternalValues(pSQLCommand)
|
||
pSQLCommand = ClassPatterns.ReplaceUserValues(pSQLCommand, USER_PRENAME, USER_SURNAME, USER_SHORTNAME, USER_LANGUAGE, USER_EMAIL, USER_ID, CURRENT_DOKART_ID)
|
||
|
||
'Dim oDatatable = ClassDatabase.Return_Datatable_Combined(pSQLCommand, oConnectionString, False)
|
||
Dim oDatatable = DATABASE_ECM.GetDatatableWithConnection(pSQLCommand, oConnectionString)
|
||
Return oDatatable
|
||
End If
|
||
Else
|
||
LOGGER.Warn("Connection String for control [{0}] is empty!", pLookup.Name)
|
||
Return Nothing
|
||
End If
|
||
End Function
|
||
|
||
Private Sub PrepareDependingControl(Control As Control)
|
||
If TypeOf Control Is Windows.Forms.Label Then
|
||
Exit Sub
|
||
End If
|
||
|
||
Try
|
||
Dim oMeta = DirectCast(Control.Tag, ControlCreator.ControlMeta)
|
||
Dim oIndexName As String = oMeta.IndexName
|
||
Dim oSQL = $"SELECT * FROM TBDD_INDEX_MAN WHERE SQL_RESULT LIKE '%{oIndexName}%' AND DOK_ID = {CURRENT_DOKART_ID}"
|
||
Dim oDatatable As DataTable = DATABASE_ECM.GetDatatable(oSQL)
|
||
|
||
If Not IsNothing(oDatatable) Then
|
||
LOGGER.Debug("Found [{0}] depending controls for [{1}]", oDatatable.Rows.Count, Control.Name)
|
||
|
||
For Each oRow As DataRow In oDatatable.Rows
|
||
Dim oControlName As String = oRow.ItemEx("NAME", "")
|
||
Dim oConnectionId As Integer = oRow.ItemEx("CONNECTION_ID", -1)
|
||
Dim oControlSql As String = oRow.ItemEx("SQL_RESULT", "")
|
||
|
||
If oConnectionId = -1 Or oControlSql = String.Empty Then
|
||
LOGGER.Warn("Missing SQL Query or ConnectionId for Control [{0}]! Continuing.", oControlName)
|
||
Continue For
|
||
End If
|
||
|
||
oControlSql = ClassPatterns.ReplaceUserValues(oControlSql, USER_PRENAME, USER_SURNAME, USER_SHORTNAME, USER_LANGUAGE, USER_EMAIL, USER_ID, CURRENT_DOKART_ID)
|
||
oControlSql = ClassPatterns.ReplaceInternalValues(oControlSql)
|
||
oControlSql = ClassPatterns.ReplaceControlValues(oControlSql, pnlIndex)
|
||
LOGGER.Debug("Setting new value for [{0}]", oControlName)
|
||
SetDependingControlResult(oControlName, oControlSql, oConnectionId)
|
||
Next
|
||
End If
|
||
Catch ex As Exception
|
||
LOGGER.Error(ex)
|
||
End Try
|
||
End Sub
|
||
|
||
Private Sub SetDependingControlResult(IndexName As String, SqlCommand As String, SqlConnectionId As Integer)
|
||
Try
|
||
If String.IsNullOrWhiteSpace(SqlCommand) OrElse SqlCommand.Contains("''") OrElse SqlCommand.Contains("IN ()") Then
|
||
LOGGER.Warn("Skipped SQL execution for Index [{0}]: Invalid or empty SQL: [{1}]", IndexName, SqlCommand)
|
||
Exit Sub
|
||
End If
|
||
|
||
Dim oConnectionString = DATABASE_ECM.Get_ConnectionStringforID(SqlConnectionId)
|
||
Dim oDatatable As DataTable = DATABASE_ECM.GetDatatableWithConnection(SqlCommand, oConnectionString)
|
||
Dim oFoundControl As Control = Nothing
|
||
|
||
For Each oControl As Control In pnlIndex.Controls
|
||
If TypeOf oControl Is Windows.Forms.Label Then
|
||
Continue For
|
||
End If
|
||
|
||
Dim oMeta = DirectCast(oControl.Tag, ControlCreator.ControlMeta)
|
||
Dim oIndex As String = oMeta.IndexName
|
||
|
||
If oIndex = IndexName Then
|
||
oFoundControl = oControl
|
||
Exit For
|
||
End If
|
||
Next
|
||
|
||
If oFoundControl Is Nothing Then
|
||
LOGGER.Warn("Depending Control for Index [{0}] not found!", IndexName)
|
||
Exit Sub
|
||
End If
|
||
|
||
If oDatatable Is Nothing Then
|
||
LOGGER.Warn("Error in SQL Command: {0}", SqlCommand)
|
||
Exit Sub
|
||
End If
|
||
|
||
Select Case oFoundControl.GetType.Name
|
||
Case GetType(TextEdit).Name
|
||
If oDatatable.Rows.Count > 0 Then
|
||
Dim oFirstRow As DataRow = oDatatable.Rows.Item(0)
|
||
|
||
If oFirstRow.ItemArray.Length > 0 Then
|
||
Dim oValue = oFirstRow.Item(0).ToString()
|
||
|
||
LOGGER.Debug("Setting Value for TextEdit [{0}]: [{1}]", oFoundControl.Name, oValue)
|
||
DirectCast(oFoundControl, TextEdit).Text = oValue
|
||
End If
|
||
End If
|
||
Case GetType(LookupControl3).Name
|
||
LOGGER.Debug("Setting Value for LookupControl [{0}]: [{1}]", oFoundControl.Name, "DATATABLE")
|
||
Dim oLookupControl = DirectCast(oFoundControl, LookupControl3)
|
||
oLookupControl.Properties.DataSource = oDatatable
|
||
|
||
If oDatatable.Columns.Count > 0 Then
|
||
oLookupControl.Properties.ValueMember = oDatatable.Columns.Item(0).ColumnName
|
||
oLookupControl.Properties.DisplayMember = oDatatable.Columns.Item(0).ColumnName
|
||
End If
|
||
Case GetType(Windows.Forms.ComboBox).Name
|
||
LOGGER.Debug("Setting Value for Combobox [{0}]: [{1}]", oFoundControl.Name, "DATATABLE")
|
||
DirectCast(oFoundControl, Windows.Forms.ComboBox).DataSource = oDatatable
|
||
Case Else
|
||
LOGGER.Debug("Could not set depending control result for [{0}]", oFoundControl.GetType.Name)
|
||
End Select
|
||
Catch ex As Exception
|
||
LOGGER.Error(ex)
|
||
End Try
|
||
End Sub
|
||
|
||
Function GetPlaceholderValue(InputValue As String, FileName As String, UserShortName As String) As String
|
||
Dim oResult As String
|
||
|
||
Try
|
||
Select Case InputValue.ToString.ToUpper
|
||
Case "$filename_ext".ToUpper
|
||
oResult = Path.GetFileName(FileName)
|
||
Case "$filename".ToUpper
|
||
oResult = Path.GetFileNameWithoutExtension(FileName)
|
||
Case "$extension".ToUpper
|
||
oResult = Path.GetExtension(FileName).Replace(".", "")
|
||
Case "$FileCreateDate".ToUpper
|
||
Dim oFileInfo As New FileInfo(FileName)
|
||
Dim oCreationDate As Date = oFileInfo.CreationTime
|
||
oResult = oCreationDate.ToShortDateString
|
||
Case "$FileCreatedWho".ToUpper
|
||
'Dim oFileSecurity As FileSecurity = File.GetAccessControl(FileName)
|
||
' Dim oSecurityId As IdentityReference = oFileSecurity.GetOwner(GetType(SecurityIdentifier))
|
||
'Dim oNTAccount As IdentityReference = oSecurityId.Translate(GetType(NTAccount))
|
||
'Dim oOwner As String = oNTAccount.ToString()
|
||
|
||
Dim fileInfo As FileInfo = New FileInfo(FileName)
|
||
Dim fileSecurity As FileSecurity = fileInfo.GetAccessControl()
|
||
|
||
' Ersteller auslesen
|
||
Dim oOwner As System.Security.Principal.NTAccount = DirectCast(fileSecurity.GetOwner(GetType(System.Security.Principal.NTAccount)), System.Security.Principal.NTAccount)
|
||
oResult = oOwner.Value
|
||
Case "$DateDDMMYYY".ToUpper
|
||
oResult = System.DateTime.Now.ToShortDateString
|
||
Case "$Username".ToUpper
|
||
oResult = Environment.UserName
|
||
Case "$Usercode".ToUpper
|
||
oResult = UserShortName
|
||
Case Else
|
||
oResult = InputValue
|
||
End Select
|
||
Catch ex As Exception
|
||
_Logger.Warn("Error in ReplacePlaceholders: " & ex.Message)
|
||
_Logger.Error(ex.Message)
|
||
oResult = Nothing
|
||
End Try
|
||
|
||
Return oResult
|
||
End Function
|
||
|
||
Function StripPlaceholder(Placeholder As String) As String
|
||
Dim oResult = Placeholder
|
||
oResult = Regex.Replace(oResult, "^\[%", "")
|
||
oResult = Regex.Replace(oResult, "\]$", "")
|
||
Return oResult
|
||
End Function
|
||
|
||
'Function FillIndexe_Autom(dokart_id As Integer)
|
||
' Try
|
||
' VWINDEX_AUTOMTableAdapter.Fill(MyDataset.VWDDINDEX_AUTOM, CURRENT_DOKART_ID)
|
||
|
||
' Dim oDatatable = MyDataset.VWDDINDEX_AUTOM
|
||
' Dim oRegex As New Regex("\[%{1}[a-zA-Z0-9\!\$\&\/\(\)\=\?\,\.\-\;\:_öÖüÜäÄ\#\'\+\*\~\{\}\@\€\<\>\ ]+]{1}")
|
||
|
||
' If oDatatable.Rows.Count = 0 Then
|
||
' Return True
|
||
' End If
|
||
' Dim oIndexName As String
|
||
' ' 1. Schritt: Einfach-Indexe und Platzhalter ersetzen
|
||
' For Each oRow As DataRow In oDatatable
|
||
' oIndexName = oRow.Item("INDEXNAME")
|
||
' _Logger.Info("Working on AutomaticIndex: " & oRow.Item("INDEXNAME") & "...")
|
||
' Dim oSqlResult As String = oRow.ItemEx("SQL_RESULT", "")
|
||
' Dim oSqlActive As Boolean = oRow.ItemEx("SQL_ACTIVE", False)
|
||
' Dim oSqlConnectionId As Integer = oRow.ItemEx("CONNECTION_ID", -1)
|
||
' Dim oSqlProvider As String = oRow.ItemEx("SQL_PROVIDER", "")
|
||
' Dim oEndResult As New List(Of String)
|
||
|
||
' ' Wenn kein SQL Befehl vorhanden oder aktiv ist,
|
||
' ' versuchen wir, die Spalte VALUE zu ersetzen
|
||
' If oSqlResult = String.Empty Or oSqlActive = 0 Then
|
||
' Dim oPlaceholderResult As String
|
||
' Dim oValue As String = oRow.ItemEx("VALUE", "")
|
||
|
||
' oPlaceholderResult = GetPlaceholderValue(oValue, CURRENT_WORKFILE, USER_SHORTNAME)
|
||
|
||
' If Not IsNothing(oPlaceholderResult) Then
|
||
' oValue = oPlaceholderResult
|
||
' End If
|
||
|
||
' oRow.Item("Indexiert") = True
|
||
' oRow.Item("Indexwert") = oValue
|
||
|
||
' Continue For
|
||
' End If
|
||
|
||
' ' Wenn ein SQL Befehl vorhanden und aktiv ist
|
||
' ' Alle Platzhalter finden
|
||
' Dim oMatches As MatchCollection = oRegex.Matches(oSqlResult)
|
||
|
||
' For Each oMatch As Match In oMatches
|
||
' Dim oIndexValue As String = StripPlaceholder(oMatch.Value)
|
||
' Dim oOptionalIndex = False
|
||
' Dim oPlaceholderResult As String = Nothing
|
||
' Dim oManualIndexResult As String = Nothing
|
||
|
||
' ' Einfachen Platzhalter Wert erzeugen
|
||
' oPlaceholderResult = GetPlaceholderValue(oIndexValue, CURRENT_WORKFILE, USER_SHORTNAME)
|
||
|
||
' ' Einfachen Platzhalter ersetzen
|
||
' If Not IsNothing(oPlaceholderResult) Then
|
||
' oSqlResult = oSqlResult.Replace(oMatch.Value, oPlaceholderResult)
|
||
' End If
|
||
|
||
' oOptionalIndex = DATABASE_ECM.GetScalarValue($"SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = {CURRENT_DOKART_ID} AND UPPER(NAME) = UPPER('{oIndexValue}')")
|
||
' oManualIndexResult = GetManIndex_Value(oIndexValue, "IDX_AUTO", oOptionalIndex)
|
||
|
||
' ' Wenn Ergebnis den VektorPlatzhalter enthält, soll nichts ersetzt werden.
|
||
' ' Werden im nächsten Schritt ersetzt.
|
||
' If oManualIndexResult.Contains(ClassConstants.VECTORSEPARATOR) Then
|
||
' oManualIndexResult = Nothing
|
||
' End If
|
||
|
||
' If Not IsNothing(oManualIndexResult) Then
|
||
' oSqlResult = oSqlResult.Replace(oMatch.Value, oManualIndexResult)
|
||
' End If
|
||
' Next
|
||
|
||
' oSqlResult = ClassPatterns.ReplaceControlValues(oSqlResult, pnlIndex)
|
||
' oSqlResult = ClassPatterns.ReplaceInternalValues(oSqlResult)
|
||
' oSqlResult = ClassPatterns.ReplaceUserValues(oSqlResult, USER_PRENAME, USER_SURNAME, USER_SHORTNAME, USER_LANGUAGE, USER_EMAIL, USER_ID, CURRENT_DOKART_ID)
|
||
|
||
|
||
' If oSqlResult <> String.Empty Then
|
||
' _Logger.Debug("oSqlResult after Replace [" & oSqlResult & "]")
|
||
' End If
|
||
' ' Ergebnis: Es wurden alle einfachen Platzhalter ersetz't, jetzt haben wir einen SQL Befehl,
|
||
' ' der nur noch vektorfelder-platzhalter enthält
|
||
|
||
' ' 2. Schritt: Vektorfelder ersetzen
|
||
' Dim oVectorMatches As MatchCollection = oRegex.Matches(oSqlResult)
|
||
' If oVectorMatches.Count > 0 Or oIndexName.Contains("Vektor") Then
|
||
' Dim oResult = GetAutomaticIndexSQLValue(oSqlResult, oSqlConnectionId, oSqlProvider)
|
||
' Dim oConnectionString As String
|
||
' oConnectionString = DATABASE_ECM.Get_ConnectionStringforID(oSqlConnectionId)
|
||
' Try
|
||
' Dim oResultDT As DataTable = DATABASE_ECM.GetDatatableWithConnection(oSqlResult, oConnectionString)
|
||
' If Not IsNothing(oResultDT) Then
|
||
' _Logger.Info("We got [" & oResultDT.Rows.Count & "] result(s) for the vector-field!")
|
||
' For Each oResultRow As DataRow In oResultDT.Rows
|
||
' oEndResult.Add(oResultRow.Item(0))
|
||
' Next
|
||
' End If
|
||
' If oEndResult.Count > 0 Then
|
||
' oRow.Item("Indexiert") = True
|
||
' oRow.Item("Indexwert") = String.Join(ClassConstants.VECTORSEPARATOR, oEndResult.ToArray)
|
||
' End If
|
||
' Catch ex As Exception
|
||
' ShowErrorMessage(ex, $"FillIndexe_Autom - Vektorfield [{oIndexName}] ")
|
||
' End Try
|
||
|
||
' 'Dim oIsFirstMatch = True
|
||
' 'D
|
||
' 'For Each oVectorMatch As Match In oVectorMatches
|
||
' ' Dim oIndexValue As String = StripPlaceholder(oVectorMatch.Value)
|
||
' ' Dim oOptionalIndex = False
|
||
' ' Dim oManualIndexResult As String = Nothing
|
||
|
||
' ' oOptionalIndex = DATABASE_ECM.GetScalarValue($"SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = {CURRENT_DOKART_ID} AND UPPER(NAME) = UPPER('{oIndexValue}')")
|
||
' ' oManualIndexResult = GetManIndex_Value(oIndexValue, "IDX_AUTO", oOptionalIndex)
|
||
|
||
' ' Dim oVectorIndexValues = oManualIndexResult.Split(ClassConstants.VECTORSEPARATOR).ToList()
|
||
|
||
' ' For Each oVectorIndexValue In oVectorIndexValues
|
||
' ' Dim oTempSql = oSqlResult.Replace(oVectorMatch.Value, oVectorIndexValue)
|
||
' ' Dim oResult = GetAutomaticIndexSQLValue(oTempSql, oSqlConnectionId, oSqlProvider)
|
||
' ' oEndResult.Add(oResult)
|
||
' ' Next
|
||
|
||
' ' ' Verhindert, dass die Schleife mehrmals durchlaufen wird
|
||
' ' If oIsFirstMatch Then
|
||
' ' Exit For
|
||
' ' End If
|
||
' ' oRow.Item("Indexiert") = True
|
||
' ' oRow.Item("Indexwert") = String.Join(ClassConstants.VECTORSEPARATOR, oEndResult.ToArray)
|
||
' 'Next
|
||
' Else
|
||
' Dim oResult = GetAutomaticIndexSQLValue(oSqlResult, oSqlConnectionId, oSqlProvider)
|
||
' _Logger.Info("Got a simple SQLResult: " & oResult.ToString)
|
||
' oRow.Item("Indexiert") = True
|
||
' oRow.Item("Indexwert") = oResult
|
||
|
||
' End If
|
||
' Next
|
||
|
||
' Return True
|
||
' Catch ex As Exception
|
||
' ShowErrorMessage(ex, "FillIndexe_Autom")
|
||
' Return False
|
||
' End Try
|
||
'End Function
|
||
|
||
Function FillIndexe_Autom(dokart_id As Integer) As Boolean
|
||
Try
|
||
VWINDEX_AUTOMTableAdapter.Fill(MyDataset.VWDDINDEX_AUTOM, dokart_id)
|
||
Dim oDatatable = MyDataset.VWDDINDEX_AUTOM
|
||
Dim placeholderRegex As New Regex("\[%{1}[a-zA-Z0-9\!\$\&\/\(\)\=\?\,\.\-\;\:_öÖüÜäÄ\#\'\+\*\~\{\}\@\€\<\>\ ]+]{1}")
|
||
|
||
If oDatatable.Rows.Count = 0 Then Return True
|
||
|
||
For Each oRow As DataRow In oDatatable
|
||
Dim indexName = oRow.Item("INDEXNAME").ToString
|
||
_Logger.Info($"Working on AutomaticIndex: {indexName}...")
|
||
|
||
Dim sql = oRow.ItemEx("SQL_RESULT", "")
|
||
Dim sqlActive = oRow.ItemEx("SQL_ACTIVE", False)
|
||
Dim connId = oRow.ItemEx("CONNECTION_ID", -1)
|
||
Dim provider = oRow.ItemEx("SQL_PROVIDER", "")
|
||
Dim value = oRow.ItemEx("VALUE", "")
|
||
Dim endResult As New List(Of String)
|
||
|
||
' #### Fall: Kein SQL oder SQL ist nicht aktiv
|
||
If String.IsNullOrWhiteSpace(sql) OrElse Not sqlActive Then
|
||
Dim resolved = GetPlaceholderValue(value, CURRENT_WORKFILE, USER_SHORTNAME)
|
||
oRow("Indexiert") = True
|
||
oRow("Indexwert") = If(resolved, value)
|
||
Continue For
|
||
End If
|
||
|
||
' #### Fall: SQL aktiv – einfache Platzhalter ersetzen
|
||
Dim matches = placeholderRegex.Matches(sql)
|
||
|
||
For Each match As Match In matches
|
||
Dim ph = StripPlaceholder(match.Value)
|
||
Dim resolvedPH = GetPlaceholderValue(ph, CURRENT_WORKFILE, USER_SHORTNAME)
|
||
If Not String.IsNullOrWhiteSpace(resolvedPH) Then
|
||
sql = sql.Replace(match.Value, resolvedPH)
|
||
Continue For
|
||
End If
|
||
|
||
Dim isOptional = DATABASE_ECM.GetScalarValue($"SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = {dokart_id} AND UPPER(NAME) = UPPER('{ph}')")
|
||
Dim manIndex = GetManIndex_Value(ph, "IDX_AUTO", isOptional)
|
||
|
||
If Not String.IsNullOrWhiteSpace(manIndex) AndAlso Not manIndex.Contains(ClassConstants.VECTORSEPARATOR) Then
|
||
sql = sql.Replace(match.Value, manIndex)
|
||
End If
|
||
Next
|
||
|
||
' #### Platzhalter durch Umgebungsvariablen ersetzen
|
||
sql = ClassPatterns.ReplaceControlValues(sql, pnlIndex)
|
||
sql = ClassPatterns.ReplaceInternalValues(sql)
|
||
sql = ClassPatterns.ReplaceUserValues(sql, USER_PRENAME, USER_SURNAME, USER_SHORTNAME, USER_LANGUAGE, USER_EMAIL, USER_ID, dokart_id)
|
||
|
||
If Not String.IsNullOrWhiteSpace(sql) Then _Logger.Debug("SQL after Replace: " & sql)
|
||
|
||
' #### Fall: Vektor-Platzhalter oder Vektor-Index
|
||
If placeholderRegex.Matches(sql).Count > 0 OrElse indexName.Contains("Vektor") Then
|
||
Try
|
||
Dim connString = DATABASE_ECM.Get_ConnectionStringforID(connId)
|
||
Dim resultDT = DATABASE_ECM.GetDatatableWithConnection(sql, connString)
|
||
|
||
If resultDT IsNot Nothing Then
|
||
For Each resultRow As DataRow In resultDT.Rows
|
||
endResult.Add(resultRow.Item(0).ToString())
|
||
Next
|
||
|
||
If endResult.Count > 0 Then
|
||
oRow("Indexiert") = True
|
||
oRow("Indexwert") = String.Join(ClassConstants.VECTORSEPARATOR, endResult)
|
||
End If
|
||
End If
|
||
Catch ex As Exception
|
||
ShowErrorMessage(ex, $"FillIndexe_Autom - Vektorfield [{indexName}]")
|
||
End Try
|
||
Else
|
||
' #### Fall: Nur einfacher SQL ohne Vektor
|
||
Dim result = GetAutomaticIndexSQLValue(sql, connId, provider)
|
||
_Logger.Info($"Got simple SQLResult: {result}")
|
||
oRow("Indexiert") = True
|
||
oRow("Indexwert") = result
|
||
End If
|
||
Next
|
||
|
||
Return True
|
||
|
||
Catch ex As Exception
|
||
ShowErrorMessage(ex, "FillIndexe_Autom")
|
||
Return False
|
||
End Try
|
||
End Function
|
||
|
||
Private Sub btnVorschau_Click(sender As System.Object, e As System.EventArgs)
|
||
PreviewFile()
|
||
End Sub
|
||
|
||
Sub PreviewFile()
|
||
Try
|
||
DocumentViewer1.LoadFile(CURRENT_WORKFILE)
|
||
Catch ex As Exception
|
||
ShowErrorMessage(ex, "PreviewFile")
|
||
End Try
|
||
End Sub
|
||
Private Function UnicodeBytesToString(ByVal bytes() As Byte) As String
|
||
Return System.Text.Encoding.UTF8.GetString(bytes)
|
||
End Function
|
||
Public Function TextStringToByteArray(ByRef str As String) As Byte()
|
||
Dim enc As System.Text.Encoding = Encoding.GetEncoding(65001)
|
||
|
||
Return enc.GetBytes(str)
|
||
End Function
|
||
Public Shared Function encode(ByVal str As String) As String
|
||
'supply True as the construction parameter to indicate
|
||
'that you wanted the class to emit BOM (Byte Order Mark)
|
||
'NOTE: this BOM value is the indicator of a UTF-8 string
|
||
Dim utf8Encoding As New System.Text.UTF8Encoding(True)
|
||
Dim encodedString() As Byte
|
||
|
||
encodedString = utf8Encoding.GetBytes(str)
|
||
|
||
Return utf8Encoding.GetString(encodedString)
|
||
End Function
|
||
Private Function WORK_FILE() As Boolean
|
||
Try
|
||
Me.VWDDINDEX_MANTableAdapter.Fill(Me.MyDataset.VWDDINDEX_MAN, CURRENT_DOKART_ID)
|
||
_Logger.Debug("Manuelle Indexe geladen")
|
||
|
||
If MyDataset.VWDDINDEX_MAN.Rows.Count > 0 Then
|
||
Dim oDokart As DocType = ComboboxDoctype.EditValue
|
||
|
||
CURRENT_DOKART_ID = oDokart.Guid
|
||
If CheckWrite_IndexeMan(oDokart.Guid) = True Then
|
||
'##### Manuelle Indexe indexiert #####
|
||
_Logger.Info("Datei [" & CURRENT_WORKFILE & "] wird nun indexiert...")
|
||
If FillIndexe_Autom(oDokart.Guid) = True Then
|
||
_Logger.Debug(" ...FillIndexe_Autom durchlaufen")
|
||
|
||
'Den Zielnamen zusammenbauen
|
||
If Name_Generieren() = True Then
|
||
'Die Datei verschieben
|
||
If Move_File_and_Index() = True Then
|
||
_Logger.Debug(" ...Move_File2_Target durchlaufen")
|
||
|
||
_Logger.Info("Datei '" & CURRENT_NEWFILENAME & "' erfolgreich erzeugt.")
|
||
Dim oDEL As String = "DELETE FROM TBGI_FILES_USER WHERE GUID = " & CURRENT_WORKFILE_GUID
|
||
DATABASE_ECM.ExecuteNonQuery(oDEL)
|
||
|
||
'Dokumentenviewer ausblenden um keinen Zugriffsfehler zu produzieren
|
||
CloseViewer()
|
||
_Logger.Debug(" ...Viewer geschlossen")
|
||
|
||
If CURR_DELETE_ORIGIN = True Then
|
||
_Logger.Info("Datei [" & CURRENT_WORKFILE & "] wird gelöscht.")
|
||
Try
|
||
File.SetAttributes(CURRENT_WORKFILE, FileAttributes.Normal)
|
||
File.Delete(CURRENT_WORKFILE)
|
||
Catch ex As Exception
|
||
_Logger.Error(ex)
|
||
End Try
|
||
_Logger.Info("Datei [" & CURRENT_WORKFILE & "] wurde gelöscht.")
|
||
End If
|
||
|
||
Return True
|
||
End If
|
||
|
||
Else
|
||
If USER_LANGUAGE = LANG_DE Then
|
||
MsgBox("Unerwarteter Fehler in Name_Generieren - Bitte überprüfen sie die Logdatei", MsgBoxStyle.Critical)
|
||
Else
|
||
MsgBox("Unexpected error in Name_Generieren - Please check the Logfile", MsgBoxStyle.Critical)
|
||
End If
|
||
Return False
|
||
End If
|
||
Else
|
||
If USER_LANGUAGE = LANG_DE Then
|
||
MsgBox("Unerwarteter Fehler in FillIndexe_Autom - Bitte überprüfen sie die Logdatei", MsgBoxStyle.Critical)
|
||
Else
|
||
MsgBox("Unexpected error in FillIndexe_Autom - Please check the Logfile", MsgBoxStyle.Critical)
|
||
End If
|
||
Return False
|
||
End If
|
||
End If
|
||
Else
|
||
If USER_LANGUAGE = LANG_DE Then
|
||
MsgBox("Bitte überprüfen Sie die Konfiguration dieser Dokumentart." & vbNewLine & "Es sind KEINE manuellen Indizes konfiguriert oder aktiv geschaltet!", MsgBoxStyle.Exclamation)
|
||
Else
|
||
MsgBox("Please check the configuration for this document-type." & vbNewLine & "There are NO manual indicies that are either configured or set to active!", MsgBoxStyle.Exclamation)
|
||
End If
|
||
Return False
|
||
End If
|
||
Catch ex As Exception
|
||
ShowErrorMessage(ex, "WORK_FILE")
|
||
Return False
|
||
End Try
|
||
End Function
|
||
|
||
'Private Sub OK_Button_Click(sender As Object, e As EventArgs)
|
||
' ClearError()
|
||
' ClearNotice()
|
||
|
||
' 'lblhinweis.Visible = False
|
||
' 'lblerror.Visible = False
|
||
|
||
' Me.Cursor = Cursors.WaitCursor
|
||
' ClassHelper.Refresh_RegexTable()
|
||
' For Each rowregex As DataRow In CURRENT_DT_REGEX.Rows
|
||
' If rowregex.Item("FUNCTION_NAME") = "CLEAN_FILENAME" Then
|
||
' REGEX_CLEAN_FILENAME = rowregex.Item("REGEX")
|
||
' End If
|
||
' Next
|
||
' If checkMultiindex.Visible = True And checkMultiindex.Checked = True Then
|
||
' 'Die erste Datei indexieren
|
||
' If WORK_FILE() = True Then
|
||
' 'Und nun die folgenden
|
||
' Dim DTFiles2Work As DataTable = DATABASE_ECM.GetDatatable("SELECT * FROM TBGI_FILES_USER WHERE WORKED = 0 AND GUID <> " & CURRENT_WORKFILE_GUID & " AND UPPER(USER@WORK) = UPPER('" & Environment.UserName & "')")
|
||
' If Not DTFiles2Work Is Nothing Then
|
||
' Dim err = False
|
||
' For Each filerow As DataRow In DTFiles2Work.Rows
|
||
' CURRENT_WORKFILE_GUID = filerow.Item("GUID")
|
||
' CURRENT_WORKFILE_HASH = NotNull(filerow.Item("FILE_HASH"), "")
|
||
' CURRENT_WORKFILE = filerow.Item("FILENAME2WORK")
|
||
' DropType = filerow.Item("HANDLE_TYPE")
|
||
|
||
' If WORK_FILE() = False Then
|
||
' err = True
|
||
' Exit For
|
||
' End If
|
||
' Next
|
||
' Me.Cursor = Cursors.Default
|
||
' If err = False Then
|
||
' If USER_LANGUAGE = LANG_DE Then
|
||
' MsgBox("Alle Dateien wurden mit Multiindexing erfolgreich verarbeitet!", MsgBoxStyle.Information, "Erfolgsmeldung:")
|
||
' Else
|
||
' MsgBox("All files were successfully processed through Multiindexing", MsgBoxStyle.Information, "Success")
|
||
' End If
|
||
|
||
' Me.Close()
|
||
' End If
|
||
' End If
|
||
' End If
|
||
' Else
|
||
' If WORK_FILE() = True Then
|
||
' Me.Cursor = Cursors.Default
|
||
|
||
' If CONFIG.Config.ShowIndexResult = True Then
|
||
' If USER_LANGUAGE = LANG_DE Then
|
||
' MsgBox("Die Datei wurde erfolgreich verarbeitet!" & vbNewLine & "Ablagepfad:" & vbNewLine & CURRENT_NEWFILENAME, MsgBoxStyle.Information, "Erfolgsmeldung")
|
||
' Else
|
||
' MsgBox("File sucessfully processed!" & vbNewLine & "Path:" & vbNewLine & CURRENT_NEWFILENAME, MsgBoxStyle.Information, "Success")
|
||
' End If
|
||
' End If
|
||
|
||
' Me.Close()
|
||
' End If
|
||
' End If
|
||
' Me.Cursor = Cursors.Default
|
||
'End Sub
|
||
Private Function Move_File_and_Index()
|
||
Dim oError As Boolean
|
||
Try
|
||
CURRENT_DOC_ID = 0
|
||
Dim oSQL As String = "SELECT FOLDER_FOR_INDEX FROM TBDD_DOKUMENTART WHERE GUID = " & CURRENT_DOKART_ID
|
||
Dim oFolderForIndex = DATABASE_ECM.GetScalarValue(oSQL)
|
||
If Not IsDBNull(oFolderForIndex) Then
|
||
CreateFolderForIndex(oFolderForIndex)
|
||
Else
|
||
CreateFolderForIndex(String.Empty)
|
||
End If
|
||
|
||
If CURR_DOKART_WD_DIRECT = False Then
|
||
'Datei verschieben
|
||
oError = Move_Rename_Only(CURRENT_WORKFILE, CURRENT_NEWFILENAME, CURR_WORKFILE_EXTENSION, VERSION_DELIMITER)
|
||
Else
|
||
Dim oExportSuccessful As Boolean = False
|
||
'Variable Folder
|
||
If DropType = "|DROPFROMFSYSTEM|" Or DropType = "|OUTLOOK_ATTACHMENT|" Or DropType = "|ATTMNTEXTRACTED|" Or DropType = "|FW_SIMPLEINDEXER|" Then
|
||
oExportSuccessful = SINGLEFILE_2_WINDREAM(CURR_DOKART_OBJECTTYPE)
|
||
ElseIf DropType = "|OUTLOOK_MESSAGE|" Or DropType = "|FW_MSGONLY|" Or DropType = "|MSGONLY|" Or DropType = "|FW_OUTLOOK_MESSAGE|" Then
|
||
oExportSuccessful = SINGLEFILE_2_WINDREAM(CURR_DOKART_OBJECTTYPE)
|
||
End If
|
||
If oExportSuccessful = True Then
|
||
Dim ofilename = Path.GetFileName(CURRENT_NEWFILENAME)
|
||
Dim odwDocID As Int64
|
||
If WM_DB_SERVER <> "" Then
|
||
oSQL = $"select max(dwdocid) from {WM_DB_SERVER}.dbo.BaseAttributes where szLongName = '{ofilename}'"
|
||
Dim oDocID = DATABASE_ECM.GetScalarValue(oSQL)
|
||
If Not IsNothing(oDocID) Then
|
||
CURRENT_DOC_ID = oDocID
|
||
End If
|
||
End If
|
||
|
||
'Kein Fehler in Export2windream
|
||
oError = False
|
||
If Write_Indizes() = True Then
|
||
'Kein Fehler in Setzen der windream-Indizes
|
||
Dim Insert_String As String
|
||
Try
|
||
Dim tempCur_WF = CURRENT_WORKFILE.Replace("'", "''")
|
||
Dim tempCur_New_FN = CURRENT_NEWFILENAME.Replace("'", "''")
|
||
Dim oUser As String = $"{Environment.UserDomainName}\{Environment.UserName}"
|
||
|
||
Insert_String = sql_history_INSERT_INTO & $",ADDED_WHO, ADDED_WHERE, FILE_HASH) VALUES ('{tempCur_WF}','{tempCur_New_FN}'{sql_history_Index_Values},'{oUser}','{Environment.MachineName}','{CURRENT_WORKFILE_HASH}')"
|
||
DATABASE_ECM.GetScalarValue(Insert_String)
|
||
If DropType.Contains("MSG") Or DropType = "|ATTMNTEXTRACTED|" Or DropType = "|OUTLOOK_ATTACHMENT|" Then
|
||
If CURRENT_MESSAGEID <> "" Then
|
||
Dim max As String = "SELECT MAX(GUID) FROM TBGI_HISTORY"
|
||
Dim GUID = DATABASE_ECM.GetScalarValue(max)
|
||
Try
|
||
If GUID > 0 Then
|
||
Dim sqlUpdate As String
|
||
If DropType = "|ATTMNTEXTRACTED|" Or DropType = "|OUTLOOK_ATTACHMENT|" Then
|
||
sqlUpdate = "Update TBGI_HISTORY SET ATTACHMENT = 1, MSG_ID = '" & CURRENT_MESSAGEID & "' WHERE GUID = " & GUID
|
||
DATABASE_ECM.ExecuteNonQuery(sqlUpdate)
|
||
Else
|
||
sqlUpdate = "Update TBGI_HISTORY SET ATTACHMENT = 0, MSG_ID = '" & CURRENT_MESSAGEID & "' WHERE GUID = " & GUID
|
||
DATABASE_ECM.ExecuteNonQuery(sqlUpdate)
|
||
End If
|
||
End If
|
||
Catch ex As Exception
|
||
_Logger.Error(ex)
|
||
End Try
|
||
End If
|
||
End If
|
||
|
||
Catch ex As Exception
|
||
_Logger.Error(ex)
|
||
MsgBox("Error in Insert-History - View logfile: " & ex.Message, MsgBoxStyle.Critical)
|
||
_Logger.Warn(" - Unexpected error in Insert-History - Fehler: " & vbNewLine & ex.Message)
|
||
_Logger.Warn(" - Unexpected error in Insert-History - SQL: " & Insert_String)
|
||
oError = True
|
||
End Try
|
||
Else
|
||
oError = True
|
||
End If
|
||
Else
|
||
oError = True
|
||
|
||
If USER_LANGUAGE = LANG_DE Then
|
||
MsgBox("Der Export nach windream war nicht erfolgreich - Check LogFile", MsgBoxStyle.Exclamation)
|
||
Else
|
||
MsgBox("Export to windream was unsucessful - Check LogFile", MsgBoxStyle.Exclamation)
|
||
End If
|
||
End If
|
||
End If
|
||
'False oder True zurückgeben
|
||
'Kein Fehler aufgetreten
|
||
If oError = False Then
|
||
Return True
|
||
Else
|
||
'Fehler aufgetreten
|
||
Return False
|
||
End If
|
||
Catch ex As Exception
|
||
ShowErrorMessage(ex, "Move_File2_Target")
|
||
Return False
|
||
End Try
|
||
End Function
|
||
|
||
Private Function CreateFolderForIndex(DynamicFolderConfig As String)
|
||
Try
|
||
Dim oRootFolder As String = Path.GetDirectoryName(CURRENT_NEWFILENAME)
|
||
'Dim oFilesystem As New Filesystem(LOGCONFIG)
|
||
|
||
If DynamicFolderConfig <> String.Empty Then
|
||
'######
|
||
Dim oRegexString As String = "\[%{1}[a-zA-Z0-9\!\$\&\/\(\)\=\?\,\.\-\;\:_öÖüÜäÄ\#\'\+\*\~\{\}\@\€\<\>\ ]+]{1}"
|
||
' einen Regulären Ausdruck laden
|
||
Dim oRegex As Regex = New Regex(oRegexString)
|
||
' die Vorkommen im Folder-String auslesen
|
||
Dim oMatches As MatchCollection = oRegex.Matches(DynamicFolderConfig)
|
||
'####
|
||
|
||
' alle Vorkommen innerhalb des Ordnerstrings durchlaufen
|
||
For Each oMatch As Match In oMatches
|
||
_Logger.Info("Elementname in FolderString: '" & oMatch.ToString & "'")
|
||
Select Case oMatch.Value.Substring(2, 1).ToUpper
|
||
|
||
'Manueller Indexwert
|
||
Case "M"
|
||
Dim oManIndexName = oMatch.Value.Substring(3, oMatch.Value.Length - 4)
|
||
Dim oIsOptional As Boolean = DATABASE_ECM.GetScalarValue("SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = " & CURRENT_DOKART_ID & " AND UPPER(NAME) = UPPER('" & oManIndexName & "')")
|
||
_Logger.Info("Versuch den Indexwert aus '" & oManIndexName & "' auszulesen.")
|
||
Dim oManIndexValue As String = GetManIndex_Value(oManIndexName, "FILE", oIsOptional)
|
||
_Logger.Info("Ergebnis/Wert für neuen Ordner: '" & oManIndexName & "'")
|
||
If Not oManIndexValue = String.Empty Then
|
||
If IsDate(oManIndexValue) Then
|
||
oManIndexValue = CDate(oManIndexValue).ToString("yyyyMMdd")
|
||
End If
|
||
|
||
oManIndexValue = FILESYSTEM.GetCleanPath(oManIndexValue)
|
||
'oManIndexValue = ClassFilehandle.CleanFilename(oManIndexValue, "")
|
||
DynamicFolderConfig = DynamicFolderConfig.Replace(oMatch.ToString, oManIndexValue)
|
||
|
||
_Logger.Info("FolderPattern: '" & DynamicFolderConfig & "'")
|
||
Else
|
||
|
||
If oIsOptional = True Then
|
||
_Logger.Info("Optionaler Indexwert ist NICHT gefüllt")
|
||
DynamicFolderConfig = DynamicFolderConfig.Replace(oMatch.ToString, String.Empty)
|
||
Else
|
||
_Logger.Info(" - Achtung Ausnahme in 'CrFolderForIndex': der Index ist leer!")
|
||
Return True
|
||
End If
|
||
End If
|
||
Case "A"
|
||
Dim oAutoIndexName = oMatch.Value.Substring(3, oMatch.Value.Length - 4)
|
||
_Logger.Info("Versuch den Auto-Indexwert aus '" & oAutoIndexName & "' auszulesen.")
|
||
Dim oAutoIndexValue As String = GetAutoIndex_Value(oAutoIndexName)
|
||
_Logger.Info("Ergebnis/Wert für neuen Ordner: '" & oAutoIndexName & "'")
|
||
If Not oAutoIndexValue = String.Empty Then
|
||
|
||
oAutoIndexValue = FILESYSTEM.GetCleanPath(oAutoIndexValue)
|
||
'oAutoIndexValue = ClassFilehandle.CleanFilename(oAutoIndexValue, "")
|
||
If oAutoIndexValue = "EMPTY_OI" Then
|
||
DynamicFolderConfig = DynamicFolderConfig.Replace(oMatch.ToString, "")
|
||
Else
|
||
DynamicFolderConfig = DynamicFolderConfig.Replace(oMatch.ToString, oAutoIndexValue)
|
||
_Logger.Info("FolderPattern: '" & DynamicFolderConfig & "'")
|
||
End If
|
||
|
||
Else
|
||
_Logger.Info(" - Achtung Ausnahme in 'CrFolderForIndex': der Index ist leer!")
|
||
End If
|
||
Case "V"
|
||
Dim oElementTemp As String
|
||
Dim _Month As String = My.Computer.Clock.LocalTime.Month
|
||
If _Month.Length = 1 Then
|
||
_Month = "0" & _Month
|
||
End If
|
||
Dim _day As String = My.Computer.Clock.LocalTime.Day
|
||
If _day.Length = 1 Then
|
||
_day = "0" & _day
|
||
End If
|
||
Dim type = oMatch.Value.Substring(3, oMatch.Value.Length - 4)
|
||
If type.StartsWith("_") Then
|
||
type = type.Replace("_", "")
|
||
End If
|
||
Select Case type
|
||
Case "YYYY/MM/DD"
|
||
oElementTemp = My.Computer.Clock.LocalTime.Year & "\" & _Month & "\" & _day
|
||
Case "YYYY/MM"
|
||
oElementTemp = My.Computer.Clock.LocalTime.Year & "\" & _Month
|
||
Case "YYYY"
|
||
oElementTemp = My.Computer.Clock.LocalTime.Year
|
||
Case "YYYY-MM"
|
||
oElementTemp = My.Computer.Clock.LocalTime.Year & "-" & _Month
|
||
End Select
|
||
DynamicFolderConfig = DynamicFolderConfig.Replace(oMatch.ToString, oElementTemp)
|
||
_Logger.Info("FolderPatter nach V-Element: '" & DynamicFolderConfig & "'")
|
||
Case Else
|
||
_Logger.Warn(" - Achtung - in der Namenkonvention wurde ein Element gefunden welches nicht zugeordnet werden kann!" & vbNewLine & "Elementname: " & oMatch.Value.ToUpper)
|
||
|
||
If USER_LANGUAGE = LANG_DE Then
|
||
MsgBox("Achtung - in der Namenkonvention wurde ein Element gefunden welches nicht zugeordnet werden kann!" & vbNewLine & "Elementname: " & oMatch.Value.ToUpper, MsgBoxStyle.Exclamation, "Unexpected error in Name generieren:")
|
||
Else
|
||
MsgBox("Attention - One element in Namingconvention could not be matched!" & vbNewLine & "Elementname: " & oMatch.Value.ToUpper, MsgBoxStyle.Exclamation, "Unexpected error in Name generieren:")
|
||
End If
|
||
End Select
|
||
Next
|
||
End If
|
||
|
||
|
||
|
||
|
||
_Logger.Info("Den Root-Folder zusammenfügen>> ")
|
||
|
||
Dim oNewFullPath As String = System.IO.Path.Combine(oRootFolder, DynamicFolderConfig)
|
||
|
||
_Logger.Info("Fullpath (mit evtl. Sonderzeichen (SZ)) '" & oNewFullPath & "'")
|
||
Dim invalidPathChars() As Char = Path.GetInvalidPathChars()
|
||
For Each sonderChar As Char In invalidPathChars
|
||
'Sonderzeichen ausser Whitespace entfernen
|
||
If Char.IsWhiteSpace(sonderChar) = False Then
|
||
If oNewFullPath.Contains(sonderChar) Then
|
||
oNewFullPath = oNewFullPath.Replace(sonderChar, "")
|
||
End If
|
||
End If
|
||
Next sonderChar
|
||
oNewFullPath = WINDREAM.GetCleanedPath(oNewFullPath)
|
||
|
||
_Logger.Info("Fullpath (ohne SZ) '" & oNewFullPath & "'")
|
||
If Directory.Exists(oNewFullPath) = False Then
|
||
Try
|
||
Dim oCreatedPath = Directory.CreateDirectory(oNewFullPath)
|
||
oNewFullPath = oCreatedPath.FullName
|
||
_Logger.Info("Folder '" & oNewFullPath & "' wurde angelegt")
|
||
Catch ex As Exception
|
||
_Logger.Info("Error in CreateFolderforIndex-Method - Root Folder '" & oNewFullPath & "' could not be created. " & ex.Message)
|
||
_Logger.Error(ex.Message)
|
||
MsgBox("Attention: Root Folder '" & oNewFullPath & "' could not be created." & vbNewLine & ex.Message, MsgBoxStyle.Critical)
|
||
Return False
|
||
End Try
|
||
End If
|
||
|
||
CURRENT_NEWFILENAME = Path.Combine(oNewFullPath, Path.GetFileName(CURRENT_NEWFILENAME))
|
||
|
||
Return True
|
||
Catch ex As Exception
|
||
ShowErrorMessage(ex, "CreateFolderForIndex")
|
||
Return False
|
||
End Try
|
||
End Function
|
||
|
||
Private Sub Button1_Click(sender As Object, e As EventArgs)
|
||
If File.Exists(CURRENT_FILENAME) Then
|
||
Select Case CancelAttempts
|
||
Case 0
|
||
If USER_LANGUAGE = LANG_DE Then
|
||
MsgBox("Bitte indexieren Sie die Datei vollständig!" & vbNewLine & "(Abbruch 1 des Indexierungsvorgangs)", MsgBoxStyle.Information)
|
||
Else
|
||
MsgBox("Please Index file completely" & vbNewLine & "(Abort 1 of Indexdialog)", MsgBoxStyle.Information)
|
||
End If
|
||
CancelAttempts += 1
|
||
Case 1
|
||
Dim result As MsgBoxResult
|
||
If USER_LANGUAGE = LANG_DE Then
|
||
result = MessageBox.Show("Sie brechen nun zum zweiten Mal den Indexierungsvorgang ab!" & vbNewLine & "Wollen Sie die Indexierung aller Dateien abbrechen?", "Bestätigung erforderlich:", MessageBoxButtons.YesNo, MessageBoxIcon.Question)
|
||
Else
|
||
result = MessageBox.Show("You are aborting the indexdialog for the 2nd time!" & vbNewLine & "Do You want to abort indexing?", "Confirmation needed:", MessageBoxButtons.YesNo, MessageBoxIcon.Question)
|
||
End If
|
||
|
||
If result = MsgBoxResult.Yes Then
|
||
Dim containsfw_file As Boolean = False
|
||
Try
|
||
ABORT_INDEXING = True
|
||
Dim sql As String = "SELECT * FROM TBGI_FILES_USER WHERE WORKED = 0 AND UPPER(USER@WORK) = UPPER('" & Environment.UserName & "')"
|
||
|
||
Dim DT As DataTable = DATABASE_ECM.GetDatatable(sql)
|
||
|
||
|
||
Dim anz = DT.Rows.Count
|
||
For Each Filerow As DataRow In DT.Rows
|
||
Dim filestring As String = Filerow.Item("FILENAME2WORK")
|
||
Dim handletype As String = Filerow.Item("HANDLE_TYPE")
|
||
|
||
If handletype = "|MSGONLY|" Or handletype = "|ATTMNTEXTRACTED|" Then
|
||
Try
|
||
System.IO.File.Delete(filestring)
|
||
Catch ex As Exception
|
||
|
||
End Try
|
||
|
||
ElseIf handletype.StartsWith("|FW") Then
|
||
containsfw_file = True
|
||
End If
|
||
Next
|
||
'Zuerst die Daten des Ablaufs löschen
|
||
If DATABASE_ECM.ExecuteNonQuery("DELETE FROM TBGI_FILES_USER WHERE UPPER(USER@WORK) = UPPER('" & Environment.UserName & "')") = True Then
|
||
If containsfw_file = True Then
|
||
If USER_LANGUAGE = LANG_DE Then
|
||
MsgBox("Der Indexierungsprozess beinhaltete (auch) Dateien per Folderwatch!" & vbNewLine & "Diese Dateien wurden nicht gelöscht und verbleiben im Folderwatch-Verzeichnis!" & vbNewLine & "Bitte verschieben Sie die Dateien ggfls.", MsgBoxStyle.Information, "Achtung - Hinweis:")
|
||
Else
|
||
MsgBox("The Indexingprocess contained (also) files from folderwatch!" & vbNewLine & "These files weren't deleted and will stay in the folderwatch-folder!" & vbNewLine & "Please move these files manually.", MsgBoxStyle.Information, "Achtung - Hinweis:")
|
||
End If
|
||
|
||
End If
|
||
End If
|
||
|
||
|
||
Catch ex As Exception
|
||
_Logger.Error(ex)
|
||
MsgBox("Unexpected Error in Abort Indexing: " & vbNewLine & ex.Message, MsgBoxStyle.Critical)
|
||
End Try
|
||
|
||
|
||
Close()
|
||
End If
|
||
End Select
|
||
End If
|
||
End Sub
|
||
|
||
Private Sub BarCheckItem1_CheckedChanged(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles checkItemTopMost.CheckedChanged
|
||
If FormLoaded = True Then
|
||
TopMost = checkItemTopMost.Checked
|
||
CONFIG.Config.TopMost = checkItemTopMost.Checked
|
||
CONFIG.Save()
|
||
End If
|
||
End Sub
|
||
|
||
Private Sub checkItemDeleteSource_CheckedChanged(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles checkItemDeleteSource.CheckedChanged
|
||
If FormLoaded = True And checkItemDeleteSource.Visibility <> DevExpress.XtraBars.BarItemVisibility.Never Then
|
||
CURR_DELETE_ORIGIN = checkItemDeleteSource.Checked
|
||
CONFIG.Config.DeleteOriginalFile = checkItemDeleteSource.Checked
|
||
CONFIG.Save()
|
||
End If
|
||
End Sub
|
||
|
||
Private Sub labelFilePath_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles labelFilePath.ItemClick
|
||
Clipboard.SetText(CURRENT_WORKFILE)
|
||
|
||
If USER_LANGUAGE = LANG_DE Then
|
||
MsgBox("Aktuellen Pfad in die Zwischenablage kopiert!", MsgBoxStyle.Information, Text)
|
||
Else
|
||
MsgBox("Current Path copied to Clipboard!", MsgBoxStyle.Information, Text)
|
||
End If
|
||
End Sub
|
||
|
||
'Private Sub SimpleButton1_Click(sender As Object, e As EventArgs) Handles btnOK.Click
|
||
' Try
|
||
' ClearError()
|
||
' ClearNotice()
|
||
|
||
' Me.Cursor = Cursors.WaitCursor
|
||
' CURRENT_DT_REGEX = DATABASE_ECM.GetDatatable("SELECT * FROM TBGI_FUNCTION_REGEX")
|
||
' For Each rowregex As DataRow In CURRENT_DT_REGEX.Rows
|
||
' If rowregex.Item("FUNCTION_NAME") = "CLEAN_FILENAME" Then
|
||
' REGEX_CLEAN_FILENAME = rowregex.Item("REGEX")
|
||
' End If
|
||
' Next
|
||
' If BarCheckItem_MultiIndexing.Checked = True Then
|
||
' 'Die erste Datei indexieren
|
||
' If WORK_FILE() = True Then
|
||
' 'Und nun die folgenden
|
||
' Dim DTFiles2Work As DataTable = DATABASE_ECM.GetDatatable("SELECT * FROM TBGI_FILES_USER WHERE WORKED = 0 AND GUID <> " & CURRENT_WORKFILE_GUID & " AND UPPER(USER@WORK) = UPPER('" & Environment.UserName & "')")
|
||
' If DTFiles2Work IsNot Nothing Then
|
||
' Dim err = False
|
||
' For Each oRow As DataRow In DTFiles2Work.Rows
|
||
' CURRENT_WORKFILE_GUID = oRow.Item("GUID")
|
||
' CURRENT_WORKFILE = oRow.Item("FILENAME2WORK")
|
||
' CURRENT_WORKFILE_HASH = oRow.ItemEx("FILE_HASH", "")
|
||
' DropType = oRow.Item("HANDLE_TYPE")
|
||
|
||
' If WORK_FILE() = False Then
|
||
' err = True
|
||
' Exit For
|
||
' End If
|
||
' Next
|
||
' Me.Cursor = Cursors.Default
|
||
' If err = False Then
|
||
' If USER_LANGUAGE = LANG_DE Then
|
||
' MsgBox("Alle Dateien wurden mit Multiindexing erfolgreich verarbeitet!", MsgBoxStyle.Information, "Erfolgsmeldung:")
|
||
' Else
|
||
' MsgBox("All files were successfully processed through Multiindexing", MsgBoxStyle.Information, "Success")
|
||
' End If
|
||
|
||
' CloseViewer()
|
||
|
||
' CancelAttempts = 2
|
||
' Me.Close()
|
||
' End If
|
||
' End If
|
||
' End If
|
||
' Else
|
||
' If WORK_FILE() = True Then
|
||
' Me.Cursor = Cursors.Default
|
||
' If CONFIG.Config.ShowIndexResult = True Then
|
||
' If USER_LANGUAGE = LANG_DE Then
|
||
' ' MsgBox("Die Datei wurde erfolgreich verarbeitet!" & vbNewLine & "Ablagepfad:" & vbNewLine & CURRENT_NEWFILENAME, MsgBoxStyle.Information, "Erfolgsmeldung")
|
||
' _FormHelper.ShowSuccessMessage($"Die Datei wurde erfolgreich verarbeitet!{vbNewLine}Ablagepfad:{vbNewLine}{CURRENT_NEWFILENAME}", "Erfolgsmeldung")
|
||
' Else
|
||
' 'MsgBox($"File sucessfully processed!{vbNewLine}Path:{vbNewLine}{CURRENT_NEWFILENAME}" & vbNewLine & "Path:" & vbNewLine & CURRENT_NEWFILENAME, MsgBoxStyle.Information, "Success")
|
||
' _FormHelper.ShowSuccessMessage($"File sucessfully processed!{vbNewLine}Path:{vbNewLine}{CURRENT_NEWFILENAME}", "Success")
|
||
' End If
|
||
|
||
|
||
' End If
|
||
|
||
' CloseViewer()
|
||
|
||
' CancelAttempts = 2
|
||
' Me.Close()
|
||
' End If
|
||
' End If
|
||
' Catch ex As Exception
|
||
' MsgBox("Uncaught error while indexing: " & vbNewLine & ex.Message, MsgBoxStyle.Critical, Text)
|
||
' Finally
|
||
' Me.Cursor = Cursors.Default
|
||
' End Try
|
||
'End Sub
|
||
|
||
Private Sub checkItemPreview_CheckedChanged(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles checkItemPreview.CheckedChanged
|
||
SetFilePreview(checkItemPreview.Checked)
|
||
CONFIG.Config.FilePreview = checkItemPreview.Checked
|
||
CONFIG.Save()
|
||
End Sub
|
||
|
||
Private Sub SplitContainer1_SplitterMoved(sender As Object, e As SplitterEventArgs) Handles SplitContainer1.SplitterMoved
|
||
CONFIG.Config.SplitterDistanceViewer = SplitContainer1.SplitterDistance
|
||
End Sub
|
||
|
||
Private Sub BarButtonItem1_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem1.ItemClick
|
||
DATABASE_ECM.ExecuteNonQuery($"DELETE FROM TBGI_FILES_USER WHERE GUID = {CURRENT_WORKFILE_GUID}")
|
||
|
||
CancelAttempts = 2
|
||
Close()
|
||
End Sub
|
||
|
||
Private Sub checkItemPreselection_CheckedChanged(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles checkItemPreselection.CheckedChanged
|
||
CONFIG.Config.ProfilePreselection = checkItemPreselection.Checked
|
||
CONFIG.Save()
|
||
End Sub
|
||
|
||
|
||
Private Sub BarButtonItem2_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem2.ItemClick
|
||
Try
|
||
MsgBox($"Deleting [{CURRENT_WORKFILE}]", MsgBoxStyle.Information, Text)
|
||
|
||
File.SetAttributes(CURRENT_WORKFILE, FileAttributes.Normal)
|
||
File.Delete(CURRENT_WORKFILE)
|
||
|
||
'IO.File.Delete(CURRENT_WORKFILE)
|
||
Catch ex As Exception
|
||
_Logger.Error(ex)
|
||
MsgBox(ex.Message)
|
||
End Try
|
||
End Sub
|
||
|
||
Private Sub ComboboxDoctype_KeyUp(sender As Object, e As KeyEventArgs) Handles ComboboxDoctype.KeyUp
|
||
If e.KeyCode = Keys.F2 Then
|
||
Dim oCombo As SearchLookUpEdit = sender
|
||
oCombo.ShowPopup()
|
||
End If
|
||
End Sub
|
||
|
||
Private Sub BarCheckItem_MultiIndexing_CheckedChanged(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarCheckItem_MultiIndexing.CheckedChanged
|
||
Dim item As DevExpress.XtraBars.BarCheckItem = CType(sender, DevExpress.XtraBars.BarCheckItem)
|
||
If item.Checked Then
|
||
BarButtonItem1.Enabled = False
|
||
MULTIINDEXING_ACTIVE = True
|
||
If USER_LANGUAGE = LANG_DE Then
|
||
Me.BarButtonItem_OK.Caption = "Dateien indexieren"
|
||
Else
|
||
Me.BarButtonItem_OK.Caption = "Index Files"
|
||
End If
|
||
Else
|
||
BarButtonItem1.Enabled = True
|
||
MULTIINDEXING_ACTIVE = False
|
||
If USER_LANGUAGE = LANG_DE Then
|
||
Me.BarButtonItem_OK.Caption = "Datei indexieren"
|
||
Else
|
||
Me.BarButtonItem_OK.Caption = "Index File"
|
||
End If
|
||
End If
|
||
End Sub
|
||
|
||
Private Sub BarButtonItem_OK_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem_OK.ItemClick
|
||
Try
|
||
ClearError()
|
||
ClearNotice()
|
||
|
||
Me.Cursor = Cursors.WaitCursor
|
||
CURRENT_DT_REGEX = DATABASE_ECM.GetDatatable("SELECT * FROM TBGI_FUNCTION_REGEX")
|
||
For Each rowregex As DataRow In CURRENT_DT_REGEX.Rows
|
||
If rowregex.Item("FUNCTION_NAME") = "CLEAN_FILENAME" Then
|
||
REGEX_CLEAN_FILENAME = rowregex.Item("REGEX")
|
||
End If
|
||
Next
|
||
If BarCheckItem_MultiIndexing.Checked = True Then
|
||
'Die erste Datei indexieren
|
||
If WORK_FILE() = True Then
|
||
'Und nun die folgenden
|
||
Dim DTFiles2Work As DataTable = DATABASE_ECM.GetDatatable("SELECT * FROM TBGI_FILES_USER WHERE WORKED = 0 AND GUID <> " & CURRENT_WORKFILE_GUID & " AND UPPER(USER@WORK) = UPPER('" & Environment.UserName & "')")
|
||
If DTFiles2Work IsNot Nothing Then
|
||
Dim err = False
|
||
For Each oRow As DataRow In DTFiles2Work.Rows
|
||
CURRENT_WORKFILE_GUID = oRow.Item("GUID")
|
||
CURRENT_WORKFILE = oRow.Item("FILENAME2WORK")
|
||
CURRENT_WORKFILE_HASH = oRow.ItemEx("FILE_HASH", "")
|
||
DropType = oRow.Item("HANDLE_TYPE")
|
||
|
||
If WORK_FILE() = False Then
|
||
err = True
|
||
Exit For
|
||
End If
|
||
Next
|
||
Me.Cursor = Cursors.Default
|
||
If err = False Then
|
||
If USER_LANGUAGE = LANG_DE Then
|
||
MsgBox("Alle Dateien wurden mit Multiindexing erfolgreich verarbeitet!", MsgBoxStyle.Information, "Erfolgsmeldung:")
|
||
Else
|
||
MsgBox("All files were successfully processed through Multiindexing", MsgBoxStyle.Information, "Success")
|
||
End If
|
||
|
||
CloseViewer()
|
||
|
||
CancelAttempts = 2
|
||
Me.Close()
|
||
End If
|
||
End If
|
||
End If
|
||
Else
|
||
If WORK_FILE() = True Then
|
||
Me.Cursor = Cursors.Default
|
||
If CONFIG.Config.ShowIndexResult = True Then
|
||
If USER_LANGUAGE = LANG_DE Then
|
||
' MsgBox("Die Datei wurde erfolgreich verarbeitet!" & vbNewLine & "Ablagepfad:" & vbNewLine & CURRENT_NEWFILENAME, MsgBoxStyle.Information, "Erfolgsmeldung")
|
||
_FormHelper.ShowSuccessMessage($"Die Datei wurde erfolgreich verarbeitet!{vbNewLine}Ablagepfad:{vbNewLine}{CURRENT_NEWFILENAME}", "Erfolgsmeldung")
|
||
Else
|
||
'MsgBox($"File sucessfully processed!{vbNewLine}Path:{vbNewLine}{CURRENT_NEWFILENAME}" & vbNewLine & "Path:" & vbNewLine & CURRENT_NEWFILENAME, MsgBoxStyle.Information, "Success")
|
||
_FormHelper.ShowSuccessMessage($"File sucessfully processed!{vbNewLine}Path:{vbNewLine}{CURRENT_NEWFILENAME}", "Success")
|
||
End If
|
||
|
||
|
||
End If
|
||
|
||
CloseViewer()
|
||
|
||
CancelAttempts = 2
|
||
Me.Close()
|
||
End If
|
||
End If
|
||
Catch ex As Exception
|
||
MsgBox("Uncaught error while indexing: " & vbNewLine & ex.Message, MsgBoxStyle.Critical, Text)
|
||
Finally
|
||
Me.Cursor = Cursors.Default
|
||
End Try
|
||
End Sub
|
||
|
||
End Class
|