AppStd/Modules
8
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

MS Globix3

Browse Source
This commit is contained in:
SchreiberM 2020-11-24 15:08:05 +01:00
parent 3de2f13133
commit 4064c5cd60
13 changed files with 3235 additions and 119 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

491
GUIs.ZooFlow/Globix/GlobixControls.vb Normal file
View File

@ -0,0 +1,491 @@
Imports System.Data.SqlClient
Imports DigitalData.Modules.Logging
Imports Oracle.ManagedDataAccess.Client
Imports DigitalData.Controls.LookupGrid
Public Class GlobixControls
Private Property Form As frmGlobix_Index
Private Property Panel As Panel
Private Patterns As GlobixPatterns
Public Class ControlMeta
Public Property IndexName As String
Public Property IndexType As String
Public Property MultipleValues As Boolean = False
End Class
Private _Logger As Logger
Public Sub New(LogConfig As LogConfig, Panel As Panel, Form As frmGlobix_Index)
_Logger = LogConfig.GetLogger
Me.Form = Form
Me.Panel = Panel
Patterns = New GlobixPatterns(LogConfig)
End Sub
Public Function AddCheckBox(indexname As String, y As Integer, vorbelegung As String, caption As String)
Try
Dim value As Boolean = False
Dim chk As New CheckBox
chk.Name = "chk" & indexname
chk.Size = New Size(100, 27)
chk.Location = New Point(11, y)
chk.Tag = New ControlMeta() With {
.IndexName = indexname,
.IndexType = "BOOLEAN"
}
If caption <> "" Then
chk.Text = caption
chk.Size = New Size(CInt(caption.Length * 15), 27)
End If
If Boolean.TryParse(vorbelegung, value) = False Then
If vorbelegung = "1" Or vorbelegung = "0" Then
chk.Checked = CBool(vorbelegung)
Else
chk.Checked = False
End If
Else
chk.Checked = value
End If
AddHandler chk.CheckedChanged, AddressOf Checkbox_CheckedChanged
Return chk
Catch ex As Exception
_Logger.Info("Unhandled Exception in AddCheckBox: " & ex.Message)
_Logger.Error(ex.Message)
Return Nothing
End Try
End Function
Public Sub Checkbox_CheckedChanged(sender As CheckBox, e As EventArgs)
PrepareDependingControl(sender)
End Sub
Public Function AddVorschlag_ComboBox(indexname As String, y As Integer, conid As Integer, sql_Vorschlag As String, Multiselect As Boolean, DataType As String, Optional Vorgabe As String = "", Optional AddNewValues As Boolean = False, Optional PreventDuplicateValues As Boolean = False, Optional SQLSuggestion As Boolean = False) As Control
Try
Dim oSql As String = sql_Vorschlag
Dim oConnectionString As String
Dim oControl As New DigitalData.Controls.LookupGrid.LookupControl2 With {
.Multiselect = Multiselect,
.AllowAddNewValues = AddNewValues,
.PreventDuplicates = PreventDuplicateValues,
.Location = New Point(11, y),
.Size = New Size(300, 27),
.Name = "cmbMulti" & indexname,
.Tag = New ControlMeta() With {
.IndexName = indexname,
.IndexType = DataType
}
}
oControl.Properties.AppearanceFocused.BackColor = Color.Lime
If Not String.IsNullOrEmpty(Vorgabe) Then
Dim oDefaultValues As New List(Of String)
If Vorgabe.Contains(",") Then
oDefaultValues = Vorgabe.
Split(",").ToList().
Select(Function(item) item.Trim()).
ToList()
Else
oDefaultValues = Vorgabe.
Split("~").ToList().
Select(Function(item) item.Trim()).
ToList()
End If
oControl.SelectedValues = oDefaultValues
End If
AddHandler oControl.SelectedValuesChanged, AddressOf Lookup_SelectedValuesChanged
oConnectionString = My.Database.Get_ConnectionStringforID(conid)
If oConnectionString IsNot Nothing And oSql.Length > 0 And SQLSuggestion = True Then
_Logger.Debug("Connection String (redacted): [{0}]", oConnectionString.Substring(0, 30))
If Patterns.HasComplexPatterns(oSql) Then
_Logger.Debug(" >>sql enthält Platzhalter und wird erst während der Laufzeit gefüllt!", False)
Else
Dim oDatatable = My.Database.GetDatatableWithConnection(oSql, oConnectionString)
oControl.DataSource = oDatatable
End If
Else
_Logger.Warn("Connection String for control [{0}] is empty!", oControl.Name)
End If
Return oControl
Catch ex As Exception
_Logger.Info(" - Unvorhergesehener Unexpected error in AddVorschlag_ComboBox - Indexname: " & indexname & " - Fehler: " & vbNewLine & ex.Message)
_Logger.Error(ex.Message)
MsgBox(ex.Message, MsgBoxStyle.Critical, "Unvorhergesehener Unexpected error in AddVorschlag_ComboBox:")
Return Nothing
End Try
End Function
Private Sub Lookup_SelectedValuesChanged(sender As LookupControl2, SelectedValues As List(Of String))
PrepareDependingControl(sender)
End Sub
Function AddCombobox(indexname As String, y As Integer)
Dim cmb As New ComboBox
cmb.Name = "cmb" & indexname
cmb.AutoSize = True
cmb.Size = New Size(300, 27)
cmb.Location = New Point(11, y)
cmb.Tag = New ControlMeta() With {
.IndexName = indexname
}
AddHandler cmb.SelectedIndexChanged, AddressOf OncmbSIndexChanged
AddHandler cmb.GotFocus, AddressOf OncmbGotFocus
AddHandler cmb.LostFocus, AddressOf OncmbLostFocus
AddHandler cmb.KeyDown, AddressOf OncmbKeyDown
Return cmb
End Function
Public Sub OncmbKeyDown(sender As System.Object, e As System.EventArgs)
Dim cmb As ComboBox = sender
' Verhindert, dass Auswahlliste und Autocompleteliste übereinander liegen
If cmb.DroppedDown = True Then
cmb.DroppedDown = False
End If
End Sub
Public Sub OncmbGotFocus(sender As System.Object, e As System.EventArgs)
Dim cmb As ComboBox = sender
cmb.BackColor = Color.Lime
End Sub
Public Sub OncmbLostFocus(sender As System.Object, e As System.EventArgs)
Dim cmb As ComboBox = sender
cmb.BackColor = Color.White
End Sub
Public Sub OncmbSIndexChanged(sender As System.Object, e As System.EventArgs)
If Form.FormLoaded = False Then
Exit Sub
End If
Dim cmb As ComboBox = sender
If cmb.SelectedIndex <> -1 Then
If cmb.Text.Length > 15 Then
Dim g As Graphics = cmb.CreateGraphics
cmb.Width = g.MeasureString(cmb.Text, cmb.Font).Width + 30
g.Dispose()
End If
Get_NextComboBoxResults(cmb)
SendKeys.Send("{TAB}")
End If
End Sub
Private Sub Get_NextComboBoxResults(cmb As ComboBox)
Try
Dim indexname = cmb.Name.Replace("cmb", "")
Dim sql = "SELECT GUID,NAME,SQL_RESULT FROM TBDD_INDEX_MAN where SUGGESTION = 1 AND SQL_RESULT like '%@" & indexname & "%' and DOK_ID = " & My.Application.Globix.CURRENT_DOCTYPE_ID & " ORDER BY SEQUENCE"
Dim DT As DataTable = My.Database.GetDatatable(sql)
If Not IsNothing(DT) Then
If DT.Rows.Count > 0 Then
Dim cmbname = "cmb" & DT.Rows(0).Item("NAME")
Renew_ComboboxResults(DT.Rows(0).Item("GUID"), indexname, cmb.Text)
End If
End If
Catch ex As Exception
MsgBox("Error in Get_NextComboBoxResults:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
End Try
End Sub
Private Sub Renew_ComboboxResults(INDEX_GUID As Integer, SearchString As String, Resultvalue As String)
Try
Dim connectionString As String
Dim sqlCnn As SqlConnection
Dim sqlCmd As SqlCommand
Dim adapter As New SqlDataAdapter
Dim oracleConn As OracleConnection
Dim oracleCmd As OracleCommand
Dim oracleadapter As New OracleDataAdapter
Dim NewDataset As New DataSet
Dim i As Integer
Dim DT_INDEX As DataTable = My.Database.GetDatatable("select * FROM TBDD_INDEX_MAN WHERE GUID = " & INDEX_GUID)
If IsNothing(DT_INDEX) Then
Exit Sub
End If
Dim conid = DT_INDEX.Rows(0).Item("CONNECTION_ID")
Dim sql_result = DT_INDEX.Rows(0).Item("SQL_RESULT")
Dim NAME = DT_INDEX.Rows(0).Item("NAME")
If Not IsNothing(conid) And Not IsNothing(sql_result) And Not IsNothing(NAME) Then
For Each ctrl As Control In Me.Panel.Controls
If ctrl.Name = "cmb" & NAME.ToString Then
Dim cmb As ComboBox = ctrl
Dim sql As String = sql_result.ToString.ToUpper.Replace("@" & SearchString.ToUpper, Resultvalue)
connectionString = My.Database.Get_ConnectionStringforID(conid)
If connectionString Is Nothing = False Then
'SQL Befehl füllt die Auswahlliste
If connectionString.Contains("Initial Catalog=") Then
sqlCnn = New SqlConnection(connectionString)
sqlCnn.Open()
sqlCmd = New SqlCommand(sql, sqlCnn)
adapter.SelectCommand = sqlCmd
adapter.Fill(NewDataset)
ElseIf connectionString.StartsWith("Data Source=") And connectionString.Contains("SERVICE_NAME") Then
oracleConn = New OracleConnection(connectionString)
' Try
oracleConn.Open()
oracleCmd = New OracleCommand(sql, oracleConn)
oracleadapter.SelectCommand = oracleCmd
oracleadapter.Fill(NewDataset)
End If
If NewDataset.Tables(0).Rows.Count > 0 Then
cmb.Items.Clear()
'Die Standargrösse definieren
Dim newWidth As Integer = 300
For i = 0 To NewDataset.Tables(0).Rows.Count - 1
'MsgBox(NewDataset.Tables(0).Rows(i).Item(0))
cmb.Items.Add(NewDataset.Tables(0).Rows(i).Item(0))
Try
Dim text As String = NewDataset.Tables(0).Rows(i).Item(0)
If text.Length > 15 Then
Dim g As Graphics = cmb.CreateGraphics
If g.MeasureString(text, cmb.Font).Width + 30 > newWidth Then
newWidth = g.MeasureString(text, cmb.Font).Width + 30
End If
g.Dispose()
End If
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Anpassung Breite ComboBox:")
End Try
Next
cmb.Size = New Size(newWidth, 27)
cmb.AutoCompleteSource = AutoCompleteSource.ListItems
cmb.AutoCompleteMode = AutoCompleteMode.Suggest
End If
If connectionString.Contains("Initial Catalog=") Then
Try
adapter.Dispose()
sqlCmd.Dispose()
sqlCnn.Close()
Catch ex As Exception
End Try
Else
Try
oracleadapter.Dispose()
oracleCmd.Dispose()
oracleConn.Close()
Catch ex As Exception
End Try
End If
End If
End If
Next
End If
Catch ex As Exception
_Logger.Info(" - Unvorhergesehener Unexpected error in Renew_ComboboxResults - Fehler: " & vbNewLine & ex.Message)
_Logger.Error(ex.Message)
MsgBox(ex.Message, MsgBoxStyle.Critical, "Unvorhergesehener Unexpected error in Renew_ComboboxResults:")
End Try
End Sub
Public Function AddTextBox(indexname As String, y As Integer, text As String, DataType As String) As DevExpress.XtraEditors.TextEdit
Dim oEdit As New DevExpress.XtraEditors.TextEdit With {
.Name = "txt" & indexname,
.Size = New Size(260, 27),
.Location = New Point(11, y),
.Tag = New ControlMeta() With {
.IndexName = indexname,
.IndexType = DataType
}
}
Select Case DataType
Case "INTEGER"
oEdit.Properties.Mask.MaskType = DevExpress.XtraEditors.Mask.MaskType.Numeric
oEdit.Properties.Mask.EditMask = "d"
Console.WriteLine()
End Select
If text IsNot Nothing Then
oEdit.Text = text
oEdit.SelectAll()
End If
AddHandler oEdit.GotFocus, AddressOf OnTextBoxFocus
AddHandler oEdit.LostFocus, AddressOf OnTextBoxLostFocus
AddHandler oEdit.KeyUp, AddressOf OnTextBoxKeyUp
AddHandler oEdit.TextChanged, AddressOf OnTextBoxTextChanged
Return oEdit
End Function
Public Sub OnTextBoxFocus(sender As System.Object, e As System.EventArgs)
Dim oTextbox As DevExpress.XtraEditors.TextEdit = sender
oTextbox.BackColor = Color.Lime
oTextbox.SelectAll()
End Sub
Public Sub OnTextBoxTextChanged(sender As System.Object, e As System.EventArgs)
Dim oTextbox As DevExpress.XtraEditors.TextEdit = sender
Using oGraphics As Graphics = oTextbox.CreateGraphics()
oTextbox.Width = oGraphics.MeasureString(oTextbox.Text, oTextbox.Font).Width + 15
End Using
End Sub
Public Sub OnTextBoxLostFocus(sender As System.Object, e As System.EventArgs)
Dim oTextbox As DevExpress.XtraEditors.TextEdit = sender
oTextbox.BackColor = Color.White
End Sub
Public Sub OnTextBoxKeyUp(sender As System.Object, e As System.Windows.Forms.KeyEventArgs)
Dim oTextbox As DevExpress.XtraEditors.TextEdit = sender
If oTextbox.Text = String.Empty Then
Exit Sub
End If
If e.KeyCode = Keys.Return Or e.KeyCode = Keys.Enter Or e.KeyCode = Keys.Tab Then
PrepareDependingControl(oTextbox)
End If
If (e.KeyCode = Keys.Return) Then
SendKeys.Send("{TAB}")
End If
End Sub
Public Function AddDateTimePicker(indexname As String, y As Integer, DataType As String, Vorgabe As String) As DevExpress.XtraEditors.DateEdit
Dim oPicker As New DevExpress.XtraEditors.DateEdit With {
.Name = "dtp" & indexname,
.Size = New Size(260, 27),
.Location = New Point(11, y),
.Tag = New ControlMeta() With {
.IndexName = indexname,
.IndexType = DataType
}
}
If Vorgabe.ToUpper = "$NULL" Then
oPicker.EditValue = Nothing
ElseIf Vorgabe IsNot Nothing Then
oPicker.EditValue = Vorgabe
End If
oPicker.Properties.AppearanceFocused.BackColor = Color.Lime
Return oPicker
End Function
Sub OndtpChanged()
'offen was hier zu tun ist
End Sub
Private Sub PrepareDependingControl(Control As Control)
If TypeOf Control Is Label Then
Exit Sub
End If
Try
Dim oMeta = DirectCast(Control.Tag, ControlMeta)
Dim oIndexName As String = oMeta.IndexName
Dim oSQL = $"SELECT * FROM TBDD_INDEX_MAN WHERE SQL_RESULT LIKE '%{oIndexName}%'"
Dim oDatatable As DataTable = My.Database.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 = NotNull(oRow.Item("NAME"), "")
Dim oConnectionId As Integer = NotNull(oRow.Item("CONNECTION_ID"), -1)
Dim oControlSql As String = NotNull(oRow.Item("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 = Patterns.ReplaceUserValues(oControlSql, My.Application.User.GivenName, My.Application.User.Surname, My.Application.User.ShortName, My.Application.User.Language, My.Application.User.Email, My.Application.User.UserId, My.Application.Globix.CURRENT_DOCTYPE_ID)
oControlSql = Patterns.ReplaceInternalValues(oControlSql)
oControlSql = Patterns.ReplaceControlValues(oControlSql, Panel)
_Logger.Debug("SQL After Preparing: [{0}]", oControlSql)
_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 = My.Database.Get_ConnectionStringforID(SqlConnectionId)
Dim oDatatable As DataTable = My.Database.GetDatatableWithConnection(SqlCommand, oConnectionString)
Dim oFoundControl As Control = Nothing
For Each oControl As Control In Panel.Controls
If TypeOf oControl Is Label Then
Continue For
End If
Dim oMeta = DirectCast(oControl.Tag, 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)
End If
If oDatatable Is Nothing Then
_Logger.Warn("Error in SQL Command: {0}", SqlCommand)
End If
Select Case oFoundControl.GetType.Name
Case GetType(DevExpress.XtraEditors.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, DevExpress.XtraEditors.TextEdit).Text = oValue
End If
End If
Case GetType(LookupControl2).Name
_Logger.Debug("Setting Value for LookupControl [{0}]: [{1}]", oFoundControl.Name, "DATATABLE")
DirectCast(oFoundControl, LookupControl2).DataSource = oDatatable
Case GetType(ComboBox).Name
_Logger.Debug("Setting Value for Combobox [{0}]: [{1}]", oFoundControl.Name, "DATATABLE")
DirectCast(oFoundControl, 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
End Class

516
GUIs.ZooFlow/Globix/GlobixPatterns.vb Normal file
View File

@ -0,0 +1,516 @@
Imports System.Text.RegularExpressions
Imports DevExpress.XtraEditors
Imports DigitalData.Controls.LookupGrid
Imports DigitalData.Modules.Logging
Public Class GlobixPatterns
Private _Logger As Logger
Private _idbdata As clsIDBData
Public Sub New(LogConfig As LogConfig)
_Logger = LogConfig.GetLogger
_idbdata = New clsIDBData(LogConfig)
End Sub
' Complex patterns that rely on a datasource like a Database or Windream
Public Const PATTERN_WMI = "WMI"
Public Const PATTERN_IDBA = "IDBA"
Public Const PATTERN_CTRL = "CTRL"
' Simple patterns that only rely on .NET functions
Public Const PATTERN_INT = "INT"
' Simple patterns that rely on Data from the TBDD_USER table
Public Const PATTERN_USER = "USER"
Public Const USER_VALUE_PRENAME = "PRENAME"
Public Const USER_VALUE_SURNAME = "SURNAME"
Public Const USER_VALUE_EMAIL = "EMAIL"
Public Const USER_VALUE_SHORTNAME = "SHORTNAME"
Public Const USER_VALUE_LANGUAGE = "LANGUAGE"
Public Const USER_VALUE_USER_ID = "USER_ID"
Public Const USER_VALUE_PROFILE_ID = "PROFILE_ID"
Public Const INT_VALUE_USERNAME = "USERNAME"
Public Const INT_VALUE_MACHINE = "MACHINE"
Public Const INT_VALUE_DOMAIN = "DOMAIN"
Public Const INT_VALUE_DATE = "DATE"
Public Const MAX_TRY_COUNT = 500
Private myregex As Regex = New Regex("{#(\w+)#([\.\w\d\s_-]+)}+")
Private allPatterns As New List(Of String) From {PATTERN_WMI, PATTERN_CTRL, PATTERN_IDBA, PATTERN_USER, PATTERN_INT}
Private complexPatterns As New List(Of String) From {PATTERN_WMI, PATTERN_CTRL, PATTERN_IDBA}
Private simplePatterns As New List(Of String) From {PATTERN_USER, PATTERN_INT}
''' <summary>
''' Wraps a pattern-type and -value in the common format: {#type#value}
''' </summary>
Public Function WrapPatternValue(type As String, value As String) As String
Return New Pattern(type, value).ToString
End Function
Public Function ReplaceAllValues(input As String, panel As Panel, prename As Object, surname As Object, shortname As Object, language As Object, email As Object, userId As Object, profileId As Object, pissql As Boolean) As String
Try
Dim result = input
_Logger.Debug($"inputString BEFORE replacing: [{result}]")
result = ReplaceInternalValues(result)
result = ReplaceControlValues(result, panel)
result = ReplaceIDBAttributes(My.Application.Globix.CURRENT_DOC_ID, result, pissql)
result = ReplaceUserValues(result, prename, surname, shortname, language, email, userId, profileId)
_Logger.Debug($"inputString AFTER replacing: [{result}]")
Return result
Catch ex As Exception
_Logger.Error(ex)
_Logger.Info("Error in ReplaceAllValues:" & ex.Message)
End Try
End Function
Public Function ReplaceInternalValues(input As String) As String
Try
Dim result = input
' Replace Username(s)
While ContainsPatternAndValue(result, PATTERN_INT, INT_VALUE_USERNAME)
result = ReplacePattern(result, PATTERN_INT, Environment.UserName)
End While
' Replace Machinename(s)
While ContainsPatternAndValue(result, PATTERN_INT, INT_VALUE_MACHINE)
result = ReplacePattern(result, PATTERN_INT, Environment.MachineName)
End While
' Replace Domainname(s)
While ContainsPatternAndValue(result, PATTERN_INT, INT_VALUE_DOMAIN)
result = ReplacePattern(result, PATTERN_INT, Environment.UserDomainName)
End While
' Replace CurrentDate(s)
While ContainsPatternAndValue(result, PATTERN_INT, INT_VALUE_DATE)
result = ReplacePattern(result, PATTERN_INT, Now.ToShortDateString)
End While
_Logger.Debug("sql after ReplaceInternalValues: " & input)
Return result
Catch ex As Exception
_Logger.Error(ex)
_Logger.Info("Error in ReplaceInternalValues:" & ex.Message)
End Try
End Function
Public Function ReplaceUserValues(input As String, prename As Object, surname As Object, shortname As Object, language As String, email As Object, userId As Object, profileId As Object) As String
Try
Dim result = input
While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_PRENAME)
result = ReplacePattern(result, PATTERN_USER, prename)
End While
While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_USER_ID)
result = ReplacePattern(result, PATTERN_USER, userId)
End While
While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_SURNAME)
result = ReplacePattern(result, PATTERN_USER, surname)
End While
If IsDBNull(shortname) Then
shortname = ""
End If
While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_SHORTNAME)
result = ReplacePattern(result, PATTERN_USER, shortname)
End While
While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_LANGUAGE)
result = ReplacePattern(result, PATTERN_USER, language)
End While
While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_EMAIL)
result = ReplacePattern(result, PATTERN_USER, email)
End While
While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_PROFILE_ID)
result = ReplacePattern(result, PATTERN_USER, profileId)
End While
_Logger.Debug("sql after ReplaceUserValues: " & input)
Return result
Catch ex As Exception
_Logger.Error(ex)
_Logger.Info("Error in ReplaceUserValues:" & ex.Message)
End Try
End Function
Public Function ReplaceControlValues(input As String, panel As Panel) As String
Try
Dim result = input
Dim oTryCounter = 0
_Logger.Debug("Input String: [{0}]", input)
While ContainsPattern(result, PATTERN_CTRL)
_Logger.Debug("ReplaceControlValues Try no. [{0}]", oTryCounter)
If oTryCounter > MAX_TRY_COUNT Then
Throw New Exception($"Max tries in ReplaceControlValues exceeded - Result so far [{result}].")
End If
_Logger.Debug("Getting next pattern..")
Dim oNextPattern = GetNextPattern(result, PATTERN_CTRL)
If oNextPattern Is Nothing Then
_Logger.Debug("No Next Pattern found. Exiting!")
Exit While
End If
_Logger.Debug("Next Pattern Value: [{0}]", oNextPattern.Value)
_Logger.Debug("Next Pattern Type: [{0}]", oNextPattern.Type)
Dim controlName As String = oNextPattern.Value
Dim oFoundControl As Control = Nothing
Dim oFoundType As String = Nothing
For Each oControl As Control In panel.Controls
If TypeOf oControl Is Label Then
Continue For
End If
_Logger.Debug("Getting control metadata from Control: [{0}]", oControl.Name)
If oControl.Tag Is Nothing Then
_Logger.Warn("No Metadata object found for control [{0}]. Skipping.", oControl.Name)
Continue For
End If
Dim oMeta = TryCast(oControl.Tag, GlobixControls.ControlMeta)
_Logger.Debug("Metadata IndexName: [{0}]", oMeta.IndexName)
_Logger.Debug("Metadata IndexType: [{0}]", oMeta.IndexType)
_Logger.Debug("Checking Control Name matches..")
If oMeta Is Nothing Then
_Logger.Warn("No Metadata found for control [{0}]. Skipping.", oControl.Name)
Continue For
End If
If oMeta.IndexName = controlName Then
_Logger.Debug("Control Name matches! Matching Control: [{0}]", controlName)
oFoundControl = oControl
oFoundType = oMeta.IndexType
Exit For
End If
Next
If oFoundControl IsNot Nothing Then
Dim oValue As String = String.Empty
_Logger.Debug("Found Control [{0}], continuing with setting value..", oFoundControl.Name)
If TypeOf oFoundControl Is TextEdit Then
Try
oValue = DirectCast(oFoundControl, TextEdit).Text
Catch ex As Exception
_Logger.Error(ex)
_Logger.Warn("Control Value for TextBox [{0}] could not be retrieved!", oFoundControl.Name)
End Try
ElseIf TypeOf oFoundControl Is CheckBox Then
Try
oValue = IIf(DirectCast(oFoundControl, CheckBox).Checked, 1, 0)
Catch ex As Exception
_Logger.Error(ex)
_Logger.Warn("Control Value for CheckBox [{0}] could not be retrieved!", oFoundControl.Name)
End Try
ElseIf TypeOf oFoundControl Is LookupControl2 Then
Try
Dim oLookupControl = DirectCast(oFoundControl, LookupControl2)
If oLookupControl.MultiSelect Then
Select Case oFoundType
Case "INTEGER"
oValue = String.Join(",", oLookupControl.SelectedValues)
Case "VARCHAR"
Dim oWrapped = oLookupControl.SelectedValues
oValue = String.Join(",", oWrapped)
Case Else
_Logger.Warn("Lookup Control with [{0}] is not supported!", oFoundType)
End Select
Else
oValue = NotNull(oLookupControl.SelectedValues.Item(0), "")
End If
Catch ex As Exception
_Logger.Error(ex)
_Logger.Warn("Control Value for LookupControl2 [{0}] could not be retrieved!", oFoundControl.Name)
End Try
Else
_Logger.Debug("Unknown Control type for type [{0}], setting value to empty string.", oFoundControl.Name)
oValue = ""
End If
_Logger.Debug("Retrieved Value from Control [{0}] is: [{1}]", controlName, oValue)
result = ReplacePattern(result, PATTERN_CTRL, oValue)
Else
_Logger.Warn("Control [{0}] not found!", controlName)
End If
oTryCounter += 1
End While
_Logger.Debug("input after ReplaceControlValues [{input}]")
Return result
Catch ex As Exception
_Logger.Error(ex)
_Logger.Info("Error in ReplaceControlValues:" & ex.Message)
Return input
End Try
End Function
Public Function ReplaceIDBAttributes(IDB_OBJ_ID As Long, pInput As String, IS_SQL As Boolean) As String
Try
Dim result = pInput
Dim oTryCounter As Integer = 0
While ContainsPattern(result, PATTERN_IDBA)
Dim indexName As String = GetNextPattern(result, PATTERN_IDBA).Value
Dim oIDBValue
If indexName = "ObjectID" Then
oIDBValue = IDB_OBJ_ID
ElseIf indexName = "OBJID" Then
oIDBValue = IDB_OBJ_ID
ElseIf indexName = "DocID" Then
oIDBValue = IDB_OBJ_ID
Else
oIDBValue = _idbdata.GetVariableValue(indexName)
End If
If IsNothing(oIDBValue) And oTryCounter = MAX_TRY_COUNT Then
_Logger.Warn($"Max tries for [{indexName}] in ReplaceIDBAttributes exceeded - Replacing with [0]!")
Dim oReplaceValue = "{" + $"#{PATTERN_IDBA}#{indexName}" + "}"
result = result.Replace(oReplaceValue, 0)
Throw New Exception("Max tries in ReplaceIDBAttributes exceeded.")
End If
If oIDBValue IsNot Nothing Or Not IsDBNull(oIDBValue) Then
Dim oReplaceValue = "{" + $"#{PATTERN_IDBA}#{indexName}" + "}"
If IS_SQL = True Then
_Logger.Debug($"IS_SQL = True - oReplaceValue = [{oReplaceValue}]")
If indexName <> "ObjectID" And indexName <> "OBJID" And indexName <> "DocID" Then
Try
oIDBValue = oIDBValue.Replace("'", "''")
Catch ex As Exception
_Logger.Warn($"Invalid IDBValue for [{indexName}] in ReplaceIDBAttributes [{ex.Message}] - Replacing with [0]!")
oIDBValue = 0
End Try
End If
_Logger.Debug($"oIDBValue = {oIDBValue}")
End If
result = result.Replace(oReplaceValue, oIDBValue)
Else
_Logger.Warn($"IDBValue for [{indexName}] in ReplaceIDBAttributes is nothing or dbnull - Replacing with [0]!")
Dim oReplaceValue = "{" + $"#{PATTERN_IDBA}#{indexName}" + "}"
result = result.Replace(oReplaceValue, 0)
End If
oTryCounter += 100
End While
_Logger.Debug("sql after ReplaceIDBAttributes: " & pInput)
Return result
Catch ex As Exception
_Logger.Error(ex)
_Logger.Info("Error in ReplaceIDBAttributes:" & ex.Message)
End Try
End Function
'Public Function ReplaceWindreamIndicies(input As String, document As WMObject) As String
' Try
' Dim result = input
' Dim oTryCounter As Integer = 0
' While ContainsPattern(result, PATTERN_WMI)
' Dim indexName As String = GetNextPattern(result, PATTERN_WMI).Value
' Dim oWMValue = document.GetVariableValue(indexName)
' If IsNothing(oWMValue) And oTryCounter = MAX_TRY_COUNT Then
' _Logger.Warn("Exit from ReplaceWindreamIndicies as oWMValue is still nothing and oTryCounter is 500!")
' Throw New Exception("Max tries in ReplaceWindreamIndicies exceeded.")
' End If
' If oWMValue IsNot Nothing Then
' result = ReplacePattern(result, PATTERN_WMI, oWMValue)
' End If
' oTryCounter += 100
' End While
' _Logger.Debug("sql after ReplaceWindreamIndicies: " & input)
' Return result
' Catch ex As Exception
' _Logger.Error(ex)
' _Logger.Info("Error in ReplaceWindreamIndicies:" & ex.Message)
' End Try
'End Function
'Public Function ReplaceIDBAttributes(input As String) As String
' Try
' Dim result = input
' Dim oTryCounter As Integer = 0
' While ContainsPattern(result, PATTERN_IDBA)
' Dim indexName As String = GetNextPattern(result, PATTERN_IDBA).Value
' Dim oIDBValue
' If indexName = "ObjectID" Then
' oIDBValue = CURRENT_DOC_ID
' ElseIf indexName = "OBJID" Then
' oIDBValue = CURRENT_DOC_ID
' ElseIf indexName = "DocID" Then
' oIDBValue = CURRENT_DOC_ID
' Else
' oIDBValue = IDBData.GetVariableValue(indexName)
' End If
' If IsNothing(oIDBValue) And oTryCounter = MAX_TRY_COUNT Then
' _Logger.Warn("Exit from ReplaceIDBIndicies as Value is still nothing and oTryCounter is 500!")
' Throw New Exception("Max tries in ReplaceIDBAttributes exceeded.")
' End If
' If oIDBValue IsNot Nothing Then
' Dim oReplaceValue = "{" + $"#{PATTERN_IDBA}#{indexName}" + "}"
' result = result.Replace(oReplaceValue, oIDBValue)
' 'result = ReplacePattern(result, oReplaceValue, oIDBValue)
' End If
' oTryCounter += 100
' End While
' _Logger.Debug("sql after ReplaceIDBAttributes: " & input)
' Return result
' Catch ex As Exception
' _Logger.Error(ex)
' _Logger.Info("Error in ReplaceIDBAttributes:" & ex.Message)
' End Try
'End Function
Private Function ContainsPattern(input As String, type As String) As String
Dim elements As MatchCollection = myregex.Matches(input)
For Each element As Match In elements
Dim t As String = element.Groups(1).Value
If t = type Then
Return True
End If
Next
Return False
End Function
Public Function GetNextPattern(input As String, type As String) As Pattern
Dim elements As MatchCollection = myregex.Matches(input)
For Each element As Match In elements
' Pattern in input
Dim t As String = element.Groups(1).Value
Dim v As String = element.Groups(2).Value
If t = type Then
Return New Pattern(t, v)
End If
Next
Return Nothing
End Function
Public Function GetAllPatterns(input As String) As List(Of Pattern)
Dim elements As MatchCollection = myregex.Matches(input)
Dim results As New List(Of Pattern)
For Each element As Match In elements
' Pattern in input
Dim t As String = element.Groups(1).Value
Dim v As String = element.Groups(2).Value
results.Add(New Pattern(t, v))
Next
Return results
End Function
Public Function ReplacePattern(input As String, type As String, replacement As String) As String
Dim elements As MatchCollection = myregex.Matches(input)
If IsNothing(replacement) Then
Return input
End If
For Each element As Match In elements
' if group 1 contains the 'pattern' the replace whole group with 'replacement'
' and return it
If element.Groups(1).Value = type Then
Return Regex.Replace(input, element.Groups(0).Value, replacement)
End If
Next
' no replacement made
Return input
End Function
Private Function ContainsPatternAndValue(input As String, type As String, value As String) As Boolean
Dim elements As MatchCollection = myregex.Matches(input)
For Each element As Match In elements
' Pattern in input
Dim t As String = element.Groups(1).Value
Dim v As String = element.Groups(2).Value
If t = type And v = value Then
Return True
End If
Next
Return False
End Function
Public Function HasAnyPatterns(input) As Boolean
Return allPatterns.Any(Function(p)
Return HasPattern(input, p)
End Function)
End Function
Public Function HasOnlySimplePatterns(input As String) As Boolean
Return Not HasComplexPatterns(input)
End Function
Public Function HasComplexPatterns(input As String) As Boolean
Return complexPatterns.Any(Function(p)
Return HasPattern(input, p)
End Function)
End Function
Public Function HasPattern(input As String, type As String) As Boolean
Dim matches = myregex.Matches(input)
For Each match As Match In matches
For Each group As Group In match.Groups
If group.Value = type Then
Return True
End If
Next
Next
Return False
End Function
Public Class Pattern
Public ReadOnly Property Type As String
Public ReadOnly Property Value As String
Public Sub New(type As String, value As String)
Me.Type = type
Me.Value = value
End Sub
'Public Sub New(stringRepresentation As String)
' Dim elements As MatchCollection = myregex.Matches(stringRepresentation)
' Dim first As Match = elements.Item(0)
' Dim t As String = first.Groups(1).Value
' Dim v As String = first.Groups(2).Value
' Type = t
' Value = v
'End Sub
Public Overrides Function ToString() As String
Return $"{{#{Type}#{Value}}}"
End Function
End Class
End Class

95
GUIs.ZooFlow/Globix/GlobixPostprocessing.vb Normal file
View File

@ -0,0 +1,95 @@
Imports System.Text.RegularExpressions
Imports DigitalData.Modules.Logging
Public Class GlobixPostprocessing
Private _Logger As Logger
Public Sub New(LogConfig As LogConfig)
_Logger = LogConfig.GetLogger
End Sub
Private Const VBSPLIT = "VBSPLIT"
Private Const VBREPLACE = "VBREPLACE"
Private Const REGEXPRESSION = "REG. EXPRESSION"
Public Function Get_Nachbearbeitung_Wert(idxvalue As String, Datatable As DataTable) As String
Dim oIndexValues As List(Of String) = idxvalue.Split("~").ToList()
Try
For Each oDataRow As DataRow In Datatable.Rows
Dim oResult As New List(Of String)
Dim oType As String = oDataRow.Item("TYPE").ToString.ToUpper
Select Case oType
Case VBSPLIT
_Logger.Info(" ...Nachbearbeitung mit VBSPLIT")
Dim oSeparator As String = oDataRow.Item("TEXT1")
Dim oSplitIndex As Integer = 0
Integer.TryParse(oDataRow.Item("TEXT2"), oSplitIndex)
For Each oIndexValue In oIndexValues
Dim oSplitted As List(Of String) = oIndexValue.Split(oSeparator).ToList()
oResult.Add(oSplitted.Item(oSplitIndex))
Next
Case VBREPLACE
Dim oFindString = oDataRow.Item("TEXT1")
Dim oReplaceString = oDataRow.Item("TEXT2")
_Logger.Info(" ...Nachbearbeitung mit VBREPLACE")
_Logger.Info(" ...Ersetze '" & oFindString & "' mit '" & oReplaceString & "'")
For Each oIndexValue In oIndexValues
Dim oReplaceResult = oIndexValue.Replace(oFindString, oReplaceString)
oResult.Add(oReplaceResult)
Next
Case REGEXPRESSION
_Logger.Info(" ...Nachbearbeitung mit RegEx")
Dim oRegexList As New List(Of Regex)
Dim oRegex As New Regex(oDataRow.Item("TEXT1"), RegexOptions.IgnoreCase)
oRegexList.Add(oRegex)
For Each oIndexValue In oIndexValues
Dim oProcessedString = extractFromStringviaRE(oIndexValue, oRegexList)
oResult.Add(oProcessedString)
_Logger.Info(" ...Ergebnis des RegEx: " & oProcessedString)
Next
End Select
oIndexValues = oResult
Next
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Get_Nachbearbeitung_Wert:")
_Logger.Info(" - Unvorhergesehener Unexpected error in Get_Nachbearbeitung_Wert - result: " & idxvalue & " - Fehler: " & vbNewLine & ex.Message)
End Try
Return String.Join("~", oIndexValues.ToArray)
End Function
''' <summary>
''' Extrahiert aus dem String anhand einer Liste von Regular Expressions ein Ergebnis.
''' </summary>
''' <param name="SearchString">Der zu untersuchende String erzeugt wurden.</param>
''' <param name="RegexList">Eine Liste von Regular Expressions</param>
''' <param name="RegexGroup">Die Ergebnisgruppe, die die Adresse enthält</param>
''' <returns>Eine Emailadresse oder Nothing, wenn keine der Regular Expressions ein Ergebnis lieferte.</returns>
Public Function extractFromStringviaRE(SearchString As String, RegexList As List(Of Regex), Optional RegexGroup As Integer = 1)
If IsNothing(SearchString) Then
Return Nothing
End If
For Each rx In RegexList
Dim match As Match = rx.Match(SearchString)
Dim result As String = match.Groups(RegexGroup).Value
If Not String.IsNullOrWhiteSpace(result) Then
'Nur den ersten Wert zurückgeben
Return result
End If
Next
Return Nothing
End Function
End Class

20
GUIs.ZooFlow/Globix/State.vb
View File

@ -9,12 +9,32 @@
Public Property CURRENT_FILENAME As String
Public Property CURRENT_WORKFILE_GUID As Long
Public Property CURRENT_WORKFILE As String
Public Property CURRENT_WORKFILE_EXTENSION As String
Public Property CURRENT_NEWFILENAME As String
Public Property CURRENT_DOC_ID As Long
Public Property ABORT_INDEXING As Boolean = False
Public Property INDEXING_ACTIVE As Boolean = False
Public Property CURRENT_ISATTACHMENT As Boolean = False
Public Property CURR_DELETE_ORIGIN As Boolean = False
Public Property CURRENT_DROPTYPE As String
Public Property CURRENT_LASTDOCTYPE As String
Public Property CURRENT_DOCTYPE_ID As Int16
Public Property CURRENT_DOCTYPE_DuplicateHandling As String
Public Property MULTIINDEXING_ACTIVE As Boolean = False
Public Property ECMDirect As Boolean = True
Public Property CURRENT_PROFILE_LOG_INDEX As String
Public Property ShowIndexResult As Boolean = True
Public Property CURR_MAN_INDEXE As DataTable
Public Property CURR_AUTO_INDEXE As DataTable
Public Property CURR_INDEX_MAN_POSTPROCESSING As DataTable
Public Property FILE_DELIMITER As String
Public Property VERSION_DELIMITER As String
Public Property CURRENT_MESSAGEID As String
Public Property CURRENT_BusinessEntity As String
Public Function FileExistsinDropTable(Filename As String) As Boolean
Dim oSQL As String
Try

60
GUIs.ZooFlow/ModuleHelpers.vb Normal file
View File

@ -0,0 +1,60 @@
Imports System.Text
Imports System.Text.RegularExpressions
Module ModuleHelpers
''' <summary>
''' Überprüft einen Wert auf verschiedene Arten von "Null" und gibt einen Standard-Wert zurück, wenn der Wert "Null" ist.
''' </summary>
''' <param name="value">Der zu überprüfende Wert</param>
''' <param name="defaultValue">Der Standard Wert</param>
''' <returns>value oder wenn dieser "Null" ist, defaultValue</returns>
Public Function NotNull(Of T)(ByVal value As T, ByVal defaultValue As T) As T
If IsNothing(value) OrElse String.IsNullOrEmpty(value.ToString) OrElse IsDBNull(value) Then
Return defaultValue
Else
Return value
End If
End Function
Public Function encode_utf8(ByVal str As String) As String
Try
'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)
Catch ex As Exception
MsgBox("Unexpected error in encode_utf8: " & ex.Message, MsgBoxStyle.Critical)
Return Nothing
End Try
End Function
Public Function StringAsUtf8Bytes(ByVal strData As String) As Byte()
Try
Dim bytes() As Byte
' get unicode string as bytes
bytes = Encoding.UTF8.GetBytes(strData)
' return byte data
Return bytes
Catch ex As Exception
MsgBox("Unexpected error in StringAsUtf8Bytes: " & ex.Message, MsgBoxStyle.Critical)
Return Nothing
End Try
End Function
Public Function CheckSpecialSigns(ByVal str As String)
Try
Dim pattern As String = "[!""#$%&'()*+,\-./:;<=>?@[\\\]^_`{|}~\s]"
Dim matches As MatchCollection = Regex.Matches(str, pattern)
Return matches.Count
Catch ex As Exception
MsgBox("Unexpected error in CheckSpecialSigns: " & ex.Message, MsgBoxStyle.Critical)
Return 0
End Try
End Function
Public Sub Refresh_RegexTable()
My.Application.BASE_DATA_DT_REGEX = My.Database.GetDatatable("SELECT * FROM TBGI_FUNCTION_REGEX")
End Sub
End Module

6
GUIs.ZooFlow/MyApplication.vb
View File

@ -26,6 +26,7 @@ Namespace My
End Property
Property DTAttributes As DataTable
Property IDB_DT_DOC_DATA As DataTable
Property LogConfig As LogConfig
Property MainForm As frmAdministrationZooFlow
Property SearchForm As frmSearchStart
@ -52,6 +53,11 @@ Namespace My
Public CommandLineFunction As String
Public CommandLineArguments As New Dictionary(Of String, String)
Public Property IDB_DT_DOC_DATA As DataTable
Public Property BASE_DATA_DT_REGEX As DataTable
End Class
End Namespace

12
GUIs.ZooFlow/ZooFlow.vbproj
View File

@ -58,6 +58,9 @@
<Reference Include="DigitalData.Controls.DocumentViewer">
<HintPath>..\Controls.DocumentViewer\bin\Debug\DigitalData.Controls.DocumentViewer.dll</HintPath>
</Reference>
<Reference Include="DigitalData.Controls.LookupGrid">
<HintPath>..\Controls.LookupGrid\bin\Debug\DigitalData.Controls.LookupGrid.dll</HintPath>
</Reference>
<Reference Include="DigitalData.GUIs.Common">
<HintPath>..\GUIs.Common\bin\Debug\DigitalData.GUIs.Common.dll</HintPath>
</Reference>
@ -72,6 +75,10 @@
<Reference Include="NLog, Version=4.0.0.0, Culture=neutral, PublicKeyToken=5120e14c03d0593c, processorArchitecture=MSIL">
<HintPath>..\packages\NLog.4.7.0\lib\net45\NLog.dll</HintPath>
</Reference>
<Reference Include="Oracle.ManagedDataAccess, Version=4.121.1.0, Culture=neutral, PublicKeyToken=89b483f429c47342, processorArchitecture=MSIL">
<SpecificVersion>False</SpecificVersion>
<HintPath>P:\Visual Studio Projekte\Bibliotheken\Oracle.ManagedDataAccess.dll</HintPath>
</Reference>
<Reference Include="System" />
<Reference Include="System.ComponentModel.DataAnnotations" />
<Reference Include="System.Configuration" />
@ -114,6 +121,7 @@
<Compile Include="ClassLayout.vb" />
<Compile Include="ClassWin32.vb" />
<Compile Include="ClipboardWatcher\State.vb" />
<Compile Include="clsIDBData.vb" />
<Compile Include="DSIDB_Stammdaten.Designer.vb">
<AutoGen>True</AutoGen>
<DesignTime>True</DesignTime>
@ -157,7 +165,11 @@
<Compile Include="frmSearchStart.vb">
<SubType>Form</SubType>
</Compile>
<Compile Include="Globix\GlobixControls.vb" />
<Compile Include="Globix\GlobixPatterns.vb" />
<Compile Include="Globix\GlobixPostprocessing.vb" />
<Compile Include="Globix\State.vb" />
<Compile Include="ModuleHelpers.vb" />
<Compile Include="My Project\Resources.Designer.vb">
<AutoGen>True</AutoGen>
<DesignTime>True</DesignTime>

231
GUIs.ZooFlow/clsIDBData.vb Normal file
View File

@ -0,0 +1,231 @@
Imports DigitalData.Modules.Logging
Public Class clsIDBData
Public DTVWIDB_BE_ATTRIBUTE As DataTable
''' <summary>
''' Gets all indices by BusinessEntity.
''' </summary>
''' <param name="BusinessEntity">Title of Business Entity</param>
''' <returns>Array with all Indices</returns>
''' <remarks></remarks>
'''
Private _Logger As Logger
Public Sub New(LogConfig As LogConfig)
_Logger = LogConfig.GetLogger
Dim oSQL = $"SELECT * FROM VWIDB_BE_ATTRIBUTE"
DTVWIDB_BE_ATTRIBUTE = My.DatabaseIDB.GetDatatable(oSQL)
End Sub
Public IDBSystemIndices As List(Of String)
Public Function GetIndicesByBE(ByVal BusinessEntity As String) As String()
Try
Dim aNames(4) As String
aNames(0) = "ObjectID"
aNames(1) = "IDBCreatedWhen"
aNames(2) = "IDBCreatedWho"
aNames(3) = "IDBChangedWhen"
aNames(4) = "IDBChangedWho"
IDBSystemIndices = aNames.ToList
' Array für Indizes vorbereiten
Dim aIndexNames(DTVWIDB_BE_ATTRIBUTE.Rows.Count + 4) As String
Dim oCount As Integer = 0
aIndexNames(oCount) = "ObjectID"
oCount += 1
aIndexNames(oCount) = "IDBCreatedWhen"
oCount += 1
aIndexNames(oCount) = "IDBCreatedWho"
oCount += 1
aIndexNames(oCount) = "IDBChangedWhen"
oCount += 1
aIndexNames(oCount) = "IDBChangedWho"
For Each oRow As DataRow In DTVWIDB_BE_ATTRIBUTE.Rows
oCount += 1
aIndexNames(oCount) = oRow.Item("ATTR_TITLE")
Next
' Indexarray sortiert zurückgeben
Array.Sort(aIndexNames)
' Indexarray zurückgeben
Return aIndexNames
Catch ex As Exception
_Logger.Error(ex)
MsgBox(ex.Message, MsgBoxStyle.Critical, "Error getting the IDB Indicies")
Return Nothing
End Try
End Function
Public Function GetTypeOfIndex(ByVal indexname As String) As Integer
Try
For Each oRow As DataRow In DTVWIDB_BE_ATTRIBUTE.Rows
If oRow.Item("ATTR_TITLE") = indexname Then
Dim oType = oRow.Item("TYP_ID")
Return oType
End If
Next
Catch ex As Exception
_Logger.Error(ex)
Return Nothing
End Try
End Function
Public Function GetVariableValue(oAttributeName As String, Optional oIDBTyp As Integer = 0, Optional FromIDB As Boolean = False) As Object
Try
Dim oSingleAttribute As Boolean = True
Select Case oIDBTyp
Case 8
oSingleAttribute = False
Case 9
oSingleAttribute = False
End Select
Dim oAttributeValue
If Not IsNothing(My.Application.IDB_DT_DOC_DATA) Then
If oSingleAttribute = True And My.Application.IDB_DT_DOC_DATA.Rows.Count = 1 And FromIDB = False Then
Try
If oAttributeName = "IDBCreatedWhen" Then
oAttributeName = "ADDED_WHEN"
ElseIf oAttributeName = "IDBCreatedWho" Then
oAttributeName = "ADDED_WHO"
ElseIf oAttributeName = "IDBChangedWhen" Then
oAttributeName = "CHANGED_WHEN"
ElseIf oAttributeName = "IDBChangedWho" Then
oAttributeName = "CHANGED_WHO"
End If
oAttributeValue = My.Application.IDB_DT_DOC_DATA.Rows(0).Item(oAttributeName)
Catch ex As Exception
_Logger.Debug($"Error getting Attribute from IDB_DT_DOC_DATA: {ex.Message}")
End Try
End If
End If
If Not IsNothing(oAttributeValue) Then
Return oAttributeValue
Else
_Logger.Debug($"oAttributeValue for Attribute [{oAttributeName}] is so far nothing..Now trying FNIDB_PM_GET_VARIABLE_VALUE ")
End If
Dim oFNSQL = $"SELECT * FROM [dbo].[FNIDB_PM_GET_VARIABLE_VALUE] ({My.Application.Globix.CURRENT_DOC_ID},'{oAttributeName}','{My.Application.User.Language}',CONVERT(BIT,'0'))"
oAttributeValue = My.DatabaseIDB.GetDatatable(oFNSQL)
Dim odt As DataTable = oAttributeValue
If odt.Rows.Count = 1 Then
oAttributeValue = odt.Rows(0).Item(0)
End If
Return oAttributeValue
Catch ex As Exception
_Logger.Error(ex)
Return Nothing
End Try
End Function
Public Function Delete_Term_Object_From_Metadata(oAttributeName As String, oTerm2Delete As String) As Object
Try
Dim oAttributeValue
Dim oID_IS_FOREIGN As Integer
oID_IS_FOREIGN = 1
Dim oDELSQL = $"EXEC PRIDB_DELETE_TERM_OBJECT_METADATA {My.Application.Globix.CURRENT_DOC_ID},'{oAttributeName}','{oTerm2Delete}','{My.Application.User.UserName}','{My.Application.User.Language}',{oID_IS_FOREIGN}"
My.DatabaseIDB.ExecuteNonQuery(oDELSQL)
Catch ex As Exception
_Logger.Error(ex)
Return Nothing
End Try
End Function
Public Function Delete_AttributeData(pIDB_OBJID As Int64, pAttributeName As String) As Object
Try
Dim oDELSQL = $"EXEC PRIDB_DELETE_ATTRIBUTE_DATA {pIDB_OBJID},'{pAttributeName}','{My.Application.User.UserName}'"
My.DatabaseIDB.ExecuteNonQuery(oDELSQL)
Catch ex As Exception
_Logger.Error(ex)
Return Nothing
End Try
End Function
Public Function SetVariableValue(oAttributeName As String, oNewValue As Object, Optional CheckDeleted As Boolean = False, Optional oIDBTyp As Integer = 0)
Try
Dim omytype = oNewValue.GetType.ToString
If omytype = "System.Data.DataTable" Then
Dim oDTMyNewValues As DataTable = oNewValue
Dim oOldAttributeResult
Dim oTypeOldResult
If CheckDeleted = True Then
oOldAttributeResult = GetVariableValue(oAttributeName, oIDBTyp)
oTypeOldResult = oOldAttributeResult.GetType.ToString
If oTypeOldResult = "System.Data.DataTable" Then
Dim myOldValues As DataTable = oOldAttributeResult
If myOldValues.Rows.Count > 1 Then
'now Checking whether the old row still remains in Vector? If not it will be deleted as it cannot be replaced in multivalues
For Each oOldValueRow As DataRow In myOldValues.Rows
Dim oExists As Boolean = False
For Each oNewValueRow As DataRow In oDTMyNewValues.Rows
Dim oInfo1 = $"Checking oldValue[{oOldValueRow.Item(0)}] vs NewValue [{oNewValueRow.Item(1)}]"
If oNewValueRow.Item(1).ToString.ToUpper = oOldValueRow.Item(0).ToString.ToUpper Then
oExists = True
Exit For
End If
Next
If oExists = False Then
Dim oInfo = $"Value [{oOldValueRow.Item(0)}] no longer existing in Vector-Attribute [{oAttributeName}] - will be deleted!"
_Logger.Info(oInfo)
SetVariableValue(My.Application.Globix.CURRENT_PROFILE_LOG_INDEX, oInfo)
Delete_Term_Object_From_Metadata(oAttributeName, oOldValueRow.Item(0))
End If
Next
End If
Else
If oDTMyNewValues.Rows.Count > 1 Then
Dim oExists As Boolean = False
For Each oNewValueRow As DataRow In oDTMyNewValues.Rows
Dim oInfo1 = $"Checking oldValue[{oOldAttributeResult}] vs NewValue [{oNewValueRow.Item(1)}]"
If oNewValueRow.Item(1).ToString.ToUpper = oOldAttributeResult.ToString.ToUpper Then
oExists = True
Exit For
End If
Next
If oExists = False Then
Dim oInfo2 = $"Value [{oOldAttributeResult}] no longer existing in Vector-Attribute [{oAttributeName}] - will be deleted!"
_Logger.Info(oInfo2)
SetVariableValue(My.Application.Globix.CURRENT_PROFILE_LOG_INDEX, oInfo2)
Delete_Term_Object_From_Metadata(oAttributeName, oOldAttributeResult)
End If
Else
Dim oInfo = $"Value [{oOldAttributeResult}] of Attribute [{oAttributeName}] obviously was updated during runtime - will be deleted!"
_Logger.Info(oInfo)
SetVariableValue(My.Application.Globix.CURRENT_PROFILE_LOG_INDEX, oInfo)
Delete_Term_Object_From_Metadata(oAttributeName, oOldAttributeResult)
End If
End If
End If
For Each oNewValueRow As DataRow In oDTMyNewValues.Rows
Dim oSuccess As Boolean = False
Dim oFNSQL = $"DECLARE @NEW_OBJ_MD_ID BIGINT " & vbNewLine & $"EXEC PRIDB_NEW_OBJ_DATA {My.Application.Globix.CURRENT_DOC_ID},'{oAttributeName}','{My.Application.User.UserName}','{oNewValueRow.Item(1).ToString}','{My.Application.User.Language}',0,@OMD_ID = @NEW_OBJ_MD_ID OUTPUT"
oSuccess = My.DatabaseIDB.ExecuteNonQuery(oFNSQL)
If oSuccess = False Then
Return False
End If
Next
Return True
Else
Dim oFNSQL = $"DECLARE @NEW_OBJ_MD_ID BIGINT " & vbNewLine & $"EXEC PRIDB_NEW_OBJ_DATA {My.Application.Globix.CURRENT_DOC_ID},'{oAttributeName}','{My.Application.User.UserName}','{oNewValue}','{My.Application.User.Language}',0,@OMD_ID = @NEW_OBJ_MD_ID OUTPUT"
Return My.DatabaseIDB.ExecuteNonQuery(oFNSQL)
End If
Catch ex As Exception
_Logger.Error(ex)
Return False
End Try
End Function
End Class

20
GUIs.ZooFlow/frmFlowForm.vb
View File

@ -49,14 +49,13 @@ Public Class frmFlowForm
' === Initialization ===
Init = New ClassInit(My.LogConfig, Me)
FileDrop = New ClassFileDrop(My.LogConfig)
FileHandle = New ClassFilehandle(My.LogConfig)
AddHandler Init.Completed, AddressOf Init_Completed
Init.InitializeApplication()
End Sub
Private Sub Init_Completed(sender As Object, e As EventArgs)
Me.Cursor = Cursors.WaitCursor
' === Initialization Complete ===
ApplicationLoading = False
SplashScreenManager.CloseForm(False)
@ -94,8 +93,13 @@ Public Class frmFlowForm
DTIDB_SEARCHES = oDatatable
PictureBoxSearch.Visible = True
End If
If My.Application.ModulesActive.Contains(ClassConstants.MODULE_GLOBAL_INDEXER) Then
FileDrop = New ClassFileDrop(My.LogConfig)
FileHandle = New ClassFilehandle(My.LogConfig)
Refresh_RegexTable()
End If
My.DTAttributes = My.DatabaseIDB.GetDatatable("SELECT * FROM TBIDB_ATTRIBUTE")
Me.Cursor = Cursors.Default
End Sub
@ -281,6 +285,9 @@ Public Class frmFlowForm
End If
End Sub
Sub DragDropForm(e As DragEventArgs)
If Not My.Application.ModulesActive.Contains(ClassConstants.MODULE_GLOBAL_INDEXER) Then
Exit Sub
End If
If TheFormIsAlreadyLoaded("frmIndexFileList") Then
Cursor = Cursors.Default
MsgBox("Please index the active file first!", MsgBoxStyle.Exclamation, "Drag 'n Drop not allowed!")
@ -302,6 +309,10 @@ Public Class frmFlowForm
End Sub
Private Sub TimerCheckDroppedFiles_Tick(sender As Object, e As EventArgs) Handles TimerCheckDroppedFiles.Tick
If Not My.Application.ModulesActive.Contains(ClassConstants.MODULE_GLOBAL_INDEXER) Then
Exit Sub
End If
TimerCheckDroppedFiles.Stop()
Check_Dropped_Files()
End Sub
@ -309,7 +320,8 @@ Public Class frmFlowForm
Try
My.Database.ExecuteNonQuery("DELETE FROM TBGI_FILES_USER WHERE WORKED = 1 AND UPPER(USER@WORK) = UPPER('" & Environment.UserName & "')")
Dim i As Integer
For Each Str As Object In ClassFileDrop.files_dropped
For Each Str As Object In FileDrop.files_dropped
If Not Str Is Nothing Then
Logger.Info(">> Check Drop-File: " & Str.ToString)
Dim handleType As String = Str.Substring(0, Str.LastIndexOf("|") + 1)

195
GUIs.ZooFlow/frmGlobix_Index.Designer.vb generated
View File

@ -28,26 +28,27 @@ Partial Class frmGlobix_Index
Me.BarButtonItem3 = New DevExpress.XtraBars.BarButtonItem()
Me.SkipItem = New DevExpress.XtraBars.BarButtonItem()
Me.BarButtonItem5 = New DevExpress.XtraBars.BarButtonItem()
Me.BarCheckItem1 = New DevExpress.XtraBars.BarCheckItem()
Me.checkItemTopMost = New DevExpress.XtraBars.BarCheckItem()
Me.SourceDeleteItem = New DevExpress.XtraBars.BarCheckItem()
Me.SaveProfileItem = New DevExpress.XtraBars.BarCheckItem()
Me.checkItemPreselection = New DevExpress.XtraBars.BarCheckItem()
Me.PreviewItem = New DevExpress.XtraBars.BarCheckItem()
Me.RibbonPage1 = New DevExpress.XtraBars.Ribbon.RibbonPage()
Me.RibbonPageGroup1 = New DevExpress.XtraBars.Ribbon.RibbonPageGroup()
Me.RibbonPageGroup2 = New DevExpress.XtraBars.Ribbon.RibbonPageGroup()
Me.RibbonStatusBar1 = New DevExpress.XtraBars.Ribbon.RibbonStatusBar()
Me.RibbonPage2 = New DevExpress.XtraBars.Ribbon.RibbonPage()
Me.BarCheckItem2 = New DevExpress.XtraBars.BarCheckItem()
Me.labelFilePath = New DevExpress.XtraBars.BarStaticItem()
Me.labelError = New DevExpress.XtraBars.BarStaticItem()
Me.labelNotice = New DevExpress.XtraBars.BarStaticItem()
Me.RibbonPageGroupMultiIndex = New DevExpress.XtraBars.Ribbon.RibbonPageGroup()
Me.chkMultiindexing = New DevExpress.XtraBars.BarCheckItem()
Me.RibbonPageGroup3 = New DevExpress.XtraBars.Ribbon.RibbonPageGroup()
Me.BarButtonItem1 = New DevExpress.XtraBars.BarButtonItem()
Me.RibbonPage1 = New DevExpress.XtraBars.Ribbon.RibbonPage()
Me.RibbonPageGroup3 = New DevExpress.XtraBars.Ribbon.RibbonPageGroup()
Me.RibbonPageGroup1 = New DevExpress.XtraBars.Ribbon.RibbonPageGroup()
Me.RibbonPageGroup2 = New DevExpress.XtraBars.Ribbon.RibbonPageGroup()
Me.RibbonPageGroupMultiIndex = New DevExpress.XtraBars.Ribbon.RibbonPageGroup()
Me.RibbonStatusBar1 = New DevExpress.XtraBars.Ribbon.RibbonStatusBar()
Me.RibbonPage2 = New DevExpress.XtraBars.Ribbon.RibbonPage()
Me.BarCheckItem2 = New DevExpress.XtraBars.BarCheckItem()
Me.SplitContainerControl1 = New DevExpress.XtraEditors.SplitContainerControl()
Me.pnlIndex = New System.Windows.Forms.Panel()
Me.Panel1 = New System.Windows.Forms.Panel()
Me.ComboBox1 = New System.Windows.Forms.ComboBox()
Me.cmbDoctype = New System.Windows.Forms.ComboBox()
Me.DocumentViewer1 = New DigitalData.Controls.DocumentViewer.DocumentViewer()
CType(Me.RibbonControl1, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.SplitContainerControl1, System.ComponentModel.ISupportInitialize).BeginInit()
@ -58,7 +59,7 @@ Partial Class frmGlobix_Index
'RibbonControl1
'
Me.RibbonControl1.ExpandCollapseItem.Id = 0
Me.RibbonControl1.Items.AddRange(New DevExpress.XtraBars.BarItem() {Me.RibbonControl1.ExpandCollapseItem, Me.RibbonControl1.SearchEditItem, Me.BarButtonItem2, Me.BarButtonItem3, Me.SkipItem, Me.BarButtonItem5, Me.BarCheckItem1, Me.SourceDeleteItem, Me.SaveProfileItem, Me.PreviewItem, Me.labelFilePath, Me.labelError, Me.labelNotice, Me.chkMultiindexing, Me.BarButtonItem1})
Me.RibbonControl1.Items.AddRange(New DevExpress.XtraBars.BarItem() {Me.RibbonControl1.ExpandCollapseItem, Me.RibbonControl1.SearchEditItem, Me.BarButtonItem2, Me.BarButtonItem3, Me.SkipItem, Me.BarButtonItem5, Me.checkItemTopMost, Me.SourceDeleteItem, Me.checkItemPreselection, Me.PreviewItem, Me.labelFilePath, Me.labelError, Me.labelNotice, Me.chkMultiindexing, Me.BarButtonItem1})
Me.RibbonControl1.Location = New System.Drawing.Point(0, 0)
Me.RibbonControl1.MaxItemId = 15
Me.RibbonControl1.Name = "RibbonControl1"
@ -95,14 +96,14 @@ Partial Class frmGlobix_Index
Me.BarButtonItem5.ImageOptions.SvgImage = CType(resources.GetObject("BarButtonItem5.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage)
Me.BarButtonItem5.Name = "BarButtonItem5"
'
'BarCheckItem1
'checkItemTopMost
'
Me.BarCheckItem1.BindableChecked = True
Me.BarCheckItem1.Caption = "Andere Fenster überdecken"
Me.BarCheckItem1.Checked = True
Me.BarCheckItem1.Id = 6
Me.BarCheckItem1.ImageOptions.SvgImage = CType(resources.GetObject("BarCheckItem1.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage)
Me.BarCheckItem1.Name = "BarCheckItem1"
Me.checkItemTopMost.BindableChecked = True
Me.checkItemTopMost.Caption = "Andere Fenster überdecken"
Me.checkItemTopMost.Checked = True
Me.checkItemTopMost.Id = 6
Me.checkItemTopMost.ImageOptions.SvgImage = CType(resources.GetObject("checkItemTopMost.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage)
Me.checkItemTopMost.Name = "checkItemTopMost"
'
'SourceDeleteItem
'
@ -111,12 +112,12 @@ Partial Class frmGlobix_Index
Me.SourceDeleteItem.ImageOptions.SvgImage = CType(resources.GetObject("SourceDeleteItem.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage)
Me.SourceDeleteItem.Name = "SourceDeleteItem"
'
'SaveProfileItem
'checkItemPreselection
'
Me.SaveProfileItem.Caption = "Profilauswahl merken"
Me.SaveProfileItem.Id = 8
Me.SaveProfileItem.ImageOptions.SvgImage = CType(resources.GetObject("SaveProfileItem.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage)
Me.SaveProfileItem.Name = "SaveProfileItem"
Me.checkItemPreselection.Caption = "Profilauswahl merken"
Me.checkItemPreselection.Id = 8
Me.checkItemPreselection.ImageOptions.SvgImage = CType(resources.GetObject("checkItemPreselection.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage)
Me.checkItemPreselection.Name = "checkItemPreselection"
'
'PreviewItem
'
@ -125,16 +126,63 @@ Partial Class frmGlobix_Index
Me.PreviewItem.ImageOptions.SvgImage = CType(resources.GetObject("PreviewItem.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage)
Me.PreviewItem.Name = "PreviewItem"
'
'labelFilePath
'
Me.labelFilePath.Caption = "labelFilePath"
Me.labelFilePath.Id = 10
Me.labelFilePath.ImageOptions.SvgImage = CType(resources.GetObject("labelFilePath.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage)
Me.labelFilePath.Name = "labelFilePath"
Me.labelFilePath.PaintStyle = DevExpress.XtraBars.BarItemPaintStyle.CaptionGlyph
'
'labelError
'
Me.labelError.Caption = "labelError"
Me.labelError.Id = 11
Me.labelError.ImageOptions.SvgImage = CType(resources.GetObject("labelError.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage)
Me.labelError.Name = "labelError"
Me.labelError.PaintStyle = DevExpress.XtraBars.BarItemPaintStyle.CaptionGlyph
'
'labelNotice
'
Me.labelNotice.Caption = "labelNotice"
Me.labelNotice.Id = 12
Me.labelNotice.ImageOptions.SvgImage = CType(resources.GetObject("labelNotice.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage)
Me.labelNotice.Name = "labelNotice"
Me.labelNotice.PaintStyle = DevExpress.XtraBars.BarItemPaintStyle.CaptionGlyph
'
'chkMultiindexing
'
Me.chkMultiindexing.Caption = "Inaktiv"
Me.chkMultiindexing.Id = 13
Me.chkMultiindexing.ImageOptions.SvgImage = CType(resources.GetObject("chkMultiindexing.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage)
Me.chkMultiindexing.ItemInMenuAppearance.Pressed.BackColor = System.Drawing.Color.FromArgb(CType(CType(255, Byte), Integer), CType(CType(128, Byte), Integer), CType(CType(0, Byte), Integer))
Me.chkMultiindexing.ItemInMenuAppearance.Pressed.Options.UseBackColor = True
Me.chkMultiindexing.Name = "chkMultiindexing"
'
'BarButtonItem1
'
Me.BarButtonItem1.Caption = "Starten"
Me.BarButtonItem1.Id = 14
Me.BarButtonItem1.ImageOptions.SvgImage = CType(resources.GetObject("BarButtonItem1.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage)
Me.BarButtonItem1.Name = "BarButtonItem1"
'
'RibbonPage1
'
Me.RibbonPage1.Groups.AddRange(New DevExpress.XtraBars.Ribbon.RibbonPageGroup() {Me.RibbonPageGroup3, Me.RibbonPageGroup1, Me.RibbonPageGroup2, Me.RibbonPageGroupMultiIndex})
Me.RibbonPage1.Name = "RibbonPage1"
Me.RibbonPage1.Text = "Start"
'
'RibbonPageGroup3
'
Me.RibbonPageGroup3.AllowTextClipping = False
Me.RibbonPageGroup3.ItemLinks.Add(Me.BarButtonItem1)
Me.RibbonPageGroup3.Name = "RibbonPageGroup3"
Me.RibbonPageGroup3.Text = "Datei verarbeiten"
'
'RibbonPageGroup1
'
Me.RibbonPageGroup1.ItemLinks.Add(Me.SourceDeleteItem)
Me.RibbonPageGroup1.ItemLinks.Add(Me.SaveProfileItem)
Me.RibbonPageGroup1.ItemLinks.Add(Me.checkItemPreselection)
Me.RibbonPageGroup1.ItemLinks.Add(Me.SkipItem)
Me.RibbonPageGroup1.ItemLinks.Add(Me.PreviewItem)
Me.RibbonPageGroup1.Name = "RibbonPageGroup1"
@ -143,10 +191,17 @@ Partial Class frmGlobix_Index
'RibbonPageGroup2
'
Me.RibbonPageGroup2.Alignment = DevExpress.XtraBars.Ribbon.RibbonPageGroupAlignment.Far
Me.RibbonPageGroup2.ItemLinks.Add(Me.BarCheckItem1)
Me.RibbonPageGroup2.ItemLinks.Add(Me.checkItemTopMost)
Me.RibbonPageGroup2.Name = "RibbonPageGroup2"
Me.RibbonPageGroup2.Text = "Fenster"
'
'RibbonPageGroupMultiIndex
'
Me.RibbonPageGroupMultiIndex.AllowTextClipping = False
Me.RibbonPageGroupMultiIndex.ItemLinks.Add(Me.chkMultiindexing)
Me.RibbonPageGroupMultiIndex.Name = "RibbonPageGroupMultiIndex"
Me.RibbonPageGroupMultiIndex.Text = "Multi-Indexing"
'
'RibbonStatusBar1
'
Me.RibbonStatusBar1.ItemLinks.Add(Me.labelFilePath)
@ -169,66 +224,13 @@ Partial Class frmGlobix_Index
Me.BarCheckItem2.ImageOptions.SvgImage = CType(resources.GetObject("BarCheckItem2.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage)
Me.BarCheckItem2.Name = "BarCheckItem2"
'
'labelFilePath
'
Me.labelFilePath.Caption = "labelFilePath"
Me.labelFilePath.Id = 10
Me.labelFilePath.ImageOptions.SvgImage = CType(resources.GetObject("labelFilePath.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage)
Me.labelFilePath.Name = "labelFilePath"
Me.labelFilePath.PaintStyle = DevExpress.XtraBars.BarItemPaintStyle.CaptionGlyph
'
'labelError
'
Me.labelError.Caption = "labelError"
Me.labelError.Id = 11
Me.labelError.ImageOptions.SvgImage = CType(resources.GetObject("BarStaticItem2.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage)
Me.labelError.Name = "labelError"
Me.labelError.PaintStyle = DevExpress.XtraBars.BarItemPaintStyle.CaptionGlyph
'
'labelNotice
'
Me.labelNotice.Caption = "labelNotice"
Me.labelNotice.Id = 12
Me.labelNotice.ImageOptions.SvgImage = CType(resources.GetObject("BarStaticItem3.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage)
Me.labelNotice.Name = "labelNotice"
Me.labelNotice.PaintStyle = DevExpress.XtraBars.BarItemPaintStyle.CaptionGlyph
'
'RibbonPageGroupMultiIndex
'
Me.RibbonPageGroupMultiIndex.AllowTextClipping = False
Me.RibbonPageGroupMultiIndex.ItemLinks.Add(Me.chkMultiindexing)
Me.RibbonPageGroupMultiIndex.Name = "RibbonPageGroupMultiIndex"
Me.RibbonPageGroupMultiIndex.Text = "Multi-Indexing"
'
'chkMultiindexing
'
Me.chkMultiindexing.Caption = "Inaktiv"
Me.chkMultiindexing.Id = 13
Me.chkMultiindexing.ImageOptions.SvgImage = CType(resources.GetObject("BarCheckItem3.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage)
Me.chkMultiindexing.ItemInMenuAppearance.Pressed.BackColor = System.Drawing.Color.FromArgb(CType(CType(255, Byte), Integer), CType(CType(128, Byte), Integer), CType(CType(0, Byte), Integer))
Me.chkMultiindexing.ItemInMenuAppearance.Pressed.Options.UseBackColor = True
Me.chkMultiindexing.Name = "chkMultiindexing"
'
'RibbonPageGroup3
'
Me.RibbonPageGroup3.AllowTextClipping = False
Me.RibbonPageGroup3.ItemLinks.Add(Me.BarButtonItem1)
Me.RibbonPageGroup3.Name = "RibbonPageGroup3"
Me.RibbonPageGroup3.Text = "Datei verarbeiten"
'
'BarButtonItem1
'
Me.BarButtonItem1.Caption = "Starten"
Me.BarButtonItem1.Id = 14
Me.BarButtonItem1.ImageOptions.SvgImage = CType(resources.GetObject("BarButtonItem1.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage)
Me.BarButtonItem1.Name = "BarButtonItem1"
'
'SplitContainerControl1
'
Me.SplitContainerControl1.CollapsePanel = DevExpress.XtraEditors.SplitCollapsePanel.Panel2
Me.SplitContainerControl1.Dock = System.Windows.Forms.DockStyle.Fill
Me.SplitContainerControl1.Location = New System.Drawing.Point(0, 159)
Me.SplitContainerControl1.Name = "SplitContainerControl1"
Me.SplitContainerControl1.Panel1.Controls.Add(Me.pnlIndex)
Me.SplitContainerControl1.Panel1.Controls.Add(Me.Panel1)
Me.SplitContainerControl1.Panel1.Text = "Panel1"
Me.SplitContainerControl1.Panel2.Controls.Add(Me.DocumentViewer1)
@ -237,25 +239,33 @@ Partial Class frmGlobix_Index
Me.SplitContainerControl1.SplitterPosition = 591
Me.SplitContainerControl1.TabIndex = 2
'
'pnlIndex
'
Me.pnlIndex.Dock = System.Windows.Forms.DockStyle.Fill
Me.pnlIndex.Location = New System.Drawing.Point(0, 56)
Me.pnlIndex.Name = "pnlIndex"
Me.pnlIndex.Size = New System.Drawing.Size(591, 359)
Me.pnlIndex.TabIndex = 1
'
'Panel1
'
Me.Panel1.Controls.Add(Me.ComboBox1)
Me.Panel1.Controls.Add(Me.cmbDoctype)
Me.Panel1.Dock = System.Windows.Forms.DockStyle.Top
Me.Panel1.Location = New System.Drawing.Point(0, 0)
Me.Panel1.Name = "Panel1"
Me.Panel1.Size = New System.Drawing.Size(591, 56)
Me.Panel1.TabIndex = 0
'
'ComboBox1
'cmbDoctype
'
Me.ComboBox1.Anchor = CType(((System.Windows.Forms.AnchorStyles.Top Or System.Windows.Forms.AnchorStyles.Left) _
Me.cmbDoctype.Anchor = CType(((System.Windows.Forms.AnchorStyles.Top Or System.Windows.Forms.AnchorStyles.Left) _
Or System.Windows.Forms.AnchorStyles.Right), System.Windows.Forms.AnchorStyles)
Me.ComboBox1.Font = New System.Drawing.Font("Segoe UI", 9.75!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
Me.ComboBox1.FormattingEnabled = True
Me.ComboBox1.Location = New System.Drawing.Point(12, 17)
Me.ComboBox1.Name = "ComboBox1"
Me.ComboBox1.Size = New System.Drawing.Size(555, 25)
Me.ComboBox1.TabIndex = 0
Me.cmbDoctype.Font = New System.Drawing.Font("Segoe UI", 9.75!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
Me.cmbDoctype.FormattingEnabled = True
Me.cmbDoctype.Location = New System.Drawing.Point(12, 17)
Me.cmbDoctype.Name = "cmbDoctype"
Me.cmbDoctype.Size = New System.Drawing.Size(555, 25)
Me.cmbDoctype.TabIndex = 0
'
'DocumentViewer1
'
@ -296,9 +306,9 @@ Partial Class frmGlobix_Index
Friend WithEvents BarButtonItem3 As DevExpress.XtraBars.BarButtonItem
Friend WithEvents SkipItem As DevExpress.XtraBars.BarButtonItem
Friend WithEvents BarButtonItem5 As DevExpress.XtraBars.BarButtonItem
Friend WithEvents BarCheckItem1 As DevExpress.XtraBars.BarCheckItem
Friend WithEvents checkItemTopMost As DevExpress.XtraBars.BarCheckItem
Friend WithEvents SourceDeleteItem As DevExpress.XtraBars.BarCheckItem
Friend WithEvents SaveProfileItem As DevExpress.XtraBars.BarCheckItem
Friend WithEvents checkItemPreselection As DevExpress.XtraBars.BarCheckItem
Friend WithEvents PreviewItem As DevExpress.XtraBars.BarCheckItem
Friend WithEvents BarCheckItem2 As DevExpress.XtraBars.BarCheckItem
Friend WithEvents labelFilePath As DevExpress.XtraBars.BarStaticItem
@ -310,6 +320,7 @@ Partial Class frmGlobix_Index
Friend WithEvents RibbonPageGroup3 As DevExpress.XtraBars.Ribbon.RibbonPageGroup
Friend WithEvents SplitContainerControl1 As DevExpress.XtraEditors.SplitContainerControl
Friend WithEvents Panel1 As Panel
Friend WithEvents ComboBox1 As ComboBox
Friend WithEvents cmbDoctype As ComboBox
Friend WithEvents DocumentViewer1 As Controls.DocumentViewer.DocumentViewer
Friend WithEvents pnlIndex As Panel
End Class

10
GUIs.ZooFlow/frmGlobix_Index.resx
View File

@ -220,7 +220,7 @@
DQo8L3N2Zz4L
</value>
</data>
<data name="BarCheckItem1.ImageOptions.SvgImage" type="DevExpress.Utils.Svg.SvgImage, DevExpress.Data.v19.2" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="checkItemTopMost.ImageOptions.SvgImage" type="DevExpress.Utils.Svg.SvgImage, DevExpress.Data.v19.2" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
AAEAAAD/////AQAAAAAAAAAMAgAAAFlEZXZFeHByZXNzLkRhdGEudjE5LjIsIFZlcnNpb249MTkuMi4z
LjAsIEN1bHR1cmU9bmV1dHJhbCwgUHVibGljS2V5VG9rZW49Yjg4ZDE3NTRkNzAwZTQ5YQUBAAAAHURl
@ -266,7 +266,7 @@
Y2xhc3M9IlJlZCIgLz4NCiAgPC9nPg0KPC9zdmc+Cw==
</value>
</data>
<data name="SaveProfileItem.ImageOptions.SvgImage" type="DevExpress.Utils.Svg.SvgImage, DevExpress.Data.v19.2" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="checkItemPreselection.ImageOptions.SvgImage" type="DevExpress.Utils.Svg.SvgImage, DevExpress.Data.v19.2" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
AAEAAAD/////AQAAAAAAAAAMAgAAAFlEZXZFeHByZXNzLkRhdGEudjE5LjIsIFZlcnNpb249MTkuMi4z
LjAsIEN1bHR1cmU9bmV1dHJhbCwgUHVibGljS2V5VG9rZW49Yjg4ZDE3NTRkNzAwZTQ5YQUBAAAAHURl
@ -328,7 +328,7 @@
DQogIDwvZz4NCjwvc3ZnPgs=
</value>
</data>
<data name="BarStaticItem2.ImageOptions.SvgImage" type="DevExpress.Utils.Svg.SvgImage, DevExpress.Data.v19.2" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="labelError.ImageOptions.SvgImage" type="DevExpress.Utils.Svg.SvgImage, DevExpress.Data.v19.2" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
AAEAAAD/////AQAAAAAAAAAMAgAAAFlEZXZFeHByZXNzLkRhdGEudjE5LjIsIFZlcnNpb249MTkuMi4z
LjAsIEN1bHR1cmU9bmV1dHJhbCwgUHVibGljS2V5VG9rZW49Yjg4ZDE3NTRkNzAwZTQ5YQUBAAAAHURl
@ -349,7 +349,7 @@
dmc+Cw==
</value>
</data>
<data name="BarStaticItem3.ImageOptions.SvgImage" type="DevExpress.Utils.Svg.SvgImage, DevExpress.Data.v19.2" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="labelNotice.ImageOptions.SvgImage" type="DevExpress.Utils.Svg.SvgImage, DevExpress.Data.v19.2" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
AAEAAAD/////AQAAAAAAAAAMAgAAAFlEZXZFeHByZXNzLkRhdGEudjE5LjIsIFZlcnNpb249MTkuMi4z
LjAsIEN1bHR1cmU9bmV1dHJhbCwgUHVibGljS2V5VG9rZW49Yjg4ZDE3NTRkNzAwZTQ5YQUBAAAAHURl
@ -370,7 +370,7 @@
PC9nPg0KPC9zdmc+Cw==
</value>
</data>
<data name="BarCheckItem3.ImageOptions.SvgImage" type="DevExpress.Utils.Svg.SvgImage, DevExpress.Data.v19.2" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="chkMultiindexing.ImageOptions.SvgImage" type="DevExpress.Utils.Svg.SvgImage, DevExpress.Data.v19.2" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
AAEAAAD/////AQAAAAAAAAAMAgAAAFlEZXZFeHByZXNzLkRhdGEudjE5LjIsIFZlcnNpb249MTkuMi4z
LjAsIEN1bHR1cmU9bmV1dHJhbCwgUHVibGljS2V5VG9rZW49Yjg4ZDE3NTRkNzAwZTQ5YQUBAAAAHURl

1660
GUIs.ZooFlow/frmGlobix_Index.vb
View File

File diff suppressed because it is too large Load Diff

38
Modules.Database/MSSQLServer.vb
View File

@ -49,6 +49,44 @@ Public Class MSSQLServer
Return oConnectionStringBuilder.ToString
End Function
Public Function Get_ConnectionStringforID(pID As Integer)
Dim connectionString As String = ""
Try
'Me.TBCONNECTIONTableAdapter.FillByID(Me.DD_DMSLiteDataSet.TBCONNECTION, id)
Dim oDTConnection As DataTable = GetDatatable("SELECT * FROM TBDD_CONNECTION WHERE GUID = " & pID)
If oDTConnection.Rows.Count = 1 Then
Select Case oDTConnection.Rows(0).Item("SQL_PROVIDER").ToString.ToUpper
Case "MS-SQL"
If oDTConnection.Rows(0).Item("USERNAME") = "WINAUTH" Then
connectionString = "Server=" & oDTConnection.Rows(0).Item("SERVER") & ";Database=" & oDTConnection.Rows(0).Item("DATENBANK") & ";Trusted_Connection=True;"
Else
connectionString = "Server=" & oDTConnection.Rows(0).Item("SERVER") & ";Database=" & oDTConnection.Rows(0).Item("DATENBANK") & ";User Id=" & oDTConnection.Rows(0).Item("USERNAME") & ";Password=" & oDTConnection.Rows(0).Item("USERNAME") & ";Password=" & oDTConnection.Rows(0).Item("PASSWORD") & ";"
End If
' connectionString = "Server=" & DTConnection.Rows(0).Item("SERVER") & ";Database=" & DTConnection.Rows(0).Item("DATENBANK") & ";User Id=" & DTConnection.Rows(0).Item("USERNAME") & ";Password=" & DTConnection.Rows(0).Item("PASSWORD") & ";"
Case "Oracle"
If oDTConnection.Rows(0).Item("BEMERKUNG").ToString.Contains("without tnsnames") Then
connectionString = "Data Source=(DESCRIPTION=(ADDRESS_LIST=(ADDRESS=(PROTOCOL=TCP)(HOST=" & oDTConnection.Rows(0).Item("SERVER") & ")(PORT=1521)))(CONNECT_DATA=(SERVER=DEDICATED)(SERVICE_NAME=" &
oDTConnection.Rows(0).Item("DATENBANK") & ")));User Id=" & oDTConnection.Rows(0).Item("USERNAME") & ";Password=" & oDTConnection.Rows(0).Item("PASSWORD") & ";"
Else
connectionString = "Data Source=" & oDTConnection.Rows(0).Item("SERVER") & ";Persist Security Info=True;User Id=" & oDTConnection.Rows(0).Item("USERNAME") & ";Password=" & oDTConnection.Rows(0).Item("PASSWORD") & ";Unicode=True"
End If
'Case "ODBC"
' Dim conn As New OdbcConnection("dsn=" & DTConnection.Rows(0).Item("SERVER") & ";uid=" & DTConnection.Rows(0).Item("USERNAME") & ";pwd=" + DTConnection.Rows(0).Item("PASSWORD"))
' connectionString = conn.ConnectionString
Case Else
_Logger.Info(" - ConnectionType nicht integriert")
End Select
Else
_Logger.Info(" No entry for Connection-ID: " & pID.ToString)
End If
Catch ex As Exception
_Logger.Error(ex)
_Logger.Info(" - Error in bei Get ConnectionString - Fehler: " & vbNewLine & ex.Message)
End Try
Return connectionString
End Function
Private Function TestCanConnect() As Boolean
Return TestCanConnect(CurrentSQLConnectionString)