2025-12-03 13:07:09 +01:00

1631 lines
68 KiB
VB.net

Imports System.Data.SqlClient
Imports System.IO
Imports System.Text.RegularExpressions
Imports System.Threading
Imports DigitalData.Modules.Base
Imports DigitalData.Modules.Config
Imports DigitalData.Modules.Database
Imports DigitalData.Modules.Logging
Imports DigitalData.Modules.Patterns
Imports EmailProfiler.Common.ClassCurrent
Imports GdPicture14
Imports Limilabs.Mail
Imports Limilabs.Mail.MIME
Imports WINDREAMLib
Imports MailBox = Limilabs.Mail.Headers.MailBox
Public Class clsWorkEmail
Private Const SUBJECT_MAX_LENGTH = 25
Private Const MESSAGE_ID_MAX_LENGTH = 100
Private _CurrentMail As MailContainer = Nothing
Private CurrentTempMailPath As String
Private CURRENT_MAIL_BODY_ALL As String
Private CURRENT_MAIL_BODY_ANSWER1 As String = ""
Private CURRENT_MAIL_BODY_Substr2 As String = ""
Private CURRENT_MAIL_SUBJECT As String = ""
Private CURRENT_MAIL_FROM As String = ""
Private CurrentMailProcessName As String
Private ReadOnly _Logger As Logger
Private ReadOnly _LogConfig As LogConfig
Private ReadOnly _DB_MSSQL As MSSQLServer
Private ReadOnly _UseWindream As Boolean
Private ReadOnly _windream As clsWindream_allgemein
Private ReadOnly _windream_index As clsWindream_Index
Private ReadOnly _windreamConnectionString As String
Private ReadOnly _Patterns As Patterns2
Private ReadOnly _EmailAccountID As Integer = 1
Private ReadOnly _RejectionTemplateId As Integer = 0
Private ReadOnly _InfoTemplateId As Integer = 0
Private ReadOnly _LicenseManager As New LicenseManager
Private ReadOnly _ValidExtensions As List(Of String)
Private ReadOnly _ValidFirstExtensions As List(Of String)
Private ReadOnly _GraphicExtensions As List(Of String)
Private DoubleBytes As Double
Private _worked_email As Boolean = False
Sub New(LogConf As LogConfig, ConStr As String, WmConStr As String, pConfigData As Config)
Try
_Logger = LogConf.GetLogger
_LogConfig = LogConf
_DB_MSSQL = New MSSQLServer(LogConf, ConStr)
_Logger.Debug("clsWorkmail _email initialized")
_UseWindream = pConfigData.UseWindream
_Patterns = New Patterns2(LogConf)
_RejectionTemplateId = pConfigData.RejectionTemplateId
_InfoTemplateId = pConfigData.InfoTemplateId
_Logger.Debug($"_RejectionTemplateId: {_RejectionTemplateId}")
_ValidExtensions = New List(Of String) From {"pdf", "xls", "xlsx", "doc", "docx", "ppt", "pptx"}
_ValidFirstExtensions = New List(Of String) From {"xml"}
_ValidFirstExtensions.AddRange(_ValidExtensions)
_GraphicExtensions = New List(Of String) From {"jpg", "bmp", "jpeg", "gif", "png", "xml"}
If _UseWindream Then
_windream = New clsWindream_allgemein(LogConf)
_windream_index = New clsWindream_Index(LogConf)
_windreamConnectionString = WmConStr
End If
GDPictureLicense = ConfigDbFunct.GetProductLicense("GDPICTURE", pConfigData.GDPictureVersion, _LogConfig, ConStr)
If String.IsNullOrEmpty(GDPictureLicense) = False Then
_LicenseManager.RegisterKEY(GDPictureLicense)
Else
_Logger.Error("clsWorkEmail() No value for GDPictureLicense found!")
End If
_EmailAccountID = pConfigData.EmailAccountId
SUBJECT_PRAFIX = pConfigData.EmailTitlePrefix
Catch ex As Exception
_Logger.Error(ex)
End Try
End Sub
Public Function WorkEmailMessage(pMailMessage As IMail, poUID As Long, pValidationSQL As String) As Boolean
Try
For Each m As MailBox In pMailMessage.From
CURRENT_MAIL_FROM = m.Address
Next
'TODO: Move all of these CURRENT_MAIL vars into a business object of type mail container
_CurrentMail = New MailContainer(pMailMessage, poUID)
_Logger.Debug($"Working on email from: {_CurrentMail.SenderAddress}...Subject: {pMailMessage.Subject}")
CURRENT_MAIL_BODY_ALL = ""
CURRENT_MAIL_BODY_ANSWER1 = ""
CURRENT_MAIL_BODY_Substr2 = ""
CURRENT_MAIL_SUBJECT = pMailMessage.Subject.ToUpper.EscapeForSQL()
CURRENT_MAIL_UID = poUID
' 05.06.23
' The MessageID is now replaced by a SHA256 Hash of the MessageID
' The reason is that MessageIDs can be very long,
' which results in the final filepath exceeding the Windream/Windows maximum of 255 chars.
' 28.07.23
' The SHA256 Hash is now truncated to half the size
' which should be a good balance between uniqueness and length
'CURRENT_MAIL_MESSAGE_ID = StringEx.GetShortHash(pMailMessage.MessageID)
'If String.IsNullOrEmpty(CURRENT_MAIL_MESSAGE_ID) Then
' CURRENT_MAIL_MESSAGE_ID = Guid.NewGuid.ToString()
'
'ElseIf CURRENT_MAIL_MESSAGE_ID.Length > MESSAGE_ID_MAX_LENGTH Then
'
' ' MessageIds longer than 100 chars will be replaced with a guid to avoid errors
' ' because of file paths longer than 255 chars.
' CURRENT_MAIL_MESSAGE_ID = Hash(CURRENT_MAIL_MESSAGE_ID)
'
'Else
' ' Default case, should cover most message ids
' CURRENT_MAIL_MESSAGE_ID = CURRENT_MAIL_MESSAGE_ID.Replace(">", "").Replace("<", "")
' CURRENT_MAIL_MESSAGE_ID = CURRENT_MAIL_MESSAGE_ID.Replace("'", "")
'
'End If
If IsNothing(_CurrentMail.SubjectOriginal) Then
CURRENT_MAIL_SUBJECT = String.Empty
_Logger.Warn("Subject was nothing!")
Else
CURRENT_MAIL_SUBJECT = _CurrentMail.SubjectOriginal.ToUpper.EscapeForSQL()
_Logger.Debug("Fixed Subject: [{0}]", CURRENT_MAIL_SUBJECT)
End If
Dim oSql = $"Select COALESCE(MAX(GUID),0) FROM TBEMLP_HISTORY WHERE EMAIL_MSGID = '{_CurrentMail.MessageId}'"
Dim oHistoryID = _DB_MSSQL.GetScalarValue(oSql)
If oHistoryID > 0 And IS_LOCAL_TEST = False Then
_Logger.Info($"Message with subject [{_CurrentMail.SubjectOriginal}] from [{_CurrentMail.SenderAddress}] has already been worked!")
Return True
End If
Dim oTempMailExists As Boolean = Save2TempDirectory(_CurrentMail)
'Checking wether Mail can be opened
Dim oTempMailAccessible As Boolean = False
If oTempMailExists = False Then
_Logger.Warn("Could not process email [{0}], file does not exist!", _CurrentMail.MessageId)
Return False
End If
Try
Dim oFS As FileStream = File.OpenRead(CurrentTempMailPath)
oTempMailAccessible = True
oFS.Close()
Catch ex As Exception
_Logger.Warn($"Could not read the Temp-Mail. Insufficient rights? Message: {ex.Message}")
End Try
If oTempMailAccessible = False Then
_Logger.Warn("Could not process email [{0}], file is not accessible!", _CurrentMail.MessageId)
Return False
End If
MESSAGE_ERROR = False
If pValidationSQL <> "" Then
Dim oReplaceValues = New Dictionary(Of String, String) From {
{"EMAIL", _CurrentMail.SenderAddress},
{"DOMAIN", _CurrentMail.SenderDomain}
}
Dim pValidationSQLWithPlaceholders = _Patterns.ReplaceCustomValues(pValidationSQL, oReplaceValues)
Dim oResult As String = ObjectEx.NotNull(_DB_MSSQL.GetScalarValue(pValidationSQLWithPlaceholders), "")
If oResult <> "" Then
Dim oRejectionCodeString = GetRejectionCodeString(_CurrentMail.MessageId, ErrorCode.SenderValidationFailed)
'insert history und exit
InsertHistoryEntryWithStatus(_CurrentMail, "REJECTED", oRejectionCodeString)
AddTrackingStatusMSSQL(_CurrentMail.MessageId, oRejectionCodeString, "Email-Adress validation failed", "", "EMailProfiler")
AddToEmailQueueMSSQL(_CurrentMail.MessageId, oResult, "Email validation failed", _EmailAccountID,
_RejectionTemplateId, ErrorCode.SenderValidationFailed, "", "")
' Return early from processing eml
Return True
End If
End If
If CURRENT_MAIL_SUBJECT.Contains("[PROCESSMANAGER]") Then
Return ProcessManager_IN(_CurrentMail)
Else
_Logger.Debug("CommonEmail-Process-Sniffer")
' Allgemeine Verarbeitung der EMail
Dim oCommonEmailResult = CommonEmail_IN(_CurrentMail)
If oCommonEmailResult = False Then
Return False
End If
If CURRENT_ATTMT_COUNT = 0 Then
_Logger.Info("### Mail contained no Attachments!! ###")
Dim oRejectionCodeString = GetRejectionCodeString(_CurrentMail.MessageId, ErrorCode.NoAttachments)
InsertHistoryEntryWithStatus(_CurrentMail, "REJECTED", oRejectionCodeString)
AddTrackingStatusMSSQL(_CurrentMail.MessageId, oRejectionCodeString, "No Attachments", "", "EMailProfiler")
Dim oBody = EmailStrings.EMAIL_NO_FERDS
If AddToEmailQueueMSSQL(_CurrentMail.MessageId, oBody, "No Attachments", _EmailAccountID,
_RejectionTemplateId, ErrorCode.NoAttachments, "", "") = True Then
CURRENT_ImapObject.DeleteMessageByUID(poUID)
End If
Else
' Jetzt werden die ggf gefundenen Attachment-Fehler überprüft und verarbeitet
Dim oNormalAttachmentsNotValid As Boolean = False
Dim oEmbeddedAttachmentsNotValid As Boolean = False
oEmbeddedAttachmentsNotValid = EmailAttachments.
Where(Function(att) att.EmbeddedFiles.Count > 0).
Any(Function(emb) emb.EmbeddedFiles.Any(Function(ext) ext.IsAttachmentValid = False))
If oEmbeddedAttachmentsNotValid = True Then
Dim oRejectionCodeString = GetRejectionCodeString(_CurrentMail.MessageId, ErrorCode.EmbeddedFileAttachmentCorrupt)
InsertHistoryEntryWithStatus(_CurrentMail, "REJECTED", oRejectionCodeString)
AddTrackingStatusMSSQL(_CurrentMail.MessageId, oRejectionCodeString, "Embedded File corrupt", "", "EMailProfiler")
SendRejectionMailToSenderIfEmbeddedAttachmentsAreNotValid()
DeleteAllCollectedAttachments()
CURRENT_ImapObject.DeleteMessageByUID(poUID)
Else
If IS_LOCAL_TEST = False Then
InsertHistoryEntry(_CurrentMail)
End If
oNormalAttachmentsNotValid = EmailAttachments.Any(Function(ext) ext.IsAttachmentValid = False)
If oNormalAttachmentsNotValid = True Then
SendInfoMailToSenderIfNormalAttachmentsAreNotValid()
End If
End If
Return True
End If
End If
' Wenn er bis hierin kommt, wird es schon gepasst haben
Return True
Catch ex As Exception
_Logger.Error(ex)
Return False
End Try
End Function
''' <summary>
''' Wenn beim Herauslösen der Attachments festgestellt wurde,
''' das ein Teil der _normalen_ Attachments fehlerhaft war, wird der Absender hier
''' darüber informiert.
''' </summary>
Private Sub SendInfoMailToSenderIfNormalAttachmentsAreNotValid()
Dim oHtmlFilenameList As String = GetHtmlFilenameList()
If oHtmlFilenameList.IsNotNullOrEmpty() Then
AddToEmailQueueMSSQL(_CurrentMail.MessageId, "", "Attachment invalid", _EmailAccountID, _InfoTemplateId, ErrorCode.NormalFileAttachmentCorrupt, oHtmlFilenameList, "")
End If
End Sub
''' <summary>
''' Wenn beim Herauslösen der Attachments festgestellt wurde,
''' das ein PDF-Attachments korrupte Anhänge enthält war, bekommt der Absender hier
''' die Ablehnung.
''' </summary>
Private Sub SendRejectionMailToSenderIfEmbeddedAttachmentsAreNotValid()
Dim oHtmlFilenameList As String = GetHtmlFilenameList()
If oHtmlFilenameList.IsNotNullOrEmpty() Then
AddToEmailQueueMSSQL(_CurrentMail.MessageId, "", "Attachment invalid", _EmailAccountID, _RejectionTemplateId, ErrorCode.EmbeddedFileAttachmentCorrupt, oHtmlFilenameList, "")
End If
End Sub
''' <summary>
''' Stellt die Dateinamen der Dateien zusammen, die nicht valide sind.
''' Die Ausgabe erfolgt als HTML-Liste
''' </summary>
Private Function GetHtmlFilenameList() As String
Dim filenameHtmlString As String = String.Empty
For Each attachmentItem In EmailAttachments
Dim oEmbeddedAttachmentsInvalid As Boolean = False
oEmbeddedAttachmentsInvalid = attachmentItem.EmbeddedFiles.Any(Function(emb) emb.IsAttachmentValid = False)
If attachmentItem.IsAttachmentValid = False Or oEmbeddedAttachmentsInvalid = True Then
AddTrackingStatusMSSQL(_CurrentMail.MessageId, attachmentItem.OrgFileName, "FILE CONSISTENCY NOT OK", attachmentItem.ErrorCodeComment, "EMail Profiler")
filenameHtmlString += "<li>" + attachmentItem.OrgFileName + "</li>"
End If
' prüfe evtl. eingebettete Anhänge
Dim embeddedFilenamesHtmlString As String = String.Empty
If attachmentItem.EmbeddedFiles.Count > 0 Then
For Each embeddedItem In attachmentItem.EmbeddedFiles
If embeddedItem.IsAttachmentValid = False Then
AddTrackingStatusMSSQL(_CurrentMail.MessageId, embeddedItem.OrgFileName, "EMBEDDED FILE CONSISTENCY NOT OK", embeddedItem.ErrorCodeComment, "EMail Profiler")
embeddedFilenamesHtmlString += "<li>" + embeddedItem.OrgFileName + "</li>"
End If
Next
If embeddedFilenamesHtmlString.IsNotNullOrEmpty() Then
embeddedFilenamesHtmlString = "<ul>" + embeddedFilenamesHtmlString + "</ul>"
End If
End If
If embeddedFilenamesHtmlString.IsNotNullOrEmpty() Then
filenameHtmlString += embeddedFilenamesHtmlString
End If
Next
If filenameHtmlString.IsNotNullOrEmpty() Then
filenameHtmlString = "<ul>" + filenameHtmlString + "</ul>"
End If
Return filenameHtmlString
End Function
''' <summary>
''' Method to decide wether we use the old or the new
''' Rejection E-mail method.
'''
''' TODO we have no information about the language of the receiver at the moment
''' </summary>
''' <param name="pMessageId">E-Mail Message ID</param>
''' <param name="pBodyText">Body Text</param>
''' <param name="pComment">Comment</param>
''' <param name="pEmailAccountId">Sending Profile from config</param>
''' <param name="pTemplateId">ID for E-Mail-Template from config</param>
''' <param name="pErrorCode">Error Code</param>
''' <param name="pParameter1">Zusätzlicher Parameter 1</param>
''' <param name="pParameter2">Zusätzlicher Parameter 2</param>
Public Function AddToEmailQueueMSSQL(pMessageId As String, pBodyText As String, pComment As String, pEmailAccountId As Integer,
pTemplateId As Integer, pErrorCode As ErrorCode, pParameter1 As String, pParameter2 As String) As Boolean
Dim useLegacyMethod = True
Dim oErrorCode As String = String.Empty
' ErrorCode valid?
If pErrorCode <> ErrorCode.Unknown Then
Dim intCode As Integer = DirectCast(pErrorCode, Integer)
oErrorCode = $"{EmailStrings.ErrorCodePraefix}{intCode}"
Dim oSQL = $"SELECT COUNT(*) FROM TBDD_GUI_LANGUAGE_PHRASE WHERE TITLE = '{oErrorCode}'"
If _DB_MSSQL.GetScalarValue(oSQL) > 0 Then
useLegacyMethod = False
Else
_Logger.Warn($"Rejection reason [{oErrorCode}] not found in TBDD_GUI_LANGUAGE_PHRASE!")
End If
End If
' Gibt es das Template in TBDD_EMAIL_TEMPLATE?
If useLegacyMethod = False AndAlso pTemplateId > 0 Then
Try
Dim oSQL = $"SELECT COUNT(*) FROM TBDD_EMAIL_TEMPLATE WHERE GUID = {pTemplateId}"
If _DB_MSSQL.GetScalarValue(oSQL) <= 0 Then
_Logger.Warn($"EMAIL_TEMPLATE [{pTemplateId}] not found in TBDD_EMAIL_TEMPLATE!")
useLegacyMethod = True
End If
Catch ex As Exception
_Logger.Error(ex)
useLegacyMethod = True
End Try
Else
_Logger.Debug($"RejectionTemplateId not configured!")
useLegacyMethod = True
End If
' Check if Stored Procedure PRDD_SEND_REJECTION_MAIL exists
If useLegacyMethod = False Then
Try
Dim oSQL = $"SELECT COUNT(*) FROM sys.objects WHERE type = 'P' AND OBJECT_ID = OBJECT_ID('dbo.PRDD_SEND_REJECTION_MAIL')"
If _DB_MSSQL.GetScalarValue(oSQL) <= 0 Then
_Logger.Warn($"Procedure ['PRDD_SEND_REJECTION_MAIL'] not found in Database!")
useLegacyMethod = True
End If
Catch ex As Exception
_Logger.Error(ex)
useLegacyMethod = True
End Try
End If
If useLegacyMethod = True Then
_Logger.Warn("New rejection mail logic is not configured correctly, use legacy logic instead!")
Return AddEmailToQueueMSSQL(pMessageId, pBodyText, pComment, pEmailAccountId)
Else
_Logger.Debug("New rejection mail logic is configured!")
Return AddEmailToQueueMSSQL(pMessageId, pTemplateId, oErrorCode, pEmailAccountId, pParameter1, pParameter2)
End If
End Function
''' <summary>
''' Function calls SP PRDD_SEND_REJECTION_MAIL
''' for sending rejection mail.
''' </summary>
''' <param name="pMessageId">E-Mail Message ID</param>
''' <param name="pTemplateId">GUID for TBDD_EMAIL_TEMPLATE from config</param>
''' <param name="pErrorCode">ErrorID (TBDD_GUI_LANGUAGE_PHRASE)</param>
''' <param name="pEmailAccountId">Sending profile from config</param>
''' <param name="pParameter1">Zusätzlicher Parameter 1</param>
''' <param name="pParameter2">Zusätzlicher Parameter 2</param>
Private Function AddEmailToQueueMSSQL(pMessageId As String, pTemplateId As Integer, pErrorCode As String, pEmailAccountId As Integer,
pParameter1 As String, pParameter2 As String) As Boolean
If pParameter1.IsNullOrEmpty Then
pParameter1 = ""
Else
pParameter1 = pParameter1.Replace("'", "''")
End If
If pParameter2.IsNullOrEmpty Then
pParameter2 = ""
Else
pParameter2 = pParameter2.Replace("'", "''")
End If
Try
Dim oExecute = $"EXECUTE dbo.PRDD_SEND_REJECTION_MAIL
'{pMessageId}'
, 0
, {pEmailAccountId}
, 'DDEmailProfiler'
, {pTemplateId}
, '{pErrorCode}'
, '{pParameter1}'
, '{pParameter2}'
, 77"
Return _DB_MSSQL.ExecuteNonQuery(oExecute)
Catch ex As Exception
_Logger.Error(ex)
Return False
End Try
End Function
Public Function AddEmailToQueueMSSQL(pMessageId As String, pBodyText As String, pComment As String, pEmailAccountId As Integer) As Boolean
Try
Dim oReference = pMessageId
Dim oEmailTo = ""
Dim oSubject = $"{SUBJECT_PRAFIX} - {EmailStrings.EMAIL_SUBJECT_REJECTED}"
Dim oCreatedWho = "DDEmailProfiler"
Dim oMaskedBodyText = pBodyText.Replace("'", "''")
Dim oSubjectBodyText = String.Format(EmailStrings.EMAIL_SUBJECT_TEXT, CURRENT_MAIL_SUBJECT)
Dim oCompleteBodyText = oMaskedBodyText & oSubjectBodyText
Dim oFinalBodyText = String.Format(EmailStrings.EMAIL_WRAPPING_TEXT, oCompleteBodyText)
Dim oEmailAddress = CURRENT_MAIL_FROM
If IsNothing(oEmailAddress) OrElse String.IsNullOrWhiteSpace(oEmailAddress) Then
_Logger.Warn("Could not find email-address for MessageId {0}", pMessageId)
oEmailTo = String.Empty
Else
oEmailTo = oEmailAddress
End If
_Logger.Debug("Trying to generate Email:")
_Logger.Debug("To: {0}", oEmailTo)
_Logger.Debug("Subject: {0}", oSubject)
_Logger.Debug("Body {0}", oFinalBodyText)
Dim osql = $"Select COALESCE(MAX(GUID), 0) FROM TBEMLP_HISTORY WHERE EMAIL_MSGID = '{pMessageId}'"
Dim oHistoryID As Integer = _DB_MSSQL.GetScalarValue(osql)
Dim oInsert = $"INSERT INTO [dbo].[TBEMLP_EMAIL_OUT] (
[REMINDER_TYPE_ID]
,[SENDING_PROFILE]
,[REFERENCE_ID]
,[REFERENCE_STRING]
,[WF_ID]
,[EMAIL_ADRESS]
,[EMAIL_SUBJ]
,[EMAIL_BODY]
,[COMMENT]
,[ADDED_WHO])
VALUES
(77
,{pEmailAccountId}
,{oHistoryID}
,'{pMessageId}'
,77
,'{oEmailTo}'
,'{oSubject}'
,'{oFinalBodyText}'
,'{pComment}'
,'{oCreatedWho}')"
Return _DB_MSSQL.ExecuteNonQuery(oInsert)
Catch ex As Exception
_Logger.Error(ex)
Return False
End Try
Return True
End Function
Private Function ProcessManager_IN(pCurrentMail As MailContainer) As Boolean
Try
_Logger.Info(String.Format("PM-related message found....[{0}]", pCurrentMail.Mail.Subject))
_Logger.Debug(String.Format("PM-related message found....[{0}]", pCurrentMail.Mail.Subject))
Dim oExpression = "PROCESS_NAME = 'ProcessManager'"
'Filter the rows using Select() method of DataTable
Dim TEMP_PROCESS_PROFILE_DT As DataTable = DT_POLL_PROCESS
Dim PM_ROW As DataRow() = TEMP_PROCESS_PROFILE_DT.Select(oExpression)
For Each row As DataRow In PM_ROW
Try
WM_REFERENCE_INDEX = row("WM_REFERENCE_INDEX")
Catch ex As Exception
_Logger.Debug($"PM_IN Attention WM_REFERENCE_INDEX seems to be Empty/null: {ex.Message}")
WM_REFERENCE_INDEX = Nothing
End Try
WM_VECTOR_LOG = row("WM_VECTOR_LOG")
WM_OBJEKTTYPE = row("WM_OBJEKTTYPE")
WM_IDX_BODY_TEXT = row("WM_IDX_BODY_TEXT")
WM_IDX_BODY_SUBSTR_LENGTH = row("WM_IDX_BODY_SUBSTR_LENGTH")
DeleteMail = row("DELETE_MAIL")
If Copy2HDD(pCurrentMail, row("COPY_2_HDD"), row("PATH_ORIGINAL"), row("PATH_EMAIL_ERRORS"), False) = True Then
ExtractBody(pCurrentMail)
End If
Next
If CURRENT_MAIL_SUBJECT.Contains("[PROCESSMANAGER][EA]") Then
_Logger.Info(String.Format("Message referencing to EASY-APPROVAL...."))
_Logger.Debug(String.Format("Message referencing to EASY-APPROVAL...."))
CurrentMailProcessName = "DD EasyApproval via Mail"
If CURRENT_MAIL_BODY_ANSWER1 <> "" Then
If CURRENT_MAIL_BODY_ANSWER1.EndsWith(":") Then
_Logger.Info(String.Format("Keyword contained a : at end...removing it..."))
CURRENT_MAIL_BODY_ANSWER1 = CURRENT_MAIL_BODY_ANSWER1.Replace(":", "")
End If
If GetWMDocInfo() = True Then
If DT_STEPS.Rows.Count > 0 Then
WorkPollSteps()
Else
_Logger.Info("No steps configured for this Profile ....")
End If
End If
End If
End If
Return True
Catch ex As Exception
_Logger.Error(ex)
Return False
End Try
End Function
Default Public Property FormatBytes(ByVal BytesCaller As ULong) As String
Get
Try
Select Case BytesCaller
Case Is >= 1099511627776
DoubleBytes = CDbl(BytesCaller / 1099511627776) 'TB
Return FormatNumber(DoubleBytes, 2) & " TB"
Case 1073741824 To 1099511627775
DoubleBytes = CDbl(BytesCaller / 1073741824) 'GB
Return FormatNumber(DoubleBytes, 2) & " GB"
Case 1048576 To 1073741823
DoubleBytes = CDbl(BytesCaller / 1048576) 'MB
Return FormatNumber(DoubleBytes, 2) & " MB"
Case 1024 To 1048575
DoubleBytes = CDbl(BytesCaller / 1024) 'KB
Return FormatNumber(DoubleBytes, 2) & " KB"
Case 0 To 1023
DoubleBytes = BytesCaller ' bytes
Return FormatNumber(DoubleBytes, 2) & " bytes"
Case Else
Return ""
End Select
Catch
Return ""
End Try
End Get
Set(value As String)
End Set
End Property
Function CommonEmail_IN(pCurrentMail As MailContainer) As Boolean
Try
_Logger.Info(String.Format("COMMON_EMAIL_IN...Subject [{0}]", pCurrentMail.Mail.Subject))
_Logger.Debug(String.Format("COMMON_EMAIL_IN...Subject [{0}]", pCurrentMail.Mail.Subject))
Dim oExpression = "PROCESS_NAME = 'Attachment Sniffer' or PROCESS_NAME = 'ZugFeRD-Parser'"
'Filter the rows using Select() method of DataTable
Dim TEMP_PROCESS_PROFILE_DT As DataTable = DT_POLL_PROCESS
Dim PM_ROW As DataRow() = TEMP_PROCESS_PROFILE_DT.Select(oExpression)
If PM_ROW.Length = 0 Then
_Logger.Info("ATTENTION: NO PROCESS-Definititon Filter [PROCESS_NAME = 'Attachment Sniffer' or PROCESS_NAME = 'ZugFeRD-Parser'] returned 0")
Return False
End If
For Each oRow As DataRow In PM_ROW
DeleteMail = oRow("DELETE_MAIL")
CurrentMailProcessName = oRow.Item("PROCESS_NAME")
WM_OBJEKTTYPE = oRow.ItemEx("WM_OBJEKTTYPE", "")
WM_REFERENCE_INDEX = oRow.ItemEx("WM_REFERENCE_INDEX", "")
WM_VECTOR_LOG = oRow.ItemEx("WM_VECTOR_LOG", "")
WM_IDX_BODY_TEXT = oRow.ItemEx("WM_IDX_BODY_TEXT", "")
WM_IDX_BODY_SUBSTR_LENGTH = oRow.ItemEx("WM_IDX_BODY_SUBSTR_LENGTH", 0)
Dim oPathOriginal As String = oRow.ItemEx("PATH_ORIGINAL", "")
Dim oExtractMainPath As String = oRow.ItemEx("PATH_EMAIL_TEMP", "")
Try
Dim oSplit As String()
Dim oStorage As String
Try
oSplit = oExtractMainPath.Split("\")
If oSplit.Length > 1 Then
oStorage = oSplit(0)
Dim oCheckdvr As New DriveInfo(oStorage)
If CURRENT_DRIVE_CHECK <> oStorage Then
CURRENT_DRIVE_CHECK = oStorage
End If
End If
Catch ex As Exception
_Logger.Warn($"Unexpected Error in Extracting Storage from [{oExtractMainPath}]: {ex.Message}")
End Try
Dim dvr As New DriveInfo(CURRENT_DRIVE_CHECK)
If dvr.IsReady = True Then
Dim oFreeSpace = dvr.TotalFreeSpace
Dim oresult = FormatBytes(oFreeSpace)
If oresult.EndsWith("MB") Then
Dim oRemainingMB As Integer = oresult.Replace(" MB", "")
If oRemainingMB < 150 Then
_Logger.Warn($"ATTENTION: THE REMAINING SPACE FOR DRIVE [{dvr.Name}] IS LESS THEN 150 MB. STOPPING EXTRACTION")
CURRENT_DRIVE_ISFULL = True
Return False
End If
ElseIf oresult.EndsWith("GB") Or oresult.EndsWith("TB") Then
If CURRENT_DRIVE_ISFULL = True Then
CURRENT_DRIVE_ISFULL = False
_Logger.Warn($"REMAINING SPACE OF [{dvr.Name}] IS NOW {oresult} - SO RESETTING CURRENT_DRIVE_ISFULL")
End If
End If
End If
Catch ex As Exception
_Logger.Warn($"Unexpected Error in Checking RemainingTotalFreeSpace for Storage [{oExtractMainPath}]: {ex.Message}")
End Try
If Copy2HDD(pCurrentMail, oRow("COPY_2_HDD"), oRow("PATH_ORIGINAL"), oRow("PATH_EMAIL_ERRORS"), True) = True Then
Dim oAllowXMLReceipts As Boolean = oRow("ALLOW_XML_RECEIPTS")
If ExtractAttachments(pCurrentMail, oExtractMainPath, oAllowXMLReceipts) = True Then
Return True
Else
_Logger.Warn("!##Returning false from EXTRACT_ATTACHMENTS!##")
Return False
End If
Else
Return False
End If
Next
Return True
Catch ex As Exception
_Logger.Error(ex)
Return False
End Try
End Function
Private Function Save2TempDirectory(pCurrentMail As MailContainer) As Boolean
Dim oTempFilename As String = ""
Try
Dim oTempPath As String = Path.Combine(Path.GetTempPath, "DD_EmailProfiler")
_Logger.Debug($"oTempPath is: {oTempPath} ...")
If Directory.Exists(oTempPath) = False Then
Directory.CreateDirectory(oTempPath)
End If
Dim oFileEntries As String() = Directory.GetFiles(oTempPath)
' Process the list of files found in the directory.
Dim oFileName As String
For Each oFileName In oFileEntries
Try
File.Delete(oFileName)
Catch ex As Exception
End Try
Next oFileName
Dim oResult As Boolean = False
' Subject can be SUBJECT_MAX_LENGTH chars at most,
' otherwise we run into errors with the path being too long
Dim oSubjectFilename = pCurrentMail.MessageId & ".eml"
oSubjectFilename = StringEx.RemoveInvalidCharacters(oSubjectFilename)
oTempFilename = Path.Combine(oTempPath, oSubjectFilename)
_Logger.Debug($"Filepath is: {oTempFilename}")
pCurrentMail.Mail.Save(oTempFilename)
CurrentTempMailPath = oTempFilename
_Logger.Debug($"Email saved to Temppath {CurrentTempMailPath}")
Dim oCounter As Integer = 1
Dim oCancel As Boolean
Do While File.Exists(CurrentTempMailPath) = False
_Logger.Debug("Trying to read saved mail.. ({0}/{1})", oCounter, 10)
Thread.Sleep(1000)
oCounter += 1
If oCounter > 10 Then
_Logger.Warn("It took to long to save the mail to Temppath!")
oCancel = True
Exit Do
End If
Loop
If oCancel = True Then
oResult = False
Else
If File.Exists(CurrentTempMailPath) Then
oResult = True
End If
End If
'Datei in Array zum Templöschen speichern
TEMP_FILES.Add(oTempFilename)
Return oResult
Catch ex As Exception
_Logger.Error(ex)
_Logger.Info($"Unexpected error in Save2Temp [{oTempFilename}]")
CurrentTempMailPath = Nothing
Return False
End Try
End Function
Private Function Copy2HDD(pCurrentMail As MailContainer, pShouldCopyToDisk As Boolean, pDestination As String, pPathErrors As String, pUseMessageIdAsFilename As Boolean) As Boolean
Try
If pShouldCopyToDisk = True Then
_Logger.Debug("COPY_2_HDD is ACTIVE!")
If Directory.Exists(pDestination) Then
Dim oTempFilename = Path.Combine(pDestination, $"{pCurrentMail.MessageId}.eml")
If File.Exists(oTempFilename) = False Then
pCurrentMail.Mail.Save(oTempFilename)
Dim oFileInfo As New FileInfo(oTempFilename)
Dim oFileLenth As Long = oFileInfo.Length
If oFileLenth > 0 Then
_Logger.Info($"[COPY2HDD] Email saved to ({oTempFilename})")
Return True
Else
_Logger.Warn("FileLenth of file [{0}] is 0! File will be deleted.", oTempFilename)
Try
File.Delete(oTempFilename)
Catch ex As Exception
_Logger.Error(ex)
End Try
Return False
End If
Else
_Logger.Info("COPY2HDD (" & pCurrentMail.Mail.Subject & ") already existing in [{oTempFilename}]!", False, "RUN_THREAD.COPY_2_HDD")
Return True
End If
Else
_Logger.Error("Destination directory [{0}] does not exist!", pDestination)
Return False
End If
Else
Return True
End If
Catch ex As Exception
_Logger.Error(ex)
Return False
End Try
End Function
Private Function ExtractBody(pCurrentMail As MailContainer)
Dim oTable As DataTable = _DB_MSSQL.GetDatatable("SELECT * FROM TBDD_FUNCTION_REGEX WHERE UPPER(FUNCTION_NAME) IN (UPPER('EMAIL_PROFILER - RemoveHTMLText'),UPPER('EMAIL_PROFILER - RemoveHTMLText1'))")
Dim oBodyText As String = ""
If Not IsNothing(pCurrentMail.Mail.Text) Then
CURRENT_MAIL_BODY_ALL = oBodyText
End If
If Not IsNothing(CURRENT_MAIL_BODY_ALL) Then
Dim oRow = oTable.Rows.Item(0)
Dim oPattern1 As String
Dim oPattern2 As String
Try
oPattern1 = oTable.Rows(0).Item("REGEX")
Catch ex As Exception
oPattern1 = ""
End Try
Try
oPattern2 = oTable.Rows(1).Item("REGEX")
Catch ex As Exception
oPattern2 = ""
End Try
Dim oReg As New Regex(oPattern1, RegexOptions.IgnoreCase)
Dim oMatch As Match = oReg.Match(CURRENT_MAIL_BODY_ALL)
Dim oClearedBodyText = CURRENT_MAIL_BODY_ALL
Do While oMatch.Success
oClearedBodyText = oClearedBodyText.Replace(oMatch.Value, "")
oMatch = oMatch.NextMatch()
Loop
_Logger.Debug($"Cleared bodytext after Regex1 is: {oClearedBodyText}")
Dim oReg2 As New Regex(oPattern2, RegexOptions.IgnoreCase)
Dim oMatch2 As Match = oReg2.Match(oClearedBodyText)
Do While oMatch2.Success
oClearedBodyText = oClearedBodyText.Replace(oMatch2.Value, "")
oMatch2 = oMatch2.NextMatch()
Loop
_Logger.Debug($"Cleared bodytext after Regex2 is: {oClearedBodyText}")
CURRENT_MAIL_BODY_ALL = oClearedBodyText
Else
_Logger.Info($"Mailbody still is nothing after bodyExtraction!!")
End If
Try
If CURRENT_MAIL_BODY_ALL = String.Empty Then
_Logger.Warn("Mailbody is empty. Email can not be processed! - Please check the html-structure")
_Logger.Info("EXCEPTION - Mailbody is empty.Email can not be processed! - Please check the html-structure")
MESSAGE_ERROR = True
Return False
Else
_Logger.Debug($"Length of Body is [{CURRENT_MAIL_BODY_ALL.Length}] - Body Text is [{CURRENT_MAIL_BODY_ALL}]")
End If
CURRENT_MAIL_BODY_ALL = CURRENT_MAIL_BODY_ALL.Replace(vbLf, "")
Dim oSplit = CURRENT_MAIL_BODY_ALL.Split(Environment.NewLine)
Dim oCount As Integer = 0
Dim oReadLength As Integer = 0
For Each oString As String In oSplit
oString = oString.Replace(vbCrLf, "")
If oString = String.Empty Then
Continue For
End If
oCount += 1
If oCount = 1 Then
CURRENT_MAIL_BODY_ANSWER1 = oString
Else
If oString.StartsWith("##") Then
Exit For
ElseIf oCount = 2 Then
CURRENT_MAIL_BODY_Substr2 = oString
Else
If ((oReadLength + oString.Length) >= WM_IDX_BODY_SUBSTR_LENGTH) Or oString.StartsWith("##") Then
Exit For
End If
CURRENT_MAIL_BODY_Substr2 = CURRENT_MAIL_BODY_Substr2 & vbNewLine & oString
End If
oReadLength += oString.Length
End If
Next
_Logger.Debug(String.Format("MailBody-ANSWER1:...[{0}]", CURRENT_MAIL_BODY_ANSWER1))
_Logger.Debug(String.Format("MailBody-ANSWER2:...[{0}]", CURRENT_MAIL_BODY_Substr2))
If CURRENT_MAIL_BODY_ANSWER1 = String.Empty Then
_Logger.Warn("CURRENT_MAIL_BODY_ANSWER1 is String.Empty: So the answer will interpreted as empty!")
End If
Return True
Catch ex As Exception
_Logger.Error(ex)
MESSAGE_ERROR = True
Return False
End Try
End Function
Private Function ExtractAttachments(pCurrentMail As MailContainer, pExtractPath As String, pAllowXMLReceipts As Boolean) As Boolean
_Logger.Debug("In ExtractAttachments - pExtractPath = [{0}]", pExtractPath)
CURRENT_ATTMT_COUNT = 0
TEMP_WORK_FILES.Clear()
EmailAttachments.Clear()
If String.IsNullOrEmpty(CurrentTempMailPath) Then
_Logger.Warn("ExtractAttachments() CurrentTempMailPath is NOTHING")
Return True
End If
If File.Exists(CurrentTempMailPath) = False Then
_Logger.Warn($"ExtractAttachments() {CurrentTempMailPath} not existing")
Return True
End If
Dim oExtractTempPath As String = GetExtractTempPath(pExtractPath)
If String.IsNullOrEmpty(oExtractTempPath) Then
_Logger.Warn("ExtractAttachments() oExtractTempPath is NOTHING")
Return True
End If
Dim oAttachmentCount As Integer = 0 ' Anzahl gültige Anhänge
Dim AttachmentPosition As Integer = 0 ' Position des Anhangs in der EMail
Dim oAttachmentList As List(Of MimeData) = GetPurgedAttachmentList(pCurrentMail.Mail.Attachments, pAllowXMLReceipts)
For Each oAttachment As MimeData In oAttachmentList
_Logger.Info("Working on Attachment [{0}]", oAttachment.SafeFileName)
AttachmentPosition += 1
Dim oEmailAttachment As EmailAttachment = New EmailAttachment() With
{
.OrgFileName = oAttachment.SafeFileName,
.AttachmentPosition = AttachmentPosition
}
EmailAttachments.Add(oEmailAttachment)
If ValidateFileExtension(oEmailAttachment, pAllowXMLReceipts) = False Then
oEmailAttachment.ErrorCodeValue = ErrorCode.NormalFileAttachmentCorrupt
Continue For
End If
oEmailAttachment.DestFileName = $"{pCurrentMail.MessageId}~Attm{oAttachmentCount}{oEmailAttachment.Extension}"
_Logger.Debug("Final Filename for Attachment: [{0}]", oEmailAttachment.DestFileName)
oEmailAttachment.DestFilePath = Path.Combine(oExtractTempPath, oEmailAttachment.DestFileName)
_Logger.Debug("Final Path for Attachment: [{0}]", oEmailAttachment.DestFilePath)
If CleanUpFilePath(oEmailAttachment.DestFilePath) = False Then
_Logger.Warn("ExtractAttachments() Could not clean up filepath!")
MESSAGE_ERROR = True
Continue For
End If
' Sichere Datei auf Platte
If SaveFileToDisk(oAttachment, oEmailAttachment) = True Then
_Logger.Info(String.Format("Attachment saved to [{0}]", oEmailAttachment.DestFilePath))
' Schreibe Satz nach EMLP_HISTORY
If (InsertAttachmentHistoryEntry(pCurrentMail, oEmailAttachment.OrgFileName, oEmailAttachment.DestFileName)) = True Then
oAttachmentCount += 1
End If
Else
_Logger.Warn($"Error while saving AttachmentName: {oEmailAttachment.DestFilePath}")
Continue For
End If
' Verarbeite PDF Files
If oEmailAttachment.Extension.Equals(".pdf", StringComparison.InvariantCultureIgnoreCase) = True Then
Dim oGdPicturePDF As New GdPicturePDF()
Dim oStatus As GdPictureStatus = oGdPicturePDF.LoadFromFile(oEmailAttachment.DestFilePath, True)
If oStatus = GdPictureStatus.OK Then
' Verarbeite Embedded Attachments
WorkEmbeddedAttachments(oEmailAttachment, oGdPicturePDF)
' Prüfen ob es ungültige Anhänge gibt.
Dim oEmbeddedAttachmentsNotValid As Boolean = EmailAttachments.
Where(Function(att) att.EmbeddedFiles.Count > 0).
Any(Function(emb) emb.EmbeddedFiles.Any(Function(ext) ext.IsAttachmentValid = False))
If oEmbeddedAttachmentsNotValid = True Then
MESSAGE_ERROR = True
Continue For
End If
Else
oAttachmentCount -= 1
CleanUpFilePath(oEmailAttachment.DestFilePath)
UpdateAttachmentTableAfterError(oEmailAttachment.OrgFileName, pCurrentMail.MessageId, "PDF Structure corrupt")
oEmailAttachment.FileStatus = oStatus
oEmailAttachment.ErrorCodeValue = ErrorCode.NormalFileAttachmentCorrupt
oEmailAttachment.ErrorCodeComment = "PDF Structure corrupt"
oEmailAttachment.IsAttachmentValid = False
MESSAGE_ERROR = True
Continue For
End If
End If
If (oEmailAttachment.ErrorCodeValue = ErrorCode.Unknown) Then
' Wenn der Status ok ist, wird das Attachment eingetragen, sonst nicht
TEMP_WORK_FILES.Add(oEmailAttachment.DestFilePath)
End If
Next
CURRENT_ATTMT_COUNT = oAttachmentCount
If MESSAGE_ERROR = True Then
WorkTempFiles("delete")
Return True
End If
WorkTempFiles("move")
Return True
End Function
''' <summary>
''' Holt aus alle Anhängen diejenigen raus,
''' die einen erlaubten Dateianhang haben
''' </summary>
''' <param name="pAttachmentList"></param>
''' <param name="pAllowXMLReceipts"></param>
''' <returns>Liste der Dateien, die wir verarbeiten wollen, nothing im Fehlerfall</returns>
Private Function GetPurgedAttachmentList(pAttachmentList As IMimeDataReadOnlyCollection, pAllowXMLReceipts As Boolean) As List(Of MimeData)
_Logger.Debug("GetPurgedAttachmentList()")
Try
Dim retValue As List(Of MimeData) = New List(Of MimeData)
Dim oIsValidExtension As Boolean = False
For Each oAttachment As MimeData In pAttachmentList
Dim lowerFilename = oAttachment.SafeFileName.ToLower
If pAllowXMLReceipts = True Then
oIsValidExtension = _ValidFirstExtensions.Any(Function(ext) lowerFilename.EndsWith(ext))
Else
oIsValidExtension = _ValidExtensions.Any(Function(ext) lowerFilename.EndsWith(ext))
End If
If oIsValidExtension = True Then
retValue.Add(oAttachment)
End If
Next
_Logger.Debug("GetPurgedAttachmentList() retValue contains [{0}] attachments.", retValue.Count)
Return retValue
Catch ex As Exception
_Logger.Error(ex)
End Try
Return Nothing
End Function
Private Sub WorkEmbeddedAttachments(pEmailAttachment As EmailAttachment, pGDPicturePDF As GdPicturePDF)
Dim embeddedFileCount As Integer = pGDPicturePDF.GetEmbeddedFileCount()
If embeddedFileCount <= 0 Then
' nothing to do
Return
End If
For i As Integer = 0 To embeddedFileCount - 1
Dim oEmbAttName As String = pGDPicturePDF.GetEmbeddedFileName(i)
Dim oEmbeddedFile As EmailAttachment = New EmailAttachment() With
{
.OrgFileName = oEmbAttName
}
pEmailAttachment.EmbeddedFiles.Add(oEmbeddedFile)
oEmbeddedFile.FileStatus = pGDPicturePDF.GetStat()
If oEmbeddedFile.FileStatus = GdPictureStatus.OK Then
If ValidateFileExtension(oEmbeddedFile, False) = False Then
oEmbeddedFile.ErrorCodeValue = ErrorCode.EmbeddedFileAttachmentCorrupt
Continue For
End If
Dim FileSize As Integer = pGDPicturePDF.GetEmbeddedFileSize(i)
If pGDPicturePDF.GetStat() = GdPictureStatus.OK Then
Dim FileData As Byte() = New Byte(FileSize) {}
Dim status As GdPictureStatus = pGDPicturePDF.ExtractEmbeddedFile(0, FileData)
oEmbeddedFile.FileStatus = status
If status <> GdPictureStatus.OK Or FileSize = 0 Then
oEmbeddedFile.ErrorCodeValue = ErrorCode.EmbeddedFileAttachmentCorrupt
oEmbeddedFile.ErrorCodeComment = "PDF Structure corrupt"
oEmbeddedFile.IsAttachmentValid = False
' wenn ein eingebettetes attachment defekt ist, ist das Hauptattachment auch defekt
pEmailAttachment.ErrorCodeValue = ErrorCode.NormalFileAttachmentCorrupt
pEmailAttachment.ErrorCodeComment = "PDF Structure corrupt"
pEmailAttachment.IsAttachmentValid = False
Continue For
End If
End If
End If
Next
End Sub
Private Function SaveFileToDisk(pAttachment As MimeData, pAttachmentData As EmailAttachment) As Boolean
Try
Dim oFilePath = pAttachmentData.DestFilePath
_Logger.Debug(String.Format("Trying to save attachment [{0}]", oFilePath))
pAttachment.Save(oFilePath)
Dim oFileInfo As New FileInfo(oFilePath)
Dim oFileLength As Long = oFileInfo.Length
If oFileLength <= 2 Then
_Logger.Warn($"##!! oFileLength for AttachmentObjects is <= 2 !!##")
CleanUpFilePath(oFilePath)
pAttachmentData.ErrorCodeValue = ErrorCode.NormalFileAttachmentCorrupt
pAttachmentData.ErrorCodeComment = "Filesize is zero"
pAttachmentData.IsAttachmentValid = False
Return False
End If
Return True
Catch ex As Exception
_Logger.Error(ex)
MESSAGE_ERROR = True
Return False
End Try
End Function
''' <summary>
''' Aktualisiert Datensätze in der Tabelle TBEMLP_HISTORY_ATTACHMENT
''' wenn ein Fehler bei einem Attachment aufgetreten ist.
''' </summary>
Private Sub UpdateAttachmentTableAfterError(pOrgFileName As String, pMessageID As String, pComment As String)
If String.IsNullOrEmpty(pOrgFileName) Then
_Logger.Info("Parameter [pOrgFileName] missing")
Return
End If
If String.IsNullOrEmpty(pMessageID) Then
_Logger.Info("Parameter [pMessageID] missing")
Return
End If
If pComment Is Nothing Then
pComment = "-"
Return
End If
Dim updateSQL As String = "UPDATE [DD_ECM].[dbo].[TBEMLP_HISTORY_ATTACHMENT] SET COMMENT = '@PARAM_COMMENT', EMAIL_ATTMT_INDEX = '-' WHERE EMAIL_MSGID = '@PARAM_MSGID' AND EMAIL_ATTMT = '@PARAM_ORGFILE';"
updateSQL = updateSQL.Replace("@PARAM_COMMENT", pComment)
updateSQL = updateSQL.Replace("@PARAM_MSGID", pMessageID)
updateSQL = updateSQL.Replace("@PARAM_ORGFILE", pOrgFileName)
_Logger.Info("Execute UPDATE-SQL: [{0}]", updateSQL)
_DB_MSSQL.ExecuteNonQuery(updateSQL)
End Sub
''' <summary>
''' Falls Datei bereits existiert, lösche sie jetzt
''' </summary>
Private Function CleanUpFilePath(pFilePath As String) As Boolean
Try
If File.Exists(pFilePath) Then
_Logger.Info("File [{0}] will be deleted!", pFilePath)
File.Delete(pFilePath)
End If
Return True
Catch ex As Exception
_Logger.Error(ex)
Return False
End Try
End Function
Private Function GetExtractTempPath(pExtractPath As String) As String
Try
Dim oExtractTempPath = Path.Combine(pExtractPath, "Temp")
If Directory.Exists(oExtractTempPath) = False Then
Directory.CreateDirectory(oExtractTempPath)
End If
Return oExtractTempPath
Catch ex As Exception
_Logger.Error(ex)
Return String.Empty
End Try
End Function
Private Function ValidateFileExtension(pAttachmentData As EmailAttachment, pAllowXMLReceipts As Boolean) As Boolean
_Logger.Debug("Validate extension of [{0}]", pAttachmentData.OrgFileName)
Dim lowerFilename = pAttachmentData.OrgFileName.ToLower
Dim oIsValidExtension As Boolean = False
Dim oIsGraphicExtension = _GraphicExtensions.Any(Function(ext) lowerFilename.EndsWith(ext))
If pAllowXMLReceipts = True AndAlso pAttachmentData.AttachmentPosition = 1 Then
oIsValidExtension = _ValidFirstExtensions.Any(Function(ext) lowerFilename.EndsWith(ext))
Else
oIsValidExtension = _ValidExtensions.Any(Function(ext) lowerFilename.EndsWith(ext))
End If
If oIsValidExtension = False Then
If oIsGraphicExtension = False Then
_Logger.Warn("File has no valid extension, and it has no graphic extension. In this case we have to inform the sender!")
pAttachmentData.IsAttachmentValid = False
pAttachmentData.ErrorCodeComment = "File Extension not valid"
End If
Return False
End If
Return True
End Function
Private Sub WorkTempFiles(pAction As String)
For Each _file In TEMP_WORK_FILES
_Logger.Debug("Working ({0}) on temp work file: [{1}]", pAction, _file)
Try
If File.Exists(_file) Then
If pAction = "Delete" Then
File.Delete(_file)
ElseIf pAction = "move" Then
File.Move(_file, _file.Replace("\Temp", ""))
End If
End If
Catch ex As Exception
_Logger.Error(ex)
_Logger.Warn("Could not delete/move the tempworkfile : [{0}]", _file)
MESSAGE_ERROR = True
End Try
Next
TEMP_WORK_FILES.Clear()
End Sub
''' <summary>
''' Wenn eingebettete Attachments defekt sind,
''' gilt die ganze E-Mail als defekt und wird abgelehnt.
''' Hier wird noch aufgeräumt.
''' </summary>
Private Sub DeleteAllCollectedAttachments()
For Each attachment In EmailAttachments
_Logger.Debug("Delete from temp work file: [{0}]", attachment.DestFilePath)
Try
If File.Exists(attachment.DestFilePath) Then
File.Delete(attachment.DestFilePath)
End If
Catch ex As Exception
_Logger.Error(ex)
_Logger.Warn("Could not delete the tempworkfile : [{0}]", attachment.DestFilePath)
End Try
Next
EmailAttachments.Clear()
End Sub
Private Function InsertHistoryEntry(pCurrentMail As MailContainer) As Boolean
If MESSAGE_ERROR = False Then
Return InsertHistoryEntryWithStatus(pCurrentMail, String.Empty, String.Empty)
Else
_Logger.Info("No INSERT_HISTORY as MessageError = True")
Return False
End If
End Function
Private Function InsertHistoryEntryWithStatus(pCurrentMail As MailContainer, pStatus As String, pComment As String) As Boolean
Dim oCommand = New SqlCommand(
"INSERT INTO TBEMLP_HISTORY (
WORK_PROCESS,
EMAIL_MSGID,
EMAIL_SUBJECT,
EMAIL_DATE,
EMAIL_BODY,
EMAIL_SUBSTRING1,
EMAIL_SUBSTRING2,
EMAIL_FROM,
PROFILE_ID,
STATUS,
COMMENT)
VALUES (
@WORK_PROCESS,
@MESSAGE_ID,
@SUBJECT,
@DATE,
@BODY,
@SUBSTRING1,
@SUBSTRING2,
@FROM,
@PROFILE_ID,
@STATUS,
@COMMENT)"
)
oCommand.Parameters.Add("WORK_PROCESS", SqlDbType.VarChar, 100).Value = CurrentMailProcessName
oCommand.Parameters.Add("MESSAGE_ID", SqlDbType.VarChar, 500).Value = pCurrentMail.MessageId
oCommand.Parameters.Add("SUBJECT", SqlDbType.VarChar, 1000).Value = pCurrentMail.SubjectOriginal
oCommand.Parameters.Add("DATE", SqlDbType.DateTime).Value = pCurrentMail.Mail.Date
oCommand.Parameters.Add("BODY", SqlDbType.VarChar).Value = CURRENT_MAIL_BODY_ALL
oCommand.Parameters.Add("SUBSTRING1", SqlDbType.VarChar, 2000).Value = CURRENT_MAIL_BODY_ANSWER1
oCommand.Parameters.Add("SUBSTRING2", SqlDbType.VarChar, 2000).Value = CURRENT_MAIL_BODY_Substr2
oCommand.Parameters.Add("FROM", SqlDbType.VarChar, 500).Value = pCurrentMail.SenderAddress
oCommand.Parameters.Add("PROFILE_ID", SqlDbType.Int).Value = CURRENT_PROFILE_GUID
oCommand.Parameters.Add("STATUS", SqlDbType.VarChar, 900).Value = pStatus
oCommand.Parameters.Add("COMMENT", SqlDbType.VarChar, 500).Value = pComment.Truncate(500)
Return _DB_MSSQL.ExecuteNonQuery(oCommand)
End Function
Private Function InsertAttachmentHistoryEntry(pCurrentMail As MailContainer, pFileName As String, pNewFileName As String) As Boolean
If IsNothing(_DB_MSSQL) Then
_Logger.Info("INSERT_HISTORY_FB: _DB_MSSQL is nothing ")
Return False
End If
Try
If MESSAGE_ERROR = True Then
_Logger.Warn("MESSAGE_ERROR = true, not inserting!")
Return False
End If
Dim oCommand = New SqlCommand(
"INSERT INTO TBEMLP_HISTORY_ATTACHMENT (
WORK_PROCESS,
EMAIL_MSGID,
EMAIL_FROM,
EMAIL_SUBJECT,
EMAIL_DATETIME,
EMAIL_BODY,
EMAIL_ATTMT,
EMAIL_ATTMT_INDEX
) VALUES (
@WORK_PROCESS,
@MESSAGE_ID,
@FROM,
@SUBJECT,
@DATE,
@BODY,
@ATTACHMENT,
@ATTACHMENT_INDEX
)")
oCommand.Parameters.Add("WORK_PROCESS", SqlDbType.VarChar, 100).Value = CurrentMailProcessName
oCommand.Parameters.Add("MESSAGE_ID", SqlDbType.VarChar, 500).Value = pCurrentMail.MessageId
oCommand.Parameters.Add("SUBJECT", SqlDbType.VarChar, 1000).Value = pCurrentMail.SubjectOriginal
oCommand.Parameters.Add("DATE", SqlDbType.DateTime).Value = pCurrentMail.Mail.Date
oCommand.Parameters.Add("BODY", SqlDbType.VarChar).Value = CURRENT_MAIL_BODY_ALL
oCommand.Parameters.Add("FROM", SqlDbType.VarChar, 500).Value = pCurrentMail.SenderAddress
oCommand.Parameters.Add("ATTACHMENT", SqlDbType.VarChar, 500).Value = pFileName
oCommand.Parameters.Add("ATTACHMENT_INDEX", SqlDbType.VarChar, 500).Value = pNewFileName
_DB_MSSQL.ExecuteNonQuery(oCommand)
Return True
Catch ex As Exception
_Logger.Error(ex)
Return False
End Try
End Function
Public Function AddTrackingStatusMSSQL(pMessageId As String, pSTATE_TITLE As String, pSTATE_TITLE1 As String, pCOMMENT As String, pADDEDWHO As String) As Boolean
Try
Dim oInsert =
$"INSERT INTO [dbo].[TBEMLP_HISTORY_STATE]
([MESSAGE_ID]
,[STATE_TITLE]
,[STATE_TITLE1]
,[COMMENT]
,ADDED_WHO)
VALUES
('{pMessageId}'
,'{pSTATE_TITLE}'
,'{pSTATE_TITLE1}'
,'{pCOMMENT}'
,'{pADDEDWHO}')"
Return _DB_MSSQL.ExecuteNonQuery(oInsert)
Catch ex As Exception
_Logger.Error(ex)
Return False
End Try
End Function
Private Function WorkPollSteps() As Boolean
Try
Dim oFoundSomething As Boolean = False
_worked_email = False
For Each row As DataRow In DT_STEPS.Rows
POLL_STEP_GUID = row.Item("GUID")
POLL_KEYWORDS = row.Item("KEYWORDS_BODY")
KEYWORDS_SPLIT = POLL_KEYWORDS.Split(";")
For Each oKeyWord As String In KEYWORDS_SPLIT
If CURRENT_MAIL_BODY_ANSWER1.ToUpper = oKeyWord.ToUpper Then
_worked_email = True
_Logger.Info(String.Format("Found Keyword '{0}' in MessageBody", oKeyWord))
oFoundSomething = True
Dim sql As String = String.Format("SELECT * FROM TBEMLP_POLL_INDEXING_STEPS WHERE STEP_ID = {0} AND ACTIVE = 1", POLL_STEP_GUID)
DT_INDEXING_STEPS = _DB_MSSQL.GetDatatable(sql)
If DT_INDEXING_STEPS.Rows.Count > 0 Then
WorkIndexingSteps()
Else
_Logger.Info("No Indexing Steps found?! - SQL: " & sql)
End If
End If
Next
Next
If oFoundSomething = False Then
_Logger.Info($"None of the keywords was found...Keyword after Regex is '{0}'")
End If
If _worked_email = False And oFoundSomething = False Then
Dim sql As String = String.Format("SELECT * FROM TBEMLP_POLL_INDEXING_STEPS WHERE STEP_ID = {0} AND ACTIVE = 1 AND USE_FOR_DIRECT_ANSWER = 1", POLL_STEP_GUID)
DT_INDEXING_STEPS = _DB_MSSQL.GetDatatable(sql)
If DT_INDEXING_STEPS.Rows.Count >= 1 Then
_Logger.Info($"An index for direct answer was configured. Therefore it will be used...")
End If
WorkIndexingSteps()
_worked_email = True
End If
'Now indexing the LogIndex
If Not IsNothing(WM_VECTOR_LOG) And (Not IsDBNull(WM_VECTOR_LOG)) And (WM_VECTOR_LOG <> "") Then
Dim msg = Now.ToString & " - " & CurrentMailProcessName
IndexFile(WM_VECTOR_LOG, msg, False)
End If
'Now indexing the Body-Message Index
If CURRENT_MAIL_BODY_Substr2 <> String.Empty And WM_IDX_BODY_TEXT <> String.Empty Then
IndexFile(WM_IDX_BODY_TEXT, CURRENT_MAIL_BODY_Substr2, True)
End If
Return True
Catch ex As Exception
MESSAGE_ERROR = True
_Logger.Error(ex)
Return False
End Try
End Function
Private Function WorkIndexingSteps() As Boolean
Try
For Each row As DataRow In DT_INDEXING_STEPS.Rows
Dim INDEXNAME As String = row.Item("INDEXNAME")
Dim INDEXVALUE As String = row.Item("INDEXVALUE")
If _UseWindream Then
IndexFile(INDEXNAME, INDEXVALUE, False)
End If
Next
Return True
Catch ex As Exception
MESSAGE_ERROR = True
_Logger.Error(ex)
Return False
End Try
End Function
Private Function IndexFile(oidxname As String, oidxvalue As String, oConcat_act_Value As Boolean)
Dim OArrIndex() As String
ReDim Preserve OArrIndex(0)
OArrIndex(0) = oidxname
If oConcat_act_Value = True Then
Dim oActValue = _windream_index.GetValueforIndex_WMFile(CURRENT_WM_DOC, oidxname)
If Not IsNothing(oActValue) Then
If oActValue.ToString.Length > 0 Then
If oActValue <> oidxvalue Then
oidxvalue = oActValue & vbNewLine & oidxvalue
End If
End If
End If
End If
Dim oArrValue() As String
Dim oMyArray()
ReDim oMyArray(0)
oMyArray(0) = oidxvalue
Dim oVektorArray()
oVektorArray = _windream_index.GetVektorArray(CURRENT_WM_DOC, oidxname, oMyArray, True)
If oVektorArray Is Nothing = False Then
'Zielindex ist ein Vektorindex
ReDim oArrValue(oVektorArray.Length - 1)
Array.Copy(oVektorArray, oArrValue, oVektorArray.Length)
If oArrValue Is Nothing Then
_Logger.Warn($"arrValue from vektor for index {oidxname} is nothing! Value: {oidxvalue} - no indexing!")
_Logger.Info($"arrValue from vektor for index {oidxname} is nothing! Value: {oidxvalue} - no indexing!")
Return False
End If
Else
'Es handelt sich um einen Einfachindex
ReDim oArrValue(0)
oArrValue(0) = oidxvalue
End If
If oArrValue Is Nothing = False Then
Return _windream_index.RunIndexing(CURRENT_WM_DOC, OArrIndex, oArrValue, WM_OBJEKTTYPE)
Else
_Logger.Warn($"arrValue for index {oidxname} is nothing! Value: {oidxvalue} - no indexing!")
_Logger.Info($"arrValue for index {oidxname} is nothing! Value: {oidxvalue} - no indexing!")
Return False
End If
End Function
Private Function GetWMDocInfo() As Boolean
Try
Dim oDOC_ID = RegExCheckDocID(CURRENT_MAIL_SUBJECT.Replace("10636", "133092").Replace("10644", "133092"))
If Not IsNothing(oDOC_ID) Then
Dim oDT_BASE_ATTR As DataTable = _DB_MSSQL.GetDatatableWithConnection("SELECT * FROM BaseAttributes WHERE dwDocID = " & oDOC_ID, _windreamConnectionString)
If Not IsNothing(oDT_BASE_ATTR) Then
If oDT_BASE_ATTR.Rows.Count = 1 Then
CURRENT_DOC_ID = oDOC_ID
Dim oSql = String.Format("Select[dbo].[FNDD_GET_WINDREAM_FILE_PATH]({0},'{1}')", CURRENT_DOC_ID, WM_DRIVE)
CURRENT_DOC_PATH = _DB_MSSQL.GetScalarValue(oSql)
_Logger.Debug("CURRENT_DOC_PATH is: " & CURRENT_DOC_PATH)
CURRENT_WM_DOC = Nothing
Dim oWMDOC As WMObject
Dim oWMNormpath = CURRENT_DOC_PATH.ToLower.Replace(WM_DRIVE.ToLower & ":", "")
oWMNormpath = CURRENT_DOC_PATH.ToLower.Replace("\\windream\objects", "")
oWMNormpath = CURRENT_DOC_PATH.ToLower.Replace("w:", "")
_Logger.Debug("oWMNormpath is: " & oWMNormpath)
Try
oWMDOC = _windream.oWMSession.GetWMObjectByPath(WMEntity.WMEntityDocument, oWMNormpath)
CURRENT_WM_DOC = oWMDOC
Return True
Catch ex As Exception
_Logger.Warn("error while creating WMObject in (GET_DOC_INFO): " & ex.Message)
_Logger.Warn("oWMNormpath: " & oWMNormpath)
Return False
End Try
Else
_Logger.Warn("No record found for dwDocID " & oDOC_ID)
Return False
End If
Else
_Logger.Warn("DT_BASE_ATTR is nothing")
Return False
End If
Else
_Logger.Warn("Could not get a DOC-ID via regex!")
Return False
End If
Catch ex As Exception
_Logger.Error(ex)
MESSAGE_ERROR = True
Return False
End Try
End Function
Public Function RegExCheckDocID(SearchString As String)
Try
Dim oRegex As New Regex("\[DID#{1}([0-9]+)]{1}")
_Logger.Debug("REGEX_String before replacing: '" & SearchString & "'")
' Regulären Ausdruck zum Auslesen der windream-Indexe definieren
Dim elements As MatchCollection = oRegex.Matches(SearchString)
Dim result = ""
For Each element As Match In elements
result = element.Groups(1).Value
_Logger.Debug(String.Format("Found Regex(0) {0} in SearchString", element.Groups(0).Value))
_Logger.Debug(String.Format("Found Regex(1) {0} in SearchString", element.Groups(1).Value))
Next
Return result
Catch ex As Exception
MESSAGE_ERROR = True
_Logger.Error(ex)
Return Nothing
End Try
End Function
Private Function GetRejectionCodeString(pMessageId As String, pRejectionCode As ErrorCode) As String
Dim intCode As Integer = DirectCast(pRejectionCode, Integer)
Dim oRejectionCodeString = $"{EmailStrings.ErrorCodePraefix}{intCode}"
' Wir wollen im error-Log den Code und die MessageID haben, um die es geht
Dim oInfoMessage = $"Rejection {oRejectionCodeString} triggered for '{pMessageId}'"
_Logger.Error(oInfoMessage)
Return oRejectionCodeString
End Function
End Class