Imports System.Text.RegularExpressions
Imports WINDREAMLib
Imports EmailProfiler.Common.ClassCurrent
Imports System.IO
Imports DigitalData.Modules.Logging
Imports DigitalData.Modules.Database
Imports DigitalData.Modules.Base
Imports System.Threading
Imports Limilabs.Mail
Imports Limilabs.Mail.MIME
Imports Limilabs.Mail.Headers
Imports MailBox = Limilabs.Mail.Headers.MailBox
Imports DigitalData.Modules.Patterns
Imports System.Data.SqlClient
Imports GdPicture14
Imports Limilabs.Client.IMAP
Imports System.Net.NetworkInformation
Imports System.Collections.Specialized.BitVector32
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 _GraphicExtensions As List(Of String)
Private _worked_email As Boolean = False
Sub New(LogConf As LogConfig, ConStr As String, WmConStr As String, pUseWindream As Boolean, EmailAccountID As Integer, EmlProfPraefix As String, pRejectionTemplateId As Integer, pInfoTemplateId As Integer)
Try
_Logger = LogConf.GetLogger
_LogConfig = LogConf
_DB_MSSQL = New MSSQLServer(LogConf, ConStr)
_Logger.Debug("clsWorkmail _email initialized")
_UseWindream = pUseWindream
_Patterns = New Patterns2(LogConf)
_RejectionTemplateId = pRejectionTemplateId
_InfoTemplateId = pInfoTemplateId
_Logger.Debug($"_RejectionTemplateId: {_RejectionTemplateId}")
_ValidExtensions = New List(Of String) From {"pdf", "xls", "xlsx", "doc", "docx", "ppt", "pptx"}
_GraphicExtensions = New List(Of String) From {"jpg", "bmp", "jpeg", "gif", "png", "xml"}
If pUseWindream Then
_windream = New clsWindream_allgemein(LogConf)
_windream_index = New clsWindream_Index(LogConf)
_windreamConnectionString = WmConStr
End If
_LicenseManager.RegisterKEY(GDPictureLicense)
_EmailAccountID = EmailAccountID
SUBJECT_PRAFIX = EmlProfPraefix
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: {CURRENT_MAIL_FROM}...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(CURRENT_MAIL_SUBJECT) Then
CURRENT_MAIL_SUBJECT = ""
Else
_Logger.Debug("Subject: [{0}]", CURRENT_MAIL_SUBJECT)
End If
_Logger.Info($"Working on email from : {CURRENT_MAIL_FROM}...")
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 [{CURRENT_MAIL_SUBJECT}] from [{CURRENT_MAIL_FROM}] 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")
'AddEmailToQueueMSSQL(CurrentMail.MessageId, oResult, "Email validation failed", _EmailAccountID)
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 PROCESS_MANAGER_IN(CurrentMail)
Else
_Logger.Debug("CommonEmail-Process-Sniffer")
Dim oCommonEmailResult = COMMON_EMAIL_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 AddEmailToQueueMSSQL(CurrentMail.MessageId, oBody, "No Attachments", _EmailAccountID) = True Then
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
'''
''' Wenn beim Herauslösen der Attachments festgestellt wurde,
''' das ein Teil der _normalen_ Attachments fehlerhaft war, wird der Absender hier
''' darüber informiert.
'''
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
'''
''' Wenn beim Herauslösen der Attachments festgestellt wurde,
''' das ein PDF-Attachments korrupte Anhänge enthält war, bekommt der Absender hier
''' die Ablehnung.
'''
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
'''
''' Stellt die Dateinamen der Dateien zusammen, die nicht valide sind.
''' Die Ausgabe erfolgt als HTML-Liste
'''
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 += "
" + attachmentItem.OrgFileName + ""
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 += "" + embeddedItem.OrgFileName + ""
End If
Next
If embeddedFilenamesHtmlString.IsNotNullOrEmpty() Then
embeddedFilenamesHtmlString = "" + embeddedFilenamesHtmlString + "
"
End If
End If
If embeddedFilenamesHtmlString.IsNotNullOrEmpty() Then
filenameHtmlString += embeddedFilenamesHtmlString
End If
Next
If filenameHtmlString.IsNotNullOrEmpty() Then
filenameHtmlString = "" + filenameHtmlString + "
"
End If
Return filenameHtmlString
End Function
'''
''' 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
'''
''' E-Mail Message ID
''' Body Text
''' Comment
''' Sending Profile from config
''' ID for E-Mail-Template from config
''' Error Code
''' Zusätzlicher Parameter 1
''' Zusätzlicher Parameter 2
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
'''
''' Function calls SP PRDD_SEND_REJECTION_MAIL
''' for sending rejection mail.
'''
''' E-Mail Message ID
''' GUID for TBDD_EMAIL_TEMPLATE from config
''' ErrorID (TBDD_GUI_LANGUAGE_PHRASE)
''' Sending profile from config
''' Zusätzlicher Parameter 1
''' Zusätzlicher Parameter 2
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 PROCESS_MANAGER_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
EXTRACT_BODY(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 GET_WMDOC_INFO() = True Then
If DT_STEPS.Rows.Count > 0 Then
WORK_POLL_STEPS()
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)
'Logger.Debug("Unexpected Error in PROCESS_MANAGER_IN: " & ex.Message & "MESSAGE_ID: " & CURRENT_MAIL_MESSAGE.MessageID)
Return False
End Try
End Function
Dim DoubleBytes As Double
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 COMMON_EMAIL_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
'If EXTRACT_ATTACHMENTS(pCurrentMail, oExtractMainPath, oRow("PATH_EMAIL_ERRORS")) = True Then
If ExtractAttachments(pCurrentMail, oExtractMainPath) = 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)
'Logger.Debug("Unexpected Error in PROCESS_MANAGER_IN: " & ex.Message & "MESSAGE_ID: " & CURRENT_MAIL_MESSAGE.MessageID)
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 = CURRENT_MAIL_MESSAGE.Subject.Truncate(SUBJECT_MAX_LENGTH) & ".eml"
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
'clsLogger.Add("Unexpected Error in COPY2HDD: " & ex.Message & "MESSAGE_ID: " & CURRENT_MAIL_MESSAGE.MessageID, True)
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!")
'PATH_ERROR = pPathErrors
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 EXTRACT_BODY(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)
' CURRENT_MAIL_BODY_ALL = oMsg_email.Body
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, "")
'Dim g As Group = m.Groups(1)
'If g.ToString.StartsWith("&") = False Then
' TEMP_HTML_RESULTS.Add(g.ToString())
'End If
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)
'clsLogger.Add("Unexpected Error in COPY2HDD: " & ex.Message & "MESSAGE_ID: " & CURRENT_MAIL_MESSAGE.MessageID, True)
MESSAGE_ERROR = True
Return False
End Try
End Function
Private Function ExtractAttachments(pCurrentMail As MailContainer, pExtractPath As String) 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
For Each oAttachment As MimeData In pCurrentMail.Mail.Attachments
_Logger.Info("Working on Attachment [{0}]", oAttachment.SafeFileName)
Dim oEmailAttachment As EmailAttachment = New EmailAttachment() With
{
.OrgFileName = oAttachment.SafeFileName
}
EmailAttachments.Add(oEmailAttachment)
If ValidateFileExtension(oEmailAttachment) = 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)
Else
oAttachmentCount -= 1
CleanUpFilePath(oEmailAttachment.DestFilePath)
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
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 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"
Return False
End If
Return True
Catch ex As Exception
_Logger.Error(ex)
MESSAGE_ERROR = True
Return False
End Try
End Function
'''
''' Falls Datei bereits existiert, lösche sie jetzt
'''
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) As Boolean
_Logger.Debug("Validate extension of [{0}]", pAttachmentData.OrgFileName)
Dim lowerFilename = pAttachmentData.OrgFileName.ToLower
Dim oIsValidExtension = _ValidExtensions.Any(Function(ext) lowerFilename.EndsWith(ext))
Dim oIsGraphicExtension = _GraphicExtensions.Any(Function(ext) lowerFilename.EndsWith(ext))
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
'''
''' Diese Funktion wird nicht mehr verwendet!!!!
'''
Private Function EXTRACT_ATTACHMENTS(pCurrentMail As MailContainer, pExtractPath As String, pErrorPath As String)
_Logger.Debug("In EXTRACT_ATTACHMENTS...")
_Logger.Debug(String.Format("PATH_TEMP[{0}]", pExtractPath))
Dim oAttachmentCount As Integer
oAttachmentCount = 0
TEMP_WORK_FILES.Clear()
Try
If CurrentTempMailPath <> Nothing Then
If File.Exists(CurrentTempMailPath) Then
Dim oATTFilename = ""
For Each oAttachment As MimeData In pCurrentMail.Mail.Attachments
oATTFilename = oAttachment.SafeFileName.ToString.ToLower
Dim oValidExtensions = New List(Of String) From {"pdf", "xls", "xlsx", "doc", "docx", "ppt", "pptx"}
Dim oGraphicExtensions = New List(Of String) From {"jpg", "bmp", "jpeg", "gif", "png", "xml"}
Dim oValidExt = oValidExtensions.Any(Function(ext) oATTFilename.EndsWith(ext))
If oValidExt = False Then
_Logger.Info("Invalid FileExtension [{0}]", oATTFilename)
Dim GraphicExt = oGraphicExtensions.Any(Function(ext) oATTFilename.EndsWith(ext))
If GraphicExt = False Then
Dim oInfo = $"Consistency or extension of attached file {oATTFilename} is not ok."
AddTrackingStatusMSSQL(CurrentMail.MessageId, oInfo, "PDF CONSISTENCY NOT OK", "Info GUI", "EML_PROF_EXTR_ATT1")
AddToEmailQueueMSSQL(CurrentMail.MessageId, oInfo, "PDF CONSISTENCY NOT OK", _EmailAccountID,
_InfoTemplateId, ErrorCode.NormalFileAttachmentCorrupt, oATTFilename, "")
End If
Continue For
End If
Dim oAttachmentFilePath = ""
_Logger.Info("Working on Attachment [{0}]", oAttachment.SafeFileName)
Try
Dim oFileInfo = New FileInfo(oAttachment.SafeFileName)
Dim oFilenameWithoutExtension = Path.GetFileNameWithoutExtension(oAttachment.SafeFileName)
Dim oFilename = StringEx.ConvertTextToSlug(oFilenameWithoutExtension) & oFileInfo.Extension
'Dim oAttachmentFileName = $"{CURRENT_MAIL_MESSAGE_ID}~{pCurrentMail.SenderDomain}~{oFilename}"
Dim oAttachmentFileName = $"{pCurrentMail.MessageId}~Attm{oAttachmentCount}{oFileInfo.Extension}"
_Logger.Debug("Final Filename for Attachment: [{0}]", oAttachmentFileName)
Dim oExtractTempPath = Path.Combine(pExtractPath, "Temp")
If Directory.Exists(oExtractTempPath) = False Then
Directory.CreateDirectory(oExtractTempPath)
End If
oAttachmentFilePath = Path.Combine(oExtractTempPath, oAttachmentFileName)
_Logger.Debug("Final Path for Attachment: [{0}]", oAttachmentFilePath)
If File.Exists(oAttachmentFilePath) Then
_Logger.Warn("File [{0}] already exists!", oAttachmentFilePath)
File.Delete(oAttachmentFilePath)
End If
_Logger.Debug(String.Format("Trying to save attachment [{0}]", oAttachmentFilePath))
Try
oAttachment.Save(oAttachmentFilePath)
'oAttachment.Save(oAttachmentFileString)
Dim oFileInfo1 As New FileInfo(oAttachmentFilePath)
'ToDo Konsistenz prüfen
If oFileInfo.Extension.ToLower = ".pdf" Then
Dim oPDFConsistent As Boolean = True
Dim oLicenseManager As New LicenseManager
oLicenseManager.RegisterKEY(GDPictureLicense)
Dim oGdPicturePDF As New GdPicturePDF()
' Lic
Dim oStatus As GdPictureStatus = oGdPicturePDF.LoadFromFile(oAttachmentFilePath, True)
If oStatus <> GdPictureStatus.OK Then
oPDFConsistent = False
Dim oResult = $"PDF-Consistency of attached file {oATTFilename} is not ok. ({oStatus.ToString})"
AddTrackingStatusMSSQL(CurrentMail.MessageId, oResult, "PDF CONSISTENCY NOT OK", "Info GUI", "EML_PROF_EXTR_ATT2")
AddToEmailQueueMSSQL(CurrentMail.MessageId, oResult, "PDF CONSISTENCY NOT OK", _EmailAccountID,
_InfoTemplateId, ErrorCode.EmbeddedFileAttachmentCorrupt, oATTFilename, "")
File.Delete(oAttachmentFilePath)
Continue For
Else
Dim embeddedFileCount As Integer = oGdPicturePDF.GetEmbeddedFileCount()
If embeddedFileCount > 0 Then
For i As Integer = 0 To embeddedFileCount - 1
Dim oEmbAttName As String = oGdPicturePDF.GetEmbeddedFileName(i)
Dim fileDetail As IO.FileInfo
fileDetail = My.Computer.FileSystem.GetFileInfo(oEmbAttName)
If oGdPicturePDF.GetStat() = GdPictureStatus.OK Then
Dim FileSize As Integer = oGdPicturePDF.GetEmbeddedFileSize(i)
oValidExt = oValidExtensions.Any(Function(ext) oEmbAttName.EndsWith(ext))
If oValidExt = False Then
_Logger.Info("Invalid FileExtension of embedded file [{0}]", oEmbAttName)
Dim GraphicExt = oGraphicExtensions.Any(Function(ext) oEmbAttName.EndsWith(ext))
If GraphicExt = False Then
Dim oInfo = $"Consistency or extension of attached file [{oEmbAttName}] is not ok."
AddTrackingStatusMSSQL(CurrentMail.MessageId, oInfo, "Extension invalid", "Info GUI", "EML_PROF_EXTR_ATT3")
AddToEmailQueueMSSQL(CurrentMail.MessageId, oInfo, "Extension invalid", _EmailAccountID,
_InfoTemplateId, ErrorCode.EmbeddedFileAttachmentCorrupt, oEmbAttName, "")
End If
Continue For
End If
If oGdPicturePDF.GetStat() = GdPictureStatus.OK Then
Dim FileData As Byte() = New Byte(FileSize) {}
Dim status As GdPictureStatus = oGdPicturePDF.ExtractEmbeddedFile(0, FileData)
If status <> GdPictureStatus.OK Or FileSize = 0 Then
oPDFConsistent = False
Dim oResult = $"Consistency or PDF-State of embedded file [{oEmbAttName}] is not ok."
AddTrackingStatusMSSQL(CurrentMail.MessageId, oResult, "PDF CONSISTENCY EMBEDDED FILE NOT OK", "Info GUI", "EML_PROF_EXTR_ATT4")
AddToEmailQueueMSSQL(CurrentMail.MessageId, oResult, "PDF CONSISTENCY EMBEDDED FILE NOT OK", _EmailAccountID,
_InfoTemplateId, ErrorCode.EmbeddedFileAttachmentCorrupt, oEmbAttName, "")
Continue For
End If
End If
End If
Next
End If
End If
End If
Dim oFileLength As Long = oFileInfo1.Length
If oFileLength > 2 Then
_Logger.Info(String.Format("Attachment saved to [{0}]", oAttachmentFilePath))
InsertAttachmentHistoryEntry(pCurrentMail, oAttachment.SafeFileName, oAttachmentFileName)
oAttachmentCount += 1
Else
_Logger.Warn($"##!! oFileLength for AttachmentObjects is <2 !!##")
Dim oResult = $"Consistency of attached file [{oAttachment.SafeFileName}] is not ok."
AddTrackingStatusMSSQL(CurrentMail.MessageId, oResult, "CONSISTENCY ATTACHED FILE NOT OK", "Info GUI", "EML_PROF_EXTR_ATT5")
AddToEmailQueueMSSQL(CurrentMail.MessageId, oResult, "CONSISTENCY ATTACHED FILE NOT OK", _EmailAccountID,
_InfoTemplateId, ErrorCode.EmbeddedFileAttachmentCorrupt, oAttachment.SafeFileName, "")
Try
File.Delete(oAttachmentFilePath)
Catch ex As Exception
_Logger.Error(ex)
End Try
End If
Catch ex As Exception
_Logger.Warn($"Error while saving attachment-name: {ex.Message} - AttachmentName: {oAttachmentFilePath}")
MESSAGE_ERROR = True
End Try
Catch ex As Exception
_Logger.Warn($"Error while creating and saving attachment-name: {ex.Message} - AttachmentName: {oAttachmentFilePath}")
MESSAGE_ERROR = True
End Try
TEMP_WORK_FILES.Add(oAttachmentFilePath)
Next
Else
_Logger.Warn($"If cause 2 EXTRACT_ATTACHMENTS: {CurrentTempMailPath} not existing")
End If
Else
_Logger.Warn($"EXTRACT_ATTACHMENTSIf cause 1: CURRENT_TEMP_MAIL_PATH is NOTHING")
End If
CURRENT_ATTMT_COUNT = oAttachmentCount
If MESSAGE_ERROR = True Then
WorkTempFiles("delete")
Return False
Else
WorkTempFiles("move")
Return True
End If
Catch ex As Exception
_Logger.Error(ex)
MESSAGE_ERROR = True
Return False
End Try
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
'''
''' Wenn eingebettete Attachments defekt sind,
''' gilt die ganze E-Mail als defekt und wird abgelehnt.
''' Hier wird noch aufgeräumt.
'''
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 WORK_POLL_STEPS() 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
WORK_INDEXING_STEPS()
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
WORK_INDEXING_STEPS()
_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)
'clsLogger.Add("Unexpected Error in WORK_POLL_STEPS: " & ex.Message & "MESSAGE_ID: " & CURRENT_MAIL_MESSAGE.MessageID, True)
Return False
End Try
End Function
Private Function WORK_INDEXING_STEPS() 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)
'clsLogger.Add("Unexpected Error in WORK_INDEXING_STEPS: " & ex.Message & "MESSAGE_ID: " & CURRENT_MAIL_MESSAGE.MessageID, True)
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 GET_WMDOC_INFO() As Boolean
Try
Dim oDOC_ID = REGEX_CHECK_DOC_ID(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)
'clsLogger.Add("Unexpected Error in GET_DOC_INFO: " & ex.Message & "MESSAGE_ID: " & CURRENT_MAIL_MESSAGE.MessageID)
MESSAGE_ERROR = True
Return False
End Try
End Function
Public Function REGEX_CHECK_DOC_ID(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