This commit is contained in:
2021-01-19 13:11:09 +01:00
parent f78f3f84b0
commit f6862cccc2
42 changed files with 3308 additions and 390 deletions

View File

@@ -1,10 +1,12 @@
Option Explicit On
Imports System.DirectoryServices
Imports System.IO
Imports System.Security.AccessControl
Imports System.Security.Principal
Imports System.Text.RegularExpressions
Imports DigitalData.Modules.Logging
Imports Independentsoft
Public Class frmGlobix_Index
#Region "+++++ Variablen ++++++"
@@ -31,6 +33,8 @@ Public Class frmGlobix_Index
Private clswindowLocation As ClassWindowLocation
Private clsPatterns As GlobixPatterns
Private clsPostProcessing As GlobixPostprocessing
Private _DataASorDB As ClassDataASorDB
Private _idbdata As ClassIDBData
#End Region
Public Sub New(LogConfig As LogConfig)
@@ -40,9 +44,11 @@ Public Class frmGlobix_Index
' Fügen Sie Initialisierungen nach dem InitializeComponent()-Aufruf hinzu.
_Logger = LogConfig.GetLogger()
_LogConfig = LogConfig
clswindowLocation = New ClassWindowLocation(_LogConfig)
_DataASorDB = New ClassDataASorDB(LogConfig)
clswindowLocation = New ClassWindowLocation(LogConfig)
clsPatterns = New GlobixPatterns(LogConfig)
clsPostProcessing = New GlobixPostprocessing(LogConfig)
_idbdata = New ClassIDBData(LogConfig)
End Sub
Private Sub frmGlobix_Index_Load(sender As Object, e As EventArgs) Handles MyBase.Load
@@ -138,9 +144,10 @@ Public Class frmGlobix_Index
SplitContainerControl1.SplitterPosition = My.UIConfig.Globix.SplitterDistanceViewer
My.Application.Globix.DTTBGI_REGEX_DOCTYPE = My.Database.GetDatatable("SELECT DISTINCT T1.DOCTYPE as DocType, T.* FROM TBGI_REGEX_DOCTYPE T, VWGI_DOCTYPE T1 WHERE T.DOCTYPE_ID = T1.DOCTYPE_ID")
My.Application.Globix.CURR_INDEX_MAN_POSTPROCESSING = My.Database.GetDatatable("SELECT * FROM TBDD_INDEX_MAN_POSTPROCESSING")
Dim oSQL As String = "SELECT DISTINCT T1.DOCTYPE as DocType, T.* FROM TBGI_REGEX_DOCTYPE T, VWGI_DOCTYPE T1 WHERE T.DOCTYPE_ID = T1.DOCTYPE_ID"
My.Application.Globix.DTTBGI_REGEX_DOCTYPE = _DataASorDB.GetDatatable("DD_ECM", oSQL, "DTTBGI_REGEX_DOCTYPE", "", "")
oSQL = "SELECT * FROM TBDD_INDEX_MAN_POSTPROCESSING"
My.Application.Globix.CURR_INDEX_MAN_POSTPROCESSING = _DataASorDB.GetDatatable("DD_ECM", oSQL, "TBDD_INDEX_MAN_POSTPROCESSING", "", "")
MULTIFILES = My.Database.GetScalarValue("SELECT COUNT(*) FROM TBGI_FILES_USER WHERE WORKED = 0 AND GUID <> " & My.Application.Globix.CURRENT_WORKFILE_GUID & " AND UPPER(USER@WORK) = UPPER('" & Environment.UserName & "')")
My.Application.Globix.MULTIINDEXING_ACTIVE = False
If MULTIFILES > 0 Then
@@ -261,11 +268,15 @@ Public Class frmGlobix_Index
End Try
End Sub
Private Sub checkItemPreselection_CheckedChanged(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles checkItemPreselection.CheckedChanged
My.UIConfig.Globix.ProfilePreselection = checkItemPreselection.Checked
My.SystemConfigManager.Save()
End Sub
Sub Refresh_Dokart()
Try
Dim sql = String.Format("select * from VWGI_DOCTYPE where UPPER(USERNAME) = UPPER('{0}') ORDER BY SEQUENCE", Environment.UserName)
_Logger.Debug("SQL DoctypeList: " & sql)
DT_DOKART = My.Database.GetDatatable(sql)
Dim oSql = String.Format("select * from VWGI_DOCTYPE where UPPER(USERNAME) = UPPER('{0}') ORDER BY SEQUENCE", My.Application.User.UserName)
Dim oFilter = $"USERNAME like '%{My.Application.User.UserName}%'"
DT_DOKART = _DataASorDB.GetDatatable("DD_ECM", oSql, "VWGI_DOCTYPE", oFilter, "SEQUENCE")
cmbDoctype.DataSource = DT_DOKART
cmbDoctype.ValueMember = DT_DOKART.Columns("DOCTYPE_ID").ColumnName
cmbDoctype.DisplayMember = DT_DOKART.Columns("DOCTYPE").ColumnName
@@ -295,8 +306,10 @@ Public Class frmGlobix_Index
Me.pnlIndex.Controls.Clear()
Dim sql As String = "Select * from TBDD_DOKUMENTART WHERE GUID = " & cmbDoctype.SelectedValue.ToString
My.Application.Globix.CURR_DT_DOCTYPE = My.Database.GetDatatable(sql)
Dim oSql As String = "Select * from TBDD_DOKUMENTART WHERE GUID = " & cmbDoctype.SelectedValue.ToString
Dim oFilter = "GUID = " & cmbDoctype.SelectedValue.ToString
My.Application.Globix.CURR_DT_DOCTYPE = _DataASorDB.GetDatatable("DD_ECM", oSql, "TBDD_DOKUMENTART", oFilter, "")
My.Application.Globix.CURRENT_DOCTYPE_DuplicateHandling = My.Application.Globix.CURR_DT_DOCTYPE.Rows(0).Item("DUPLICATE_HANDLING").ToString
@@ -309,7 +322,9 @@ Public Class frmGlobix_Index
Dim oSql
Try
oSql = "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 = My.Database.GetDatatable(oSql)
Dim oFilter = "DOK_ID = " & dokartid
DT_INDEXEMAN = _DataASorDB.GetDatatable("DD_ECM", oSql, "DT_INDEXE_MAN", oFilter, "SEQUENCE")
pnlIndex.Visible = True
LoadIndexe_Man()
Catch ex As System.Exception
@@ -360,32 +375,32 @@ Public Class frmGlobix_Index
addLabel(oControlName, oRow.Item("COMMENT").ToString, oLabelPosition, oControlCount)
End If
'Dim DefaultValue = Check_HistoryValues(oControlName, oRow.Item("DOKUMENTART"))
' If DefaultValue Is Nothing Then
Dim DefaultValue = GetPlaceholderValue(oRow.Item("DEFAULT_VALUE"), My.Application.Globix.CURRENT_WORKFILE, My.Application.User.ShortName)
' End If
Dim oDefaultValue = Check_HistoryValues(oControlName, oRow.Item("DOKUMENTART"))
If oDefaultValue Is Nothing Then
oDefaultValue = GetPlaceholderValue(oRow.Item("DEFAULT_VALUE"), My.Application.Globix.CURRENT_WORKFILE, My.Application.User.ShortName)
End If
Select Case oDataType
Case "BOOLEAN"
Dim chk As CheckBox = oControls.AddCheckBox(oControlName, oControlPosition, DefaultValue, oRow.Item("COMMENT").ToString)
Dim chk As CheckBox = oControls.AddCheckBox(oControlName, oControlPosition, oDefaultValue, oRow.Item("COMMENT").ToString)
If Not IsNothing(chk) Then
pnlIndex.Controls.Add(chk)
End If
Case "INTEGER"
If (oSQLSuggestion = True And oRow.Item("SQL_RESULT").ToString.Length > 0) Or MultiSelect = True Then
Dim oControl = oControls.AddVorschlag_ComboBox(oControlName, oControlPosition, oConnectionId, oRow.Item("SQL_RESULT"), MultiSelect, oDataType, DefaultValue, AddNewItems, PreventDuplicates, oSQLSuggestion)
Dim oControl = oControls.AddVorschlag_ComboBox(oControlName, oControlPosition, oConnectionId, oRow.Item("SQL_RESULT"), MultiSelect, oDataType, oDefaultValue, AddNewItems, PreventDuplicates, oSQLSuggestion)
If Not IsNothing(oControl) Then
pnlIndex.Controls.Add(oControl)
End If
Else
'nur eine Textbox
Dim oControl = oControls.AddTextBox(oControlName, oControlPosition, DefaultValue, oDataType)
Dim oControl = oControls.AddTextBox(oControlName, oControlPosition, oDefaultValue, oDataType)
If Not IsNothing(oControl) Then
pnlIndex.Controls.Add(oControl)
End If
End If
Case "VARCHAR"
If (oSQLSuggestion = True And oRow.Item("SQL_RESULT").ToString.Length > 0) Or MultiSelect = True Then
Dim oControl = oControls.AddVorschlag_ComboBox(oControlName, oControlPosition, oConnectionId, oRow.Item("SQL_RESULT"), MultiSelect, oDataType, DefaultValue, AddNewItems, PreventDuplicates, oSQLSuggestion)
Dim oControl = oControls.AddVorschlag_ComboBox(oControlName, oControlPosition, oConnectionId, oRow.Item("SQL_RESULT"), MultiSelect, oDataType, oDefaultValue, AddNewItems, PreventDuplicates, oSQLSuggestion)
If Not IsNothing(oControl) Then
pnlIndex.Controls.Add(oControl)
End If
@@ -396,7 +411,7 @@ Public Class frmGlobix_Index
pnlIndex.Controls.Add(oControl)
End If
Else
Dim VORBELGUNG As String = DefaultValue
Dim VORBELGUNG As String = oDefaultValue
Dim oControl = oControls.AddTextBox(oControlName, oControlPosition, VORBELGUNG, oDataType)
If Not IsNothing(oControl) Then
pnlIndex.Controls.Add(oControl)
@@ -404,7 +419,7 @@ Public Class frmGlobix_Index
End If
End If
Case "DATE"
Dim oPicker = oControls.AddDateTimePicker(oControlName, oControlPosition, oDataType, DefaultValue)
Dim oPicker = oControls.AddDateTimePicker(oControlName, oControlPosition, oDataType, oDefaultValue)
pnlIndex.Controls.Add(oPicker)
Case Else
@@ -475,26 +490,26 @@ Public Class frmGlobix_Index
Return oResult
End Function
'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
' _Logger.Error(ex)
' MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Check_HistoryValues:")
' Return Nothing
' End Try
'End Function
Function Check_HistoryValues(Indexname As String, Dokart As String) As String
Try
Dim result = Nothing
Dim DT As DataTable = GlobixDataset.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
_Logger.Error(ex)
MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Check_HistoryValues:")
Return Nothing
End Try
End Function
Sub ClearError()
labelError.Visibility = DevExpress.XtraBars.BarItemVisibility.Never
labelError.Caption = String.Empty
@@ -613,7 +628,7 @@ Public Class frmGlobix_Index
ClearNotice()
Me.Cursor = Cursors.WaitCursor
Refresh_RegexTable()
For Each rowregex As DataRow In My.Application.BASE_DATA_DT_REGEX.Rows
For Each rowregex As DataRow In My.Application.Globix.DT_FUNCTION_REGEX.Rows
If rowregex.Item("FUNCTION_NAME") = "CLEAN_FILENAME" Then
My.Application.Globix.REGEX_CLEAN_FILENAME = rowregex.Item("REGEX")
End If
@@ -657,10 +672,14 @@ Public Class frmGlobix_Index
If WORK_FILE() = True Then
Me.Cursor = Cursors.Default
If My.UIConfig.Globix.ShowIndexResult = True Then
NI_TYPE = "INFO"
If My.Application.User.Language = "de-DE" Then
MsgBox("Die Datei wurde erfolgreich verarbeitet!" & vbNewLine & "Ablagepfad:" & vbNewLine & My.Application.Globix.CURRENT_NEWFILENAME, MsgBoxStyle.Information, "Erfolgsmeldung")
NI_TITLE = "Globix Flow erfolgreich"
NI_MESSAGE = "Die Datei wurde erfolgreich verarbeitet"
Else
MsgBox("File sucessfully processed!" & vbNewLine & "Path:" & vbNewLine & My.Application.Globix.CURRENT_NEWFILENAME, MsgBoxStyle.Information, "Success")
NI_TITLE = "Success Globix Flow"
NI_MESSAGE = "File successfully processed"
End If
End If
@@ -677,7 +696,8 @@ Public Class frmGlobix_Index
Private Function WORK_FILE()
Try
Dim oSQL = $"SELECT * ,CONVERT(VARCHAR(512),'') As IndexValueGUI,CONVERT(VARCHAR(512),'') As IndexValue_File,CONVERT(Bit,0) as Indexed FROM VWDDINDEX_MAN WHERE DOK_ID = {My.Application.Globix.CURRENT_DOCTYPE_ID}"
My.Application.Globix.CURR_DT_MAN_INDEXE = My.Database.GetDatatable(oSQL)
Dim oFilter = "DOK_ID = " & My.Application.Globix.CURRENT_DOCTYPE_ID
My.Application.Globix.CURR_DT_MAN_INDEXE = _DataASorDB.GetDatatable("DD_ECM", oSQL, "VWDDINDEX_MAN", oFilter, "")
_Logger.Debug("Manuelle Indexe geladen")
@@ -947,16 +967,17 @@ Public Class frmGlobix_Index
End If
Dim oExportSuccessful As Boolean = False
Dim oIDBImportResult As Boolean = False
'Variable Folder
If DropType = "|DROPFROMFSYSTEM|" Or DropType = "|OUTLOOK_ATTACHMENT|" Or DropType = "|ATTMNTEXTRACTED|" Or DropType = "|FW_SIMPLEINDEXER|" Then
Move_File(My.Application.Globix.CURRENT_WORKFILE, My.Application.Globix.CURRENT_NEWFILENAME, My.Application.Globix.CURRENT_WORKFILE_EXTENSION, My.Application.Globix.FILE_DELIMITER)
oIDBImportResult = ImportFile2IDB()
' oExportSuccessful = SINGLEFILE_2_WINDREAM(My.Application.Globix.CURR_D)
ElseIf DropType = "|OUTLOOK_MESSAGE|" Or DropType = "|FW_MSGONLY|" Or DropType = "|MSGONLY|" Or DropType = "|FW_OUTLOOK_MESSAGE|" Then
' oExportSuccessful = SINGLEFILE_2_WINDREAM(CURR_DOKART_OBJECTTYPE)
oIDBImportResult = ImportFile2IDB()
End If
If oExportSuccessful = True Then
If oIDBImportResult = True Then
'Kein Fehler in Export2windream
oError = False
If Write_Indizes() = True Then
@@ -966,7 +987,7 @@ Public Class frmGlobix_Index
Dim tempCur_WF = My.Application.Globix.CURRENT_WORKFILE.Replace("'", "''")
Dim tempCur_New_FN = My.Application.Globix.CURRENT_NEWFILENAME.Replace("'", "''")
Insert_String = sql_history_INSERT_INTO & ",ADDED_WHO) VALUES ('" & tempCur_WF & "','" & tempCur_New_FN & "'" & sql_history_Index_Values & ",'" & Environment.UserDomainName & "\" & Environment.UserName & "')"
My.Database.GetScalarValue(Insert_String)
My.Database.ExecuteNonQuery(Insert_String)
If DropType.Contains("MSG") Or DropType = "|ATTMNTEXTRACTED|" Or DropType = "|OUTLOOK_ATTACHMENT|" Then
If My.Application.Globix.CURRENT_MESSAGEID <> "" Then
Dim max As String = "SELECT MAX(GUID) FROM TBGI_HISTORY"
@@ -1000,11 +1021,13 @@ Public Class frmGlobix_Index
End If
Else
oError = True
NI_TYPE = "ERROR"
If My.Application.User.Language = "de-DE" Then
MsgBox("Der Export nach windream war nicht erfolgreich - Check LogFile", MsgBoxStyle.Exclamation)
NI_TITLE = "Fehler Globix-Import"
NI_MESSAGE = "Der Import war nicht erfolgreich - Check LogFile"
Else
MsgBox("Export to windream was unsucessful - Check LogFile", MsgBoxStyle.Exclamation)
NI_TITLE = "Error Globix-Import"
NI_MESSAGE = "The import was not successful - Check LogFile"
End If
End If
@@ -1033,7 +1056,7 @@ Public Class frmGlobix_Index
If oDTRESULT.Rows.Count = 0 Then
Return False
Else
My.Application.Globix.CURRENT_DOC_ID = oDTRESULT.Rows(0).Item(0)
My.Application.Globix.CURRENT_IDB_OBJ_ID = oDTRESULT.Rows(0).Item(0)
Return True
End If
End If
@@ -1042,6 +1065,7 @@ Public Class frmGlobix_Index
Catch ex As Exception
_Logger.Error(ex)
Return False
End Try
End Function
Function Move_File(Quelle As String, _NewFilename As String, extension As String, _versionTz As String) As Boolean
@@ -1059,6 +1083,10 @@ Public Class frmGlobix_Index
My.Application.Globix.CURRENT_NEWFILENAME = neuername
Loop
End If
Dim opath = Path.GetDirectoryName(My.Application.Globix.CURRENT_NEWFILENAME)
If Directory.Exists(opath) = False Then
Directory.CreateDirectory(opath)
End If
'Die Datei wird nun verschoben
If My.Application.Globix.CURR_DELETE_ORIGIN = True Then
My.Computer.FileSystem.MoveFile(My.Application.Globix.CURRENT_WORKFILE, My.Application.Globix.CURRENT_NEWFILENAME)
@@ -1100,139 +1128,107 @@ Public Class frmGlobix_Index
End Function
Private Function Write_Indizes()
Try
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("IndexValueGUI")
' Dim indexname = row.Item("WD_INDEX").ToString
' _Logger.Debug($"Write_Indizes - Index [{indexname}]...")
' Dim optional_Index = CBool(row.Item("OPTIONAL"))
' Dim Indexed = CBool(row.Item("Indexed"))
' If Indexed 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("IndexValueGUI")
' 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("IndexValueGUI")
' DTTemp.Rows.Add(newRow)
' End If
' End If
Dim oSetVariableOK As Boolean = False
Dim oAttributeValue As String
Dim oAttributeName As String
'Manuelle Indexe Indexieren
If My.Application.Globix.CURR_DT_MAN_INDEXE.Rows.Count > 0 Then
Dim Count As Integer = 0
For Each row As DataRow In My.Application.Globix.CURR_DT_MAN_INDEXE.Rows
' _Logger.Debug($"Manueller Indexvalue [{idxvalue.ToString}]...NOW THE INDEXING...")
' Count += 1
oAttributeValue = row.Item("IndexValueGUI")
oAttributeName = row.Item("WD_INDEX").ToString
_Logger.Debug($"Write_Indizes - Index [{oAttributeName}]...")
Dim oIsOptional = CBool(row.Item("OPTIONAL"))
Dim oIndexed = CBool(row.Item("Indexed"))
If oIndexed And oAttributeValue.ToString <> "" And oAttributeValue <> "EMPTY_OI" Then
If oAttributeName <> String.Empty Then
If row.Item("SAVE_VALUE") = True Then
'Den Indexwert zwischenspeichern
Dim oDTIndexResults As DataTable = GlobixDataset.TBTEMP_INDEXRESULTS
Dim rowexists As Boolean = False
For Each rowTemp As DataRow In oDTIndexResults.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("IndexValueGUI")
End If
Next
'.....ansonsten neu anlegen
If rowexists = False Then
Dim newRow As DataRow = oDTIndexResults.NewRow()
newRow("Dokumentart") = row.Item("DOKUMENTART").ToString
newRow("Indexname") = row.Item("INDEXNAME").ToString
newRow("Value") = row.Item("IndexValueGUI")
oDTIndexResults.Rows.Add(newRow)
End If
End If
End If
_Logger.Debug($"Manueller Indexvalue [{oAttributeValue.ToString}]...NOW THE INDEXING...")
Count += 1
' den Typ des Zielindexes auslesen
Dim oIndexType As Integer = _idbdata.GetTypeOfIndex(oAttributeName)
_Logger.Debug($"oIndexType [{oIndexType.ToString}]...")
_Logger.Debug($"Indexing oIndexType < 8...")
oSetVariableOK = _idbdata.SetVariableValue(oAttributeName, oAttributeValue)
'indexierung_erfolgreich = ClassWindream.DateiIndexieren(CURRENT_NEWFILENAME, indexname, idxvalue)
If oSetVariableOK = False Then
MsgBox("Error in Indexing file - See log", MsgBoxStyle.Critical)
Return False
Exit For
End If
Else
_Logger.Debug("No Indexing Attributename: " & oAttributeName)
_Logger.Debug("is optional? " & oIsOptional.ToString)
End If
'Else
'_Logger.Debug("Indexvalue is empty or field is not indexed - Indexname: " & oAttributeName)
'_Logger.Info("Indexvalue is empty or field is not indexed - Indexname: " & oAttributeName)
'End If
Next
' ' den Typ des Zielindexes auslesen
' Dim oIndexType As Integer = WINDREAM.GetIndexType(indexname)
' _Logger.Debug($"oIndexType [{oIndexType.ToString}]...")
' 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
End If
oSetVariableOK = False
'Automatische Indexe Indexieren
If My.Application.Globix.CURR_DT_AUTO_INDEXE.Rows.Count > 0 Then
Dim Count As Integer = 0
For Each row As DataRow In My.Application.Globix.CURR_DT_AUTO_INDEXE.Rows
oSetVariableOK = CBool(row.Item("Indexed"))
oAttributeValue = row.Item("IndexValueGUI").ToString
oAttributeName = row.Item("INDEXNAME").ToString
If oSetVariableOK = True And oAttributeValue <> "" Then
If oAttributeValue <> "EMPTY_OI" Then
_Logger.Info("Auto Indexname: " & oAttributeName.ToString)
_Logger.Info("oAttributeValue: " & oAttributeValue.ToString)
Count += 1
' den Typ des Zielindexes auslesen
Dim indexType As Integer = _idbdata.GetTypeOfIndex(oAttributeName)
oSetVariableOK = _idbdata.SetVariableValue(oAttributeName, oAttributeValue)
' 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 Indexed = CBool(row.Item("Indexed"))
' Dim Indexvalue = row.Item("IndexValueGUI").ToString
' Dim indexname = row.Item("INDEXNAME").ToString
' If Indexed = 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.EndsWith(".msg") Then
' indexierung_erfolgreich = SetEmailIndices()
' 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 = SetAttachmentIndices()
' If indexierung_erfolgreich = False Then
' MsgBox("Error in SetEmailIndices - See log", MsgBoxStyle.Critical)
' Return False
' End If
' End If
If oSetVariableOK = 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 My.Application.Globix.CURRENT_NEWFILENAME.EndsWith(".msg") Then
oSetVariableOK = SetEmailIndices()
If oSetVariableOK = False Then
MsgBox("Error in SetEmailIndices - See log", MsgBoxStyle.Critical)
Return False
End If
ElseIf DropType = "|ATTMNTEXTRACTED|" Or DropType = "|OUTLOOK_ATTACHMENT|" Then
oSetVariableOK = SetAttachmentIndices()
If oSetVariableOK = False Then
MsgBox("Error in SetEmailIndices - See log", MsgBoxStyle.Critical)
Return False
End If
End If
Return True
Catch ex As Exception
_Logger.Warn("Unexpected error in Write_Indizes - Fehler: " & vbNewLine & ex.Message)
@@ -1622,7 +1618,52 @@ Public Class frmGlobix_Index
Return False
End Try
End Function
Private Function SetAttachmentIndices()
Dim indexierung_erfolgreich As Boolean = True
Try
Dim DT As DataTable = My.Database.GetDatatable("SELECT * FROM TBGI_OBJECTTYPE_EMAIL_INDEX WHERE OBJECTTYPE = 'DEFAULT'")
If DT.Rows.Count = 1 Then
If Not My.Application.Globix.CURRENT_MESSAGEID Is Nothing Then
If My.Application.Globix.CURRENT_MESSAGEID <> "" Then
indexierung_erfolgreich = _idbdata.SetVariableValue(DT.Rows(0).Item("IDX_EMAIL_ID").ToString, My.Application.Globix.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 My.Application.Globix.CURRENT_MESSAGESUBJECT <> "" Then
indexierung_erfolgreich = _idbdata.SetVariableValue(DT.Rows(0).Item("IDX_EMAIL_SUBJECT").ToString, My.Application.Globix.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 My.Application.Globix.CURRENT_MESSAGEDATE <> "" Then
indexierung_erfolgreich = _idbdata.SetVariableValue(DT.Rows(0).Item("IDX_EMAIL_DATE_IN").ToString, My.Application.Globix.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 = _idbdata.SetVariableValue(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
_Logger.Error(ex)
MsgBox("Error in SetAttachmentIndices:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
Return False
End Try
End Function
Function Indexwert_checkValueDB(indexname As String, wert As String)
Try
Dim oRow As DataRow
@@ -1678,8 +1719,10 @@ Public Class frmGlobix_Index
Try
Dim oSQL = $"SELECT * FROM VWDDINDEX_AUTOM WHERE DOCTYPE_ID = {My.Application.Globix.CURRENT_DOCTYPE_ID}"
Dim oFilter = $"DOCTYPE_ID = {My.Application.Globix.CURRENT_DOCTYPE_ID}"
My.Application.Globix.CURR_DT_AUTO_INDEXE = _DataASorDB.GetDatatable("DD_ECM", oSQL, "VWDDINDEX_AUTOM", oFilter, "")
My.Application.Globix.CURR_DT_AUTO_INDEXE = My.Database.GetDatatable(oSQL)
Dim oRegex As New Regex("\[%{1}[a-zA-Z0-9\!\$\&\/\(\)\=\?\,\.\-\;\:_öÖüÜäÄ\#\'\+\*\~\{\}\@\€\<\>\ ]+]{1}")
@@ -1853,7 +1896,7 @@ Public Class frmGlobix_Index
'FILE AND INDEX
'Zuerst nur die Fälle für die Variante ONLY FILE/FOLDER
Dim DTNB As DataTable = FilterDatatable(My.Application.Globix.CURR_INDEX_MAN_POSTPROCESSING, "IDXMAN_ID = " & idxid & " AND VARIANT = 'ONLY FILE/FOLDER'", "", "SEQUENCE", True)
'ClassDatabase.Return_Datatable("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 = clsPostProcessing.Get_Nachbearbeitung_Wert(wert_in, DTNB)
@@ -1865,7 +1908,7 @@ Public Class frmGlobix_Index
DTNB = Nothing
DTNB = FilterDatatable(My.Application.Globix.CURR_INDEX_MAN_POSTPROCESSING, "IDXMAN_ID = " & idxid & " AND VARIANT = 'FILE AND INDEX'", "", "SEQUENCE", True)
'ClassDatabase.Return_Datatable("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 = clsPostProcessing.Get_Nachbearbeitung_Wert(wert_in, DTNB)
@@ -1887,6 +1930,331 @@ Public Class frmGlobix_Index
GlobixFlow()
End Sub
Private Function SetEmailIndices()
Dim indexierung_erfolgreich As Boolean = False
Dim _step As String = "1"
Try
Dim msg As Msg.Message = New Msg.Message(My.Application.Globix.CURRENT_NEWFILENAME)
Dim msgDisplayTo = msg.DisplayTo
Dim msgInternetAccountName = msg.InternetAccountName
_Logger.Debug("")
_Logger.Debug("msgInternetAccountName: " & msgInternetAccountName)
_Logger.Debug("SenderName: " & msg.SenderName)
_Logger.Debug("SenderEmailAddress: " & msg.SenderEmailAddress)
_Logger.Debug("ReceivedByName: " & msg.ReceivedByName)
_Logger.Debug("ReceivedByEmailAddress: " & msg.ReceivedByEmailAddress)
_Logger.Debug("")
_step = "2"
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 My.Application.Globix.DT_FUNCTION_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 = My.Database.GetDatatable("SELECT * FROM TBGI_OBJECTTYPE_EMAIL_INDEX WHERE OBJECTTYPE = 'DEFAULT'")
If IsNothing(DT) Then
_Logger.Info("SELECT * FROM TBGI_OBJECTTYPE_EMAIL_INDEX RESULTED in NOTHING")
Return False
End If
If DT.Rows.Count = 1 Then
_step = "3"
My.Application.Globix.CURRENT_MESSAGEDATE = ""
My.Application.Globix.CURRENT_MESSAGESUBJECT = ""
'Message-ID nur auswerten wenn vorher nicht gestzt wurde!
If My.Application.Globix.CURRENT_MESSAGEID = "" Then
If Not msg.InternetMessageId Is Nothing Then
indexierung_erfolgreich = _idbdata.SetVariableValue(DT.Rows(0).Item("IDX_EMAIL_ID").ToString, msg.InternetMessageId)
'Die aktuelle Message-ID zwischenspeichern
My.Application.Globix.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
My.Application.Globix.CURRENT_MESSAGEID = ClassEmailHeaderExtractor.extractFromHeader(headers, messageIDPattern)
If IsNothing(My.Application.Globix.CURRENT_MESSAGEID) Then
My.Application.Globix.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 = _idbdata.SetVariableValue(DT.Rows(0).Item("IDX_EMAIL_ID").ToStrin, My.Application.Globix.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
frmGlobixMissingInput.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
frmGlobixMissingInput.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 = _idbdata.SetVariableValue(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 = _idbdata.SetVariableValue(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 = 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 = _idbdata.SetVariableValue(DT.Rows(0).Item("IDX_EMAIL_SUBJECT").ToString, subj)
My.Application.Globix.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 = _idbdata.SetVariableValue(DT.Rows(0).Item("IDX_EMAIL_DATE_IN").ToString, msg.MessageDeliveryTime)
My.Application.Globix.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
MsgBox("Error in SetEmailIndices:" & vbNewLine & ex.Message & vbNewLine & "Please check the configuration Email-Indexing!", MsgBoxStyle.Critical)
_Logger.Warn("Error in SetEmailIndices (Step finisched: " & _step & "): " & ex.Message)
_Logger.Error(ex)
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 Sub PictureEdit1_EditValueChanged(sender As Object, e As EventArgs) Handles PictureEdit1.EditValueChanged
End Sub