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

MS

Browse Source
This commit is contained in:
SchreiberM
2017-02-17 11:23:22 +01:00
parent 64c99f80b9
commit ca7a26beb9
24 changed files with 21009 additions and 3463 deletions
Download Patch File Download Diff File Expand all files Collapse all files

220
Global_Indexer/frmIndex.vb
View File

@@ -774,7 +774,7 @@ Public Class frmIndex
Function CheckWrite_IndexeMan(dokartid As Integer)
'#### Zuerst manuelle Werte indexieren ####
Try
If LogErrorsOnly = False Then ClassLogger.Add(" >>In CheckWrite_IndexeMan", False)
If LogErrorsOnly = False Then ClassLogger.Add(" >> In CheckWrite_IndexeMan", False)
Dim result As Boolean = False
For Each ctrl As Control In Me.pnlIndex.Controls
' ' MsgBox(ctrl.Name)
@@ -1123,7 +1123,6 @@ Public Class frmIndex
Catch ex As Exception
ClassLogger.Add(" - Unvorhergesehener Unexpected error in Name_Generieren - Fehler: " & vbNewLine & ex.Message)
File.Delete(CURRENT_WORKFILE)
MsgBox(ex.Message, MsgBoxStyle.Critical, "Allgemeiner Unexpected error in Name_Generieren:")
Return False
End Try
@@ -1244,6 +1243,7 @@ Public Class frmIndex
Private Function SetEmailIndices()
Dim indexierung_erfolgreich As Boolean = False
Dim _step As String = "1"
Try
Dim msg As Msg.Message = New Msg.Message(CURRENT_NEWFILENAME)
Dim msgDisplayTo = msg.DisplayTo
@@ -1257,7 +1257,7 @@ Public Class frmIndex
ClassLogger.Add(" >> ReceivedByEmailAddress: " & msg.ReceivedByEmailAddress, False)
ClassLogger.Add("", False)
End If
_step = "2"
'Console.WriteLine("Subject: " + msg.Subject)
'Console.WriteLine("MessageDeliveryTime:" & msg.MessageDeliveryTime)
@@ -1270,9 +1270,32 @@ Public Class frmIndex
'Console.WriteLine("Body: " + msg.Body)
'Console.WriteLine("-----------------------------------------------------------------------")
'Console.WriteLine("BodyHtmlText: " + msg.BodyHtmlText)
Dim fromPattern As String = ""
Dim toPattern As String = ""
Dim messageIDPattern As String = ""
Dim finalize_pattern As String = ""
Dim DT_REGEX As DataTable = ClassDatabase.Return_Datatable("SELECT * FROM TBGI_FUNCTION_REGEX")
' Email Header auslesen
Dim headers As String = ClassEmailHeaderExtractor.getMessageHeaders(msg)
For Each rowregex As DataRow In DT_REGEX.Rows
If rowregex.Item("FUNCTION_NAME") = "FROM_EMAIL_HEADER" Then
fromPattern = rowregex.Item("REGEX")
ElseIf rowregex.Item("FUNCTION_NAME") = "TO_EMAIL_HEADER" Then
toPattern = rowregex.Item("REGEX")
ElseIf rowregex.Item("FUNCTION_NAME") = "MESSAGE_ID" Then
messageIDPattern = rowregex.Item("REGEX")
ElseIf rowregex.Item("FUNCTION_NAME") = "FINALIZE" Then
finalize_pattern = rowregex.Item("REGEX")
End If
Next
Dim DT As DataTable = ClassDatabase.Return_Datatable("SELECT * FROM TBGI_OBJECTTYPE_EMAIL_INDEX WHERE OBJECTTYPE = '" & ClassWindream._WDObjekttyp & "'")
If IsNothing(DT) Then
ClassLogger.Add(" >> SELECT * FROM TBGI_OBJECTTYPE_EMAIL_INDEX WHERE OBJECTTYPE = '" & ClassWindream._WDObjekttyp & "' RESULTED in NOTHING")
Return False
End If
If DT.Rows.Count = 1 Then
_step = "3"
CURRENT_MESSAGEDATE = ""
CURRENT_MESSAGESUBJECT = ""
'Message-ID nur auswerten wenn vorher nicht gestzt wurde!
@@ -1286,7 +1309,19 @@ Public Class frmIndex
Return False
End If
Else
ClassLogger.Add("Eine Message-ID konnte nicht ausgelesen werden!", True)
If messageIDPattern = String.Empty Then
ClassLogger.Add("A messageID could not be read!", True)
Else
If Not IsNothing(headers) Then
CURRENT_MESSAGEID = ClassEmailHeaderExtractor.extractFromHeader(headers, messageIDPattern)
If IsNothing(CURRENT_MESSAGEID) Then
CURRENT_MESSAGEID = ""
End If
Else
ClassLogger.Add("A messageID could not be read - messageheader nothing/messagIDpattern value!", True)
End If
End If
End If
Else
indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_ID").ToString, CURRENT_MESSAGEID)
@@ -1295,12 +1330,11 @@ Public Class frmIndex
Return False
End If
End If
_step = "4"
' Regular Expressions vorbereiten
Dim fromPattern As String = ClassDatabase.Execute_Scalar("SELECT REGEX FROM TBGI_FUNCTION_REGEX WHERE FUNCTION_NAME = 'FROM_EMAIL_HEADER'", MyConnectionString)
Dim toPattern As String = ClassDatabase.Execute_Scalar("SELECT REGEX FROM TBGI_FUNCTION_REGEX WHERE FUNCTION_NAME = 'TO_EMAIL_HEADER'", MyConnectionString)
Dim finalize_pattern As String = ClassDatabase.Execute_Scalar("SELECT REGEX FROM TBGI_FUNCTION_REGEX WHERE FUNCTION_NAME = 'FINALIZE'", MyConnectionString)
If fromPattern <> "" And toPattern <> "" Then
_step = "4.1"
Dim FromRegexList As New List(Of Regex)
Dim ToRegexList As New List(Of Regex)
Dim fromRegex As New Regex(fromPattern, RegexOptions.IgnoreCase)
@@ -1309,41 +1343,90 @@ Public Class frmIndex
FromRegexList.Add(fromRegex)
ToRegexList.Add(toRegex)
' Email Header auslesen
Dim headers As String = ClassEmailHeaderExtractor.getMessageHeaders(msg)
Dim emailFrom
Dim emailTo
' Email Absender und Empfänger
If headers Is Nothing Then
_step = "4.2"
If IsNothing(msgDisplayTo) Then
_step = "4.3"
ClassLogger.Add(" >> DisplayTo in email is nothing - default will be set", False)
emailTo = "NO RECIPIENT"
Else
_step = "4.4"
emailTo = msgDisplayTo.ToString.Replace("'", "")
End If
If IsNothing(msgInternetAccountName) Then
_step = "4.5"
ClassLogger.Add(" >> InternetAccountName in email is nothing - default will be set", False)
emailFrom = ""
Else
_step = "4.6"
emailFrom = msgInternetAccountName.ToString.Replace("'", "")
End If
Else
_step = "5"
If LogErrorsOnly = False Then ClassLogger.Add(" >> emailTo and From Extraction via messageheader.", False)
emailFrom = ClassEmailHeaderExtractor.extractFromAddress1(headers, fromPattern) 'FromRegexList)
emailFrom = ClassEmailHeaderExtractor.extractFromAddress1(emailFrom, finalize_pattern)
emailTo = ClassEmailHeaderExtractor.extractFromAddress1(headers, toPattern) ' extractToAddress(headers, ToRegexList)
emailTo = ClassEmailHeaderExtractor.extractFromAddress1(emailTo, finalize_pattern)
emailFrom = ClassEmailHeaderExtractor.extractFromHeader(headers, fromPattern) 'FromRegexList)
emailFrom = emailFrom.Replace("<", "")
emailFrom = emailFrom.Replace(">", "")
emailTo = ClassEmailHeaderExtractor.extractFromHeader(headers, toPattern) ' extractToAddress(headers, ToRegexList)
'Handler für leere emailTo-Adresse
If IsNothing(emailTo) Then
_step = "5.1"
If LogErrorsOnly = False Then ClassLogger.Add(" >> emailTo couldn't be extracted from messageheader...", False)
If (headers.Contains("exc") Or headers.Contains("exchange")) Then
_step = "5.2"
If LogErrorsOnly = False Then ClassLogger.Add(" >> ...try with LDAP-option", False)
Dim _email = GetUserEmailfromLDAP(msgDisplayTo)
_step = "5.3"
If _email <> "" Then
emailTo = _email
Else
ClassLogger.Add(">> email-adress couldn't be read from LDAP with name '" & msgDisplayTo & "'", False)
MsgBox("Could't get 'emailto' from messageHeader and later on with LDAP-Option." & vbNewLine & "Please check the dropped email and Configuration of Email-Indexing!", MsgBoxStyle.Exclamation)
Return False
End If
Else
_step = "5.4"
CURR_MISSING_PATTERN_NAME = "Email To"
CURR_MISSING_SEARCH_STRING = headers
CURR_MISSING_MANUAL_VALUE = String.Empty
frmMissingInput.ShowDialog()
_step = "5.4.1"
If CURR_MISSING_MANUAL_VALUE <> String.Empty Then
_step = "5.4.2"
emailTo = CURR_MISSING_MANUAL_VALUE
Else
_step = "5.4.3"
If LogErrorsOnly = False Then ClassLogger.Add(" >> no exchange patterns found in headers!", False)
MsgBox("Could't get 'emailto' from messageHeader and exhange-Patterns weren't found." & vbNewLine & "Please check the dropped email and Configuration of Email-Indexing!", MsgBoxStyle.Exclamation)
Return False
End If
End If
End If
_step = "6"
emailTo = ClassEmailHeaderExtractor.extractFromHeader(emailTo, finalize_pattern)
emailFrom = ClassEmailHeaderExtractor.extractFromHeader(emailFrom, finalize_pattern)
_step = "6.1"
If Not IsNothing(emailFrom) Then
emailFrom = emailFrom.Replace("<", "")
emailFrom = emailFrom.Replace(">", "")
Else
_step = "6.1.x"
ClassLogger.Add(" >> emailFrom is Nothing?!")
End If
If Not IsNothing(emailTo) Then
_step = "6.1.1 " & emailTo.ToString
emailTo = emailTo.Replace("<", "")
emailTo = emailTo.Replace(">", "")
End If
If Not IsNothing(emailTo) Then
_step = "6.2"
Dim _duplicatesCheck As List(Of String) = New List(Of String)
_duplicatesCheck = emailTo.ToString.Split(";").ToList
' Filter distinct elements, and convert back into list.
' Filter distinct elements, and convert back into list.
Dim result As List(Of String) = _duplicatesCheck.Distinct().ToList
' Display result.
Dim i As Integer = 0
@@ -1355,60 +1438,64 @@ Public Class frmIndex
End If
i += 1
Next
Else
_step = "6.3"
ClassLogger.Add(" >> emailTo is Nothing?!")
End If
If LogErrorsOnly = False Then ClassLogger.Add("", True)
If LogErrorsOnly = False Then ClassLogger.Add(" >> Headers-Content: ", True)
If LogErrorsOnly = False Then ClassLogger.Add(headers.ToString, False)
If LogErrorsOnly = False Then ClassLogger.Add("", True)
End If
'Handler für leere emailFrom-Adresse
If IsNothing(emailFrom) Then
If LogErrorsOnly = False Then ClassLogger.Add(" >> emailFrom couldn't be extracted from messageheader...", False)
_step = "7"
ClassLogger.Add(" >> emailFrom couldn't be extracted from messageheader...", False)
If Not IsNothing(msg.SenderEmailAddress) Then
If LogErrorsOnly = False Then ClassLogger.Add(" >> emailFrom via msg.SenderEmailAddress will be used instead!", False)
emailFrom = msg.SenderEmailAddress.ToString.Replace("'", "")
If msg.SenderEmailAddress <> String.Empty Then
_step = "7.1"
ClassLogger.Add(" >> emailFrom via msg.SenderEmailAddress will be used instead!", False)
emailFrom = msg.SenderEmailAddress.ToString.Replace("'", "")
End If
End If
End If
If IsNothing(emailFrom) Or emailFrom = String.Empty Then
_step = "7.2"
CURR_MISSING_PATTERN_NAME = "Email From"
CURR_MISSING_SEARCH_STRING = emailFrom
CURR_MISSING_MANUAL_VALUE = String.Empty
frmMissingInput.ShowDialog()
If CURR_MISSING_MANUAL_VALUE <> String.Empty Then
_step = "7.3"
emailFrom = CURR_MISSING_MANUAL_VALUE
Else
MsgBox("Could't get 'emailfrom' from messageHeader." & vbNewLine & "Please check the dropped email and Configuration of Email-Indexing!", MsgBoxStyle.Exclamation)
Return False
End If
End If
'Handler für leere emailTo-Adresse
If IsNothing(emailTo) Then
If LogErrorsOnly = False Then ClassLogger.Add(" >> emailTo couldn't be extracted from messageheader...", False)
If (headers.Contains("exc") Or headers.Contains("exchange")) Then
If LogErrorsOnly = False Then ClassLogger.Add(" >> ...try with LDAP-option", False)
Dim _email = GetUserEmailfromLDAP(msgDisplayTo)
If _email <> "" Then
emailTo = _email
Else
ClassLogger.Add(">> email-adress couldn't be read from LDAP with name '" & msgDisplayTo & "'", False)
MsgBox("Could't get 'emailto' from messageHeader and later on with LDAP-Option." & vbNewLine & "Please check the dropped email and Configuration of Email-Indexing!", MsgBoxStyle.Exclamation)
Return False
End If
Else
If LogErrorsOnly = False Then ClassLogger.Add(" >> no exchange patterns found in headers!", False)
MsgBox("Could't get 'emailto' from messageHeader and exhange-Patterns weren't found." & vbNewLine & "Please check the dropped email and Configuration of Email-Indexing!", MsgBoxStyle.Exclamation)
Return False
End If
End If
If LogErrorsOnly = False Then ClassLogger.Add(" >> emailFrom: " & emailFrom, False)
If LogErrorsOnly = False Then ClassLogger.Add(" >> emailTo: " & emailTo, False)
'FROM
If Not IsNothing(emailFrom) Then
indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_FROM").ToString, emailFrom)
If indexierung_erfolgreich = False Then
MsgBox("Error in SetEmailIndices-From - See log", MsgBoxStyle.Critical)
MsgBox("Error in SetEmailIndices [emailFrom] - See log", MsgBoxStyle.Critical)
Return False
End If
Else
ClassLogger.Add(" >> emailFrom is still Nothing?!")
_step = "7.4"
End If
'TO
If Not IsNothing(emailTo) Then
indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_TO").ToString, emailTo)
If indexierung_erfolgreich = False Then
MsgBox("Error in SetEmailIndices-To - See log", MsgBoxStyle.Critical)
MsgBox("Error in SetEmailIndices [emailTo] - See log", MsgBoxStyle.Critical)
Return False
End If
Else
ClassLogger.Add(" >> emailTo is still Nothing?!")
_step = "7.5"
End If
' Dim subj As String = ClassFormFunctions.CleanInput(msg.Subject)
@@ -1417,20 +1504,27 @@ Public Class frmIndex
ClassLogger.Add(" >> msg subject is empty...DEFAULT will be set", False)
subj = "No subject"
MsgBox("Attention: Email was send without a subject - Default value 'No subject' will be used!", MsgBoxStyle.Exclamation)
Else
subj = ClassHelper.encode_utf8(msg.Subject)
If IsNothing(subj) Then
subj = msg.Subject
End If
End If
If LogErrorsOnly = False Then ClassLogger.Add(" >> subj: " & subj, False)
If LogErrorsOnly = False Then ClassLogger.Add(" >> Now all email-items will be indexed!", False)
If LogErrorsOnly = False Then ClassLogger.Add(" >> subj: " & subj, False)
indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_SUBJECT").ToString, subj)
CURRENT_MESSAGESUBJECT = subj
If indexierung_erfolgreich = False Then
MsgBox("Error in SetEmailIndices-Subject - See log", MsgBoxStyle.Critical)
MsgBox("Error in SetEmailIndices [Subject] - See log", MsgBoxStyle.Critical)
Return False
End If
If LogErrorsOnly = False Then ClassLogger.Add(" >> MessageDeliveryTime: " & msg.MessageDeliveryTime, False)
indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_DATE_IN").ToString, msg.MessageDeliveryTime)
CURRENT_MESSAGEDATE = msg.MessageDeliveryTime
If indexierung_erfolgreich = False Then
MsgBox("Error in SetEmailIndices-Datein - See log", MsgBoxStyle.Critical)
MsgBox("Error in SetEmailIndices [Datein] - See log", MsgBoxStyle.Critical)
Return False
End If
Else
@@ -1441,6 +1535,8 @@ Public Class frmIndex
End If
Catch ex As Exception
MsgBox("Error in SetEmailIndices:" & vbNewLine & ex.Message & vbNewLine & "Please check the configuration Email-Indexing!", MsgBoxStyle.Critical)
ClassLogger.Add("Error in SetEmailIndices (Step finisched: " & _step & "): " & ex.Message)
ClassLogger.Add("Stack-Trace: " & ex.StackTrace, True)
Return False
End Try
@@ -1639,7 +1735,7 @@ Public Class frmIndex
chkdelete_origin.Visible = False
If DropType = "|DROPFROMFSYSTEM|" Then
chkdelete_origin.Visible = True
chkdelete_origin.Checked = Delete_OriginFile
chkdelete_origin.Checked = CURR_DELETE_ORIGIN
Me.Text = "Indexierung der gedroppten Datei:"
ElseIf DropType = "|OUTLOOK_MESSAGE|" Or DropType = "|FW_MSGONLY|" Then
Select Case DropType
@@ -1721,7 +1817,7 @@ Public Class frmIndex
Sub Refresh_Dokart()
Try
Dim sql = String.Format("select * from VWGI_DOCTYPE where UPPER(USERNAME) = UPPER('{0}') ORDER BY SEQUENCE", Environment.UserName)
If LogErrorsOnly = False Then ClassLogger.Add(" >> SQL DoctypeList: " & sql)
If LogErrorsOnly = False Then ClassLogger.Add(" >> SQL DoctypeList: " & sql, False)
DT_DOKART = ClassDatabase.Return_Datatable(sql)
cmbDokumentart.DataSource = DT_DOKART
cmbDokumentart.ValueMember = DT_DOKART.Columns("DOCTYPE_ID").ColumnName
@@ -2086,7 +2182,13 @@ Public Class frmIndex
If msg_email.Subject = "" Then
Me.txtBetreff.Text = "!! No subject in email !!"
Else
Me.txtBetreff.Text = msg_email.Subject
Dim betreff = ClassHelper.encode_utf8(msg_email.Subject)
If Not IsNothing(betreff) Then
Me.txtBetreff.Text = betreff
Else
Me.txtBetreff.Text = msg_email.Subject
End If
End If
'Try
@@ -2101,12 +2203,10 @@ Public Class frmIndex
'Catch ex As IOException
' MsgBox(ex.ToString)
'End Try
Dim vIn() As Byte
If IsNothing(msg_email.BodyHtml) Then
File.WriteAllText(tempFilename, msg_email.Body, System.Text.Encoding.UTF8)
Else
vIn = msg_email.BodyHtml
Dim vOut As String = System.Text.Encoding.UTF8.GetString(vIn)
Dim vOut As String = System.Text.Encoding.UTF8.GetString(msg_email.BodyHtml)
File.WriteAllText(tempFilename, vOut, System.Text.Encoding.UTF8)
End If
@@ -2184,7 +2284,7 @@ Public Class frmIndex
If LogErrorsOnly = False Then ClassLogger.Add(" ...Move_File2_Target durchlaufen", False)
'Die Originaldatei löschen
If DropType = "|DROPFROMFSYSTEM|" Then
If chkdelete_origin.Checked = True Then
If CURR_DELETE_ORIGIN = True Then
'Die temporäre Datei löschen
DeleteFile()
End If
@@ -2233,6 +2333,7 @@ Public Class frmIndex
End Function
Sub DeleteFile()
Try
If CURR_DELETE_ORIGIN = False Then Exit Sub
File.Delete(CURRENT_WORKFILE)
Catch ex As Exception
MsgBox("Unexpeted Error in Delete Current Workfile:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
@@ -2514,7 +2615,8 @@ Public Class frmIndex
End Try
End If
CURRENT_NEWFILENAME = CURRENT_NEWFILENAME.Replace(RootFolder, fullpath)
CURRENT_NEWFILENAME = CURRENT_NEWFILENAME.Replace("\\", "\")
''Die aktuelle Datei soll gleichzeitig verschoben werden
'Dim extension As String = Path.GetExtension(CURRENT_NEWFILENAME)
'Dim Dateiname As String = Path.GetFileName(CURRENT_NEWFILENAME)
@@ -2601,8 +2703,8 @@ Public Class frmIndex
End Sub
Private Sub chkdelete_origin_CheckedChanged(sender As Object, e As EventArgs) Handles chkdelete_origin.CheckedChanged
Delete_OriginFile = chkdelete_origin.Checked
SaveConfigValue("Delete_OriginFile", Delete_OriginFile)
CURR_DELETE_ORIGIN = chkdelete_origin.Checked
SaveConfigValue("Delete_OriginFile", CURR_DELETE_ORIGIN)
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click