FileFlow/Global_Indexer/frmIndex.vb

2915 lines
146 KiB
VB.net

Imports System.IO
Imports System.Text.RegularExpressions
Imports System.Text
Imports System.Security.AccessControl
Imports System.Security.Principal
Imports DigitalData.Modules.Logging
Imports DigitalData.Controls.LookupGrid
Imports DigitalData.GUIs.GlobalIndexer
Imports DevExpress.XtraEditors.Controls
Imports Limilabs.Mail
Imports DevExpress.XtraEditors
Imports DigitalData.GUIs.Common
Imports DigitalData.Modules.Base
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()
_FormHelper = New FormHelper(LOGCONFIG, Me)
_PostProcessing = New ClassPostprocessing(LOGCONFIG)
Localizer.Active = New LookupGridLocalizer()
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 Label With {
.Name = "lbl" & indexname,
.AutoSize = True,
.Text = hinweis,
.Location = New Point(11, ylbl)
}
pnlIndex.Controls.Add(lbl)
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")
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:")
Else
MsgBox(TEXT_MISSING_INPUT_EN, MsgBoxStyle.Exclamation, "Missing Input:")
End If
box.Focus()
Return False
Else
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)
MsgBox(oMessage, MsgBoxStyle.Exclamation, oTitle)
box.Focus()
Return False
Else
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)
Else
MsgBox(TEXT_MISSING_INPUT_EN, MsgBoxStyle.Exclamation, Text)
End If
oLookup.Focus()
Return False
Else
Indexwert_Postprocessing(Replace(oLookup.Name, "cmbMulti", ""), "")
oResult = True
End If
Else
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)
Else
MsgBox(TEXT_MISSING_INPUT_EN, MsgBoxStyle.Exclamation, Text)
End If
cmbSingle.Focus()
Return False
Else
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)
Else
MsgBox(TEXT_MISSING_INPUT_EN, MsgBoxStyle.Exclamation, Text)
End If
cmb.Focus()
Return False
Else
Indexwert_Postprocessing(Replace(cmb.Name, "cmb", ""), "")
oResult = True
End If
Else
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)
Else
MsgBox(TEXT_MISSING_INPUT_EN, MsgBoxStyle.Exclamation, Text)
End If
dtp.Focus()
Return False
Else
Indexwert_Postprocessing(oIndexName, "")
oResult = True
End If
Else
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
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
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 < WINDREAM.WMObjectVariableValueTypeVector Then
_Logger.Debug($"Indexing oIndexType < WINDREAM.WMObjectVariableValueTypeVector...")
indexierung_erfolgreich = WINDREAM.SetFileIndex(CURRENT_NEWFILENAME, indexname, idxvalue, CURR_DOKART_OBJECTTYPE)
Else
Dim oSplitArray = Split(idxvalue, ClassConstants.VECTORSEPARATOR)
Dim oListofString As New List(Of String)
If oSplitArray.Count = 0 Then
oListofString.Add(idxvalue)
Else
For Each oStr In oSplitArray
oListofString.Add(oStr)
Next
End If
indexierung_erfolgreich = WINDREAM.SetFileIndex(CURRENT_NEWFILENAME, indexname, oListofString, 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
Dim Count As Integer = 0
For Each row As DataRow In DTAut.Rows
Dim indexiert = CBool(row.Item("Indexiert"))
Dim Indexvalue = row.Item("Indexwert").ToString
Dim indexname = row.Item("INDEXNAME").ToString
If indexiert = True And Indexvalue <> "" Then
If Indexvalue <> "EMPTY_OI" Then
_Logger.Info("Auto Indexname: " & indexname.ToString)
_Logger.Info("Indexvalue: " & Indexvalue.ToString)
Count += 1
' den Typ des Zielindexes auslesen
Dim indexType As Integer = WINDREAM.GetIndexType(indexname)
If indexType < WINDREAM.WMObjectVariableValueTypeVector Then
indexierung_erfolgreich = WINDREAM.SetFileIndex(CURRENT_NEWFILENAME, indexname, Indexvalue, CURR_DOKART_OBJECTTYPE)
Else
Dim oSplitArray = Split(Indexvalue, ClassConstants.VECTORSEPARATOR)
Dim oListofString As New List(Of String)
If oSplitArray.Count = 0 Then
oListofString.Add(Indexvalue)
Else
For Each oStr In oSplitArray
oListofString.Add(oStr)
Next
End If
indexierung_erfolgreich = WINDREAM.SetFileIndex(CURRENT_NEWFILENAME, indexname, oListofString, 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(pIndexAttachment:=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(pIndexAttachment:=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 DocType = [{0}]. Exiting.", CURR_DOKART_OBJECTTYPE)
Return False
End If
If oTable.Rows.Count = 0 Then
LOGGER.Warn("Could not get Email Indicies for DocType = [{0}]. Exiting.")
Return False
End If
If oTable.Rows.Count > 1 Then
LOGGER.Warn("Got multiple rows for Email Indicies for DocType = [{0}]. Exiting.")
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)
Dim oDateIn As Date = EMAIL.Get_MessageDate(oMail)
Dim oSubject As String = oMail.Subject
CURRENT_MESSAGEID = oMessageId
CURRENT_MESSAGEDATE = oDateIn
CURRENT_MESSAGESUBJECT = oSubject
oIndexNames = New Dictionary(Of String, Object) From {
{"IDX_EMAIL_ID", oMessageId},
{"IDX_EMAIL_FROM", oMessageFrom},
{"IDX_EMAIL_TO", oMessageTo},
{"IDX_EMAIL_SUBJECT", oSubject},
{"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
VIEWER_LICENSE = DATABASE_ECM.GetScalarValue("SELECT LICENSE FROM TBDD_3RD_PARTY_MODULES WHERE NAME = 'GDPICTURE'")
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 & "')")
MULTIINDEXING_ACTIVE = False
If MULTIFILES > 0 Then
If USER_LANGUAGE = LANG_DE Then
checkMultiindex.Text = "Multi-Indexing - Alle nachfolgenden Dateien (" & MULTIFILES & ") identisch indexieren"
Else
checkMultiindex.Text = "Multi-Indexing - All following files (" & MULTIFILES & ") will be indexed identically"
End If
checkMultiindex.Checked = False
checkMultiindex.Visible = True
BarButtonItem1.Visibility = DevExpress.XtraBars.BarItemVisibility.Always
Else
checkMultiindex.Visible = False
BarButtonItem1.Visibility = DevExpress.XtraBars.BarItemVisibility.Never
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
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")) 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
Exit For
End If
End If
Next
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
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
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 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 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 SqlCommand Is Nothing OrElse SqlCommand = String.Empty Then
LOGGER.Warn("New Value for Index [{0}] could not be set. Supplied SQL is empty.")
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 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()
oResult = oOwner
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
' 1. Schritt: Einfach-Indexe und Platzhalter ersetzen
For Each oRow As DataRow In oDatatable
_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 Then
_Logger.Info(" There are " & oVectorMatches.Count & " matches for vectors!")
Dim oIsFirstMatch = True
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
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_File2_Target() = 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
'#### Automatische Werte indexieren ####
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_File2_Target()
Dim oError As Boolean
Try
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
'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 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 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 checkMultiindex_CheckedChanged(sender As Object, e As EventArgs) Handles checkMultiindex.CheckedChanged
If USER_LANGUAGE = LANG_DE Then
If checkMultiindex.Checked Then
Me.btnOK.Text = "Dateien indexieren"
MULTIINDEXING_ACTIVE = True
Else
Me.btnOK.Text = "Datei indexieren"
MULTIINDEXING_ACTIVE = False
End If
Else
If checkMultiindex.Checked Then
Me.btnOK.Text = "Index Files"
MULTIINDEXING_ACTIVE = True
Else
Me.btnOK.Text = "Index File"
MULTIINDEXING_ACTIVE = False
End If
End If
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
End Class