AppStd/Monorepo
8
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Zooflow: Massive Clean up

Browse Source
This commit is contained in:
Jonathan Jenne 2022-02-17 15:47:52 +01:00
parent 2ce576d54e
commit c6c548afe4
45 changed files with 1039 additions and 2090 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Controls.LookupGrid/frmLookupGrid.vb
View File

@ -20,7 +20,7 @@ Public Class frmLookupGrid
Private _DataSourceTemp As DataTable
Private _View As GridView
Private _Grid As GridControl
Private _R As Resources.ResourceManager = My.Resources.Strings.ResourceManager
Private ReadOnly _R As Resources.ResourceManager = My.Resources.Strings.ResourceManager
Private Sub frmLookupGrid_Load(sender As Object, e As EventArgs) Handles Me.Load
_View = viewLookup

4
GUIs.Common/DocumentResultList/Loader.vb
View File

@ -5,12 +5,12 @@ Imports DigitalData.Modules.EDMI.API.EDMIServiceReference
Imports DigitalData.Modules.Logging
Imports DigitalData.Modules.Base.IDB
Imports DigitalData.Modules.ZooFlow.Constants
Imports DigitalData.Modules.ZooFlow.State
Imports DigitalData.Modules.Base
Namespace DocumentResultList
Public Class Loader
Inherits Modules.ZooFlow.Base.BaseClass
Inherits BaseClass
Private ReadOnly Client As Client
Private ReadOnly Mode As OperationMode

2
GUIs.Common/DocumentResultList/Watcher.vb
View File

@ -2,7 +2,7 @@
Imports System.Text
Imports System.Timers
Imports DigitalData.Modules.Logging
Imports DigitalData.Modules.ZooFlow.Base
Imports DigitalData.Modules.Base
Imports DigitalData.Modules.Language.DateTimeEx
Namespace DocumentResultList

391
GUIs.GlobalIndexer/FileHandler.vb Normal file
View File

@ -0,0 +1,391 @@
Imports System.Windows.Forms
Imports DigitalData.Modules.Messaging
Imports DigitalData.Modules.Base
Imports DigitalData.Modules.Logging
Imports Limilabs.Mail
Public Class ClassFileHandler
Inherits BaseClass
Private Email As Email2
Public Sub New(pLogConfig As LogConfig)
MyBase.New(pLogConfig)
Email = New Email2(pLogConfig)
End Sub
Public Property TempFiles As New List(Of String)
Private Function GetTempPath(pSourceFilePath As String, pNewFileName As String, pSubfolder As String) As String
Try
Dim oTempDirectory = IO.Path.GetTempPath()
Dim oTempSubDirectory As String = IO.Path.Combine(oTempDirectory, pSubfolder)
' Try to create a subdirectory for all temp files so it will be easier to clean up
' these files by just deleting the whole fucking folder. 🤬
If Not IO.Directory.Exists(oTempSubDirectory) Then
Try
IO.Directory.CreateDirectory(oTempSubDirectory)
Catch ex As Exception
Logger.Error(ex)
' We could not create a subfolder
' Set the final directory to the default temp
oTempSubDirectory = oTempDirectory
End Try
End If
' Copy the file to the new location
Dim oNewPath = IO.Path.Combine(oTempSubDirectory, pNewFileName)
IO.File.Copy(pSourceFilePath, oNewPath)
Return oNewPath
Catch ex As Exception
Return Nothing
End Try
End Function
Public Sub Clear_Tempfiles()
For Each oFile In TempFiles
Try
IO.File.Delete(oFile)
Catch ex As Exception
Logger.Error(ex)
End Try
Next
TempFiles.Clear()
End Sub
Public Function Decide_FileHandle(pFilepath As String, pHandletype As String) As Boolean
Try
''TODO: Before doing anything, clean the filename
'Dim oFilename = IO.Path.GetFileName(pFilepath)
'Dim oCleanFileName = Utils.RemoveInvalidCharacters(oFilename)
'Dim oTempDirectory = IO.Path.GetTempPath()
'Dim oTempFilePath = IO.Path.Combine(oTempDirectory, oCleanFileName)
'Try
' TEMP_FILES.Add(oTempFilePath)
' LOGGER.Debug("Copying file")
' LOGGER.Debug(pFilepath)
' LOGGER.Debug(oTempFilePath)
' IO.File.Copy(pFilepath, oTempFilePath, True)
'Catch ex As Exception
' LOGGER.Error(ex)
' Throw ex
'End Try
Dim oTempFilePath = pFilepath
Dim oInboxRegex As New Text.RegularExpressions.Regex("\.INBOX\d+$")
If oInboxRegex.IsMatch(oTempFilePath) Then
Logger.Info("Renaming INBOX file to EML")
Try
Dim oInfo As New IO.FileInfo(oTempFilePath)
Logger.Info("Old Name: {0}", oInfo.Name)
Dim oNewName = $"{oInfo.Name}.eml"
Logger.Info("New Name: {0}", oNewName)
Dim oTempDirectory = IO.Path.GetTempPath()
Dim oNewPath = IO.Path.Combine(oTempDirectory, oNewName)
IO.File.Copy(oInfo.FullName, oNewPath)
'TEMP_FILES.Add(oNewPath)
TempFiles.Add(oNewPath)
oTempFilePath = oNewPath
Catch ex As Exception
Logger.Error(ex)
End Try
End If
If oTempFilePath.ToUpper.EndsWith(".MSG") Or oTempFilePath.ToUpper.EndsWith(".EML") Then
CURRENT_MESSAGEID = ""
Dim oMail As IMail = Email.Load_Email(oTempFilePath)
If oMail.Attachments.Count > 0 Then
Dim oTitle As String
Dim oMessage As String
If USER_LANGUAGE = "de-DE" Then
oTitle = "Nachfrage zur Indexierung:"
oMessage = "Achtung: Die Email enthält Anhänge!" & vbNewLine & "Wollen Sie die Anhänge separat indexieren und herauslösen?"
Else
oTitle = "Question about Indexing:"
oMessage = "Attention: This Email contains Attachments!" & vbNewLine & "Do you want to extract the attachments and index them seperately?"
End If
Dim oResult As DialogResult
' Weird hack to force messagebox to be topmost
' https://stackoverflow.com/questions/1220882/keep-messagebox-show-on-top-of-other-application-using-c-sharp
oResult = MessageBox.Show(oMessage, oTitle, MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1, MessageBoxOptions.DefaultDesktopOnly)
If oResult = MsgBoxResult.Yes Then
Dim oIsFolderWatch = pHandletype.StartsWith("|FW")
Return Save_EmailAndAttachmentsToDisk(oTempFilePath, oIsFolderWatch)
End If
End If
End If
If oTempFilePath.ToUpper.EndsWith(".LNK") Then
If USER_LANGUAGE = "de-DE" Then
MsgBox("Verknüpfungen können nicht abgelegt werden!", MsgBoxStyle.Critical, "Global Indexer")
Else
MsgBox("Shortcuts cannot be droppped!", MsgBoxStyle.Critical, "Global Indexer")
End If
Return False
End If
Return Insert_GI_File(oTempFilePath, pHandletype)
Catch ex As Exception
MsgBox("Unexpected Error in Decide_FileHandle: " & ex.Message, MsgBoxStyle.Critical)
Return False
End Try
End Function
Private Function Save_EmailAndAttachmentsToDisk(pEmailFilePath As String, Optional pFolderWatch As Boolean = False) As Boolean
Try
Dim oMessageOnlyMarker As String = "|MSGONLY|"
Dim oExtractedAttachmentMarker As String = "|ATTMNTEXTRACTED|"
If pFolderWatch = True Then
oMessageOnlyMarker = "|FW_MSGONLY|"
oExtractedAttachmentMarker = "|FW_ATTMNTEXTRACTED|"
End If
Dim oSuccess As Boolean = False
Logger.Info("Converting file to Eml if needed: [{0}]", pEmailFilePath)
Dim oEmail As IMail = Email.Load_Email(pEmailFilePath)
If oEmail.MessageID IsNot Nothing Then
CURRENT_MESSAGEID = oEmail.MessageID
Else
Logger.Info("Es konnte keine Message-ID gelesen werden. Eine GUID wird erzeugt!")
CURRENT_MESSAGEID = NewGuid.ToString()
End If
Dim oEmailFilePathWithoutAttachments = Email.Remove_AttachmentsFromEmail(pEmailFilePath, "_excl_attachments")
TempFiles.Add(oEmailFilePathWithoutAttachments)
'TEMP_FILES.Add(oEmailFilePathWithoutAttachments)
If Insert_GI_File(oEmailFilePathWithoutAttachments, oMessageOnlyMarker) = True Then
oSuccess = True
Dim oAttachments As List(Of String) = Email.Save_AttachmentsToDisk(pEmailFilePath)
Logger.Debug("Saved [{0}] attachments to disk.", oAttachments.Count)
For Each oAttachment In oAttachments
'TEMP_FILES.Add(oAttachment)
TempFiles.Add(oAttachment)
Logger.Debug("Saved attachment [{0}].", oAttachment)
oSuccess = Insert_GI_File(oAttachment, oExtractedAttachmentMarker)
If oSuccess = False Then
Logger.Warn("Saving attachment to disk failed: [{0}]", oAttachment)
Exit For
End If
Next
End If
Return oSuccess
Catch ex As Exception
Logger.Warn("Saving email to disk failed (Email_Decay)")
Logger.Error(ex)
Return False
End Try
End Function
'Private Shared Function Email_Decay(msgname As String, Optional FW As Boolean = False)
' Try
' Dim msgonly As String = "|MSGONLY|"
' Dim ATT_EXTR As String = "|ATTMNTEXTRACTED|"
' If FW = True Then
' msgonly = "|FW_MSGONLY|"
' ATT_EXTR = "|FW_ATTMNTEXTRACTED|"
' End If
' Dim erfolgreich As Boolean = False
' Dim msg As New MSG.Message(msgname)
' If msg.InternetMessageId IsNot Nothing Then
' CURRENT_MESSAGEID = msg.InternetMessageId
' Else
' LOGGER.Info("Es konnte keine Message-ID gelesen werden. Eine GUID wird erzeugt!")
' Dim sGUID As String
' sGUID = System.Guid.NewGuid.ToString()
' CURRENT_MESSAGEID = sGUID
' End If
' 'Nur die MSGDatei ablegen
' Dim tempfile As String = Path.Combine(Path.GetTempPath, Path.GetFileNameWithoutExtension(msgname) & "_excl_att.msg")
' If File.Exists(tempfile) Then
' File.Delete(tempfile)
' End If
' Dim _msgEXAtt As New Msg.Message(msgname)
' _msgEXAtt.Attachments.Clear()
' _msgEXAtt.Save(tempfile)
' 'Datei in Array zum Templöschen speichern
' TEMP_FILES.Add(tempfile)
' If Insert_GI_File(tempfile, msgonly) = True Then
' erfolgreich = True
' 'Hier nun die Anhänge herauslösen
' Dim _msg As New Msg.Message(msgname)
' Dim i1 As Integer = 1
' LOGGER.Info(">> Anzahl der Attachments: " & _msg.Attachments.Count)
' For Each attachment As Independentsoft.Msg.Attachment In _msg.Attachments
' If erfolgreich = False Then
' Exit For
' End If
' Dim attachment_name As String
' If attachment.LongFileName Is Nothing Then
' attachment_name = attachment.DisplayName
' Else
' attachment_name = attachment.LongFileName
' End If
' If attachment.EmbeddedMessage IsNot Nothing Then
' attachment_name = Utils.RemoveInvalidCharacters(attachment_name)
' tempfile = Path.Combine(Path.GetTempPath, attachment_name & ".msg")
' tempfile = ClassFilehandle.Versionierung_Datei(tempfile)
' If tempfile <> String.Empty Then
' Dim oMessage = attachment.EmbeddedMessage
' oMessage.IsEmbedded = False
' oMessage.Save(tempfile)
' TEMP_FILES.Add(tempfile)
' LOGGER.Info(">> Attachment (" & i1 & "):" & tempfile)
' erfolgreich = Insert_GI_File(tempfile, ATT_EXTR)
' i1 += 1
' End If
' ElseIf Not attachment_name.Contains("inline") Then
' 'Sonderzeichen entfernen
' attachment_name = Utils.RemoveInvalidCharacters(attachment_name)
' tempfile = Path.Combine(Path.GetTempPath, attachment_name)
' tempfile = ClassFilehandle.Versionierung_Datei(tempfile)
' If tempfile <> "" Then
' attachment.Save(tempfile)
' 'Datei in Array zum Templöschen speichern
' TEMP_FILES.Add(tempfile)
' LOGGER.Info(">> Attachment (" & i1 & "):" & tempfile)
' 'nun der Insert des Anhanges
' erfolgreich = Insert_GI_File(tempfile, ATT_EXTR)
' i1 += 1
' End If
' End If
' Next
' End If
' Return erfolgreich
' Catch ex As Exception
' MsgBox("Error in Email_Decay: " & ex.Message, MsgBoxStyle.Critical)
' End Try
'End Function
Private Function Insert_GI_File(filename As String, handleType As String)
Try
filename = filename.Replace("'", "''")
Dim oHash As String = String.Empty
If File.Exists(filename) Then
If (filename.ToUpper.EndsWith(".MSG") Or filename.ToUpper.EndsWith(".EML")) And (handleType = "|OUTLOOK_MESSAGE|" Or handleType = "|MSGONLY|") Then
oHash = FileSystem.GetChecksumFromString(filename)
Else
oHash = FileSystem.GetChecksum(filename)
End If
End If
Dim filename_only As String = Path.GetFileName(filename)
Dim ins As String = $"INSERT INTO TBGI_FILES_USER (FILENAME2WORK, USER@WORK, HANDLE_TYPE, FILENAME_ONLY, FILE_HASH) VALUES ('{filename}','{Environment.UserName}','{handleType}','{filename_only}', '{oHash}')"
Return DATABASE_ECM.ExecuteNonQuery(ins)
Catch ex As Exception
Return False
End Try
End Function
Public Function IsFileInUse(ByVal fullFilePath As String) As Boolean
' Gibt zurück, ob die übergebene Datei momentan exklusiv zu haben ist.
' Prüft, ob die angegeben Datei aktuell durch eine
' andere Anwendung in Benutzung ist
Dim ff As Integer = FreeFile()
If File.Exists(fullFilePath) Then
Try
' Versuchen, die Datei mit *exklusiven* Lese- und
' Schreibrechten zu öffnen
FileOpen(ff, fullFilePath, OpenMode.Binary, OpenAccess.ReadWrite, OpenShare.LockReadWrite)
Catch ex As Exception
' Ist ein Fehler aufgetreten, so wird nach außen hin generell
' davon ausgegangen, dass die Datei in Benutzung ist (obwohl
' auch andere Ursachen, etwa Rechteprobleme, möglich sind).
Logger.Info(">> FileInUse Message: " & ex.Message)
IsFileInUse = True
Finally
' Die eventuell geöffnete Datei schließen
FileClose(ff)
End Try
Return False
End If
End Function
Public Function Versionierung_Datei(Dateiname As String)
Dim extension
Dim _NewFileString
Try
Dim version As Integer = 1
Dim Stammname As String = Path.GetDirectoryName(Dateiname) & "\" & Path.GetFileNameWithoutExtension(Dateiname).Trim()
extension = Path.GetExtension(Dateiname)
Dim _neuername As String = Stammname
'Dim MoveFilename As String = DATEINAME.Replace(element.Value, "")
'Überprüfen ob File existiert
If File.Exists(_neuername & extension) = False Then
_NewFileString = _neuername
Else
Do While File.Exists(_neuername & extension)
version += 1
_neuername = Stammname & "~" & version
_NewFileString = _neuername
Loop
End If
Return _NewFileString & extension
Catch ex As Exception
Logger.Info(" - Error in versioning file - error: " & vbNewLine & ex.Message)
Logger.Error(ex)
MsgBox(ex.Message, MsgBoxStyle.Critical, "Error in versioning file:")
Return ""
End Try
End Function
'' <summary>
''' Ersetzt alle nicht zulässigen Zeichen im angegebenen Dateinamen
''' </summary>
''' <param name="sFilename">Dateiname ohne Pfadangabe</param>
''' <param name="sChar">Ersatzzeichen für alle unzulässigen Zeichen
''' im Dateinamen</param>
Public Function CleanFilename(ByVal sFilename As String, Optional ByVal REPLACEChar As String = "") As String
Logger.Info(" >> Filename before CleanFilename: '" & sFilename & "'")
If sFilename.Contains(".\") Then
sFilename = sFilename.Replace(".\", "\")
End If
'If sFilename.Contains("'") Then
' sFilename = sFilename.Replace("'", "")
'End If
'If sFilename.Contains("..") Then
' sFilename = sFilename.Replace("..", ".")
'End If
' alle nicht zulässigen Zeichen ersetzen
sFilename = System.Text.RegularExpressions.Regex.Replace(sFilename, REGEX_CLEAN_FILENAME, REPLACEChar)
sFilename = System.Text.RegularExpressions.Regex.Replace(sFilename, "[\\/:*?""<>|\r\n]", "", System.Text.RegularExpressions.RegexOptions.Singleline)
'Dim oCleanFileName As String = String.Join(REPLACEChar, sFilename.Split(Path.GetInvalidFileNameChars()))
Dim oCleanFileName As New System.IO.FileInfo(System.Text.RegularExpressions.Regex.Replace(sFilename, String.Format("[{0}]", String.Join(String.Empty, Path.GetInvalidFileNameChars)), REPLACEChar))
Logger.Info(" >> Filename after CleanFilename: '" & sFilename & "'")
Return sFilename
End Function
End Class

5
GUIs.Test.TestGUI/frmEmail.vb
View File

@ -7,8 +7,9 @@ Public Class frmEmail
Private Email As Email2
Private Sub frmEmail_Load(sender As Object, e As EventArgs) Handles Me.Load
Logconfig = New LogConfig(LogConfig.PathType.Temp, ProductName:="TestGUI.IMAP")
Logconfig.Debug = True
Logconfig = New LogConfig(LogConfig.PathType.Temp, ProductName:="TestGUI.IMAP") With {
.Debug = True
}
Email = New Email2(Logconfig)
End Sub

3
GUIs.ZooFlow/Administration/ClassDetailForm.vb
View File

@ -1,7 +1,8 @@
Imports DigitalData.GUIs.ZooFlow.Administration.ClassConstants
Imports DigitalData.Modules.Base
Public Class ClassDetailForm
Inherits Base.BaseClass
Inherits BaseClass
Public Event DetailFormClosed As EventHandler(Of Form)

74
GUIs.ZooFlow/Administration/ClassGIDatatables.vb
View File

@ -1,31 +1,41 @@
Public Class ClassGIDatatables
Imports DigitalData.Modules.Base
Imports DigitalData.Modules.Logging
Public Class ClassGIDatatables
Inherits BaseClass
Public Sub New(pLogConfig As LogConfig)
MyBase.New(pLogConfig)
End Sub
#Region "TBDD_GROUP"
Public Shared Function AddGroupToProfile(GroupId As Integer, ProfileId As Integer) As Boolean
Try
Dim oSQL = $"
Public Function AddGroupToProfile(GroupId As Integer, ProfileId As Integer) As Boolean
Try
Dim oSQL = $"
INSERT INTO TBDD_USRGRP_DOKTYPE
(DOCTYPE_ID, GROUP_ID, ADDED_WHO)
VALUES ({ProfileId}, {GroupId}, '{Environment.UserName}')
"
Return My.DatabaseECM.ExecuteNonQuery(oSQL)
Catch ex As Exception
LOGGER.Error(ex)
Return False
End Try
End Function
Public Shared Function RemoveGroupFromProfile(GroupId As Integer, ProfileId As Integer) As Boolean
Try
Dim oSQL = $"DELETE FROM TBDD_USRGRP_DOKTYPE WHERE DOCTYPE_ID = {ProfileId} AND GROUP_ID = {GroupId}"
Return My.DatabaseECM.ExecuteNonQuery(oSQL)
Catch ex As Exception
LOGGER.Error(ex)
Logger.Error(ex)
Return False
End Try
End Function
Public Shared Function GetAssignedGroups(ProfileId As Integer) As DataTable
Public Function RemoveGroupFromProfile(GroupId As Integer, ProfileId As Integer) As Boolean
Try
Dim oSQL = $"DELETE FROM TBDD_USRGRP_DOKTYPE WHERE DOCTYPE_ID = {ProfileId} AND GROUP_ID = {GroupId}"
Return My.DatabaseECM.ExecuteNonQuery(oSQL)
Catch ex As Exception
Logger.Error(ex)
Return False
End Try
End Function
Public Function GetAssignedGroups(ProfileId As Integer) As DataTable
Try
Dim oSQL As String = $"
SELECT GUID, NAME FROM TBDD_GROUPS
@ -40,12 +50,12 @@
Return oDatatable
Catch ex As Exception
LOGGER.Error(ex)
Logger.Error(ex)
Return Nothing
End Try
End Function
Public Shared Function GetAvailableGroups(ProfileId As Integer) As DataTable
Public Function GetAvailableGroups(ProfileId As Integer) As DataTable
Try
Dim oSQL As String = $"
SELECT GUID, NAME FROM TBDD_GROUPS
@ -60,7 +70,7 @@
Return oDatatable
Catch ex As Exception
LOGGER.Error(ex)
Logger.Error(ex)
Return Nothing
End Try
End Function
@ -68,7 +78,7 @@
#Region "TBDD_USER"
Public Shared Function AddUserToProfile(UserId As Integer, ProfileId As Integer) As Boolean
Public Function AddUserToProfile(UserId As Integer, ProfileId As Integer) As Boolean
Try
Dim oSQL = $"
INSERT INTO TBDD_USER_DOKTYPE
@ -77,22 +87,22 @@
"
Return My.DatabaseECM.ExecuteNonQuery(oSQL)
Catch ex As Exception
LOGGER.Error(ex)
Logger.Error(ex)
Return False
End Try
End Function
Public Shared Function RemoveUserFromProfile(UserId As Integer, ProfileId As Integer) As Boolean
Public Function RemoveUserFromProfile(UserId As Integer, ProfileId As Integer) As Boolean
Try
Dim oSQL = $"DELETE FROM TBDD_USER_DOKTYPE WHERE DOCTYPE_ID = {ProfileId} AND USER_ID = {UserId}"
Return My.DatabaseECM.ExecuteNonQuery(oSQL)
Catch ex As Exception
LOGGER.Error(ex)
Logger.Error(ex)
Return False
End Try
End Function
Public Shared Function GetAssignedUsers(ProfileId As Integer) As DataTable
Public Function GetAssignedUsers(ProfileId As Integer) As DataTable
Try
Dim oSQL As String = $"
SELECT GUID, EMAIL, NAME + ', ' + PRENAME AS NAME FROM TBDD_USER
@ -106,12 +116,12 @@
Return oDatatable
Catch ex As Exception
LOGGER.Error(ex)
Logger.Error(ex)
Return Nothing
End Try
End Function
Public Shared Function GetAvailableUsers(ProfileId As Integer) As DataTable
Public Function GetAvailableUsers(ProfileId As Integer) As DataTable
Try
Dim oSQL As String = $"
SELECT GUID, EMAIL, NAME + ', ' + PRENAME AS NAME FROM TBDD_USER
@ -125,14 +135,14 @@
Dim oDatatable As DataTable = My.DatabaseECM.GetDatatable(oSQL)
Return oDatatable
Catch ex As Exception
LOGGER.Error(ex)
Return Nothing
End Try
End Function
Catch ex As Exception
Logger.Error(ex)
Return Nothing
End Try
End Function
#End Region
End Class
End Class

35
GUIs.ZooFlow/Administration/frmAdmin_Globix.vb
View File

@ -7,7 +7,7 @@ Public Class frmAdmin_Globix
Public Property HasChanges As Boolean = False Implements IAdminForm.HasChanges
Public Property IsInsert As Boolean = False Implements IAdminForm.IsInsert
Public Property PrimaryKey As Integer Implements IAdminForm.PrimaryKey
Public Property GlobixHelper As ClassGIDatatables
Private Pages As ClassDetailPages
Public Sub New(PrimaryKey As Integer, Optional IsInsert As Boolean = False)
@ -17,6 +17,7 @@ Public Class frmAdmin_Globix
' Fügen Sie Initialisierungen nach dem InitializeComponent()-Aufruf hinzu.
Me.PrimaryKey = PrimaryKey
Me.IsInsert = IsInsert
Me.GlobixHelper = New ClassGIDatatables(My.LogConfig)
End Sub
Private Sub frmAdmin_Globix_Load(sender As Object, e As EventArgs) Handles MyBase.Load
@ -409,10 +410,10 @@ Public Class frmAdmin_Globix
Private Sub XtraTabControl1_SelectedPageChanged(sender As Object, e As DevExpress.XtraTab.TabPageChangedEventArgs) Handles XtraTabControl1.SelectedPageChanged
Select Case XtraTabControl1.SelectedTabPageIndex
Case 1
gridAssignedGroups.DataSource = ClassGIDatatables.GetAssignedGroups(TextEditDoctypeID.Text)
gridAvailableGroups.DataSource = ClassGIDatatables.GetAvailableGroups(TextEditDoctypeID.Text)
gridAssignedUsers.DataSource = ClassGIDatatables.GetAssignedUsers(TextEditDoctypeID.Text)
gridAvailableUsers.DataSource = ClassGIDatatables.GetAvailableUsers(TextEditDoctypeID.Text)
gridAssignedGroups.DataSource = GlobixHelper.GetAssignedGroups(TextEditDoctypeID.Text)
gridAvailableGroups.DataSource = GlobixHelper.GetAvailableGroups(TextEditDoctypeID.Text)
gridAssignedUsers.DataSource = GlobixHelper.GetAssignedUsers(TextEditDoctypeID.Text)
gridAvailableUsers.DataSource = GlobixHelper.GetAvailableUsers(TextEditDoctypeID.Text)
End Select
End Sub
@ -422,9 +423,9 @@ Public Class frmAdmin_Globix
Dim userId As Integer = data.Split("|")(0)
Dim profileId As Integer = TextEditDoctypeID.Text
ClassGIDatatables.AddUserToProfile(userId, profileId)
gridAssignedUsers.DataSource = ClassGIDatatables.GetAssignedUsers(profileId)
gridAvailableUsers.DataSource = ClassGIDatatables.GetAvailableUsers(profileId)
GlobixHelper.AddUserToProfile(userId, profileId)
gridAssignedUsers.DataSource = GlobixHelper.GetAssignedUsers(profileId)
gridAvailableUsers.DataSource = GlobixHelper.GetAvailableUsers(profileId)
Catch ex As Exception
Logger.Error(ex)
MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler beim Hinzufügen eines Users:")
@ -437,9 +438,9 @@ Public Class frmAdmin_Globix
Dim userId As Integer = data.Split("|")(0)
Dim profileId As Integer = TextEditDoctypeID.Text
ClassGIDatatables.RemoveUserFromProfile(userId, profileId)
gridAssignedUsers.DataSource = ClassGIDatatables.GetAssignedUsers(profileId)
gridAvailableUsers.DataSource = ClassGIDatatables.GetAvailableUsers(profileId)
GlobixHelper.RemoveUserFromProfile(userId, profileId)
gridAssignedUsers.DataSource = GlobixHelper.GetAssignedUsers(profileId)
gridAvailableUsers.DataSource = GlobixHelper.GetAvailableUsers(profileId)
Catch ex As Exception
Logger.Error(ex)
MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler beim Hinzufügen eines Users:")
@ -452,9 +453,9 @@ Public Class frmAdmin_Globix
Dim groupId As Integer = data.Split("|")(0)
Dim profileId As Integer = TextEditDoctypeID.Text
ClassGIDatatables.AddGroupToProfile(groupId, profileId)
gridAssignedGroups.DataSource = ClassGIDatatables.GetAssignedGroups(profileId)
gridAvailableGroups.DataSource = ClassGIDatatables.GetAvailableGroups(profileId)
GlobixHelper.AddGroupToProfile(groupId, profileId)
gridAssignedGroups.DataSource = GlobixHelper.GetAssignedGroups(profileId)
gridAvailableGroups.DataSource = GlobixHelper.GetAvailableGroups(profileId)
Catch ex As Exception
Logger.Error(ex)
MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler beim Hinzufügen einer Gruppe:")
@ -467,9 +468,9 @@ Public Class frmAdmin_Globix
Dim groupId As Integer = data.Split("|")(0)
Dim profileId As Integer = TextEditDoctypeID.Text
ClassGIDatatables.RemoveGroupFromProfile(groupId, profileId)
gridAssignedGroups.DataSource = ClassGIDatatables.GetAssignedGroups(profileId)
gridAvailableGroups.DataSource = ClassGIDatatables.GetAvailableGroups(profileId)
GlobixHelper.RemoveGroupFromProfile(groupId, profileId)
gridAssignedGroups.DataSource = GlobixHelper.GetAssignedGroups(profileId)
gridAvailableGroups.DataSource = GlobixHelper.GetAvailableGroups(profileId)
Catch ex As Exception
Logger.Error(ex)
MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler beim Hinzufügen einer Gruppe:")

15
GUIs.ZooFlow/Administration/frmAdmin_GlobixRelations.vb
View File

@ -1,5 +1,10 @@
Public Class frmAdmin_GlobixRelations
Imports DigitalData.Modules.Logging
Public Class frmAdmin_GlobixRelations
Private SELECTED_DTID As Integer
Private Logger As Logger
Private Function GetAvailableUsers(doctypeid As Integer) As DataTable
Try
Dim dt As DataTable
@ -33,6 +38,8 @@ INNER JOIN TBDD_USER B ON A.USER_ID = B.GUID WHERE A.DOCTYPE_ID = {doctypeid}"
Try
Dim oSQL = "SELECT DOCTYPE_ID As ID, DOCTYPE as Doctype FROM VWGI_DOCTYPE_IDB ORDER BY DOCTYPE"
Dim oDT As DataTable = My.DatabaseECM.GetDatatable(oSQL)
Logger = My.LogConfig.GetLogger()
GridControlDoctypesUsers.DataSource = oDT
Catch ex As Exception
ShowErrorMessage($"Error in FormLoad", ex)
@ -76,7 +83,7 @@ INNER JOIN TBDD_USER B ON A.USER_ID = B.GUID WHERE A.DOCTYPE_ID = {doctypeid}"
VALUES ({SELECTED_DTID},{UsrID},'{My.Application.User.UserName}')"
Return My.DatabaseECM.ExecuteNonQuery(oSQL)
Catch ex As Exception
LOGGER.Error(ex)
Logger.Error(ex)
Return False
End Try
End Function
@ -91,12 +98,12 @@ INNER JOIN TBDD_USER B ON A.USER_ID = B.GUID WHERE A.DOCTYPE_ID = {doctypeid}"
LoadFreeUsers()
LoadRelatedAttributes()
End Sub
Public Shared Function DeleteUserRelation(ID As Integer) As Boolean
Public Function DeleteUserRelation(ID As Integer) As Boolean
Try
Dim oSQL = $"DELETE FROM TBDD_USER_DOKTYPE WHERE GUID = {ID}"
Return My.DatabaseECM.ExecuteNonQuery(oSQL)
Catch ex As Exception
LOGGER.Error(ex)
Logger.Error(ex)
Return False
End Try
End Function

15
GUIs.ZooFlow/Administration/frmAdmin_IDBBERelations.vb
View File

@ -2,6 +2,7 @@
Imports DevExpress.XtraGrid.Views.Base
Imports DevExpress.XtraGrid.Views.Grid
Imports DevExpress.XtraGrid.Views.Grid.ViewInfo
Imports DigitalData.Modules.Logging
Public Class frmAdmin_IDBBERelations
Private GridCursorLocation As Point
@ -11,6 +12,8 @@ Public Class frmAdmin_IDBBERelations
Private DraggedAttributeID
Private DragDropManager As ClassDragDrop = Nothing
Private downHitInfo As GridHitInfo = Nothing
Private Logger As Logger
Private Function GetAvailableAttributesByBEID(beID As Integer) As DataTable
Try
Dim dt As DataTable
@ -41,6 +44,8 @@ Public Class frmAdmin_IDBBERelations
Private Sub frmAdmin_IDBBERelations_Load(sender As Object, e As EventArgs) Handles Me.Load
Try
Logger = My.LogConfig.GetLogger()
Dim oSQL = "Select Guid As ID,TITLE As BusinessEntity from TBIDB_BUSINESS_ENTITY"
Dim oDT As DataTable = My.DatabaseIDB.GetDatatable(oSQL)
GridControlBusinessEntities.DataSource = oDT
@ -88,12 +93,12 @@ Public Class frmAdmin_IDBBERelations
End If
End If
Catch ex As Exception
LOGGER.Error(ex)
Logger.Error(ex)
MsgBox(ex.Message, MsgBoxStyle.Critical, "Error Adding AttrID:")
End Try
End Sub
Public Shared Function AddAttr2BE(AttrId As Integer, BeId As Integer) As Boolean
Public Function AddAttr2BE(AttrId As Integer, BeId As Integer) As Boolean
Try
Dim oSQL = $"
INSERT INTO TBIDB_BE_ATTRIBUTE (BE_ID,ATTR_ID,ADDED_WHO)
@ -101,16 +106,16 @@ Public Class frmAdmin_IDBBERelations
"
Return My.DatabaseIDB.ExecuteNonQuery(oSQL)
Catch ex As Exception
LOGGER.Error(ex)
Logger.Error(ex)
Return False
End Try
End Function
Public Shared Function DeleteAttrfromBE(ID As Integer) As Boolean
Public Function DeleteAttrfromBE(ID As Integer) As Boolean
Try
Dim oSQL = $"DELETE FROM TBIDB_BE_ATTRIBUTE WHERE GUID = {ID}"
Return My.DatabaseIDB.ExecuteNonQuery(oSQL)
Catch ex As Exception
LOGGER.Error(ex)
Logger.Error(ex)
Return False
End Try
End Function

6
GUIs.ZooFlow/Administration/frmSQLDesigner.vb
View File

@ -1,4 +1,6 @@
Public Class frmSQLDesigner
Imports DigitalData.Modules.Database
Public Class frmSQLDesigner
Dim CurrentPosition As Integer = 0
Dim CurrentPlaceholders As New Placeholders()
Dim CurrentTableType As String
@ -130,7 +132,7 @@
MsgBox(cmbConnection.SelectedValue)
Dim oconString = My.DatabaseECM.Get_ConnectionStringforID(cmbConnection.SelectedValue)
MsgBox(oconString)
Dim decryptedConString = My.DatabaseECM.DecryptConnectionString(oconString)
Dim decryptedConString = MSSQLServer.DecryptConnectionString(oconString)
MsgBox(decryptedConString)
Dim oDT = My.DatabaseECM.GetDatatableWithConnection(query, decryptedConString)

22
GUIs.ZooFlow/Base/BaseClass.vb
View File

@ -1,22 +0,0 @@
Imports DigitalData.Modules.Logging
Namespace Base
''' <summary>
''' Base Class which supplies a Logger/LogConfig
''' </summary>
Public Class BaseClass
Protected LogConfig As LogConfig
Protected Logger As Logger
Public Sub New(LogConfig As LogConfig)
Dim oClassName = Me.GetType().Name
Me.LogConfig = LogConfig
Me.Logger = LogConfig.GetLogger(oClassName)
End Sub
End Class
End Namespace

3
GUIs.ZooFlow/ClassCommandlineArgs.vb
View File

@ -1,5 +1,6 @@
Imports System.Text.RegularExpressions
Imports DigitalData.Modules.Logging
Imports DigitalData.Modules.Base
''' <summary>
''' Parses Commandline Arguments. Used to jump to a specific point in the application.
@ -7,7 +8,7 @@ Imports DigitalData.Modules.Logging
''' Example: --start-search=id#7~doctype#ARE
''' </summary>
Public Class ClassCommandlineArgs
Inherits Base.BaseClass
Inherits BaseClass
Private CommandLineArgTypes As New List(Of String) From {
"show-profile",

90
GUIs.ZooFlow/ClassDataASorDB.vb
View File

@ -1,90 +0,0 @@
Imports DigitalData.Modules.EDMI.API.EDMIServiceReference
Imports DigitalData.Modules.Logging
Imports DigitalData.Modules.Language.Utils
Public Class ClassDataASorDB
Private _Logger As Logger
Public Sub New(LogConfig As LogConfig)
_Logger = LogConfig.GetLogger
End Sub
Public Function GetDatatable(pDB As String, pSQL As String, pAppServDT As String, pAppServFilter As String, Optional pAppServSort As String = "", Optional pForce As String = "") As DataTable
Try
Dim oReturnDT As DataTable = Nothing
If My.Application.Service.IsActive = True And pForce = String.Empty Then
Try
Dim oTableResult As TableResult = My.Application.Service.Client.GetDatatableByName(pAppServDT, pAppServFilter, pAppServSort)
oReturnDT = oTableResult.Table
If IsNothing(oReturnDT) Then
_Logger.Warn($"Datatable from ApPServData is nothing [{pAppServDT} - {pAppServFilter}] - Failover via DB")
Return GetDatatable(pDB, pSQL, "", "", "", "DB")
End If
Catch ex As Exception
_Logger.Warn($"Error getting ApPServData [{pAppServDT} - {pAppServFilter}]")
Return GetDatatable(pDB, pSQL, "", "", "", "DB")
End Try
Else
If pDB = "DD_ECM" Then
oReturnDT = My.DatabaseECM.GetDatatable(pSQL)
ElseIf pDB = "IDB" Then
oReturnDT = My.DatabaseIDB.GetDatatable(pSQL)
End If
End If
Return oReturnDT
Catch ex As Exception
_Logger.Error(ex)
End Try
End Function
Public Function CheckModuleData() As Boolean
Try
Dim oSql = String.Format("SELECT * FROM [dbo].[FNDD_CHECK_USER_MODULE] ('{0}','CW',{1})", My.Application.User.UserName)
Dim DT_CHECKUSER_MODULE As DataTable
DT_CHECKUSER_MODULE = GetDatatable("DD_ECM", oSql, "TBDD_USER_MODULE", $"USERNAME = '{My.Application.User.UserName.ToLower}' AND MODULE_SHORT = 'CW'", "", "")
If DT_CHECKUSER_MODULE.Rows.Count = 0 Then
_Logger.Info("DT_CHECKUSER_MODULE.Rows.Count = 0", True)
'ERROR_STATE = "NO USER"
MsgBox("Sorry - Something went wrong in getting Your rights." & vbNewLine & "Please contact the system administrator!", MsgBoxStyle.Exclamation)
Return False
End If
If DT_CHECKUSER_MODULE.Rows.Count = 1 Then
_Logger.Info(">> Login Username: " & My.Application.User.UserName, False)
_Logger.Info(">> Login time: " & Now.ToString, False)
My.Application.User.UserId = DT_CHECKUSER_MODULE.Rows(0).Item("USER_ID")
My.Application.User.Surname = IIf(IsDBNull(DT_CHECKUSER_MODULE.Rows(0).Item("USER_SURNAME")), "", DT_CHECKUSER_MODULE.Rows(0).Item("USER_SURNAME"))
My.Application.User.GivenName = IIf(IsDBNull(DT_CHECKUSER_MODULE.Rows(0).Item("USER_PRENAME")), "", DT_CHECKUSER_MODULE.Rows(0).Item("USER_PRENAME"))
My.Application.User.ShortName = IIf(IsDBNull(DT_CHECKUSER_MODULE.Rows(0).Item("USER_SHORTNAME")), "", DT_CHECKUSER_MODULE.Rows(0).Item("USER_SHORTNAME"))
My.Application.User.Email = IIf(IsDBNull(DT_CHECKUSER_MODULE.Rows(0).Item("USER_EMAIL")), "", DT_CHECKUSER_MODULE.Rows(0).Item("USER_EMAIL"))
My.Application.User.Language = DT_CHECKUSER_MODULE.Rows(0).Item("USER_LANGUAGE")
My.Application.User.LanguageId = DT_CHECKUSER_MODULE.Rows(0).Item("USER_LANGUAGE_ID")
My.Application.User.DateFormat = DT_CHECKUSER_MODULE.Rows(0).Item("USER_DATE_FORMAT")
My.Application.User.IsAdmin = DT_CHECKUSER_MODULE.Rows(0).Item("IS_ADMIN")
ADDITIONAL_TITLE = NotNull(DT_CHECKUSER_MODULE.Rows(0).Item("ADDITIONAL_TITLE"), My.Application.Info.ProductName)
Return True
Else
_Logger.Info(" - User '" & My.Application.User.UserName & "' not listed in Useradministration!", False)
'MsgBox("Achtung: Sie sind nicht in der Userverwaltung hinterlegt." & vbNewLine & "Bitte setzen Sie sich mit dem Systembetreuer in Verbindung!", MsgBoxStyle.Critical, "Achtung:")
'Me.Close()
Dim msg = String.Format("You are not listed in the Useradministration." & vbNewLine & "Please contact the admin.")
MsgBox(msg, MsgBoxStyle.Exclamation)
Return False
End If
Catch ex As Exception
_Logger.Error(ex)
Return False
End Try
End Function
Public Sub Refresh_Connections()
Try
Dim oSql = String.Format("SELECT * FROM TBDD_CONNECTION WHERE AKTIV = 1")
My.Tables.DTDD_CONNECTION = GetDatatable("DD_ECM", oSql, "TBDD_CONNECTION", "", "", "")
Catch ex As Exception
_Logger.Error(ex)
MsgBox("Unexpected Error in Refresh_Connections: " & ex.Message, MsgBoxStyle.Critical)
End Try
End Sub
End Class

4
GUIs.ZooFlow/ClassDragDrop.vb
View File

@ -2,12 +2,12 @@
Imports DevExpress.XtraGrid.Views.Grid
Imports DevExpress.XtraGrid.Views.Grid.ViewInfo
Imports DigitalData.Modules.Logging
Imports DigitalData.Modules.Base
Public Class ClassDragDrop
Inherits Base.BaseClass
Inherits BaseClass
Private downHitInfo As GridHitInfo = Nothing
Private _Logger As Logger
Public Sub New(LogConfig As LogConfig)
MyBase.New(LogConfig)
End Sub

115
GUIs.ZooFlow/ClassHelpers.vb
View File

@ -1,115 +0,0 @@
Imports DigitalData.GUIs.ZooFlow.Base
Imports DigitalData.Modules.Logging
Public Class ClassHelpers
Inherits BaseClass
Public Sub New(pLogConfig As LogConfig)
MyBase.New(pLogConfig)
End Sub
Public Function GetValueFromDatatable(pDatatable As DataTable, pFilterString As String, pCheckColumn As String, pSortString As String) As Object
Try
If pDatatable Is Nothing OrElse pDatatable.Rows.Count = 0 Then
Return Nothing
End If
Dim oDataView As DataView = pDatatable.DefaultView
oDataView.RowFilter = pFilterString
If oDataView.Count > 1 Then
Logger.Warn("Multiple Results For Filter [{0}] and Column [{1}].", pFilterString, pCheckColumn)
Return Nothing
End If
If oDataView.Count = 0 Then
Logger.Warn("No Results For Filter [{0}] and Column [{1}].", pFilterString, pCheckColumn)
Return Nothing
End If
Dim oView As DataRowView = oDataView.Item(0)
Dim oRow As DataRow = oView.Row
Try
Return oRow.Item(pCheckColumn)
Catch ex As Exception
Logger.Warn("Datatable with Filter [{0}] does not contain Column [{1}]", pFilterString, pCheckColumn)
Logger.Error(ex)
Return Nothing
End Try
Catch ex As Exception
Logger.Error(ex)
Return Nothing
End Try
End Function
Public Function GetFilteredDatatable(pDatatable As DataTable, pFilterString As String, pSortString As String) As DataTable
Try
If pDatatable.Rows.Count = 0 Then
Return Nothing
End If
Dim oSelectedRows = pDatatable.Select(pFilterString, pSortString)
If oSelectedRows.Count = 0 Then
Return Nothing
End If
Dim oFilteredTable As DataTable = New DataTable()
oFilteredTable = oSelectedRows.CopyToDataTable()
Return oFilteredTable
Catch ex As Exception
Logger.Error(ex)
Return Nothing
End Try
End Function
Public Shared Function FileExistsinDropTable(Filename As String) As Date
Dim oSQL As String
Dim oHash As String
Dim oFilesystem As New DigitalData.Modules.Filesystem.File(My.LogConfig)
Try
If Filename.Contains("'") Then
Filename = Filename.Replace("'", "''")
End If
Try
oHash = oFilesystem.GetChecksum(Filename)
Catch ex As Exception
oHash = ""
End Try
oSQL = "SELECT * FROM TBGI_FILES_USER WHERE UPPER(FILE_HASH) = UPPER('" & oHash & "') AND WORKED = 0 ORDER BY ADDED_WHEN"
Dim oResult As DataTable = My.DatabaseECM.GetDatatable(oSQL)
If oResult Is Nothing Then
Return Nothing
End If
If oResult.Rows.Count = 0 Then
oSQL = "SELECT * FROM TBGI_HISTORY WHERE UPPER(FILE_HASH) = UPPER('" & oHash & "') ORDER BY ADDED_WHEN"
oResult = My.DatabaseECM.GetDatatable(oSQL)
If oResult Is Nothing Then
Return Nothing
End If
If oResult.Rows.Count = 0 Then
Return Nothing
Else
Dim oFirstRow As DataRow = oResult.Rows.Item(0)
Return oFirstRow.Item("ADDED_WHEN")
End If
Else
Dim oFirstRow As DataRow = oResult.Rows.Item(0)
Return oFirstRow.Item("ADDED_WHEN")
End If
Catch ex As Exception
MsgBox("Error in FileExistsinDropTable - Error-Message:" & vbNewLine & ex.Message & vbNewLine & "SQL-Command:" & vbNewLine & oSQL, MsgBoxStyle.Critical)
Return Nothing
End Try
End Function
End Class

215
GUIs.ZooFlow/ClassIDBData.vb
View File

@ -1,215 +0,0 @@
Imports DigitalData.Modules.EDMI.API
Imports DigitalData.Modules.EDMI.API.Constants
Imports DigitalData.Modules.Logging
Public Class ClassIDBData
Public Property 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>
Private _Logger As Logger
Private _Database As DatabaseWithFallback
Public Sub New(LogConfig As LogConfig)
_Logger = LogConfig.GetLogger
_Database = New DatabaseWithFallback(LogConfig, My.Application.Service.Client, My.DatabaseECM, My.DatabaseIDB)
Dim oSQL = $"SELECT * FROM VWIDB_BE_ATTRIBUTE WHERE LANG_ID = {My.Application.User.LanguageId}"
DTVWIDB_BE_ATTRIBUTE = _Database.GetDatatable("VWIDB_BE_ATTRIBUTE", oSQL, DatabaseType.IDB, $"LANG_ID = {My.Application.User.LanguageId}")
End Sub
Public IDBSystemIndices As List(Of String)
Public Function GetIndicesByBE(ByVal pBusinessEntity As String) As List(Of String)
Try
IDBSystemIndices = New List(Of String) From {
"ObjectID", "IDBCreatedWhen", "IDBCreatedWho", "IDBChangedWhen", "IDBChangedWho"
}
Dim oIndexNames As New List(Of String)
oIndexNames.AddRange(IDBSystemIndices.ToArray)
For Each oRow As DataRow In DTVWIDB_BE_ATTRIBUTE.Rows
oIndexNames.Add(oRow.Item("ATTR_TITLE").ToString)
Next
oIndexNames.Sort()
Return oIndexNames
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 pIndexname As String) As Integer
Try
For Each oRow As DataRow In DTVWIDB_BE_ATTRIBUTE.Rows
If oRow.Item("ATTR_TITLE").ToString = pIndexname Then
Return Integer.Parse(oRow.Item("TYP_ID").ToString)
End If
Next
Catch ex As Exception
_Logger.Error(ex)
Return Nothing
End Try
End Function
Public Function GetVariableValue(pAttributeName As String, Optional pIDBType As Integer = 0, Optional pFromIDB As Boolean = False) As Object
Try
Dim oSingleAttribute As Boolean
Select Case pIDBType
Case 8
oSingleAttribute = False
Case 9
oSingleAttribute = False
Case Else
oSingleAttribute = True
End Select
Dim oAttributeValue As Object = Nothing
If Not IsNothing(My.Tables.DTIDB_DOC_DATA) Then
If oSingleAttribute = True And My.Tables.DTIDB_DOC_DATA.Rows.Count = 1 And pFromIDB = False Then
Try
If pAttributeName = "IDBCreatedWhen" Then
pAttributeName = "ADDED_WHEN"
ElseIf pAttributeName = "IDBCreatedWho" Then
pAttributeName = "ADDED_WHO"
ElseIf pAttributeName = "IDBChangedWhen" Then
pAttributeName = "CHANGED_WHEN"
ElseIf pAttributeName = "IDBChangedWho" Then
pAttributeName = "CHANGED_WHO"
End If
oAttributeValue = My.Tables.DTIDB_DOC_DATA.Rows(0).Item(pAttributeName)
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 [{pAttributeName}] 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_IDB_OBJ_ID},'{pAttributeName}','{My.Application.User.Language}',CONVERT(BIT,'0'))"
Dim oDatatable As DataTable = My.DatabaseIDB.GetDatatable(oFNSQL)
If oDatatable.Rows.Count = 1 Then
oAttributeValue = oDatatable.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(pAttributeName As String, pTerm2Delete As String) As Object
Try
Dim oIdIsForeign As Integer = 1
Dim oDELSQL = $"EXEC PRIDB_DELETE_TERM_OBJECT_METADATA {My.Application.Globix.CURRENT_IDB_OBJ_ID},'{pAttributeName}','{pTerm2Delete}','{My.Application.User.UserName}','{My.Application.User.Language}',{oIdIsForeign}"
My.DatabaseIDB.ExecuteNonQuery(oDELSQL)
Catch ex As Exception
_Logger.Error(ex)
Return Nothing
End Try
End Function
Public Function Delete_AttributeData(pObjectId As Int64, pAttributeName As String) As Object
Try
Dim oDELSQL = $"EXEC PRIDB_DELETE_ATTRIBUTE_DATA {pObjectId},'{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(pAttributeName As String, pNewValue As Object, Optional pCheckDeleted As Boolean = False, Optional oIDBTyp As Integer = 0) As Boolean
Try
Dim oType = pNewValue.GetType.ToString
If oType = "System.Data.DataTable" Then
Dim oDTMyNewValues As DataTable = pNewValue
Dim oOldAttributeResult As Object
Dim oTypeOldResult As Object
If pCheckDeleted = True Then
oOldAttributeResult = GetVariableValue(pAttributeName, oIDBTyp)
oTypeOldResult = oOldAttributeResult.GetType.ToString
If oTypeOldResult = "System.Data.DataTable" Then
Dim oOldValues As DataTable = oOldAttributeResult
If oOldValues.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 oOldValues.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 [{pAttributeName}] - will be deleted!"
_Logger.Debug(oInfo)
SetVariableValue(My.Application.Globix.CURRENT_PROFILE_LOG_INDEX, oInfo)
Delete_Term_Object_From_Metadata(pAttributeName, 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 [{pAttributeName}] - will be deleted!"
_Logger.Debug(oInfo2)
SetVariableValue(My.Application.Globix.CURRENT_PROFILE_LOG_INDEX, oInfo2)
Delete_Term_Object_From_Metadata(pAttributeName, oOldAttributeResult)
End If
Else
Dim oInfo = $"Value [{oOldAttributeResult}] of Attribute [{pAttributeName}] obviously was updated during runtime - will be deleted!"
_Logger.Debug(oInfo)
SetVariableValue(My.Application.Globix.CURRENT_PROFILE_LOG_INDEX, oInfo)
Delete_Term_Object_From_Metadata(pAttributeName, 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_IDB_OBJ_ID},'{pAttributeName}','{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_IDB_OBJ_ID},'{pAttributeName}','{My.Application.User.UserName}','{pNewValue}','{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

1
GUIs.ZooFlow/ClassInit.vb
View File

@ -54,7 +54,6 @@ Public Class ClassInit
#Region "=== Init Steps ==="
Private Sub InitializeBase(MyApplication As My.MyApplication)
My.Helpers = New ClassHelpers(My.LogConfig)
End Sub
Private Sub InitializeDatabase(MyApplication As My.MyApplication)

8
GUIs.ZooFlow/ClassInitLoader.vb
View File

@ -1,8 +1,9 @@
Imports System.ComponentModel
Imports DigitalData.Modules.Logging
Imports DigitalData.Modules.Base
Public Class ClassInitLoader
Inherits Base.BaseClass
Inherits BaseClass
Private _Worker As BackgroundWorker
Private _CurrentStep As InitStep
@ -24,8 +25,9 @@ Public Class ClassInitLoader
End Sub
Public Function Run() As Boolean
_Worker = New BackgroundWorker()
_Worker.WorkerReportsProgress = True
_Worker = New BackgroundWorker With {
.WorkerReportsProgress = True
}
AddHandler _Worker.DoWork, AddressOf DoWork
AddHandler _Worker.ProgressChanged, Sub(sender As Object, e As ProgressChangedEventArgs)

3
GUIs.ZooFlow/ClassWindowLayout.vb
View File

@ -1,8 +1,9 @@
Imports System.Xml
Imports System.IO
Imports DigitalData.Modules.Logging
Imports DigitalData.Modules.Base
Public Class ClassWindowLayout
Inherits Base.BaseClass
Inherits BaseClass
Private _FileName As String
Private _Reader As XmlReader

5
GUIs.ZooFlow/Globix/ClassExclusions.vb
View File

@ -18,8 +18,9 @@
End Function
Private Function CreateExclusionTable() As DataTable
Try
Dim oMyExclusions As New DataTable
oMyExclusions.TableName = "TBEXCLUSION"
Dim oMyExclusions As New DataTable With {
.TableName = "TBEXCLUSION"
}
' Create two columns, ID and Name.
oMyExclusions.Columns.Add("FILE_CONTAIN", GetType(System.String))

161
GUIs.ZooFlow/Globix/ClassFileDrop.vb
View File

@ -1,161 +0,0 @@
Option Strict Off
Imports System.IO
Imports DigitalData.Modules.Logging
Imports Microsoft.Office.Interop
Public Class ClassFileDrop
Inherits Base.BaseClass
Public Property files_dropped As List(Of String)
Private ReadOnly FileHandle As ClassFilehandle
Public Class DroppedFile
Public FilePath As String
Public Enum DropType
Filesystem
OutlookAttachment
OutlookMessage
End Enum
End Class
Public Sub New(pLogConfig As LogConfig)
MyBase.New(pLogConfig)
FileHandle = New ClassFilehandle(pLogConfig)
End Sub
Public Function Drop_File(e As DragEventArgs) As Boolean
Try
Logger.Info("Available Drop Formats:")
For Each oFormat As String In e.Data.GetFormats()
Logger.Debug(oFormat)
Next
Logger.Info(">> Drop_File")
files_dropped = New List(Of String)
If e.Data.GetDataPresent(DataFormats.FileDrop) Then
Dim MyFiles() As String
Dim i As Integer
' Assign the files to an array.
MyFiles = DirectCast(e.Data.GetData(DataFormats.FileDrop), String())
' Loop through the array and add the files to the list.
For i = 0 To MyFiles.Length - 1
Logger.Info(">> Simple FileDrop - File: " & MyFiles(i))
files_dropped.Add("|DROPFROMFSYSTEM|" & MyFiles(i))
Next
Return True
ElseIf (e.Data.GetDataPresent("FileGroupDescriptor")) AndAlso (e.Data.GetDataPresent("FileContents")) Then
'// the first step here is to get the stbFileName
'// of the attachment and
'// build a full-path name so we can store it
'// in the temporary folder
'//
'// set up to obtain the aryFileGroupDescriptor
'// and extract the file name
Dim stmInput As IO.Stream = CType(e.Data.GetData("FileGroupDescriptor"), IO.Stream)
Dim aryFileGroupDescriptor(512) As Byte ' = new byte[512]
stmInput.Read(aryFileGroupDescriptor, 0, 512)
'// used to build the stbFileName from the aryFileGroupDescriptor block
Dim stbFileName As System.Text.StringBuilder = New System.Text.StringBuilder("")
'// this trick gets the stbFileName of the passed attached file
Dim intCnt As Integer = 76
Do While aryFileGroupDescriptor(intCnt) <> 0
stbFileName.Append(Convert.ToChar(aryFileGroupDescriptor(intCnt), System.Globalization.CultureInfo.CreateSpecificCulture("de-DE")))
intCnt += 1
Loop
stmInput.Close()
'Sonderzeichen entfernen
Dim Tempfilename = FileHandle.InvalidCharacters(stbFileName.ToString)
Dim anhaenge = e.Data.GetDataPresent("FileContents")
'Dim path As String = "C:\VBProjekte\Dateien"
'// put the zip file into the temp directory
Dim strOutFile As String = Path.GetTempPath() & Tempfilename
'// create the full-path name
'//
'// Second step: we have the file name.
'// Now we need to get the actual raw
'// data for the attached file and copy it to disk so we work on it.
'//
'// get the actual raw file into memory
Dim msInput As IO.MemoryStream = CType(e.Data.GetData("FileContents", True), IO.MemoryStream) 'This returns nothing for an Email
If msInput Is Nothing = False Then
'// allocate enough bytes to hold the raw date
Dim aryFileBytes(CType(msInput.Length, Int32)) As Byte
'// set starting position at first byte and read in the raw data
msInput.Position = 0
msInput.Read(aryFileBytes, 0, CType(msInput.Length, Int32))
'// create a file and save the raw zip file to it
Dim fsOutput As IO.FileStream = New IO.FileStream(strOutFile, IO.FileMode.Create) ';
fsOutput.Write(aryFileBytes, 0, aryFileBytes.Length)
fsOutput.Close() ' // close the file
Dim resultVersion = FileHandle.Versionierung_Datei(strOutFile)
If resultVersion <> "" Then
strOutFile = resultVersion
End If
Dim finTemp As IO.FileInfo = New IO.FileInfo(strOutFile)
'// always good to make sure we actually created the file
If (finTemp.Exists = True) Then
files_dropped.Add("|OUTLOOK_ATTACHMENT|" & strOutFile)
'ReDim Preserve files_dropped(0)
'files_dropped(0) = "|OUTLOOK_ATTACHMENT|" & strOutFile
Logger.Info(">> Drop an Attachment - File: " & strOutFile)
Return True
Else
Logger.Info(">> Attachment File from Outlook could not be created")
End If
End If
End If
If e.Data.GetDataPresent("FileGroupDescriptor") Then
Dim oApp As Outlook.Application
Try
oApp = New Outlook.Application()
Catch ex As Exception
MsgBox("Unexpected error in Initialisieren von Outlook-API:" & vbNewLine & ex.Message & vbNewLine & vbNewLine & "Evtl ist Outlook nicht in der dafür vorgesehenen For")
End Try
Logger.Info(">> Drop of msg")
'supports a drop of a Outlook message
Dim myobj As Object
For i As Integer = 1 To oApp.ActiveExplorer.Selection.Count
myobj = oApp.ActiveExplorer.Selection.Item(i)
Dim subj As String = myobj.Subject
If subj = "" Then
subj = "NO_SUBJECT"
End If
If subj.Contains("\") Then
subj = subj.Replace("\", "-")
End If
If subj.Contains("/") Then
subj = subj.Replace("/", "-")
End If
'Sonderzeichen entfernen
subj = FileHandle.InvalidCharacters(subj)
'hardcode a destination path for testing
Dim strFile As String = IO.Path.Combine(Path.GetTempPath, subj + ".msg")
strFile = strFile.Replace("?", "")
strFile = strFile.Replace("!", "")
strFile = strFile.Replace("%", "")
strFile = strFile.Replace("$", "")
Logger.Info(">> Drop of msg - File:" & strFile)
Try
myobj.SaveAs(strFile)
Catch ex As Exception
MsgBox("Error in Save Email2Tempfile" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
Return False
End Try
'ReDim Preserve files_dropped(i)
'files_dropped(i) = "|OUTLOOK_MESSAGE|" & strFile
files_dropped.Add("|OUTLOOK_MESSAGE|" & strFile)
Next
Return True
'Drop eines Outlook Attachments
End If
Catch ex As Exception
MsgBox("Error in Drop-File" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
Return False
End Try
End Function
End Class

281
GUIs.ZooFlow/Globix/ClassFilehandle.vb
View File

@ -1,34 +1,47 @@
Option Explicit On
Imports System.IO
Imports System.Text.RegularExpressions
Imports DigitalData.Modules.Logging
Imports Independentsoft
Imports DigitalData.Modules.Base
Imports DigitalData.Modules.Language
Imports DigitalData.Modules.Filesystem
Imports DigitalData.Modules.Messaging
Imports Limilabs.Mail
Public Class ClassFilehandle
Inherits Base.BaseClass
Inherits BaseClass
Private FileEx As File
Private Email As Email2
Private UserFiles As ClassUserFiles
Private TempFiles As New List(Of String)
Public Sub New(pLogConfig As LogConfig)
MyBase.New(pLogConfig)
Email = New Email2(pLogConfig)
FileEx = New File(pLogConfig)
UserFiles = New ClassUserFiles(pLogConfig)
End Sub
Public Sub ClearTempFiles()
For Each oFile In TempFiles
Try
IO.File.Delete(oFile)
Logger.Debug("Temp file [{0}] was deleted.", oFile)
Catch ex As Exception
Logger.Warn("Temp file [{0}] could not be deleted", oFile)
Logger.Error(ex)
End Try
Next
Email.Clear_TempFiles()
TempFiles.Clear()
End Sub
''' <summary>
''' Diese Funktion entfernt alle Zeichen aus dem übergebenen String
''' die in Dateinamen nicht erlaubt sind.
''' </summary>
''' <param name="Input">Der zu prüfende String</param>
''' <returns>String ohne nichterlaubte Zeichen</returns>
Public Function InvalidCharacters(Input As String) As String
Dim replacement = ""
'Return System.Text.RegularExpressions.Regex.Replace(Input, "[\\/:*?""<>|\r\n]", "", System.Text.RegularExpressions.RegexOptions.Singleline)
Dim regexSearch = New String(Path.GetInvalidFileNameChars()) & New String(Path.GetInvalidPathChars())
Dim r = New Regex(String.Format("[{0}]", Regex.Escape(regexSearch)))
Return r.Replace(Input, replacement)
End Function
Public Function CheckDuplicateFiles(Filepath As String, ModuleTitle As String)
Dim oFileInfo As New FileInfo(Filepath)
Dim oFileInfo As New IO.FileInfo(Filepath)
Dim oFilename As String = oFileInfo.Name
Dim oFileExists As Date = ClassHelpers.FileExistsinDropTable(Filepath)
Dim oFileExists As Date = UserFiles.FileExistsinDropTable(Filepath)
If oFileExists.Equals(Date.MinValue) Then
Return True
@ -52,31 +65,62 @@ Public Class ClassFilehandle
Return False
End Function
Public Function Decide_FileHandle(filename As String, handletype As String) As Boolean
Public Function Decide_FileHandle(pFilepath As String, pHandletype As String) As Boolean
Try
If filename.EndsWith(".msg") Then
Dim oTempFilePath = pFilepath
Dim oInboxRegex As New Regex("\.INBOX\d+$")
If oInboxRegex.IsMatch(oTempFilePath) Then
Logger.Info("Renaming INBOX file to EML")
Try
Dim oInfo As New IO.FileInfo(oTempFilePath)
Logger.Info("Old Name: {0}", oInfo.Name)
Dim oNewName = $"{oInfo.Name}.eml"
Logger.Info("New Name: {0}", oNewName)
Dim oTempDirectory = IO.Path.GetTempPath()
Dim oNewPath = IO.Path.Combine(oTempDirectory, oNewName)
IO.File.Copy(oInfo.FullName, oNewPath)
TempFiles.Add(oNewPath)
oTempFilePath = oNewPath
Catch ex As Exception
Logger.Error(ex)
End Try
End If
If oTempFilePath.ToUpper.EndsWith(".MSG") Or oTempFilePath.ToUpper.EndsWith(".EML") Then
My.Application.Globix.CurrMessageID = ""
Dim _msg As New Msg.Message(filename)
If _msg.Attachments.Count > 0 Then
Dim result As DialogResult
Dim oMail As IMail = Email.Load_Email(oTempFilePath)
If oMail.Attachments.Count > 0 Then
Dim oTitle As String
Dim oMessage As String
If My.Application.User.Language = "de-DE" Then
result = MessageBox.Show(New Form With {.TopMost = True}, "Achtung: Die Email enthält Anhänge!" & vbNewLine & "Wollen Sie die Anhänge separat indexieren und herauslösen?", "Nachfrage zur Indexierung:", MessageBoxButtons.YesNo, MessageBoxIcon.Question)
oTitle = "Nachfrage zur Indexierung:"
oMessage = "Achtung: Die Email enthält Anhänge!" & vbNewLine & "Wollen Sie die Anhänge separat indexieren und herauslösen?"
Else
result = MessageBox.Show(New Form With {.TopMost = True}, "Attention: This Email contains Attachments!" & vbNewLine & "Do you want to extract the attachments and index them seperately?", "Question about Indexing:", MessageBoxButtons.YesNo, MessageBoxIcon.Question)
oTitle = "Question about Indexing:"
oMessage = "Attention: This Email contains Attachments!" & vbNewLine & "Do you want to extract the attachments and index them seperately?"
End If
Dim oResult As DialogResult
If result = MsgBoxResult.Yes Then
If handletype.StartsWith("|FW") Then
Return Email_Decay(filename, True)
Else
Return Email_Decay(filename)
End If
' Weird hack to force messagebox to be topmost
' https://stackoverflow.com/questions/1220882/keep-messagebox-show-on-top-of-other-application-using-c-sharp
oResult = MessageBox.Show(oMessage, oTitle, MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1, MessageBoxOptions.DefaultDesktopOnly)
If oResult = MsgBoxResult.Yes Then
Dim oIsFolderWatch = pHandletype.StartsWith("|FW")
Return Save_EmailAndAttachmentsToDisk(oTempFilePath, oIsFolderWatch)
End If
End If
End If
If filename.ToUpper.EndsWith(".LNK") Then
If oTempFilePath.ToUpper.EndsWith(".LNK") Then
If My.Application.User.Language = "de-DE" Then
MsgBox("Verknüpfungen können nicht abgelegt werden!", MsgBoxStyle.Critical, "Global Indexer")
Else
@ -85,164 +129,63 @@ Public Class ClassFilehandle
Return False
End If
Return Insert_GI_File(filename, handletype)
Return UserFiles.Insert_GI_File(oTempFilePath, pHandletype)
Catch ex As Exception
Logger.Error(ex)
MsgBox("Unexpected Error in Decide_FileHandle: " & ex.Message, MsgBoxStyle.Critical)
Return False
End Try
End Function
Private Function Email_Decay(msgname As String, Optional FW As Boolean = False) As Boolean
Private Function Save_EmailAndAttachmentsToDisk(pEmailFilePath As String, Optional pFolderWatch As Boolean = False) As Boolean
Try
Dim msgonly As String = "|MSGONLY|"
Dim ATT_EXTR As String = "|ATTMNTEXTRACTED|"
If FW = True Then
msgonly = "|FW_MSGONLY|"
ATT_EXTR = "|FW_ATTMNTEXTRACTED|"
Dim oMessageOnlyMarker As String = "|MSGONLY|"
Dim oExtractedAttachmentMarker As String = "|ATTMNTEXTRACTED|"
If pFolderWatch = True Then
oMessageOnlyMarker = "|FW_MSGONLY|"
oExtractedAttachmentMarker = "|FW_ATTMNTEXTRACTED|"
End If
Dim erfolgreich As Boolean = False
Dim msg As New Msg.Message(msgname)
Dim oSuccess As Boolean = False
If Not msg.InternetMessageId Is Nothing Then
My.Application.Globix.CurrMessageID = msg.InternetMessageId
Logger.Info("Converting file to Eml if needed: [{0}]", pEmailFilePath)
Dim oEmail As IMail = Email.Load_Email(pEmailFilePath)
If oEmail.MessageID IsNot Nothing Then
My.Application.Globix.CurrMessageID = oEmail.MessageID
Else
Logger.Info(">> Email_Decay: Es konnte keine Message-ID gelesen werden. Eine GUID wird erzeugt!")
Dim sGUID As String
sGUID = System.Guid.NewGuid.ToString()
My.Application.Globix.CurrMessageID = sGUID
Logger.Info("Es konnte keine Message-ID gelesen werden. Eine GUID wird erzeugt!")
My.Application.Globix.CurrMessageID = Guid.NewGuid.ToString()
End If
'Nur die MSGDatei ablegen
Dim tempfile As String = Path.Combine(Path.GetTempPath, Path.GetFileNameWithoutExtension(msgname) & "_excl_att.msg")
Dim oEmailFilePathWithoutAttachments = Email.Remove_AttachmentsFromEmail(pEmailFilePath, "_excl_attachments")
If File.Exists(tempfile) Then
File.Delete(tempfile)
End If
Dim _msgEXAtt As New Msg.Message(msgname)
_msgEXAtt.Attachments.Clear()
_msgEXAtt.Save(tempfile)
'Datei in Array zum Templöschen speichern
My.Application.Globix.TEMP_FILES.Add(tempfile)
TempFiles.Add(oEmailFilePathWithoutAttachments)
If Insert_GI_File(tempfile, msgonly) = True Then
erfolgreich = True
'Hier nun die Anhänge herauslösen
Dim _msg As New Msg.Message(msgname)
Dim i1 As Integer = 1
If UserFiles.Insert_GI_File(oEmailFilePathWithoutAttachments, oMessageOnlyMarker) = True Then
oSuccess = True
Logger.Info(">> Anzahl der Attachments: " & _msg.Attachments.Count)
For Each attachment As Independentsoft.Msg.Attachment In _msg.Attachments
If erfolgreich = False Then
Dim oAttachments As List(Of String) = Email.Save_AttachmentsToDisk(pEmailFilePath)
Logger.Debug("Saved [{0}] attachments to disk.", oAttachments.Count)
For Each oAttachment In oAttachments
TempFiles.Add(oAttachment)
Logger.Debug("Saved attachment [{0}].", oAttachment)
oSuccess = UserFiles.Insert_GI_File(oAttachment, oExtractedAttachmentMarker)
If oSuccess = False Then
Logger.Warn("Saving attachment to disk failed: [{0}]", oAttachment)
Exit For
End If
Dim attachment_name As String
If attachment.LongFileName Is Nothing Then
attachment_name = attachment.DisplayName
Else
attachment_name = attachment.LongFileName
End If
If attachment.EmbeddedMessage IsNot Nothing Then
attachment_name = InvalidCharacters(attachment_name)
tempfile = Path.Combine(Path.GetTempPath, attachment_name & ".msg")
tempfile = CType(Versionierung_Datei(tempfile), String)
If tempfile <> String.Empty Then
Dim oMessage = attachment.EmbeddedMessage
oMessage.Save(tempfile)
My.Application.Globix.TEMP_FILES.Add(tempfile)
Logger.Info("Attachment (" & i1 & "):" & tempfile)
erfolgreich = Insert_GI_File(tempfile, ATT_EXTR)
i1 += 1
End If
ElseIf Not attachment_name.Contains("inline") Then
'Sonderzeichen entfernen
attachment_name = InvalidCharacters(attachment_name)
tempfile = Path.Combine(Path.GetTempPath, attachment_name)
tempfile = Versionierung_Datei(tempfile)
If tempfile <> "" Then
attachment.Save(tempfile)
'Datei in Array zum Templöschen speichern
My.Application.Globix.TEMP_FILES.Add(tempfile)
Logger.Info("Attachment (" & i1 & "):" & tempfile)
'nun der Insert des Anhanges
erfolgreich = Insert_GI_File(tempfile, ATT_EXTR)
i1 += 1
End If
End If
Next
End If
Return erfolgreich
Return oSuccess
Catch ex As Exception
Logger.Warn("Saving email to disk failed (Email_Decay)")
Logger.Error(ex)
MsgBox("Error in Email_Decay: " & ex.Message, MsgBoxStyle.Critical)
Return False
End Try
End Function
Private Function Insert_GI_File(filename As String, handleType As String) As Boolean
Try
filename = filename.Replace("'", "''")
Dim filename_only As String = Path.GetFileName(filename)
Dim ins As String = "INSERT INTO TBGI_FILES_USER (FILENAME2WORK, USER@WORK,HANDLE_TYPE,FILENAME_ONLY) VALUES ('" & filename & "','" & Environment.UserName & "','" & handleType & "','" & filename_only & "')"
Return My.DatabaseECM.ExecuteNonQuery(ins)
Catch ex As Exception
Return False
End Try
End Function
Public Function IsFileInUse(ByVal fullFilePath As String) As Boolean
' Gibt zurück, ob die übergebene Datei momentan exklusiv zu haben ist.
' Prüft, ob die angegeben Datei aktuell durch eine
' andere Anwendung in Benutzung ist
Dim ff As Integer = FreeFile()
If System.IO.File.Exists(fullFilePath) Then
Try
' Versuchen, die Datei mit *exklusiven* Lese- und
' Schreibrechten zu öffnen
FileOpen(ff, fullFilePath, OpenMode.Binary, OpenAccess.ReadWrite, OpenShare.LockReadWrite)
Catch ex As Exception
' Ist ein Fehler aufgetreten, so wird nach außen hin generell
' davon ausgegangen, dass die Datei in Benutzung ist (obwohl
' auch andere Ursachen, etwa Rechteprobleme, möglich sind).
Logger.Info(">> FileInUse Message: " & ex.Message)
Return True
Finally
' Die eventuell geöffnete Datei schließen
FileClose(ff)
End Try
Return False
Else
Return False
End If
End Function
Public Function Versionierung_Datei(Dateiname As String) As String
Dim extension As String
Dim _NewFileString As String = ""
Try
Dim version As Integer = 1
Dim Stammname As String = Path.GetDirectoryName(Dateiname) & "\" & Path.GetFileNameWithoutExtension(Dateiname)
extension = Path.GetExtension(Dateiname)
Dim _neuername As String = Stammname
'Dim MoveFilename As String = DATEINAME.Replace(element.Value, "")
'Überprüfen ob File existiert
If File.Exists(_neuername & extension) = False Then
_NewFileString = _neuername
Else
Do While File.Exists(_neuername & extension)
version = version + 1
_neuername = Stammname & "~" & version
_NewFileString = _neuername
Loop
End If
Return _NewFileString & extension
Catch ex As Exception
Logger.Info(" - Error in versioning file - error: " & vbNewLine & ex.Message)
Logger.Error(ex)
MsgBox(ex.Message, MsgBoxStyle.Critical, "Error in versioning file:")
Return ""
End Try
End Function
End Class

3
GUIs.ZooFlow/Globix/ClassFolderwatcher.vb
View File

@ -1,8 +1,9 @@
Imports System.IO
Imports DigitalData.Modules.Base
Imports DigitalData.Modules.Logging
Public Class ClassFolderwatcher
Inherits Base.BaseClass
Inherits BaseClass
Public Shared FWFolderWatcher As FileSystemWatcher
Public Shared FWScan As FileSystemWatcher

70
GUIs.ZooFlow/Globix/ClassUserFiles.vb Normal file
View File

@ -0,0 +1,70 @@
Imports DigitalData.Modules.Base
Imports DigitalData.Modules.Logging
Public Class ClassUserFiles
Inherits BaseClass
Public Sub New(pLogConfig As LogConfig)
MyBase.New(pLogConfig)
End Sub
Public Function Insert_GI_File(filename As String, handleType As String) As Boolean
Try
filename = filename.Replace("'", "''")
Dim filename_only As String = IO.Path.GetFileName(filename)
Dim ins As String = "INSERT INTO TBGI_FILES_USER (FILENAME2WORK, USER@WORK,HANDLE_TYPE,FILENAME_ONLY) VALUES ('" & filename & "','" & Environment.UserName & "','" & handleType & "','" & filename_only & "')"
Return My.DatabaseECM.ExecuteNonQuery(ins)
Catch ex As Exception
Return False
End Try
End Function
Public Function FileExistsinDropTable(Filename As String) As Date
Dim oSQL As String
Dim oHash As String
Dim oFilesystem As New DigitalData.Modules.Filesystem.File(My.LogConfig)
Try
If Filename.Contains("'") Then
Filename = Filename.Replace("'", "''")
End If
Try
oHash = oFilesystem.GetChecksum(Filename)
Catch ex As Exception
oHash = ""
End Try
oSQL = "SELECT * FROM TBGI_FILES_USER WHERE UPPER(FILE_HASH) = UPPER('" & oHash & "') AND WORKED = 0 ORDER BY ADDED_WHEN"
Dim oResult As DataTable = My.DatabaseECM.GetDatatable(oSQL)
If oResult Is Nothing Then
Return Nothing
End If
If oResult.Rows.Count = 0 Then
oSQL = "SELECT * FROM TBGI_HISTORY WHERE UPPER(FILE_HASH) = UPPER('" & oHash & "') ORDER BY ADDED_WHEN"
oResult = My.DatabaseECM.GetDatatable(oSQL)
If oResult Is Nothing Then
Return Nothing
End If
If oResult.Rows.Count = 0 Then
Return Nothing
Else
Dim oFirstRow As DataRow = oResult.Rows.Item(0)
Return oFirstRow.Item("ADDED_WHEN")
End If
Else
Dim oFirstRow As DataRow = oResult.Rows.Item(0)
Return oFirstRow.Item("ADDED_WHEN")
End If
Catch ex As Exception
MsgBox("Error in FileExistsinDropTable - Error-Message:" & vbNewLine & ex.Message & vbNewLine & "SQL-Command:" & vbNewLine & oSQL, MsgBoxStyle.Critical)
Return Nothing
End Try
End Function
End Class

9
GUIs.ZooFlow/Globix/ClassValidator.vb
View File

@ -1,12 +1,11 @@
Imports DigitalData.Controls.LookupGrid
Imports DigitalData.GUIs.ZooFlow.Base
Imports DevExpress.XtraEditors
Imports DigitalData.Controls.LookupGrid
Imports DigitalData.GUIs.ZooFlow.Globix.Models
Imports DigitalData.GUIs.ZooFlow.frmGlobix_Index
Imports DigitalData.GUIs.GlobalIndexer.ControlCreator
Imports DigitalData.Modules.EDMI.API
Imports DigitalData.Modules.EDMI.API.EDMIServiceReference
Imports DigitalData.Modules.Logging
Imports DigitalData.GUIs.GlobalIndexer.ControlCreator
Imports DevExpress.XtraEditors
Imports DigitalData.Modules.Base
Public Class ClassValidator
Inherits BaseClass

496
GUIs.ZooFlow/Globix/GlobixControls.vb
View File

@ -1,496 +0,0 @@
Imports System.Data.SqlClient
Imports DigitalData.Modules.Logging
Imports Oracle.ManagedDataAccess.Client
Imports DigitalData.Controls.LookupGrid
Imports DigitalData.Modules.Language.Utils
Imports DigitalData.Modules.Patterns
Imports DigitalData.GUIs.ZooFlow.Globix.Models
Public Class GlobixControls
Private Property Form As frmGlobix_Index
Private Property Panel As Panel
Private ReadOnly DocType As DocType
Private Property Patterns2 As Patterns2
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, pDocType As DocType)
_Logger = LogConfig.GetLogger
Me.Form = Form
Me.Panel = Panel
DocType = pDocType
Patterns2 = New Patterns2(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 LookupControl3 With {
.Location = New Point(11, y),
.Size = New Size(300, 27),
.Name = "cmbMulti" & indexname,
.Tag = New ControlMeta() With {
.IndexName = indexname,
.IndexType = DataType
}
}
oControl.Properties.MultiSelect = Multiselect
oControl.Properties.AllowAddNewValues = AddNewValues
oControl.Properties.PreventDuplicates = PreventDuplicateValues
oControl.Properties.AppearanceFocused.BackColor = Color.LightGray
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.Properties.SelectedValues = oDefaultValues
End If
AddHandler oControl.Properties.SelectedValuesChanged, AddressOf Lookup_SelectedValuesChanged
oConnectionString = My.DatabaseECM.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 Patterns2.HasComplexPatterns(oSql) Then
_Logger.Debug("sql enthält Platzhalter und wird erst während der Laufzeit gefüllt!", False)
Else
Dim oDatatable = My.DatabaseECM.GetDatatableWithConnection(oSql, oConnectionString)
oControl.Properties.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 LookupControl3, 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.LightGray
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 = " & DocType.Guid & " ORDER BY SEQUENCE"
Dim DT As DataTable = My.DatabaseECM.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.DatabaseECM.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.DatabaseECM.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.LightGray
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.LightGray
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.DatabaseECM.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 = Patterns2.ReplaceInternalValues(oControlSql)
oControlSql = Patterns2.ReplaceUserValues(oControlSql, My.Application.User)
oControlSql = Patterns2.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.DatabaseECM.Get_ConnectionStringforID(SqlConnectionId)
Dim oDatatable As DataTable = My.DatabaseECM.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(LookupControl3).Name
_Logger.Debug("Setting Value for LookupControl [{0}]: [{1}]", oFoundControl.Name, "DATATABLE")
DirectCast(oFoundControl, LookupControl3).Properties.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

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

@ -6,11 +6,9 @@ Namespace Globix
Public Property DTACTUAL_FILES As DataTable
Public Property TEMP_FILES As List(Of String) = New List(Of String)
Public Property CurrMessageID As String
'Public Property CURRENT_FILENAME As String
Public Property CurrentFolderWatchPath As String
Public Property CURRENT_SCAN_FOLDERWATCH As String
'Public Property CURRENT_WORKFILE_GUID As Long
'Public Property CURRENT_WORKFILE As String
Public Property CurrentWorkfile As Globix.Models.WorkFile
Public Property CURRENT_IDB_OBJ_ID As Long
@ -21,23 +19,6 @@ Namespace Globix
Public Property CURRENT_LASTDOCTYPE As String
Public Property MULTIINDEXING_ACTIVE As Boolean = False
Public Property CURRENT_PROFILE_LOG_INDEX As String
'Public Property DT_FUNCTION_REGEX As DataTable
'Public Property DTTBGI_REGEX_DOCTYPE As DataTable
'Public Property REGEX_CLEAN_FILENAME As String = "[?*^""<>|]"
'Public Property CURRENT_DOCTYPE_ID As Int16
'Public Property CURRENT_WORKFILE_EXTENSION As String
'Public Property CURRENT_NEWFILENAME As String
'Public Property CURRENT_MESSAGEDATE As String
'Public Property CURRENT_MESSAGESUBJECT As String
'Public Property CURRENT_DOCTYPE_DuplicateHandling As String
'Public Property CURR_DT_MAN_INDEXE As DataTable
'Public Property CURR_DT_AUTO_INDEXE As DataTable
'Public Property CURR_DT_DOCTYPE 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 Folderwatchstarted As Boolean = False
Public Property DTEXCLUDE_FILES As DataTable
Public Property PATH_FileExclusions As String = Path.Combine(Application.UserAppDataPath(), "FileExclusions.xml")

6
GUIs.ZooFlow/Globix/frmGlobix_Index.vb
View File

@ -581,7 +581,9 @@ Public Class frmGlobix_Index
End Try
End Sub
Private Function GetLookupData(pLookup As LookupControl3, pSQLCommand As String, pConnectionId As Integer)
Dim oConnectionString = GetConnectionString(pConnectionId)
Dim oConnectionString = Database.GetConnectionString(pConnectionId)
'Dim oConnectionString = GetConnectionString(pConnectionId)
oConnectionString = MSSQLServer.DecryptConnectionString(oConnectionString)
If oConnectionString IsNot Nothing And pSQLCommand.Length > 0 Then
@ -643,7 +645,7 @@ Public Class frmGlobix_Index
Else
MsgBox("Please Index file completely" & vbNewLine & "(Abort 1 of Indexdialog)", MsgBoxStyle.Information)
End If
CancelAttempts = CancelAttempts + 1
CancelAttempts += 1
e.Cancel = True
Case 1
Dim result As MsgBoxResult

77
GUIs.ZooFlow/ModuleHelpers.vb
View File

@ -1,77 +0,0 @@
Imports System.Text
Imports System.Text.RegularExpressions
Module ModuleHelpers
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 GetConnectionString(id As Integer)
Dim connectionString As String = ""
Try
Dim oSQL = "SELECT * FROM TBDD_CONNECTION WHERE GUID = " & id
Dim DTConnection As DataTable = My.Database.GetDatatable("TBDD_CONNECTION", oSQL, Modules.EDMI.API.Constants.DatabaseType.ECM, $"GUID = {id}")
If DTConnection.Rows.Count = 1 Then
Dim CSType = DTConnection.Rows(0).Item("SQL_PROVIDER").ToString.ToUpper
Select Case CSType
Case "MS-SQL".ToUpper
If DTConnection.Rows(0).Item("USERNAME").ToString.ToLower = "winauth" Then
connectionString = "Data Source=" & DTConnection.Rows(0).Item("SERVER") & ";Initial Catalog= " & DTConnection.Rows(0).Item("DATENBANK") & ";Trusted_Connection=True;"
Else
connectionString = "Data Source=" & DTConnection.Rows(0).Item("SERVER") & ";Initial Catalog= " & DTConnection.Rows(0).Item("DATENBANK") & ";User Id=" & DTConnection.Rows(0).Item("USERNAME") & ";Password=" & DTConnection.Rows(0).Item("PASSWORD") & ";"
End If
Case "MS-SQLServer".ToUpper
If DTConnection.Rows(0).Item("USERNAME").ToString.ToLower = "winauth" Then
connectionString = "Data Source=" & DTConnection.Rows(0).Item("SERVER") & ";Initial Catalog= " & DTConnection.Rows(0).Item("DATENBANK") & ";Trusted_Connection=True;"
Else
connectionString = "Data Source=" & DTConnection.Rows(0).Item("SERVER") & ";Initial Catalog= " & DTConnection.Rows(0).Item("DATENBANK") & ";User Id=" & DTConnection.Rows(0).Item("USERNAME") & ";Password=" & DTConnection.Rows(0).Item("PASSWORD") & ";"
End If
Case "Oracle".ToUpper
If DTConnection.Rows(0).Item("BEMERKUNG").ToString.Contains("without tnsnames") Then
connectionString = "Data Source=(DESCRIPTION=(ADDRESS_LIST=(ADDRESS=(PROTOCOL=TCP)(HOST=" & DTConnection.Rows(0).Item("SERVER") & ")(PORT=1521)))(CONNECT_DATA=(SERVER=DEDICATED)(SERVICE_NAME=" &
DTConnection.Rows(0).Item("DATENBANK") & ")));User Id=" & DTConnection.Rows(0).Item("USERNAME") & ";Password=" & DTConnection.Rows(0).Item("PASSWORD") & ";"
Else
connectionString = "Data Source=" & DTConnection.Rows(0).Item("SERVER") & ";Persist Security Info=True;User Id=" & DTConnection.Rows(0).Item("USERNAME") & ";Password=" & DTConnection.Rows(0).Item("PASSWORD") & ";Unicode=True"
End If
Case Else
MsgBox("ConnectionType not integrated", MsgBoxStyle.Critical, "Please check connection:")
End Select
End If
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "Error in GetConnectionString:")
End Try
Return connectionString
End Function
End Module

6
GUIs.ZooFlow/My Project/AssemblyInfo.vb
View File

@ -10,7 +10,7 @@ Imports System.Runtime.InteropServices
<Assembly: AssemblyConfiguration("")>
<Assembly: AssemblyCompany("Digital Data")>
<Assembly: AssemblyProduct("ZooFlow")>
<Assembly: AssemblyCopyright("Copyright © 2020")>
<Assembly: AssemblyCopyright("Copyright © 2022")>
<Assembly: AssemblyTrademark("")>
<Assembly: AssemblyCulture("")>
@ -32,5 +32,5 @@ Imports System.Runtime.InteropServices
' You can specify all the values or you can default the Build and Revision Numbers
' by using the '*' as shown below:
' [assembly: AssemblyVersion("1.0.*")]
<Assembly: AssemblyVersion("0.0.4.0")>
<Assembly: AssemblyFileVersion("1.1.0.2")>
<Assembly: AssemblyVersion("1.0.0.0")>
<Assembly: AssemblyFileVersion("1.0.0.0")>

25
GUIs.ZooFlow/My Project/licenses.licx
View File

@ -1,16 +1,17 @@
DevExpress.XtraEditors.ComboBoxEdit, DevExpress.XtraEditors.v21.2, Version=21.2.4.0, Culture=neutral, PublicKeyToken=b88d1754d700e49a
DevExpress.XtraNavBar.NavBarControl, DevExpress.XtraNavBar.v21.2, Version=21.2.4.0, Culture=neutral, PublicKeyToken=b88d1754d700e49a
DevExpress.XtraLayout.LayoutControl, DevExpress.XtraLayout.v21.2, Version=21.2.4.0, Culture=neutral, PublicKeyToken=b88d1754d700e49a
DevExpress.XtraEditors.DateEdit, DevExpress.XtraEditors.v21.2, Version=21.2.4.0, Culture=neutral, PublicKeyToken=b88d1754d700e49a
DevExpress.XtraBars.Docking.DockManager, DevExpress.XtraBars.v21.2, Version=21.2.4.0, Culture=neutral, PublicKeyToken=b88d1754d700e49a
DevExpress.XtraBars.BarManager, DevExpress.XtraBars.v21.2, Version=21.2.4.0, Culture=neutral, PublicKeyToken=b88d1754d700e49a
DevExpress.XtraTreeList.TreeList, DevExpress.XtraTreeList.v21.2, Version=21.2.4.0, Culture=neutral, PublicKeyToken=b88d1754d700e49a
DevExpress.XtraEditors.CheckEdit, DevExpress.XtraEditors.v21.2, Version=21.2.4.0, Culture=neutral, PublicKeyToken=b88d1754d700e49a
DevExpress.XtraEditors.ButtonEdit, DevExpress.XtraEditors.v21.2, Version=21.2.4.0, Culture=neutral, PublicKeyToken=b88d1754d700e49a
DevExpress.XtraEditors.TileControl, DevExpress.XtraEditors.v21.2, Version=21.2.4.0, Culture=neutral, PublicKeyToken=b88d1754d700e49a
DevExpress.XtraEditors.LookUpEdit, DevExpress.XtraEditors.v21.2, Version=21.2.4.0, Culture=neutral, PublicKeyToken=b88d1754d700e49a
DevExpress.XtraBars.Ribbon.RibbonControl, DevExpress.XtraBars.v21.2, Version=21.2.4.0, Culture=neutral, PublicKeyToken=b88d1754d700e49a
DevExpress.XtraBars.Docking.DockManager, DevExpress.XtraBars.v21.2, Version=21.2.4.0, Culture=neutral, PublicKeyToken=b88d1754d700e49a
DevExpress.XtraBars.Ribbon.RibbonControl, DevExpress.XtraBars.v19.2, Version=19.2.3.0, Culture=neutral, PublicKeyToken=b88d1754d700e49a
DevExpress.XtraGrid.GridControl, DevExpress.XtraGrid.v21.2, Version=21.2.4.0, Culture=neutral, PublicKeyToken=b88d1754d700e49a
DevExpress.XtraEditors.PictureEdit, DevExpress.XtraEditors.v21.2, Version=21.2.4.0, Culture=neutral, PublicKeyToken=b88d1754d700e49a
DevExpress.XtraEditors.ProgressBarControl, DevExpress.XtraEditors.v21.2, Version=21.2.4.0, Culture=neutral, PublicKeyToken=b88d1754d700e49a
DevExpress.XtraEditors.DateEdit, DevExpress.XtraEditors.v21.2, Version=21.2.4.0, Culture=neutral, PublicKeyToken=b88d1754d700e49a
DevExpress.XtraEditors.ComboBoxEdit, DevExpress.XtraEditors.v21.2, Version=21.2.4.0, Culture=neutral, PublicKeyToken=b88d1754d700e49a
DevExpress.XtraEditors.TextEdit, DevExpress.XtraEditors.v21.2, Version=21.2.4.0, Culture=neutral, PublicKeyToken=b88d1754d700e49a
DevExpress.XtraEditors.CheckEdit, DevExpress.XtraEditors.v21.2, Version=21.2.4.0, Culture=neutral, PublicKeyToken=b88d1754d700e49a
DevExpress.XtraEditors.TileControl, DevExpress.XtraEditors.v21.2, Version=21.2.4.0, Culture=neutral, PublicKeyToken=b88d1754d700e49a
DevExpress.XtraBars.Ribbon.RibbonControl, DevExpress.XtraBars.v19.2, Version=19.2.3.0, Culture=neutral, PublicKeyToken=b88d1754d700e49a
DevExpress.XtraBars.BarManager, DevExpress.XtraBars.v21.2, Version=21.2.4.0, Culture=neutral, PublicKeyToken=b88d1754d700e49a
DevExpress.XtraEditors.ButtonEdit, DevExpress.XtraEditors.v21.2, Version=21.2.4.0, Culture=neutral, PublicKeyToken=b88d1754d700e49a
DevExpress.XtraTreeList.TreeList, DevExpress.XtraTreeList.v21.2, Version=21.2.4.0, Culture=neutral, PublicKeyToken=b88d1754d700e49a
DevExpress.XtraBars.Ribbon.RibbonControl, DevExpress.XtraBars.v21.2, Version=21.2.4.0, Culture=neutral, PublicKeyToken=b88d1754d700e49a
DevExpress.XtraNavBar.NavBarControl, DevExpress.XtraNavBar.v21.2, Version=21.2.4.0, Culture=neutral, PublicKeyToken=b88d1754d700e49a
DevExpress.XtraLayout.LayoutControl, DevExpress.XtraLayout.v21.2, Version=21.2.4.0, Culture=neutral, PublicKeyToken=b88d1754d700e49a

2
GUIs.ZooFlow/MyApplication.vb
View File

@ -36,7 +36,6 @@ Namespace My
Property Tables As New ClassTables
Property Queries As New ClassQueries
Property Helpers As ClassHelpers
#End Region
End Module
@ -55,7 +54,6 @@ Namespace My
Public Property IDB_ConnectionString As String
Public Property Globix As New Globix.State
Public Property Search As New Search.State
Public Property Sidebar As Sidebar2
Public CommandLineFunction As String
Public CommandLineArguments As New Dictionary(Of String, String)

94
GUIs.ZooFlow/Sidebar.vb
View File

@ -1,94 +0,0 @@
Public Class Sidebar
#Region "Sidebar Declarations"
Private Declare Function SetWindowPos Lib "user32" Alias "SetWindowPos" (ByVal hwnd As IntPtr, ByVal hWndInsertAfter As Integer, ByVal x As Integer, ByVal y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer) As Integer
Public Declare Auto Function MoveWindow Lib "user32.dll" (ByVal hWnd As IntPtr, ByVal X As Int32, ByVal Y As Int32, ByVal nWidth As Int32, ByVal nHeight As Int32, ByVal bRepaint As Boolean) As Boolean
Declare Function SHAppBarMessage Lib "shell32.dll" Alias "SHAppBarMessage" (ByVal dwMessage As Integer, ByRef pData As APPBARDATA) As Integer
Declare Function SetWindowPos Lib "user32.dll" (ByVal hwnd As Integer, ByVal hWndInsertAfter As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal cX As Integer, ByVal cY As Integer, ByVal wFlags As Integer) As Integer
Structure APPBARDATA
Dim cbSize As Integer
Dim hwnd As Integer
Dim uCallbackMessage As [Delegate]
Dim uEdge As Integer
Dim rc As RECT
Dim lParam As Integer ' message specific
End Structure
Structure RECT
Dim Left As Integer
Dim Top As Integer
Dim Right As Integer
Dim Bottom As Integer
End Structure
Const ABE_LEFT As Integer = 0
Const ABE_TOP As Integer = &H1
Const ABE_RIGHT As Integer = 2
Const ABE_BOTTOM As Integer = 3
Const ABM_NEW As Integer = 0
Const ABM_REMOVE As Integer = 1
Const ABM_QUERYPOS As Integer = 2
Const ABM_SETPOS As Integer = &H3
Const ABM_GETSTATE As Integer = 4
Const ABM_GETTASKBARPOS As Integer = 5
Const ABM_ACTIVATE As Integer = 6
Const ABM_GETAUTOHIDEBAR As Integer = 7
Const ABM_SETAUTOHIDEBAR As Integer = 8
Const ABM_WINDOWPOSCHANGED As Integer = 9
Const ABS_AUTOHIDE As Integer = 1
Const ABS_ALWAYSONTOP As Integer = 2
Const HWND_NOTTOPMOST As Integer = -2
Const HWND_TOPMOST As Integer = -1
Const HWND_TOP As Integer = 0
Const SHOWNORMAL As Integer = 5
Const SWP_NOSIZE As Integer = &H1
Const SWP_NOMOVE As Short = &H2
Const SWP_NOZORDER As Integer = 4
Const SWP_NOACTIVATE As Integer = &H10
Const SWP_DRAWFRAME As Integer = &H20
Const SWP_SHOWWINDOW As Integer = &H40
#End Region
Private Sidebar As APPBARDATA
Private Handle As IntPtr
Public Sub New(pHandle As IntPtr)
Handle = pHandle
End Sub
Public Sub RegisterSidebar(pScreenName As String)
Sidebar.hwnd = Handle.ToInt32
Sidebar.cbSize = Len(Sidebar)
Dim oSelectedScreen = System.Windows.Forms.Screen.PrimaryScreen
' TODO: Make Sidebar Screen configurable
'If pScreenName <> "" Then
' Dim oScreens = System.Windows.Forms.Screen.AllScreens
' For Each oScreen In oScreens
' If oScreen.DeviceName = pScreenName Then
' oSelectedScreen = oScreen
' End If
' Next
'End If
With Sidebar
.uEdge = ABE_RIGHT
.rc.Top = oSelectedScreen.WorkingArea.Top '0
.rc.Right = oSelectedScreen.WorkingArea.Right ' right
.rc.Left = oSelectedScreen.WorkingArea.Right - 200 ' width of our appbar
.rc.Bottom = oSelectedScreen.WorkingArea.Height ' bottom
SHAppBarMessage(ABM_NEW, Sidebar)
SetWindowPos(Sidebar.hwnd, HWND_TOP, .rc.Left, .rc.Top, .rc.Right - .rc.Left, .rc.Bottom, SWP_SHOWWINDOW Or SWP_NOACTIVATE)
SHAppBarMessage(ABM_SETPOS, Sidebar)
End With
End Sub
Public Sub UnregisterSidebar()
SHAppBarMessage(ABM_REMOVE, Sidebar)
End Sub
End Class

170
GUIs.ZooFlow/Sidebar2.vb
View File

@ -1,170 +0,0 @@
Imports System.Runtime.InteropServices
Public Class Sidebar2
<DllImport("SHELL32", CallingConvention:=CallingConvention.StdCall)>
Private Shared Function SHAppBarMessage(ByVal dwMessage As Integer, ByRef BarrData As AppDeskBar) As Integer
End Function
<DllImport("User32.dll", CharSet:=CharSet.Auto)>
Public Shared Function RegisterWindowMessage(ByVal msg As String) As Integer
End Function
Structure RECT
Public left As Integer
Public top As Integer
Public right As Integer
Public bottom As Integer
End Structure
Structure AppDeskBar
Public cbSize As Integer
Public hWnd As IntPtr
Public uCallbackMessage As Integer
Public uEdge As Integer
Public rc As RECT
Public lParam As IntPtr
End Structure
Public Enum ABMsg
ABM_NEW = 0
ABM_REMOVE = 1
ABM_QUERYPOS = 2
ABM_SETPOS = 3
ABM_GETSTATE = 4
ABM_GETTASKBARPOS = 5
ABM_ACTIVATE = 6
ABM_GETAUTOHIDEBAR = 7
ABM_SETAUTOHIDEBAR = 8
ABM_WINDOWPOSCHANGED = 9
ABM_SETSTATE = 10
End Enum
Public Enum ABEdge
ABE_LEFT = 0
ABE_TOP = 1
ABE_RIGHT = 2
ABE_BOTTOM = 3
End Enum
Public Enum ABNotify
ABN_STATECHANGE = 0
ABN_POSCHANGED = 1
ABN_FULLSCREENAPP = 2
ABN_WINDOWARRANGE = 3
End Enum
Private AppDeskData As AppDeskBar
Private fBarRegistered As Boolean = False
Private Form As Form
Public ReadOnly Property SidebarRegistered As Boolean
Get
Return fBarRegistered
End Get
End Property
Public Property uCallBack As Integer
Public Sub New(pForm As Form)
Form = pForm
End Sub
Public Sub RegisterBar(dockEdge As ABEdge)
AppDeskData = New AppDeskBar()
AppDeskData.cbSize = Marshal.SizeOf(AppDeskData)
AppDeskData.hWnd = Form.Handle
If Not fBarRegistered Then
fBarRegistered = True
Form.FormBorderStyle = FormBorderStyle.None
Form.ShowInTaskbar = False
uCallBack = RegisterWindowMessage("AppBarMessage")
AppDeskData.uCallbackMessage = uCallBack
'ToDo: Unsigned Integers not supported
SHAppBarMessage(CInt(ABMsg.ABM_NEW), AppDeskData)
ABSetPos(dockEdge)
Else
SHAppBarMessage(CInt(ABMsg.ABM_REMOVE), AppDeskData)
fBarRegistered = False
End If
End Sub
Public Sub UnregisterSidebar()
If fBarRegistered = True Then
fBarRegistered = False
Form.FormBorderStyle = FormBorderStyle.Sizable
Form.ShowInTaskbar = True
'----NEW
Dim abd As New AppDeskBar()
abd.cbSize = Marshal.SizeOf(abd)
abd.hWnd = Form.Handle
' TODO: Save and restore width and taskbar
'Me.Width = 305
'Me.Height = 85
'Me.ShowInTaskbar = True
SHAppBarMessage(ABMsg.ABM_REMOVE, abd)
End If
End Sub
Public Sub ABSetPos(dockEdge As ABEdge)
Dim abd As New AppDeskBar()
abd.cbSize = Marshal.SizeOf(abd)
abd.hWnd = Form.Handle
abd.uEdge = CInt(dockEdge)
If abd.uEdge = CInt(ABEdge.ABE_LEFT) Or abd.uEdge = CInt(ABEdge.ABE_RIGHT) Then
abd.rc.top = 0
abd.rc.bottom = SystemInformation.PrimaryMonitorSize.Height
If abd.uEdge = CInt(ABEdge.ABE_LEFT) Then
abd.rc.left = 0
abd.rc.right = Form.Size.Width
Else
abd.rc.right = SystemInformation.PrimaryMonitorSize.Width
abd.rc.left = abd.rc.right - Form.Size.Width
End If
Else
abd.rc.left = 0
abd.rc.right = SystemInformation.PrimaryMonitorSize.Width
If abd.uEdge = CInt(ABEdge.ABE_TOP) Then
abd.rc.top = 0
abd.rc.bottom = Form.Size.Height
Else
abd.rc.bottom = SystemInformation.PrimaryMonitorSize.Height
abd.rc.top = abd.rc.bottom - Form.Size.Height
End If
End If
' Query the system for an approved size and position.
SHAppBarMessage(CInt(ABMsg.ABM_QUERYPOS), abd)
' Adjust the rectangle, depending on the edge to which the
' appbar is anchored.
Select Case abd.uEdge
Case CInt(ABEdge.ABE_LEFT)
abd.rc.right = abd.rc.left + Form.Size.Width
Case CInt(ABEdge.ABE_RIGHT)
abd.rc.left = abd.rc.right - Form.Size.Width
Case CInt(ABEdge.ABE_TOP)
abd.rc.bottom = abd.rc.top + Form.Size.Height
Case CInt(ABEdge.ABE_BOTTOM)
abd.rc.top = abd.rc.bottom - Form.Size.Height
End Select
' Pass the final bounding rectangle to the system.
SHAppBarMessage(CInt(ABMsg.ABM_SETPOS), abd)
' Move and size the appbar so that it conforms to the
' bounding rectangle passed to the system.
Form.Location = New Point(abd.rc.left, abd.rc.top)
Dim PSBH = System.Windows.Forms.Screen.PrimaryScreen.Bounds.Height
Dim TaskBarHeight = PSBH - System.Windows.Forms.Screen.PrimaryScreen.WorkingArea.Height
Form.Height = Screen.PrimaryScreen.Bounds.Height - TaskBarHeight
' MoveWindow(abd.hWnd, abd.rc.left, abd.rc.top, abd.rc.right - abd.rc.left, abd.rc.bottom - abd.rc.top, True)
End Sub
End Class

11
GUIs.ZooFlow/ZooFlow.vbproj
View File

@ -101,6 +101,7 @@
<Reference Include="Independentsoft.Msg">
<HintPath>P:\Visual Studio Projekte\Bibliotheken\MSG .NET\Bin\22_11_19\Independentsoft.Msg.dll</HintPath>
</Reference>
<Reference Include="Mail, Version=3.0.21189.1553, Culture=neutral, PublicKeyToken=6dc438ab78a525b3" />
<Reference Include="Microsoft.Office.Interop.Outlook, Version=15.0.0.0, Culture=neutral, PublicKeyToken=71e9bce111e9429c, processorArchitecture=MSIL">
<SpecificVersion>False</SpecificVersion>
<EmbedInteropTypes>True</EmbedInteropTypes>
@ -215,13 +216,11 @@
</Compile>
<Compile Include="Administration\ClassSourceBundle.vb" />
<Compile Include="ApplicationEvents.vb" />
<Compile Include="Base\BaseClass.vb" />
<Compile Include="ClassDragDrop.vb" />
<Compile Include="ClassStrings.vb" />
<Compile Include="ClipboardWatcher\ClassProfileLoader.vb" />
<Compile Include="ClipboardWatcher\Watcher.vb" />
<Compile Include="ClassCommandlineArgs.vb" />
<Compile Include="ClassDataASorDB.vb" />
<Compile Include="clsPatterns.vb" />
<Compile Include="DBCW_Stammdaten.Designer.vb">
<AutoGen>True</AutoGen>
@ -258,7 +257,6 @@
<SubType>Form</SubType>
</Compile>
<Compile Include="Globix\ClassExclusions.vb" />
<Compile Include="ClassHelpers.vb" />
<Compile Include="Globix\ClassValidator.vb" />
<Compile Include="Globix\frmGlobixNameconvention.Designer.vb">
<DependentUpon>frmGlobixNameconvention.vb</DependentUpon>
@ -275,6 +273,7 @@
<Compile Include="frmWaitForm.vb">
<SubType>Form</SubType>
</Compile>
<Compile Include="Globix\ClassUserFiles.vb" />
<Compile Include="modCurrent.vb" />
<Compile Include="MyDataset.Designer.vb">
<AutoGen>True</AutoGen>
@ -310,12 +309,10 @@
<SubType>Form</SubType>
</Compile>
<Compile Include="Search\ClassControlCreator.vb" />
<Compile Include="Globix\ClassFileDrop.vb" />
<Compile Include="Globix\ClassFilehandle.vb" />
<Compile Include="ClassInit.vb" />
<Compile Include="ClassWindowLayout.vb" />
<Compile Include="ClipboardWatcher\State.vb" />
<Compile Include="ClassIDBData.vb" />
<Compile Include="DSIDB_Stammdaten.Designer.vb">
<AutoGen>True</AutoGen>
<DesignTime>True</DesignTime>
@ -371,9 +368,7 @@
<Compile Include="Search\frmSearchStart.vb">
<SubType>Form</SubType>
</Compile>
<Compile Include="Globix\GlobixControls.vb" />
<Compile Include="Globix\State.vb" />
<Compile Include="ModuleHelpers.vb" />
<Compile Include="My Project\Resources.Designer.vb">
<AutoGen>True</AutoGen>
<DesignTime>True</DesignTime>
@ -417,8 +412,6 @@
<Compile Include="Search\SearchFilter.vb" />
<Compile Include="Search\SearchToken.vb" />
<Compile Include="Search\State.vb" />
<Compile Include="Sidebar.vb" />
<Compile Include="Sidebar2.vb" />
<EmbeddedResource Include="Administration\frmAdmin_ClipboardWatcher.resx">
<DependentUpon>frmAdmin_ClipboardWatcher.vb</DependentUpon>
</EmbeddedResource>

420
GUIs.ZooFlow/clsPatterns.vb
View File

@ -100,195 +100,195 @@ Public Class clsPatterns
' End Try
'End Function
Public Shared Function ReplaceInternalValues(pInput As String) As String
Dim oResult = pInput
'Public Shared Function ReplaceInternalValues(pInput As String) As String
' Dim oResult = pInput
Try
' Replace Username(s)
While ContainsPatternAndValue(oResult, PATTERN_INT, INT_VALUE_USERNAME)
oResult = ReplacePattern(oResult, PATTERN_INT, My.Application.User.UserName)
End While
' Try
' ' Replace Username(s)
' While ContainsPatternAndValue(oResult, PATTERN_INT, INT_VALUE_USERNAME)
' oResult = ReplacePattern(oResult, PATTERN_INT, My.Application.User.UserName)
' End While
' Replace Machinename(s)
While ContainsPatternAndValue(oResult, PATTERN_INT, INT_VALUE_MACHINE)
oResult = ReplacePattern(oResult, PATTERN_INT, Environment.MachineName)
End While
' ' Replace Machinename(s)
' While ContainsPatternAndValue(oResult, PATTERN_INT, INT_VALUE_MACHINE)
' oResult = ReplacePattern(oResult, PATTERN_INT, Environment.MachineName)
' End While
' Replace Domainname(s)
While ContainsPatternAndValue(oResult, PATTERN_INT, INT_VALUE_DOMAIN)
oResult = ReplacePattern(oResult, PATTERN_INT, Environment.UserDomainName)
End While
' ' Replace Domainname(s)
' While ContainsPatternAndValue(oResult, PATTERN_INT, INT_VALUE_DOMAIN)
' oResult = ReplacePattern(oResult, PATTERN_INT, Environment.UserDomainName)
' End While
' Replace CurrentDate(s)
While ContainsPatternAndValue(oResult, PATTERN_INT, INT_VALUE_DATE)
oResult = ReplacePattern(oResult, PATTERN_INT, Now.ToShortDateString)
End While
' ' Replace CurrentDate(s)
' While ContainsPatternAndValue(oResult, PATTERN_INT, INT_VALUE_DATE)
' oResult = ReplacePattern(oResult, PATTERN_INT, Now.ToShortDateString)
' End While
Return oResult
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Info("Error in ReplaceInternalValues:" & ex.Message)
Return oResult
End Try
End Function
' Return oResult
' Catch ex As Exception
' LOGGER.Error(ex)
' LOGGER.Info("Error in ReplaceInternalValues:" & ex.Message)
' Return oResult
' End Try
'End Function
Public Shared Function ReplaceUserValues(input As String) As String
Try
Dim result = input
'Public Shared Function ReplaceUserValues(input As String) As String
' Try
' Dim result = input
While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_PRENAME)
result = ReplacePattern(result, PATTERN_USER, My.Application.User.GivenName)
End While
' While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_PRENAME)
' result = ReplacePattern(result, PATTERN_USER, My.Application.User.GivenName)
' End While
While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_USER_ID)
result = ReplacePattern(result, PATTERN_USER, My.Application.User.UserId)
End While
' While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_USER_ID)
' result = ReplacePattern(result, PATTERN_USER, My.Application.User.UserId)
' End While
While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_SURNAME)
result = ReplacePattern(result, PATTERN_USER, My.Application.User.Surname)
End While
' While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_SURNAME)
' result = ReplacePattern(result, PATTERN_USER, My.Application.User.Surname)
' End While
While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_SHORTNAME)
result = ReplacePattern(result, PATTERN_USER, My.Application.User.ShortName)
End While
' While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_SHORTNAME)
' result = ReplacePattern(result, PATTERN_USER, My.Application.User.ShortName)
' End While
While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_LANGUAGE)
result = ReplacePattern(result, PATTERN_USER, My.Application.User.Language)
End While
' While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_LANGUAGE)
' result = ReplacePattern(result, PATTERN_USER, My.Application.User.Language)
' End While
While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_EMAIL)
result = ReplacePattern(result, PATTERN_USER, My.Application.User.Email)
End While
' While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_EMAIL)
' result = ReplacePattern(result, PATTERN_USER, My.Application.User.Email)
' End While
Return result
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Info("Error in ReplaceUserValues:" & ex.Message)
End Try
End Function
' Return result
' Catch ex As Exception
' LOGGER.Error(ex)
' LOGGER.Info("Error in ReplaceUserValues:" & ex.Message)
' End Try
'End Function
Public Shared Function ReplaceControlValues(pInput As String, oPanel As Panel, oIsSQL As Boolean) As String
Dim oResult = pInput
'Public Shared Function ReplaceControlValues(pInput As String, oPanel As Panel, oIsSQL As Boolean) As String
' Dim oResult = pInput
Try
' Try
Dim oTryCounter = 0
' Dim oTryCounter = 0
While ContainsPattern(oResult, PATTERN_CTRL)
If oTryCounter > MAX_TRY_COUNT Then
LOGGER.Warn($"Max tries in ReplaceControlValues exceeded - Replacing with [0]")
oResult = ReplacePattern(oResult, PATTERN_CTRL, 0)
Throw New Exception($"Max tries in ReplaceControlValues exceeded - Result so far [{oResult}].")
End If
' While ContainsPattern(oResult, PATTERN_CTRL)
' If oTryCounter > MAX_TRY_COUNT Then
' LOGGER.Warn($"Max tries in ReplaceControlValues exceeded - Replacing with [0]")
' oResult = ReplacePattern(oResult, PATTERN_CTRL, 0)
' Throw New Exception($"Max tries in ReplaceControlValues exceeded - Result so far [{oResult}].")
' End If
Dim oControlName As String = GetNextPattern(oResult, PATTERN_CTRL).Value
Dim oColumnName As String = String.Empty
' Dim oControlName As String = GetNextPattern(oResult, PATTERN_CTRL).Value
' Dim oColumnName As String = String.Empty
If oControlName.Contains("::") Then
Dim oSplitName = Split(oControlName, "::").ToList()
oControlName = oSplitName.First()
oColumnName = oSplitName.Last()
End If
' If oControlName.Contains("::") Then
' Dim oSplitName = Split(oControlName, "::").ToList()
' oControlName = oSplitName.First()
' oColumnName = oSplitName.Last()
' End If
LOGGER.Debug("Found placeholder for control [{0}].", oControlName)
' LOGGER.Debug("Found placeholder for control [{0}].", oControlName)
Dim oControl As Control = oPanel.Controls.Find(oControlName, False).FirstOrDefault()
' Dim oControl As Control = oPanel.Controls.Find(oControlName, False).FirstOrDefault()
If oControl IsNot Nothing Then
Dim oReplaceValue As String
Select Case oControl.GetType
Case GetType(TextBox)
oReplaceValue = oControl.Text
' If oControl IsNot Nothing Then
' Dim oReplaceValue As String
' Select Case oControl.GetType
' Case GetType(TextBox)
' oReplaceValue = oControl.Text
Case GetType(LookupControl3)
Dim oLookupControl3 As LookupControl3 = oControl
If oLookupControl3.Properties.SelectedValues.Count = 1 Then
oReplaceValue = oLookupControl3.Properties.SelectedValues.Item(0)
Else
oReplaceValue = ERROR_REPLACE_VALUE
End If
' Case GetType(LookupControl3)
' Dim oLookupControl3 As LookupControl3 = oControl
' If oLookupControl3.Properties.SelectedValues.Count = 1 Then
' oReplaceValue = oLookupControl3.Properties.SelectedValues.Item(0)
' Else
' oReplaceValue = ERROR_REPLACE_VALUE
' End If
Case GetType(ComboBox)
oReplaceValue = oControl.Text
' Case GetType(ComboBox)
' oReplaceValue = oControl.Text
Case GetType(CheckBox)
Dim oCheckBox As CheckBox = oControl
oReplaceValue = oCheckBox.Checked
' Case GetType(CheckBox)
' Dim oCheckBox As CheckBox = oControl
' oReplaceValue = oCheckBox.Checked
Case GetType(GridControl)
Dim oGrid As GridControl = oControl
Dim oView As GridView = oGrid.FocusedView
' Case GetType(GridControl)
' Dim oGrid As GridControl = oControl
' Dim oView As GridView = oGrid.FocusedView
If oColumnName = String.Empty Then
LOGGER.Warn("Used placeholder for Table [{0}] but without Column Name!", oControlName)
oReplaceValue = ERROR_REPLACE_VALUE
End If
' If oColumnName = String.Empty Then
' LOGGER.Warn("Used placeholder for Table [{0}] but without Column Name!", oControlName)
' oReplaceValue = ERROR_REPLACE_VALUE
' End If
Dim oColumn As GridColumn = oView.Columns.
Where(Function(c) c.FieldName = oColumnName).
SingleOrDefault()
' Dim oColumn As GridColumn = oView.Columns.
' Where(Function(c) c.FieldName = oColumnName).
' SingleOrDefault()
If oColumn?.SummaryItem?.SummaryValue Is Nothing Then
LOGGER.Warn("Column [{0}] not found in Grid!", oColumnName)
oReplaceValue = ERROR_REPLACE_VALUE
Else
oReplaceValue = oColumn.SummaryItem.SummaryValue
End If
' If oColumn?.SummaryItem?.SummaryValue Is Nothing Then
' LOGGER.Warn("Column [{0}] not found in Grid!", oColumnName)
' oReplaceValue = ERROR_REPLACE_VALUE
' Else
' oReplaceValue = oColumn.SummaryItem.SummaryValue
' End If
Case Else
oReplaceValue = ERROR_REPLACE_VALUE
End Select
If oIsSQL = True Then
'LOGGER.Debug($"IS_SQL = True - oReplaceValue = {oReplaceValue}")
'LOGGER.Debug($"oReplaceValue = {oReplaceValue}")
oReplaceValue = oReplaceValue.Replace("'", "''")
End If
oResult = ReplacePattern(oResult, PATTERN_CTRL, oReplaceValue)
End If
' Case Else
' oReplaceValue = ERROR_REPLACE_VALUE
' End Select
' If oIsSQL = True Then
' 'LOGGER.Debug($"IS_SQL = True - oReplaceValue = {oReplaceValue}")
' 'LOGGER.Debug($"oReplaceValue = {oReplaceValue}")
' oReplaceValue = oReplaceValue.Replace("'", "''")
' End If
' oResult = ReplacePattern(oResult, PATTERN_CTRL, oReplaceValue)
' End If
oTryCounter += 1
End While
Return oResult
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Warn("Error in ReplaceControlValues:" & ex.Message)
Return oResult
End Try
End Function
' oTryCounter += 1
' End While
' Return oResult
' Catch ex As Exception
' LOGGER.Error(ex)
' LOGGER.Warn("Error in ReplaceControlValues:" & ex.Message)
' Return oResult
' End Try
'End Function
Public Shared Function ReplaceAttributes(pInput As String, pIDBOBJ_ID As Long, pIsSQL As Boolean) As String
Try
Dim oResult = pInput
Dim oTryCounter As Integer = 0
'Public Shared Function ReplaceAttributes(pInput As String, pIDBOBJ_ID As Long, pIsSQL As Boolean) As String
' Try
' Dim oResult = pInput
' Dim oTryCounter As Integer = 0
While ContainsPattern(oResult, PATTERN_ZFATTRIBUTE)
' While ContainsPattern(oResult, PATTERN_ZFATTRIBUTE)
Dim oIndexName As String = GetNextPattern(oResult, PATTERN_ZFATTRIBUTE).Value
Dim oValue As String '= pDocument.GetVariableValue(oIndexName)
' Dim oIndexName As String = GetNextPattern(oResult, PATTERN_ZFATTRIBUTE).Value
' Dim oValue As String '= pDocument.GetVariableValue(oIndexName)
If IsNothing(oValue) And oTryCounter = MAX_TRY_COUNT Then
Throw New Exception("Max tries in ReplaceWindreamIndicies exceeded.")
End If
' If IsNothing(oValue) And oTryCounter = MAX_TRY_COUNT Then
' Throw New Exception("Max tries in ReplaceWindreamIndicies exceeded.")
' End If
If oValue IsNot Nothing Then
If pIsSQL = True Then
LOGGER.Debug($"IS_SQL = True - oReplaceValue = {oValue}")
oValue = oValue.ToString().Replace("'", "''")
LOGGER.Debug($"oReplaceValue = {oValue}")
End If
oResult = ReplacePattern(oResult, PATTERN_ZFATTRIBUTE, oValue)
End If
' If oValue IsNot Nothing Then
' If pIsSQL = True Then
' LOGGER.Debug($"IS_SQL = True - oReplaceValue = {oValue}")
' oValue = oValue.ToString().Replace("'", "''")
' LOGGER.Debug($"oReplaceValue = {oValue}")
' End If
' oResult = ReplacePattern(oResult, PATTERN_ZFATTRIBUTE, oValue)
' End If
' Increase counter by 10 to avoid DDOSing the Windream Service
oTryCounter += 10
End While
Return oResult
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Info("Error in ReplaceWindreamIndicies:" & ex.Message)
Return pInput
End Try
End Function
' ' Increase counter by 10 to avoid DDOSing the Windream Service
' oTryCounter += 10
' End While
' Return oResult
' Catch ex As Exception
' LOGGER.Error(ex)
' LOGGER.Info("Error in ReplaceWindreamIndicies:" & ex.Message)
' Return pInput
' End Try
'End Function
'Public Shared Function ReplaceIDBAttributes(input As String, IS_SQL As Boolean) As String
' Try
' Dim result = input
@ -347,35 +347,35 @@ Public Class clsPatterns
' End Try
'End Function
Private Shared Function ContainsPattern(input As String, type As String) As String
Dim elements As MatchCollection = MyRegex.Matches(input)
'Private Shared 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
' For Each element As Match In elements
' Dim t As String = element.Groups(1).Value
If t = type Then
Return True
End If
Next
' If t = type Then
' Return True
' End If
' Next
Return False
End Function
' Return False
'End Function
Public Shared Function GetNextPattern(input As String, type As String) As Pattern
Dim elements As MatchCollection = MyRegex.Matches(input)
'Public Shared 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 pInput
Dim t As String = element.Groups(1).Value
Dim v As String = element.Groups(2).Value
' For Each element As Match In elements
' ' Pattern in pInput
' 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
' If t = type Then
' Return New Pattern(t, v)
' End If
' Next
Return Nothing
End Function
' Return Nothing
'End Function
Public Shared Function GetAllPatterns(input As String) As List(Of Pattern)
Dim elements As MatchCollection = MyRegex.Matches(input)
@ -411,51 +411,51 @@ Public Class clsPatterns
Return input
End Function
Private Shared Function ContainsPatternAndValue(input As String, type As String, value As String) As Boolean
Dim elements As MatchCollection = MyRegex.Matches(input)
'Private Shared 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 pInput
Dim t As String = element.Groups(1).Value
Dim v As String = element.Groups(2).Value
' For Each element As Match In elements
' ' Pattern in pInput
' 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
' If t = type And v = value Then
' Return True
' End If
' Next
Return False
End Function
' Return False
'End Function
Public Shared Function HasAnyPatterns(input) As Boolean
Return allPatterns.Any(Function(p)
Return HasPattern(input, p)
End Function)
End Function
'Public Shared Function HasAnyPatterns(input) As Boolean
' Return allPatterns.Any(Function(p)
' Return HasPattern(input, p)
' End Function)
'End Function
Public Shared Function HasOnlySimplePatterns(input As String) As Boolean
Return Not HasComplexPatterns(input)
End Function
'Public Shared Function HasOnlySimplePatterns(input As String) As Boolean
' Return Not HasComplexPatterns(input)
'End Function
Public Shared Function HasComplexPatterns(input As String) As Boolean
Return complexPatterns.Any(Function(p)
Return HasPattern(input, p)
End Function)
End Function
'Public Shared Function HasComplexPatterns(input As String) As Boolean
' Return complexPatterns.Any(Function(p)
' Return HasPattern(input, p)
' End Function)
'End Function
Public Shared Function HasPattern(input As String, type As String) As Boolean
Dim matches = MyRegex.Matches(input)
'Public Shared 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
' 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
' Return False
'End Function
Public Class Pattern
Public ReadOnly Property Type As String

28
GUIs.ZooFlow/frmFlowForm.Designer.vb generated
View File

@ -48,7 +48,6 @@ Partial Class frmFlowForm
Me.PictureBoxPM1 = New DevExpress.XtraEditors.SvgImageBox()
Me.PictureBoxDragDrop = New System.Windows.Forms.PictureBox()
Me.TimerCheckActiveForms = New System.Windows.Forms.Timer(Me.components)
Me.TimerCheckDroppedFiles = New System.Windows.Forms.Timer(Me.components)
Me.TimerFolderwatch = New System.Windows.Forms.Timer(Me.components)
Me.ToastNotificationsManager1 = New DevExpress.XtraBars.ToastNotifications.ToastNotificationsManager(Me.components)
Me.BehaviorManager1 = New DevExpress.Utils.Behaviors.BehaviorManager(Me.components)
@ -60,12 +59,13 @@ Partial Class frmFlowForm
Me.ToolStripMenuItem2 = New System.Windows.Forms.ToolStripMenuItem()
Me.ZooflowBeendenToolStripMenuItem1 = New System.Windows.Forms.ToolStripMenuItem()
Me.NeustartZooflowToolStripMenuItem = New System.Windows.Forms.ToolStripMenuItem()
Me.AppServiceToolStripMenuItem = New System.Windows.Forms.ToolStripMenuItem()
Me.DatenbankverbindungToolStripMenuItem1 = New System.Windows.Forms.ToolStripMenuItem()
Me.GrundeinstellungenToolStripMenuItem = New System.Windows.Forms.ToolStripMenuItem()
Me.PictureBoxGlobix1 = New DevExpress.XtraEditors.SvgImageBox()
Me.PictureBoxSearch1 = New DevExpress.XtraEditors.SvgImageBox()
Me.AppServiceToolStripMenuItem = New System.Windows.Forms.ToolStripMenuItem()
Me.Panel1 = New System.Windows.Forms.Panel()
Me.PopupMenu1 = New DevExpress.XtraBars.PopupMenu(Me.components)
Me.ContextMenuSystray.SuspendLayout()
CType(Me.PictureBoxAbo, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.PictureBoxPM1, System.ComponentModel.ISupportInitialize).BeginInit()
@ -79,6 +79,7 @@ Partial Class frmFlowForm
CType(Me.PictureBoxGlobix1, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.PictureBoxSearch1, System.ComponentModel.ISupportInitialize).BeginInit()
Me.Panel1.SuspendLayout()
CType(Me.PopupMenu1, System.ComponentModel.ISupportInitialize).BeginInit()
Me.SuspendLayout()
'
'SplashScreenManager
@ -210,10 +211,6 @@ Partial Class frmFlowForm
'
Me.TimerCheckActiveForms.Interval = 2000
'
'TimerCheckDroppedFiles
'
Me.TimerCheckDroppedFiles.Interval = 400
'
'TimerFolderwatch
'
Me.TimerFolderwatch.Interval = 2000
@ -304,6 +301,12 @@ Partial Class frmFlowForm
Me.NeustartZooflowToolStripMenuItem.Size = New System.Drawing.Size(192, 22)
Me.NeustartZooflowToolStripMenuItem.Text = "Neustart Zooflow"
'
'AppServiceToolStripMenuItem
'
Me.AppServiceToolStripMenuItem.Name = "AppServiceToolStripMenuItem"
Me.AppServiceToolStripMenuItem.Size = New System.Drawing.Size(192, 22)
Me.AppServiceToolStripMenuItem.Text = "AppService"
'
'DatenbankverbindungToolStripMenuItem1
'
Me.DatenbankverbindungToolStripMenuItem1.Name = "DatenbankverbindungToolStripMenuItem1"
@ -346,12 +349,6 @@ Partial Class frmFlowForm
Me.PictureBoxSearch1.TabIndex = 13
Me.PictureBoxSearch1.Text = "SvgImageBox1"
'
'AppServiceToolStripMenuItem
'
Me.AppServiceToolStripMenuItem.Name = "AppServiceToolStripMenuItem"
Me.AppServiceToolStripMenuItem.Size = New System.Drawing.Size(192, 22)
Me.AppServiceToolStripMenuItem.Text = "AppService"
'
'Panel1
'
Me.Panel1.Controls.Add(Me.pnlQuicksearch1)
@ -365,6 +362,10 @@ Partial Class frmFlowForm
Me.Panel1.Size = New System.Drawing.Size(202, 464)
Me.Panel1.TabIndex = 18
'
'PopupMenu1
'
Me.PopupMenu1.Name = "PopupMenu1"
'
'frmFlowForm
'
Me.AllowDrop = True
@ -402,6 +403,7 @@ Partial Class frmFlowForm
CType(Me.PictureBoxGlobix1, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.PictureBoxSearch1, System.ComponentModel.ISupportInitialize).EndInit()
Me.Panel1.ResumeLayout(False)
CType(Me.PopupMenu1, System.ComponentModel.ISupportInitialize).EndInit()
Me.ResumeLayout(False)
Me.PerformLayout()
@ -418,7 +420,6 @@ Partial Class frmFlowForm
Friend WithEvents ToolStripSeparator1 As ToolStripSeparator
Friend WithEvents DatenbankverbindungToolStripMenuItem As ToolStripMenuItem
Friend WithEvents TimerCheckActiveForms As Timer
Friend WithEvents TimerCheckDroppedFiles As Timer
Friend WithEvents TimerFolderwatch As Timer
Friend WithEvents GlobixToolStripMenuItem As ToolStripMenuItem
Friend WithEvents TsiGlobixConfig As ToolStripMenuItem
@ -443,4 +444,5 @@ Partial Class frmFlowForm
Friend WithEvents NeustartZooflowToolStripMenuItem As ToolStripMenuItem
Friend WithEvents AppServiceToolStripMenuItem As ToolStripMenuItem
Friend WithEvents Panel1 As Panel
Friend WithEvents PopupMenu1 As DevExpress.XtraBars.PopupMenu
End Class

14
GUIs.ZooFlow/frmFlowForm.resx
View File

@ -1965,17 +1965,14 @@
<metadata name="TimerCheckActiveForms.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>709, 17</value>
</metadata>
<metadata name="TimerCheckDroppedFiles.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<metadata name="TimerFolderwatch.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>891, 17</value>
</metadata>
<metadata name="TimerFolderwatch.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>17, 56</value>
</metadata>
<metadata name="ToastNotificationsManager1.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>166, 56</value>
<value>1040, 17</value>
</metadata>
<metadata name="BehaviorManager1.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>371, 56</value>
<value>17, 56</value>
</metadata>
<assembly alias="DevExpress.Data.v21.2" name="DevExpress.Data.v21.2, Version=21.2.4.0, Culture=neutral, PublicKeyToken=b88d1754d700e49a" />
<data name="PictureEdit1.EditValue" type="DevExpress.Utils.Svg.SvgImage, DevExpress.Data.v21.2" mimetype="application/x-microsoft.net.object.bytearray.base64">
@ -2005,6 +2002,9 @@
</value>
</data>
<metadata name="MenuStrip1.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>525, 56</value>
<value>171, 56</value>
</metadata>
<metadata name="PopupMenu1.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>286, 56</value>
</metadata>
</root>

187
GUIs.ZooFlow/frmFlowForm.vb
View File

@ -24,7 +24,6 @@ Public Class frmFlowForm
Public Shared Function RegisterWindowMessage(ByVal msg As String) As Integer
End Function
#End Region
#Region "Sidebar Variablen"
Private AppDeskData As AppDeskBar
Private fBarRegistered As Boolean = False
@ -70,7 +69,6 @@ Public Class frmFlowForm
ABN_WINDOWARRANGE
End Enum
#End Region
#Region "Sidebar Enum Properties Register"
Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
If m.Msg = uCallBack Then
@ -152,12 +150,12 @@ Public Class frmFlowForm
' Common Helpers Classes
Private Init As ClassInit
Private FileClass As Filesystem.File
Private FileEx As Filesystem.File
Private ErrorHandler As BaseErrorHandler
Private Logger As Logger
' Globix Helper Classes
Private FileDrop As ClassFileDrop
Private FileDropNew As FileDrop
Private FileHandle As ClassFilehandle
Private FolderWatch As ClassFolderwatcher
@ -194,8 +192,6 @@ Public Class frmFlowForm
' === Register Sidebar ===
RegisterBar(ABEdge.ABE_RIGHT)
End Sub
Private Sub frmFlowForm_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing
@ -212,11 +208,6 @@ Public Class frmFlowForm
Logger = My.LogConfig.GetLogger()
ErrorHandler = New BaseErrorHandler(My.LogConfig, Logger, Me)
' Register Form as Sidebar
My.Application.Sidebar = New Sidebar2(Me)
My.Application.Sidebar.RegisterBar(Sidebar2.ABEdge.ABE_RIGHT)
'RegisterBar(ABEdge.ABE_RIGHT)
' === Setup Timers ===
AddHandler TimerRefreshData.Tick, AddressOf TimerRefreshData_Tick
TimerRefreshData.Enabled = True
@ -290,7 +281,7 @@ Public Class frmFlowForm
End If
If My.Application.ModulesActive.Contains(MODULE_GLOBAL_INDEXER) Then
FileDrop = New ClassFileDrop(My.LogConfig)
FileDropNew = New FileDrop(My.LogConfig, "ZooFlow")
FileHandle = New ClassFilehandle(My.LogConfig)
FolderWatch = New ClassFolderwatcher(My.LogConfig)
@ -518,8 +509,8 @@ Public Class frmFlowForm
Drag_Enter(sender, e)
End Sub
Private Sub frmFlowForm_DragDrop(sender As Object, e As DragEventArgs) Handles MyBase.DragDrop
DragDropForm(e)
Private Async Sub frmFlowForm_DragDrop(sender As Object, e As DragEventArgs) Handles MyBase.DragDrop
Await DragDropForm(e)
End Sub
Private Sub frmFlowForm_DragLeave(sender As Object, e As EventArgs) Handles Me.DragLeave
@ -563,7 +554,6 @@ Public Class frmFlowForm
End If
Next
'TimerCheckActiveForms.Enabled = False
Return True
End Function
@ -571,19 +561,11 @@ Public Class frmFlowForm
frmConfigDatabase.ShowDialog()
End Sub
'Private Sub TimerCheckActiveForms_Tick(sender As Object, e As EventArgs) Handles TimerCheckActiveForms.Tick
' Visible = FormLoaded_Visible()
' If Visible = False Then Exit Sub
'End Sub
Private Sub NotifyIcon_DoubleClick(sender As Object, e As EventArgs) Handles NotifyIcon.DoubleClick
If Visible = False Then
Visible = True
Else
Visible = False
'TimerCheckActiveForms.Enabled = False
End If
End Sub
@ -607,52 +589,59 @@ Public Class frmFlowForm
End If
End Sub
Sub DragDropForm(e As DragEventArgs)
Async Function DragDropForm(e As DragEventArgs) As Threading.Tasks.Task
If Not My.Application.ModulesActive.Contains(ClassConstants.MODULE_GLOBAL_INDEXER) Then
Exit Sub
Exit Function
End If
If TheFormIsAlreadyLoaded("frmIndexFileList") Then
Cursor = Cursors.Default
MsgBox("Please index the active file first!", MsgBoxStyle.Exclamation, "Drag 'n Drop not allowed!")
Exit Sub
Exit Function
End If
'Erstmal alles löschen
My.Database.ExecuteNonQueryECM("DELETE FROM TBGI_FILES_USER WHERE USER@WORK = '" & My.Application.User.UserName & "'")
If FileDrop.Drop_File(e) = True Then
TimerCheckDroppedFiles.Start()
Me.Cursor = Cursors.WaitCursor
End If
End Sub
Private Sub PictureBox1_DragDrop(sender As Object, e As DragEventArgs) Handles PictureBoxDragDrop.DragDrop
DragDropForm(e)
End Sub
Private Async 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
Dim oDroppedFiles = FileDropNew.GetFiles(e)
If oDroppedFiles.Count > 0 Then
Await Globix_Check_Dropped_Files(oDroppedFiles)
End If
TimerCheckDroppedFiles.Stop()
Await Globix_Check_Dropped_Files()
Me.Cursor = Cursors.Default
'If FileDrop.Drop_File(e) = True Then
' Me.Cursor = Cursors.WaitCursor
' Await Globix_Check_Dropped_Files()
'End If
End Function
Private Async Sub PictureBox1_DragDrop(sender As Object, e As DragEventArgs) Handles PictureBoxDragDrop.DragDrop
Await DragDropForm(e)
End Sub
Private Async Function Globix_Check_Dropped_Files() As Threading.Tasks.Task
'Private Async Sub TimerCheckDroppedFiles_Tick(sender As Object, e As EventArgs)
' If Not My.Application.ModulesActive.Contains(ClassConstants.MODULE_GLOBAL_INDEXER) Then
' Exit Sub
' End If
' Dim oDroppedFiles = FileDropNew.GetFiles(e)
' If oDroppedFiles.Count > 0 Then
' Await Globix_Check_Dropped_Files()
' End If
' 'TimerCheckDroppedFiles.Stop()
' Await Globix_Check_Dropped_Files()
' Me.Cursor = Cursors.Default
'End Sub
Private Async Function Globix_Check_Dropped_Files(pDroppedFiles As List(Of FileDrop.DroppedFile)) As Threading.Tasks.Task
Try
Await My.Database.ExecuteNonQueryECMAsync($"DELETE FROM TBGI_FILES_USER WHERE WORKED = 1 AND USER@WORK = '{My.Application.User.UserName}'")
Dim i As Integer
For Each pFile As String In FileDrop.files_dropped
If Not pFile Is Nothing Then
Logger.Info(" Check Drop-File: " & pFile.ToString)
Dim handleType As String = pFile.Substring(0, pFile.LastIndexOf("|") + 1)
Dim filename As String = pFile.Substring(pFile.LastIndexOf("|") + 1)
If FileHandle.CheckDuplicateFiles(filename, "Manuelle Ablage") Then
FileHandle.Decide_FileHandle(filename, handleType)
i += 1
End If
For Each oDroppedFile In pDroppedFiles
Logger.Info("Checking Dropped File: [{0}]", oDroppedFile.FilePath)
Dim oDropType = oDroppedFile.DropType
Dim oFileName = oDroppedFile.FilePath
If FileHandle.CheckDuplicateFiles(oFileName, "Manuelle Ablage") Then
FileHandle.Decide_FileHandle(oFileName, oDropType)
End If
Next
@ -685,29 +674,44 @@ Public Class frmFlowForm
}
Logger.Info(" CURRENT_WORKFILE: {0}", My.Application.Globix.CurrentWorkfile)
If IO.File.Exists(My.Application.Globix.CurrentWorkfile.FilePath) = True And My.Application.Globix.DTACTUAL_FILES.Rows.Count > 0 Then
If IO.File.Exists(My.Application.Globix.CurrentWorkfile.FilePath) = True And
My.Application.Globix.DTACTUAL_FILES.Rows.Count > 0 Then
Globix_Open_IndexDialog()
PictureBoxDragDrop.Image = My.Resources._1_LOGO_ZOO_FLOW1
End If
Next
Show()
Catch ex As Exception
ShowErrorMessage(ex)
Finally
CleanTempFiles()
Show()
End Try
End Function
Private Sub CleanTempFiles()
Dim oTempFiles = My.Application.Globix.TEMP_FILES
For Each oFile In oTempFiles
Try
IO.File.Delete(oFile)
Logger.Debug("Temp file [{0}] was deleted.", oFile)
Catch ex As Exception
Logger.Warn("Temp file [{0}] could not be deleted", oFile)
Logger.Error(ex)
End Try
Next
My.Application.Globix.TEMP_FILES.Clear()
FileHandle.ClearTempFiles()
FileDropNew.RemoveTempDirectory()
End Sub
Sub Globix_Open_IndexDialog()
Try
IndexForm = New frmGlobix_Index(My.LogConfig)
NotifyIconReset()
AddHandler IndexForm.FormClosed, AddressOf GlobixClosed
IndexForm.Show()
IndexForm.ShowDialog()
Cursor = Cursors.Default
'If TimerCheckActiveForms.Enabled = False Then
' TimerCheckActiveForms.Enabled = True
'End If
Catch ex As Exception
ShowErrorMessage(ex)
End Try
@ -858,7 +862,9 @@ Public Class frmFlowForm
End If
Dim FileForWork As String = row.Item(1).ToString
Logger.Info(" In Timer Folderwatch - File: " & FileForWork)
Dim fileInUse As Boolean = FileHandle.IsFileInUse(FileForWork)
Dim fileInUse As Boolean = FileEx.TestFileIsLocked(FileForWork)
'Dim fileInUse As Boolean = FileHandle.IsFileInUse(FileForWork)
Dim fileexists As Boolean = System.IO.File.Exists(FileForWork)
If fileInUse = False Then
If fileexists = True Then
@ -905,47 +911,40 @@ Public Class frmFlowForm
oState.CurrentClipboardContents = ClipboardContents
' TODO: These messages are so fucking annoying
If oState.MonitoringActive = False Then
Dim oMessage As String = "Clipboard Watcher is not active!"
Logger.Warn(oMessage)
'If oState.MonitoringActive = False Then
' Dim oMessage As String = "Clipboard Watcher is not active!"
' Logger.Info(oMessage)
' MsgBox(oMessage, MsgBoxStyle.Critical, Text)
Exit Sub
End If
' Exit Sub
'End If
If oState.UserProfiles Is Nothing Then
Dim oMessage As String = "User Profiles are empty!"
Logger.Warn(oMessage)
'If oState.UserProfiles Is Nothing Then
' Dim oMessage As String = "User Profiles are empty!"
' Logger.Info(oMessage)
' MsgBox(oMessage, MsgBoxStyle.Critical, Text)
Exit Sub
End If
' Exit Sub
'End If
If oState.ProfileProcesses Is Nothing OrElse oState.ProfileProcesses.Rows.Count = 0 Then
Dim oMessage As String = "Profile Processes are empty!"
Logger.Warn(oMessage)
'If oState.ProfileProcesses Is Nothing OrElse oState.ProfileProcesses.Rows.Count = 0 Then
' Dim oMessage As String = "Profile Processes are empty!"
' Logger.Info(oMessage)
' MsgBox(oMessage, MsgBoxStyle.Critical, Text)
Exit Sub
End If
' Exit Sub
'End If
If oState.ProfileWindows Is Nothing OrElse oState.ProfileWindows.Rows.Count = 0 Then
Dim oMessage As String = "Profile Windows are empty!"
Logger.Warn(oMessage)
'If oState.ProfileWindows Is Nothing OrElse oState.ProfileWindows.Rows.Count = 0 Then
' Dim oMessage As String = "Profile Processes are empty!"
' Logger.Info(oMessage)
' MsgBox(oMessage, MsgBoxStyle.Critical, Text)
Exit Sub
End If
' Exit Sub
'End If
If oState.ProfileControls Is Nothing OrElse oState.ProfileControls.Rows.Count = 0 Then
Dim oMessage As String = "Profile Processes are empty!"
Logger.Warn(oMessage)
'If oState.ProfileProcesses Is Nothing OrElse oState.ProfileProcesses.Rows.Count = 0 Then
' Dim oMessage As String = "Profile Processes are empty!"
' Logger.Info(oMessage)
' MsgBox(oMessage, MsgBoxStyle.Critical, Text)
' Exit Sub
'End If
Exit Sub
End If
Dim oWindowInfo = ClassWindow.GetWindowInfo()

2
GUIs.ZooFlow/modCurrent.vb
View File

@ -3,9 +3,7 @@ Imports DigitalData.Modules.Logging
Imports DigitalData.Modules.Config
Module modCurrent
Public Property LOGGER As Logger
Public Property ADDITIONAL_TITLE As String
Public Property CURR_MISSING_PATTERN_NAME = "Email To"
Public Property CURR_MISSING_SEARCH_STRING = String.Empty
Public Property CURR_MISSING_MANUAL_VALUE = String.Empty

2
Modules.EDMIAPI/Client.vb
View File

@ -42,8 +42,6 @@ Public Class Client
End Get
End Property
''' <summary>
''' Parse a IPAddress:Port String into its parts
''' </summary>

4
Modules.EDMIAPI/DatabaseWithFallback.vb
View File

@ -65,6 +65,10 @@ Public Class DatabaseWithFallback
_DatabaseIDB = pDatabaseIDB
End Sub
Public Function GetConnectionString(pConnectionId As Integer) As String
Return _DatabaseECM.GetConnectionStringForId(pConnectionId)
End Function
Public Function GetDatatableECM(pSQL As String, Optional pConnectionId As Integer = 0) As DataTable
Return GetDatatable(New GetDatatableOptions(pSQL, Constants.DatabaseType.ECM) With {
.ConnectionId = pConnectionId

21
Modules.ZooFlow/Base/BaseClass.vb
View File

@ -1,21 +0,0 @@
Imports DigitalData.Modules.Logging
Namespace Base
''' <summary>
''' Base Class which supplies a Logger/LogConfig
''' </summary>
Public Class BaseClass
Protected LogConfig As LogConfig
Protected Logger As Logger
Public Sub New(LogConfig As LogConfig)
Dim oClassName = Me.GetType().Name
Me.LogConfig = LogConfig
Me.Logger = LogConfig.GetLogger(oClassName)
End Sub
End Class
End Namespace

1
Modules.ZooFlow/ZooFlow.vbproj
View File

@ -74,7 +74,6 @@
<Import Include="System.Threading.Tasks" />
</ItemGroup>
<ItemGroup>
<Compile Include="Base\BaseClass.vb" />
<Compile Include="Constants.vb" />
<Compile Include="Environment.vb" />
<Compile Include="My Project\AssemblyInfo.vb" />