Zooflow: Massive Clean up

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

View File

@ -20,7 +20,7 @@ Public Class frmLookupGrid
Private _DataSourceTemp As DataTable Private _DataSourceTemp As DataTable
Private _View As GridView Private _View As GridView
Private _Grid As GridControl 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 Private Sub frmLookupGrid_Load(sender As Object, e As EventArgs) Handles Me.Load
_View = viewLookup _View = viewLookup

View File

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

View File

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

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

View File

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

View File

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

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" #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 INSERT INTO TBDD_USRGRP_DOKTYPE
(DOCTYPE_ID, GROUP_ID, ADDED_WHO) (DOCTYPE_ID, GROUP_ID, ADDED_WHO)
VALUES ({ProfileId}, {GroupId}, '{Environment.UserName}') VALUES ({ProfileId}, {GroupId}, '{Environment.UserName}')
" "
Return My.DatabaseECM.ExecuteNonQuery(oSQL) Return My.DatabaseECM.ExecuteNonQuery(oSQL)
Catch ex As Exception Catch ex As Exception
LOGGER.Error(ex) 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)
Return False Return False
End Try End Try
End Function 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 Try
Dim oSQL As String = $" Dim oSQL As String = $"
SELECT GUID, NAME FROM TBDD_GROUPS SELECT GUID, NAME FROM TBDD_GROUPS
@ -40,12 +50,12 @@
Return oDatatable Return oDatatable
Catch ex As Exception Catch ex As Exception
LOGGER.Error(ex) Logger.Error(ex)
Return Nothing Return Nothing
End Try End Try
End Function End Function
Public Shared Function GetAvailableGroups(ProfileId As Integer) As DataTable Public Function GetAvailableGroups(ProfileId As Integer) As DataTable
Try Try
Dim oSQL As String = $" Dim oSQL As String = $"
SELECT GUID, NAME FROM TBDD_GROUPS SELECT GUID, NAME FROM TBDD_GROUPS
@ -60,7 +70,7 @@
Return oDatatable Return oDatatable
Catch ex As Exception Catch ex As Exception
LOGGER.Error(ex) Logger.Error(ex)
Return Nothing Return Nothing
End Try End Try
End Function End Function
@ -68,7 +78,7 @@
#Region "TBDD_USER" #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 Try
Dim oSQL = $" Dim oSQL = $"
INSERT INTO TBDD_USER_DOKTYPE INSERT INTO TBDD_USER_DOKTYPE
@ -77,22 +87,22 @@
" "
Return My.DatabaseECM.ExecuteNonQuery(oSQL) Return My.DatabaseECM.ExecuteNonQuery(oSQL)
Catch ex As Exception Catch ex As Exception
LOGGER.Error(ex) Logger.Error(ex)
Return False Return False
End Try End Try
End Function 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 Try
Dim oSQL = $"DELETE FROM TBDD_USER_DOKTYPE WHERE DOCTYPE_ID = {ProfileId} AND USER_ID = {UserId}" Dim oSQL = $"DELETE FROM TBDD_USER_DOKTYPE WHERE DOCTYPE_ID = {ProfileId} AND USER_ID = {UserId}"
Return My.DatabaseECM.ExecuteNonQuery(oSQL) Return My.DatabaseECM.ExecuteNonQuery(oSQL)
Catch ex As Exception Catch ex As Exception
LOGGER.Error(ex) Logger.Error(ex)
Return False Return False
End Try End Try
End Function End Function
Public Shared Function GetAssignedUsers(ProfileId As Integer) As DataTable Public Function GetAssignedUsers(ProfileId As Integer) As DataTable
Try Try
Dim oSQL As String = $" Dim oSQL As String = $"
SELECT GUID, EMAIL, NAME + ', ' + PRENAME AS NAME FROM TBDD_USER SELECT GUID, EMAIL, NAME + ', ' + PRENAME AS NAME FROM TBDD_USER
@ -106,12 +116,12 @@
Return oDatatable Return oDatatable
Catch ex As Exception Catch ex As Exception
LOGGER.Error(ex) Logger.Error(ex)
Return Nothing Return Nothing
End Try End Try
End Function End Function
Public Shared Function GetAvailableUsers(ProfileId As Integer) As DataTable Public Function GetAvailableUsers(ProfileId As Integer) As DataTable
Try Try
Dim oSQL As String = $" Dim oSQL As String = $"
SELECT GUID, EMAIL, NAME + ', ' + PRENAME AS NAME FROM TBDD_USER SELECT GUID, EMAIL, NAME + ', ' + PRENAME AS NAME FROM TBDD_USER
@ -125,14 +135,14 @@
Dim oDatatable As DataTable = My.DatabaseECM.GetDatatable(oSQL) Dim oDatatable As DataTable = My.DatabaseECM.GetDatatable(oSQL)
Return oDatatable Return oDatatable
Catch ex As Exception Catch ex As Exception
LOGGER.Error(ex) Logger.Error(ex)
Return Nothing Return Nothing
End Try End Try
End Function End Function
#End Region #End Region
End Class End Class

View File

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

View File

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

View File

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

View File

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

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

View File

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

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

View File

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

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

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

View File

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

View File

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

View File

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

View File

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

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

View File

@ -1,34 +1,47 @@
Option Explicit On Option Explicit On
Imports System.IO
Imports System.Text.RegularExpressions Imports System.Text.RegularExpressions
Imports DigitalData.Modules.Logging 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 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) Public Sub New(pLogConfig As LogConfig)
MyBase.New(pLogConfig) 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 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) 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 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 If oFileExists.Equals(Date.MinValue) Then
Return True Return True
@ -52,31 +65,62 @@ Public Class ClassFilehandle
Return False Return False
End Function 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 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 = "" My.Application.Globix.CurrMessageID = ""
Dim _msg As New Msg.Message(filename) Dim oMail As IMail = Email.Load_Email(oTempFilePath)
If _msg.Attachments.Count > 0 Then If oMail.Attachments.Count > 0 Then
Dim result As DialogResult Dim oTitle As String
Dim oMessage As String
If My.Application.User.Language = "de-DE" Then 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 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 End If
Dim oResult As DialogResult
If result = MsgBoxResult.Yes Then ' Weird hack to force messagebox to be topmost
If handletype.StartsWith("|FW") Then ' https://stackoverflow.com/questions/1220882/keep-messagebox-show-on-top-of-other-application-using-c-sharp
Return Email_Decay(filename, True) oResult = MessageBox.Show(oMessage, oTitle, MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1, MessageBoxOptions.DefaultDesktopOnly)
Else
Return Email_Decay(filename)
End If If oResult = MsgBoxResult.Yes Then
Dim oIsFolderWatch = pHandletype.StartsWith("|FW")
Return Save_EmailAndAttachmentsToDisk(oTempFilePath, oIsFolderWatch)
End If End If
End If 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 If My.Application.User.Language = "de-DE" Then
MsgBox("Verknüpfungen können nicht abgelegt werden!", MsgBoxStyle.Critical, "Global Indexer") MsgBox("Verknüpfungen können nicht abgelegt werden!", MsgBoxStyle.Critical, "Global Indexer")
Else Else
@ -85,164 +129,63 @@ Public Class ClassFilehandle
Return False Return False
End If End If
Return Insert_GI_File(filename, handletype) Return UserFiles.Insert_GI_File(oTempFilePath, pHandletype)
Catch ex As Exception Catch ex As Exception
Logger.Error(ex)
MsgBox("Unexpected Error in Decide_FileHandle: " & ex.Message, MsgBoxStyle.Critical) MsgBox("Unexpected Error in Decide_FileHandle: " & ex.Message, MsgBoxStyle.Critical)
Return False Return False
End Try End Try
End Function 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 Try
Dim msgonly As String = "|MSGONLY|" Dim oMessageOnlyMarker As String = "|MSGONLY|"
Dim ATT_EXTR As String = "|ATTMNTEXTRACTED|" Dim oExtractedAttachmentMarker As String = "|ATTMNTEXTRACTED|"
If FW = True Then If pFolderWatch = True Then
msgonly = "|FW_MSGONLY|" oMessageOnlyMarker = "|FW_MSGONLY|"
ATT_EXTR = "|FW_ATTMNTEXTRACTED|" oExtractedAttachmentMarker = "|FW_ATTMNTEXTRACTED|"
End If End If
Dim erfolgreich As Boolean = False Dim oSuccess As Boolean = False
Dim msg As New Msg.Message(msgname)
If Not msg.InternetMessageId Is Nothing Then Logger.Info("Converting file to Eml if needed: [{0}]", pEmailFilePath)
My.Application.Globix.CurrMessageID = msg.InternetMessageId Dim oEmail As IMail = Email.Load_Email(pEmailFilePath)
If oEmail.MessageID IsNot Nothing Then
My.Application.Globix.CurrMessageID = oEmail.MessageID
Else Else
Logger.Info(">> Email_Decay: Es konnte keine Message-ID gelesen werden. Eine GUID wird erzeugt!") Logger.Info("Es konnte keine Message-ID gelesen werden. Eine GUID wird erzeugt!")
Dim sGUID As String My.Application.Globix.CurrMessageID = Guid.NewGuid.ToString()
sGUID = System.Guid.NewGuid.ToString()
My.Application.Globix.CurrMessageID = sGUID
End If End If
'Nur die MSGDatei ablegen Dim oEmailFilePathWithoutAttachments = Email.Remove_AttachmentsFromEmail(pEmailFilePath, "_excl_attachments")
Dim tempfile As String = Path.Combine(Path.GetTempPath, Path.GetFileNameWithoutExtension(msgname) & "_excl_att.msg")
If File.Exists(tempfile) Then TempFiles.Add(oEmailFilePathWithoutAttachments)
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)
If Insert_GI_File(tempfile, msgonly) = True Then If UserFiles.Insert_GI_File(oEmailFilePathWithoutAttachments, oMessageOnlyMarker) = True Then
erfolgreich = True oSuccess = 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) Dim oAttachments As List(Of String) = Email.Save_AttachmentsToDisk(pEmailFilePath)
For Each attachment As Independentsoft.Msg.Attachment In _msg.Attachments
If erfolgreich = False Then 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 Exit For
End If 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 Next
End If End If
Return erfolgreich
Return oSuccess
Catch ex As Exception Catch ex As Exception
Logger.Warn("Saving email to disk failed (Email_Decay)")
Logger.Error(ex) Logger.Error(ex)
MsgBox("Error in Email_Decay: " & ex.Message, MsgBoxStyle.Critical)
Return False Return False
End Try End Try
End Function 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 End Class

View File

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

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

View File

@ -1,12 +1,11 @@
Imports DigitalData.Controls.LookupGrid Imports DevExpress.XtraEditors
Imports DigitalData.GUIs.ZooFlow.Base Imports DigitalData.Controls.LookupGrid
Imports DigitalData.GUIs.ZooFlow.Globix.Models 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
Imports DigitalData.Modules.EDMI.API.EDMIServiceReference Imports DigitalData.Modules.EDMI.API.EDMIServiceReference
Imports DigitalData.Modules.Logging Imports DigitalData.Modules.Logging
Imports DigitalData.GUIs.GlobalIndexer.ControlCreator Imports DigitalData.Modules.Base
Imports DevExpress.XtraEditors
Public Class ClassValidator Public Class ClassValidator
Inherits BaseClass Inherits BaseClass

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

View File

@ -6,11 +6,9 @@ Namespace Globix
Public Property DTACTUAL_FILES As DataTable Public Property DTACTUAL_FILES As DataTable
Public Property TEMP_FILES As List(Of String) = New List(Of String) Public Property TEMP_FILES As List(Of String) = New List(Of String)
Public Property CurrMessageID As String Public Property CurrMessageID As String
'Public Property CURRENT_FILENAME As String
Public Property CurrentFolderWatchPath As String Public Property CurrentFolderWatchPath As String
Public Property CURRENT_SCAN_FOLDERWATCH 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 CurrentWorkfile As Globix.Models.WorkFile
Public Property CURRENT_IDB_OBJ_ID As Long Public Property CURRENT_IDB_OBJ_ID As Long
@ -21,23 +19,6 @@ Namespace Globix
Public Property CURRENT_LASTDOCTYPE As String Public Property CURRENT_LASTDOCTYPE As String
Public Property MULTIINDEXING_ACTIVE As Boolean = False Public Property MULTIINDEXING_ACTIVE As Boolean = False
Public Property CURRENT_PROFILE_LOG_INDEX As String 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 Folderwatchstarted As Boolean = False
Public Property DTEXCLUDE_FILES As DataTable Public Property DTEXCLUDE_FILES As DataTable
Public Property PATH_FileExclusions As String = Path.Combine(Application.UserAppDataPath(), "FileExclusions.xml") Public Property PATH_FileExclusions As String = Path.Combine(Application.UserAppDataPath(), "FileExclusions.xml")

View File

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

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

View File

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

View File

@ -1,16 +1,17 @@
DevExpress.XtraEditors.ComboBoxEdit, DevExpress.XtraEditors.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.XtraNavBar.NavBarControl, DevExpress.XtraNavBar.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.XtraLayout.LayoutControl, DevExpress.XtraLayout.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.DateEdit, 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.XtraBars.Docking.DockManager, DevExpress.XtraBars.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.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.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.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.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.XtraNavBar.NavBarControl, DevExpress.XtraNavBar.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.XtraLayout.LayoutControl, DevExpress.XtraLayout.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

View File

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

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

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

View File

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

View File

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

View File

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

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"> <metadata name="TimerCheckActiveForms.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>709, 17</value> <value>709, 17</value>
</metadata> </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> <value>891, 17</value>
</metadata> </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"> <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>
<metadata name="BehaviorManager1.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a"> <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> </metadata>
<assembly alias="DevExpress.Data.v21.2" name="DevExpress.Data.v21.2, Version=21.2.4.0, Culture=neutral, PublicKeyToken=b88d1754d700e49a" /> <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"> <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> </value>
</data> </data>
<metadata name="MenuStrip1.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a"> <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> </metadata>
</root> </root>

View File

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

View File

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

View File

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

View File

@ -65,6 +65,10 @@ Public Class DatabaseWithFallback
_DatabaseIDB = pDatabaseIDB _DatabaseIDB = pDatabaseIDB
End Sub 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 Public Function GetDatatableECM(pSQL As String, Optional pConnectionId As Integer = 0) As DataTable
Return GetDatatable(New GetDatatableOptions(pSQL, Constants.DatabaseType.ECM) With { Return GetDatatable(New GetDatatableOptions(pSQL, Constants.DatabaseType.ECM) With {
.ConnectionId = pConnectionId .ConnectionId = pConnectionId

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

View File

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