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

Zooflow: Massive Clean up

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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