From aa5a268e14c4b58c78269a5e72f868d77c8f3cdb Mon Sep 17 00:00:00 2001 From: Jonathan Jenne Date: Mon, 3 Jul 2023 16:35:24 +0200 Subject: [PATCH] Big update: MessageID replaced with Hash of MessageID --- App/CONFIG_APP/CONFIG_APP.vbproj | 4 + App/CONFIG_APP/frmMain.vb | 67 +- App/DigitalData.EMLProfiler/ClassConfig.vb | 72 ++ App/DigitalData.EMLProfiler/ClassCurrent.vb | 24 +- .../DigitalData.EMLProfiler.vbproj | 2 +- App/DigitalData.EMLProfiler/MailContainer.vb | 76 ++- App/DigitalData.EMLProfiler/ModuleCurrent.vb | 9 - App/DigitalData.EMLProfiler/clsDatabase.vb | 33 +- App/DigitalData.EMLProfiler/clsEmail.IMAP.vb | 4 +- .../clsWindream_allgemein.vb | 1 + App/DigitalData.EMLProfiler/clsWorkEmail.vb | 643 ++++++++---------- App/DigitalData.EMLProfiler/clsWorker.vb | 62 +- App/SERV_EMAIL/MyService.vb | 56 +- App/SERV_EMAIL/SERV_EMAIL.vbproj | 6 + 14 files changed, 522 insertions(+), 537 deletions(-) create mode 100644 App/DigitalData.EMLProfiler/ClassConfig.vb delete mode 100644 App/DigitalData.EMLProfiler/ModuleCurrent.vb diff --git a/App/CONFIG_APP/CONFIG_APP.vbproj b/App/CONFIG_APP/CONFIG_APP.vbproj index f9ce108..fce588c 100644 --- a/App/CONFIG_APP/CONFIG_APP.vbproj +++ b/App/CONFIG_APP/CONFIG_APP.vbproj @@ -59,6 +59,10 @@ + + False + ..\wisag_check_Att\bin\Debug\DigitalData.Modules.Database.dll + ..\..\..\DDModules\Logging\bin\Debug\DigitalData.Modules.Logging.dll diff --git a/App/CONFIG_APP/frmMain.vb b/App/CONFIG_APP/frmMain.vb index 683a0d5..6a34dc1 100644 --- a/App/CONFIG_APP/frmMain.vb +++ b/App/CONFIG_APP/frmMain.vb @@ -2,13 +2,15 @@ Imports System.IO Imports System.Text.RegularExpressions Imports DigitalData.EMLProfiler +Imports DigitalData.Modules.Database Imports DigitalData.Modules.Logging Imports DigitalData.Modules.Messaging Public Class frmMain Private Logger As DigitalData.Modules.Logging.Logger - Private Shared MyLogger As LogConfig - Private _database As clsDatabase + Private Shared LogConfig As LogConfig + 'Private _database As clsDatabase + Private _database As MSSQLServer Private _Encryption As clsEncryption Private _windream As clsWindream_allgemein ' Private _email As clsEmail @@ -18,7 +20,8 @@ Public Class frmMain Private _SQLServerConString As String Private _Worklist As List(Of String) Private _limilab As DigitalData.Modules.Messaging.Limilab - + Private _ConfigManager As ClassConfig + Private _Config As ClassConfig.Config Public Sub New() @@ -31,22 +34,22 @@ Public Class frmMain Private Sub frmMain_Load(sender As Object, e As EventArgs) Handles Me.Load Try - MyLogger = New LogConfig(LogConfig.PathType.CustomPath, Path.Combine(My.Application.Info.DirectoryPath, "Log"), Nothing, My.Application.Info.CompanyName, My.Application.Info.ProductName) - _limilab = New Limilab(MyLogger) - Logger = MyLogger.GetLogger() + LogConfig = New LogConfig(LogConfig.PathType.CustomPath, Path.Combine(My.Application.Info.DirectoryPath, "Log"), Nothing, My.Application.Info.CompanyName, My.Application.Info.ProductName) + _limilab = New Limilab(LogConfig) + Logger = LogConfig.GetLogger() If My.Settings.DEBUG = True Then Logger.Info("!! DEBUG is ACTIVE !!") End If - MyLogger.Debug = My.Settings.DEBUG + LogConfig.Debug = My.Settings.DEBUG InitDatabase() ToolStripProgressBar1.Visible = False Logger.Debug($"AppConfig is located at: [{AppDomain.CurrentDomain.SetupInformation.ConfigurationFile}]") If My.Settings.USE_WM Then - _windream = New clsWindream_allgemein(MyLogger) + _windream = New clsWindream_allgemein(LogConfig) End If '_email = New clsEmail(MyLogger) - _emailIMAP = New clsEmailIMAP(MyLogger, _SQLServerConString) + _emailIMAP = New clsEmailIMAP(LogConfig) Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical, "Error in FormLoad") End Try @@ -62,7 +65,7 @@ Public Class frmMain ObjektTypenEintragen() End If - _Encryption = New clsEncryption("!35452didalog=", MyLogger) + _Encryption = New clsEncryption("!35452didalog=", LogConfig) End Sub Private Function Set_ConnectionStrings() Try @@ -168,8 +171,15 @@ Public Class frmMain Logger.Debug($"SQL-Server ConnString is [{_SQLServerConString}]") - _database = New clsDatabase(MyLogger, My.Settings.MyConnectionString) - dbResult = _database.Init(My.Settings.MyConnectionString) + _ConfigManager = New ClassConfig(LogConfig, _database) + _Config = _ConfigManager.GetConfig() + + If _Config Is Nothing Then + MsgBox("Configuration could not be loaded. Please check the Logfile.", MsgBoxStyle.Critical, Text) + End If + + '_database = New clsDatabase(MyLogger, My.Settings.MyConnectionString) + 'dbResult = _database.Init(My.Settings.MyConnectionString) Else MsgBox("No Databaseconnection configured. (First Start or Appdata not accessible)" & vbNewLine & "Basic-Config will be loaded.", MsgBoxStyle.Information) @@ -178,7 +188,7 @@ Public Class frmMain tslblstatus.BackColor = Color.Red End If If dbResult = False Then - MsgBox("Error in init database. (Connection failed) More information in the logfile.", MsgBoxStyle.Critical) + MsgBox("Error in init database. (Connection failed) More information in the logfile.", MsgBoxStyle.Critical, Text) Return False Else Return True @@ -259,8 +269,13 @@ Public Class frmMain 'Set the construction string MyConnectionString = con My.Settings.MyConnectionString = MyConnectionString + + _database = New MSSQLServer(LogConfig, MyConnectionString) + _ConfigManager = New ClassConfig(LogConfig, _database) + 'csb.ConnectionString - _database.Init(MyConnectionString) + '_database.Init(MyConnectionString) + My.Settings.Save() If chkbxUserAut.Checked = False Then @@ -285,15 +300,15 @@ Public Class frmMain Private Sub BackgroundWorker1_DoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork If _RunwithLocalemail = False Then - MyLogger.Debug = True - Dim _work As New clsWorker(My.Settings.EML_LIMITATION_SENDER, MyLogger, _SQLServerConString, GUIDTextBox.Text, My.Settings.FB_DATASOURCE, My.Settings.FB_DATABASE, My.Settings.FB_USER, My.Settings.FB_PW, + LogConfig.Debug = True + Dim _work As New clsWorker(My.Settings.EML_LIMITATION_SENDER, LogConfig, _SQLServerConString, _Config.WindreamConnectionString, GUIDTextBox.Text, My.Settings.FB_DATASOURCE, My.Settings.FB_DATABASE, My.Settings.FB_USER, My.Settings.FB_PW, My.Settings.USE_WM, ToolStripEmailAccountID.Text, "EmailProfilerTestClient") _work.Start_WorkingProfiles() Else For Each ofile As String In _Worklist Logger.Info($"## Manual working on file {ofile} ... ") - Dim _work As New clsWorker(My.Settings.EML_LIMITATION_SENDER, MyLogger, _SQLServerConString, GUIDTextBox.Text, My.Settings.FB_DATASOURCE, My.Settings.FB_DATABASE, My.Settings.FB_USER, My.Settings.FB_PW, My.Settings.USE_WM, ToolStripEmailAccountID.Text, "EmailProfilerTestClient", ofile) + Dim _work As New clsWorker(My.Settings.EML_LIMITATION_SENDER, LogConfig, _SQLServerConString, _Config.WindreamConnectionString, GUIDTextBox.Text, My.Settings.FB_DATASOURCE, My.Settings.FB_DATABASE, My.Settings.FB_USER, My.Settings.FB_PW, My.Settings.USE_WM, ToolStripEmailAccountID.Text, "EmailProfilerTestClient", ofile) _work.Start_WorkingProfiles(True) Next @@ -311,7 +326,7 @@ Public Class frmMain fi.Delete() Next Catch ex As Exception - If MyLogger.Debug = True Then + If LogConfig.Debug = True Then Logger.Warn($"Could not delete the tempfile: {ex.Message}") End If End Try @@ -391,7 +406,7 @@ Public Class frmMain End Sub Private Sub btnShowLogpath_Click(sender As Object, e As EventArgs) Handles btnShowLogpath.Click - Process.Start(MyLogger.LogDirectory) + Process.Start(LogConfig.LogDirectory) End Sub Private Sub TBEMLP_POLL_PROFILESBindingNavigatorSaveItem_Click(sender As Object, e As EventArgs) @@ -590,7 +605,7 @@ Public Class frmMain Case 4 Try Dim osql = "SELECT * FROM TBDD_FUNCTION_REGEX WHERE UPPER(FUNCTION_NAME) IN (UPPER('EMAIL_PROFILER - RemoveHTMLText'),UPPER('EMAIL_PROFILER - RemoveHTMLText1'))" - Dim oDTFunctionRegex As DataTable = _database.Return_Datatable(osql) + Dim oDTFunctionRegex As DataTable = _database.GetDatatable(osql) txtRegex1.Text = oDTFunctionRegex.Rows(0).Item("REGEX") txtRegex2.Text = oDTFunctionRegex.Rows(1).Item("REGEX") txthtmlEmail.BackColor = Color.Wheat @@ -635,10 +650,10 @@ Public Class frmMain Private Sub LOG_ERRORS_ONLYCheckBox_CheckedChanged(sender As Object, e As EventArgs) Handles LOG_ERRORS_ONLYCheckBox.CheckedChanged If _LoadInProgress = True Then Exit Sub - MyLogger.Debug = LOG_ERRORS_ONLYCheckBox.Checked + LogConfig.Debug = LOG_ERRORS_ONLYCheckBox.Checked My.Settings.Save() Dim upd = $"UPDATE TBEMLP_CONFIG SET CHANGED_WHO = '{Environment.UserName}',LOG_ERRORS_ONLY = '{LOG_ERRORS_ONLYCheckBox.Checked}' WHERE GUID = 1" - _database.Execute_non_Query(upd) + _database.ExecuteNonQuery(upd) Load_Config() End Sub @@ -672,7 +687,7 @@ Public Class frmMain Private Sub CHECK_INTERVALL_MINUTESNumericUpDown_ValueChanged(sender As Object, e As EventArgs) Handles CHECK_INTERVALL_MINUTESNumericUpDown.ValueChanged If _LoadInProgress = True Then Exit Sub Dim upd = $"UPDATE TBEMLP_CONFIG SET CHANGED_WHO = '{Environment.UserName}',CHECK_INTERVALL_MINUTES = {CHECK_INTERVALL_MINUTESNumericUpDown.Value} WHERE GUID = 1" - _database.Execute_non_Query(upd) + _database.ExecuteNonQuery(upd) Load_Config() End Sub 'Private Function GetChildren(ByVal bodyParts As BodyPartCollection) As BodyPartCollection @@ -739,7 +754,7 @@ Public Class frmMain Private Sub Button1_Click(sender As Object, e As EventArgs) Handles btntestImap.Click My.Settings.Save() Dim oSQL = $"SELECT * FROM TBDD_EMAIL_ACCOUNT WHERE GUID = {EMAILIDTextBox.Text}" - Dim oDT As DataTable = _database.Return_Datatable(oSQL) + Dim oDT As DataTable = _database.GetDatatable(oSQL) If Not IsNothing(oDT) Then If oDT.Rows.Count = 1 Then @@ -813,7 +828,7 @@ Public Class frmMain Private Sub btnsaveRegex_Click_1(sender As Object, e As EventArgs) Handles btnsaveRegex.Click tslblRefresh.BackColor = Color.Transparent Dim upd = $"UPDATE TBDD_FUNCTION_REGEX SET REGEX = '{txtRegex1.Text}' WHERE UPPER(FUNCTION_NAME) = UPPER('EMAIL_PROFILER - RemoveHTMLText')" - If _database.Execute_non_Query(upd) = True Then + If _database.ExecuteNonQuery(upd) = True Then tslblRefresh.Text = "Regex1 saved - " & Now.ToString tslblRefresh.BackColor = Color.Yellow Else @@ -879,7 +894,7 @@ Public Class frmMain Private Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.Click tslblRefresh.BackColor = Color.Transparent Dim upd = $"UPDATE TBDD_FUNCTION_REGEX SET REGEX = '{txtRegex2.Text}' WHERE UPPER(FUNCTION_NAME) = UPPER('EMAIL_PROFILER - RemoveHTMLText1')" - If _database.Execute_non_Query(upd) = True Then + If _database.ExecuteNonQuery(upd) = True Then tslblRefresh.Text = "Regex2 saved - " & Now.ToString tslblRefresh.BackColor = Color.Yellow Else diff --git a/App/DigitalData.EMLProfiler/ClassConfig.vb b/App/DigitalData.EMLProfiler/ClassConfig.vb new file mode 100644 index 0000000..9c87b3c --- /dev/null +++ b/App/DigitalData.EMLProfiler/ClassConfig.vb @@ -0,0 +1,72 @@ +Imports DigitalData.Modules.Database +Imports DigitalData.Modules.Logging +Imports DigitalData.Modules.Base + +Public Class ClassConfig + Public Class Config + Public Property PathError As String + Public Property PathAttachments As String + Public Property BodyFont As String + Public Property WindreamConnectionString As String + Public Property TimerInterval As Integer + Public Property WindreamDrive As String = "W" + End Class + + Private ReadOnly Logger As Logger + Private ReadOnly Database As MSSQLServer + + Public Sub New(pLogConfig As LogConfig, pDatabase As MSSQLServer) + Logger = pLogConfig.GetLogger() + Database = pDatabase + End Sub + + Private Function GetConfigTable() As DataTable + Dim oSQL As String = "SELECT * FROM TBEMLP_CONFIG" + Dim oTable As DataTable = Database.GetDatatable(oSQL) + Return oTable + End Function + + Private Function GetBaseConfigTable() As DataTable + Dim oSQL As String = "SELECT * FROM TBDD_BASECONFIG" + Dim oTable As DataTable = Database.GetDatatable(oSQL) + Return oTable + End Function + + Public Function GetConfig() As Config + Dim oConfigTable = GetConfigTable() + Dim oBaseTable = GetBaseConfigTable() + + If oBaseTable Is Nothing Then + Logger.Warn("Config from TBDD_BASECONFIG could not be loaded!") + Return Nothing + End If + + If oBaseTable.Rows.Count = 0 Then + Logger.Warn("Config from TBDD_BASECONFIG could not be loaded!") + Return Nothing + End If + + If oConfigTable Is Nothing Then + Logger.Warn("Config from TBEMLP_CONFIG could not be loaded!") + Return Nothing + End If + + If oConfigTable.Rows.Count = 0 Then + Logger.Warn("Config from TBEMLP_CONFIG is empty!") + Return Nothing + End If + + Dim oRow As DataRow = oConfigTable.Rows.Item(0) + + Dim oConfig As New Config With { + .PathAttachments = oRow.ItemEx("PATH_EMAIL_TEMP", ""), + .PathError = oRow.ItemEx("PATH_EMAIL_ERRORS", ""), + .BodyFont = oRow.ItemEx("FONT_BODY", "Arial"), + .TimerInterval = oRow.ItemEx("CHECK_INTERVALL_MINUTES", 5), + .WindreamConnectionString = oRow.ItemEx("WM_CON_STRING", ""), + .WindreamDrive = oRow.ItemEx("WM_DRIVE", "W") + } + + Return oConfig + End Function +End Class diff --git a/App/DigitalData.EMLProfiler/ClassCurrent.vb b/App/DigitalData.EMLProfiler/ClassCurrent.vb index ffc62ed..28f829d 100644 --- a/App/DigitalData.EMLProfiler/ClassCurrent.vb +++ b/App/DigitalData.EMLProfiler/ClassCurrent.vb @@ -6,18 +6,13 @@ Imports MailBox = Limilabs.Mail.Headers.MailBox Imports Limilabs.Client.IMAP Public Class ClassCurrent - Public Shared Property WM_CON_STRING As String Public Shared Property WM_DRIVE As String - Public Shared Property TIMER_INTERVALL As Integer = 5 Public Shared Property CURRENT_EMAIL_GUID As Integer Public Shared Property CURRENT_PROFILE_GUID As Integer Public Shared Property DTCONFIG As DataTable Public Shared Property DT_ECM_BASE_CONFIG As DataTable - Public Shared Property PATH_TEMP As String - Public Shared Property PATH_ERROR As String - Public Shared Property MAIL_BODY_FONT As String = "" Public Shared Property MAIL_FROM As String = "" Public Shared Property MAIL_SERVER As String = "" Public Shared Property MAIL_USER As String = "" @@ -30,20 +25,21 @@ Public Class ClassCurrent Public Shared Property DT_STEPS As DataTable Public Shared Property DT_INDEXING_STEPS As DataTable + Public Shared Property CURRENToWMSession As Object + Public Shared Property CURRENToWMSession_Created As Date = Now + Public Shared Property CURRENToWMConnect As Object + Public Shared Property CURRENT_ATTMT_COUNT As Integer + Public Shared Property SUBJECT_PRAFIX As String = "EmailProfiler" + Public Shared Property CURRENT_DRIVE_CHECK As String = "" + Public Shared Property CURRENT_DRIVE_ISFULL As Boolean = False + + ' Public Shared Property oCURRENT_WORKMAIL_LIST As New ArrayList() Public Shared Property CURRENT_WORKMAIL_UID_LIST As New List(Of Long) Public Shared Property CURRENT_MAIL_MESSAGE As IMail - Public Shared Property CURRENT_TEMP_MAIL_PATH As String - Public Shared Property CURRENT_MAIL_BODY_ALL As String - Public Shared Property CURRENT_MAIL_BODY_ANSWER1 As String = "" - Public Shared Property CURRENT_MAIL_BODY_Substr2 As String = "" - Public Shared Property CURRENT_MAIL_SUBJECT As String = "" - Public Shared Property CURRENT_MAIL_FROM As String = "" - Public Shared Property CURRENT_MAIL_MESSAGE_ID As String = "" - Public Shared Property CURRENT_MAIL_UID As Long - Public Shared Property CURRENT_MAIL_PROCESS_NAME As String Public Shared Property CURRENT_ImapObject As Imap + Public Shared Property CURRENT_MAIL_UID As Long Public Shared Property DeleteMail As Boolean = False Public Shared Property CURRENT_POLL_TYPE As String diff --git a/App/DigitalData.EMLProfiler/DigitalData.EMLProfiler.vbproj b/App/DigitalData.EMLProfiler/DigitalData.EMLProfiler.vbproj index eecaa65..b1e0c06 100644 --- a/App/DigitalData.EMLProfiler/DigitalData.EMLProfiler.vbproj +++ b/App/DigitalData.EMLProfiler/DigitalData.EMLProfiler.vbproj @@ -106,6 +106,7 @@ + @@ -116,7 +117,6 @@ - True diff --git a/App/DigitalData.EMLProfiler/MailContainer.vb b/App/DigitalData.EMLProfiler/MailContainer.vb index d726928..ea2f1d8 100644 --- a/App/DigitalData.EMLProfiler/MailContainer.vb +++ b/App/DigitalData.EMLProfiler/MailContainer.vb @@ -1,52 +1,64 @@ Imports Limilabs.Mail -Imports DigitalData.Modules.Language +Imports DigitalData.Modules.Base Public Class MailContainer - Private ReadOnly Uid As String - Private ReadOnly FilteredMessageId + Private Const SUBJECT_MAX_LENGTH = 25 + ''' + ''' The Mail object created by Limilabs + ''' Public ReadOnly Property Mail As IMail - + ''' + ''' The IMAP Id coming from the IMAP folder. Used to reference the mail. + ''' + Public ReadOnly Property ImapId As Integer + ''' + ''' The original MessageID from the eml file + ''' + Public ReadOnly Property MessageIdOriginal As String + ''' + ''' The new MessageID, which is generated by hashing the original MessageID + ''' + Public ReadOnly Property MessageId As String + ''' + ''' The subject, truncated to SUBJECT_MAX_LENGTH characters + ''' Public ReadOnly Property Subject As String - Get - Return Mail.Subject - End Get - End Property - Public ReadOnly Property MessageId As String - Get - Return Mail.MessageID - End Get - End Property + Public ReadOnly Property SenderDomain As String + Public ReadOnly Property SenderAddress As String - Public ReadOnly Property MessageIdPathSafe As String - Get - Return FilteredMessageId - End Get - End Property - Public Property BodyComplete As String - Public Property BodySubstring1 As String - Public Property BodySubstring2 As String + Public Sub New(pMail As IMail, pImapId As Integer) + Mail = pMail + ImapId = pImapId + MessageIdOriginal = pMail.MessageID + MessageId = StringEx.GetHash(pMail.MessageID) + Subject = ObjectEx.NotNull(pMail.Subject.Truncate(SUBJECT_MAX_LENGTH), String.Empty) - Public Sub New(pMail As IMail, pUid As String) - Mail = pMail - Uid = pUid - FilteredMessageId = ProcessMessageId(pMail.MessageID) + SenderAddress = GetSenderAddress(pMail) + SenderDomain = GetSenderDomain(pMail) End Sub - Private Function ProcessMessageId(pOriginalMessageId As String) As String - If pOriginalMessageId Is Nothing Then - Return Guid.NewGuid.ToString - End If - If TypeOf pOriginalMessageId Is String AndAlso pOriginalMessageId.Length = 0 Then - Return Guid.NewGuid.ToString + Private Function GetSenderAddress(pMail As IMail) + Dim oMailBox = pMail.From.FirstOrDefault() + If oMailBox Is Nothing Then + Return "InvalidSenderAddress" + Else + Return oMailBox.Address End If + End Function - Return Utils.RemoveInvalidCharacters(pOriginalMessageId) + Private Function GetSenderDomain(pMail As IMail) + Dim oMailBox = pMail.From.FirstOrDefault() + If oMailBox Is Nothing Then + Return "InvalidSenderAddress" + Else + Return oMailBox.DomainPart + End If End Function End Class diff --git a/App/DigitalData.EMLProfiler/ModuleCurrent.vb b/App/DigitalData.EMLProfiler/ModuleCurrent.vb deleted file mode 100644 index 8f32085..0000000 --- a/App/DigitalData.EMLProfiler/ModuleCurrent.vb +++ /dev/null @@ -1,9 +0,0 @@ -Module ModuleCurrent - Public CURRENToWMSession As Object - Public CURRENToWMSession_Created As Date = Now - Public CURRENToWMConnect As Object - Public CURRENT_ATTMT_COUNT As Integer - Public SUBJECT_PRAFIX As String = "EmailProfiler" - Public CURRENT_DRIVE_CHECK As String = "" - Public CURRENT_DRIVE_ISFULL As Boolean = False -End Module diff --git a/App/DigitalData.EMLProfiler/clsDatabase.vb b/App/DigitalData.EMLProfiler/clsDatabase.vb index 8677b56..3759f20 100644 --- a/App/DigitalData.EMLProfiler/clsDatabase.vb +++ b/App/DigitalData.EMLProfiler/clsDatabase.vb @@ -10,7 +10,7 @@ Public Class clsDatabase MyLogger = LogConf Init(ConStr) End Sub - Public Function Init(ConString As String) + Public Function Init(ConString As String) As Boolean Try Dim SQLconnect As New SqlClient.SqlConnection @@ -21,11 +21,11 @@ Public Class clsDatabase DTCONFIG = Return_Datatable("select * from TBEMLP_CONFIG") If Not IsNothing(DTCONFIG) Then If DTCONFIG.Rows.Count = 1 Then - PATH_TEMP = DTCONFIG.Rows(0).Item("PATH_EMAIL_TEMP") - PATH_ERROR = DTCONFIG.Rows(0).Item("PATH_EMAIL_ERRORS") - MAIL_BODY_FONT = DTCONFIG.Rows(0).Item("FONT_BODY") - WM_CON_STRING = DTCONFIG.Rows(0).Item("WM_CON_STRING") - TIMER_INTERVALL = DTCONFIG.Rows(0).Item("CHECK_INTERVALL_MINUTES") + 'PATH_EXTRACT_ATTACHMENTS = DTCONFIG.Rows(0).Item("PATH_EMAIL_TEMP") + 'PATH_ERROR = DTCONFIG.Rows(0).Item("PATH_EMAIL_ERRORS") + 'MAIL_BODY_FONT = DTCONFIG.Rows(0).Item("FONT_BODY") + 'WM_CON_STRING = DTCONFIG.Rows(0).Item("WM_CON_STRING") + 'TIMER_INTERVALL = DTCONFIG.Rows(0).Item("CHECK_INTERVALL_MINUTES") End If End If DT_ECM_BASE_CONFIG = Return_Datatable("select * from TBDD_BASECONFIG") @@ -132,25 +132,4 @@ Public Class clsDatabase Return Nothing End Try End Function - Public Function Execute_Scalar_CS(cmdscalar As String, constring As String) - Dim result - Try - Dim SQLconnect As New SqlClient.SqlConnection - Dim SQLcommand As SqlClient.SqlCommand - SQLconnect.ConnectionString = constring - SQLconnect.Open() - SQLcommand = SQLconnect.CreateCommand - 'Update Last Created Record in Foo - SQLcommand.CommandText = cmdscalar - result = SQLcommand.ExecuteScalar() - SQLcommand.Dispose() - SQLconnect.Close() - Return result - Catch ex As Exception - Logger.Error(ex) - Logger.Warn("Unexpected Error in Execute_Scalar_CS: " & ex.Message) - Logger.Warn("SQL: " & cmdscalar) - Return Nothing - End Try - End Function End Class diff --git a/App/DigitalData.EMLProfiler/clsEmail.IMAP.vb b/App/DigitalData.EMLProfiler/clsEmail.IMAP.vb index 19b7d91..9ecb0a4 100644 --- a/App/DigitalData.EMLProfiler/clsEmail.IMAP.vb +++ b/App/DigitalData.EMLProfiler/clsEmail.IMAP.vb @@ -10,12 +10,10 @@ Imports DigitalData.Modules.Messaging Public Class clsEmailIMAP Private Shared Logger As Logger Private Shared LogConfig As LogConfig - Private _DB_MSSQL As clsDatabase Private _limilab As Limilab - Sub New(LogConf As LogConfig, ECMConnectionString As String) + Sub New(LogConf As LogConfig) LogConfig = LogConf Logger = LogConf.GetLogger - _DB_MSSQL = New clsDatabase(LogConf, ECMConnectionString) _limilab = New Limilab(LogConf) End Sub Public Function FetchIMAPMessagesLimilab(Server As String, Port As Integer, Username As String, Password As String, AuthType As String) As Boolean diff --git a/App/DigitalData.EMLProfiler/clsWindream_allgemein.vb b/App/DigitalData.EMLProfiler/clsWindream_allgemein.vb index 5abe64f..9f66b87 100644 --- a/App/DigitalData.EMLProfiler/clsWindream_allgemein.vb +++ b/App/DigitalData.EMLProfiler/clsWindream_allgemein.vb @@ -9,6 +9,7 @@ Imports WMOBRWSLib Imports WMOSRCHLib Imports System.IO Imports DigitalData.Modules.Logging +Imports DigitalData.EMLProfiler.ClassCurrent Public Class clsWindream_allgemein diff --git a/App/DigitalData.EMLProfiler/clsWorkEmail.vb b/App/DigitalData.EMLProfiler/clsWorkEmail.vb index 5854b95..fc4d310 100644 --- a/App/DigitalData.EMLProfiler/clsWorkEmail.vb +++ b/App/DigitalData.EMLProfiler/clsWorkEmail.vb @@ -4,107 +4,133 @@ Imports DigitalData.EMLProfiler.ClassCurrent Imports System.IO Imports DigitalData.Modules.Logging Imports DigitalData.Modules.Database -Imports DigitalData.Modules.Language +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.Messaging Public Class clsWorkEmail - Private Const FILENAME_MAX_LENGTH = 100 + Private Const SUBJECT_MAX_LENGTH = 25 Private Const MESSAGE_ID_MAX_LENGTH = 100 - Private Shared Logger As Logger - Private MyLogger As LogConfig - Private _DB_MSSQL As clsDatabase - Private _USE_WM As Boolean - Private _windream As clsWindream_allgemein - Private _windream_index As clsWindream_Index - Private _firebird As Firebird + Private CurrentMail As IMail = Nothing + + Private CURRENT_TEMP_MAIL_PATH 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 = "" + + ''' + ''' Primary Mail Identifier. + ''' Is a hash of the MessageId, used to be the MessageId itself. + ''' + Private Property CURRENT_MAIL_MESSAGE_ID As String = "" + + Private CurrentMailProcessName As String + + Private ReadOnly _Logger As Logger + Private ReadOnly _LogConfig As LogConfig + + 'Private ReadOnly _DB_MSSQL As clsDatabase + Private ReadOnly _DB_MSSQL As MSSQLServer + Private ReadOnly _DB_FIREBIRD As Firebird + + 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 _EmailAccountID As Integer = 1 + Private _worked_email As Boolean = False - Private _EmailAccountID As Integer = 1 - Sub New(LogConf As LogConfig, ConStr As String, FB_DATASOURCE As String, FB_DATABASE As String, FB_USER As String, FB_PW As String, USE_WM As Boolean, EmailAccountID As Integer, EmlProfPraefix As String) + + Sub New(LogConf As LogConfig, ConStr As String, WmConStr As String, FB_DATASOURCE As String, FB_DATABASE As String, FB_USER As String, FB_PW As String, pUseWindream As Boolean, EmailAccountID As Integer, EmlProfPraefix As String) Try - Logger = LogConf.GetLogger - MyLogger = LogConf - _DB_MSSQL = New clsDatabase(LogConf, ConStr) - Logger.Debug("clsWorkmail _email initialized") - _USE_WM = USE_WM - If USE_WM Then + _Logger = LogConf.GetLogger + _LogConfig = LogConf + '_DB_MSSQL = New clsDatabase(LogConf, ConStr) + _DB_MSSQL = New MSSQLServer(LogConf, ConStr) + _Logger.Debug("clsWorkmail _email initialized") + _UseWindream = pUseWindream + If pUseWindream Then _windream = New clsWindream_allgemein(LogConf) _windream_index = New clsWindream_Index(LogConf) + _windreamConnectionString = WmConStr End If If FB_DATASOURCE <> String.Empty Then - _firebird = New Firebird(LogConf, FB_DATASOURCE, FB_DATABASE, FB_USER, FB_PW) + _DB_FIREBIRD = New Firebird(LogConf, FB_DATASOURCE, FB_DATABASE, FB_USER, FB_PW) End If _EmailAccountID = EmailAccountID SUBJECT_PRAFIX = EmlProfPraefix Catch ex As Exception - Logger.Error(ex) + _Logger.Error(ex) End Try - End Sub Public Shared Function RemoveIllegalFileNameChars(input As String, Optional replacement As String = "") As String Dim regexSearch = New String(Path.GetInvalidFileNameChars()) & New String(Path.GetInvalidPathChars()) Dim r = New Regex(String.Format("[{0}]", Regex.Escape(regexSearch))) Return r.Replace(input, replacement) End Function - Public Function WorkEmailMessage(MyEmailMessage As IMail, poUID As Long) As Boolean + Public Function WorkEmailMessage(pMailMessage As IMail, poUID As Long) As Boolean Try - For Each m As MailBox In MyEmailMessage.From + 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 - 'Dim oMail As New MailContainer(MyEmailMessage, poUID) + CurrentMail = New MailContainer(pMailMessage, poUID) - Logger.Debug($"Working on email from: {CURRENT_MAIL_FROM}...Subject: {MyEmailMessage.Subject}") + _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_MESSAGE = MyEmailMessage - CURRENT_MAIL_SUBJECT = MyEmailMessage.Subject.ToUpper.Replace("'", "''") - CURRENT_MAIL_MESSAGE_ID = RemoveIllegalFileNameChars(MyEmailMessage.MessageID) - CURRENT_MAIL_UID = poUID - - - - 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("'", "") + CURRENT_MAIL_MESSAGE = pMailMessage + CURRENT_MAIL_SUBJECT = pMailMessage.Subject.ToUpper.EscapeForSQL() - End If + 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. + 'CURRENT_MAIL_MESSAGE_ID = RemoveIllegalFileNameChars(pMailMessage.MessageID) + CURRENT_MAIL_MESSAGE_ID = StringEx.GetHash(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: {CURRENT_MAIL_SUBJECT}...") + _Logger.Debug("Subject: [{0}]", CURRENT_MAIL_SUBJECT) End If - - Logger.Debug($"Working on email from : {CURRENT_MAIL_FROM}...") + _Logger.Debug($"Working on email from : {CURRENT_MAIL_FROM}...") Dim osql = $"Select COALESCE(MAX(GUID),0) FROM TBEMLP_HISTORY WHERE EMAIL_MSGID = '{CURRENT_MAIL_MESSAGE_ID}'" - Dim oHistoryID = _DB_MSSQL.Execute_Scalar(osql) + Dim oHistoryID = _DB_MSSQL.GetScalarValue(osql) If oHistoryID > 0 Then - Logger.Debug($"Messsage with subject [{CURRENT_MAIL_SUBJECT}] from [{CURRENT_MAIL_FROM}] has already been worked!") + _Logger.Debug($"Messsage with subject [{CURRENT_MAIL_SUBJECT}] from [{CURRENT_MAIL_FROM}] has already been worked!") Return True End If - Dim oTempMailExists As Boolean = SAVE2TEMP() + Dim oTempMailExists As Boolean = SAVE2TEMP(CurrentMail) 'Checking wether Mail can be opened Dim oTempMailAccessible As Boolean = False If oTempMailExists = True Then @@ -113,20 +139,20 @@ Public Class clsWorkEmail oTempMailAccessible = True oFS.Close() Catch ex As Exception - Logger.Warn($"Could not read the Temp-Mail. Insufficient rights? Message: {ex.Message}") + _Logger.Warn($"Could not read the Temp-Mail. Insufficient rights? Message: {ex.Message}") End Try If oTempMailAccessible = True Then MessageError = False If CURRENT_MAIL_SUBJECT.Contains("[PROCESSMANAGER]") Then - PROCESS_MANAGER_IN() - ElseIf MyEmailMessage.Subject.Contains("[ADDI]") Then + PROCESS_MANAGER_IN(CurrentMail) + ElseIf pMailMessage.Subject.Contains("[ADDI]") Then Else - Logger.Debug("CommonEmail-Process-Sniffer") - If COMMON_EMAIL_IN() = True Then + _Logger.Debug("CommonEmail-Process-Sniffer") + If COMMON_EMAIL_IN(CurrentMail) = True Then INSERT_HISTORY_MSSQL() If CURRENT_ATTMT_COUNT = 0 Then - Logger.Info("### Mail contained no Attachments!! ###") + _Logger.Info("### Mail contained no Attachments!! ###") Dim oBody = EmailStrings.EMAIL_NO_FERDS If AddToEmailQueueMSSQL(CURRENT_MAIL_MESSAGE_ID, oBody, "No Attachments", _EmailAccountID) = True Then CURRENT_ImapObject.DeleteMessageByUID(poUID) @@ -141,25 +167,11 @@ Public Class clsWorkEmail End If End If Catch ex As Exception - Logger.Error(ex) - 'clsLogger.Add("Unexpected Error in WORK_MAIL: " & ex.Message & "MESSAGE_ID: " & msg.MessageID) + _Logger.Error(ex) Return False End Try End Function - Private Function Hash(pString As String) As String - Using sha1 As Security.Cryptography.SHA1Managed = New Security.Cryptography.SHA1Managed() - Dim oHash = sha1.ComputeHash(Text.Encoding.UTF8.GetBytes(pString)) - Dim oBuilder = New Text.StringBuilder(oHash.Length * 2) - - For Each b As Byte In oHash - oBuilder.Append(b.ToString("X2")) - Next - - Return oBuilder.ToString() - End Using - End Function - Public Function AddToEmailQueueMSSQL(MessageId As String, BodyText As String, SourceProcedure As String, pEmailAccountId As Integer) As Boolean Try @@ -178,18 +190,18 @@ Public Class clsWorkEmail If IsNothing(oEmailAddress) OrElse String.IsNullOrWhiteSpace(oEmailAddress) Then - Logger.Warn("Could not find email-address for MessageId {0}", MessageId) + _Logger.Warn("Could not find email-address for MessageId {0}", MessageId) 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) + _Logger.Debug("Trying to generate Email:") + _Logger.Debug("To: {0}", oEmailTo) + _Logger.Debug("Subject: {0}", oSubject) + _Logger.Debug("Body {0}", oFinalBodyText) Dim osql = $"Select MAX(GUID) FROM TBEMLP_HISTORY WHERE EMAIL_MSGID = '{MessageId}'" - Dim oHistoryID = _DB_MSSQL.Execute_Scalar(osql) + Dim oHistoryID = _DB_MSSQL.GetScalarValue(osql) If IsNumeric(oHistoryID) Then Dim oInsert = $"INSERT INTO [dbo].[TBEMLP_EMAIL_OUT] ( @@ -214,20 +226,20 @@ Public Class clsWorkEmail ,'{oFinalBodyText}' ,'{SourceProcedure}' ,'{oCreatedWho}')" - Return _DB_MSSQL.Execute_non_Query(oInsert) + Return _DB_MSSQL.ExecuteNonQuery(oInsert) Else - Logger.Warn($"!! Could not get oHistoryID in AddToEmailQueueMSSQL [{osql}]") + _Logger.Warn($"!! Could not get oHistoryID in AddToEmailQueueMSSQL [{osql}]") End If Catch ex As Exception - Logger.Error(ex) + _Logger.Error(ex) Return False End Try End Function - Private Function PROCESS_MANAGER_IN() As Boolean + Private Function PROCESS_MANAGER_IN(pCurrentMail As MailContainer) As Boolean Try - Logger.Info(String.Format("PM-related message found....[{0}]", CURRENT_MAIL_MESSAGE.Subject)) - Logger.Debug(String.Format("PM-related message found....[{0}]", CURRENT_MAIL_MESSAGE.Subject)) + _Logger.Info(String.Format("PM-related message found....[{0}]", CURRENT_MAIL_MESSAGE.Subject)) + _Logger.Debug(String.Format("PM-related message found....[{0}]", CURRENT_MAIL_MESSAGE.Subject)) Dim oExpression = "PROCESS_NAME = 'ProcessManager'" 'Filter the rows using Select() method of DataTable Dim TEMP_PROCESS_PROFILE_DT As DataTable = DT_POLL_PROCESS @@ -237,7 +249,7 @@ Public Class clsWorkEmail 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}") + _Logger.Debug($"PM_IN Attention WM_REFERENCE_INDEX seems to be Empty/null: {ex.Message}") WM_REFERENCE_INDEX = Nothing End Try @@ -255,20 +267,20 @@ Public Class clsWorkEmail 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....")) - CURRENT_MAIL_PROCESS_NAME = "DD EasyApproval via Mail" + _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...")) + _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 ....") + _Logger.Info("No steps configured for this Profile ....") End If End If @@ -278,7 +290,7 @@ Public Class clsWorkEmail End If Return True Catch ex As Exception - Logger.Error(ex) + _Logger.Error(ex) 'Logger.Debug("Unexpected Error in PROCESS_MANAGER_IN: " & ex.Message & "MESSAGE_ID: " & CURRENT_MAIL_MESSAGE.MessageID) Return False End Try @@ -314,46 +326,32 @@ Public Class clsWorkEmail End Set End Property - Function COMMON_EMAIL_IN() As Boolean + Function COMMON_EMAIL_IN(pCurrentMail As MailContainer) As Boolean Try - Logger.Info(String.Format("COMMON_EMAIL_IN...Subject [{0}]", CURRENT_MAIL_MESSAGE.Subject)) - Logger.Debug(String.Format("COMMON_EMAIL_IN...Subject [{0}]", CURRENT_MAIL_MESSAGE.Subject)) + _Logger.Info(String.Format("COMMON_EMAIL_IN...Subject [{0}]", CURRENT_MAIL_MESSAGE.Subject)) + _Logger.Debug(String.Format("COMMON_EMAIL_IN...Subject [{0}]", CURRENT_MAIL_MESSAGE.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") + _Logger.Info("ATTENTION: NO PROCESS-Definititon Filter [PROCESS_NAME = 'Attachment Sniffer' or PROCESS_NAME = 'ZugFeRD-Parser'] returned 0") Return False End If - For Each oDataRow As DataRow In PM_ROW - DeleteMail = oDataRow("DELETE_MAIL") - CURRENT_MAIL_PROCESS_NAME = oDataRow.Item("PROCESS_NAME") - Try - WM_REFERENCE_INDEX = oDataRow("WM_REFERENCE_INDEX") - Catch ex As Exception - Logger.Debug($"Attention WM_REFERENCE_INDEX seems to be Empty/null: {ex.Message}") - WM_REFERENCE_INDEX = "" - End Try - Try - WM_VECTOR_LOG = oDataRow("WM_VECTOR_LOG") - Catch ex As Exception - Logger.Debug($"Attention WM_VECTOR_LOG seems to be Empty/null: {ex.Message}") - WM_VECTOR_LOG = "" - End Try - WM_OBJEKTTYPE = oDataRow("WM_OBJEKTTYPE") - WM_IDX_BODY_TEXT = oDataRow("WM_IDX_BODY_TEXT") - WM_IDX_BODY_SUBSTR_LENGTH = oDataRow("WM_IDX_BODY_SUBSTR_LENGTH") - Dim oPathOriginal As String - Try - oPathOriginal = oDataRow("PATH_ORIGINAL") - Catch ex As Exception - oPathOriginal = "" - End Try - Dim oExtractMainPath As String = oDataRow("PATH_EMAIL_TEMP") + For Each oRow As DataRow In PM_ROW + DeleteMail = oRow("DELETE_MAIL") + CurrentMailProcessName = oRow.Item("PROCESS_NAME") + WM_REFERENCE_INDEX = oRow.ItemEx("WM_REFERENCE_INDEX", "") + WM_VECTOR_LOG = oRow.ItemEx("WM_VECTOR_LOG", "") + + WM_OBJEKTTYPE = oRow.Item("WM_OBJEKTTYPE") + WM_IDX_BODY_TEXT = oRow.Item("WM_IDX_BODY_TEXT") + WM_IDX_BODY_SUBSTR_LENGTH = oRow.Item("WM_IDX_BODY_SUBSTR_LENGTH") + Dim oPathOriginal As String = oRow.ItemEx("PATH_ORIGINAL", "") + Dim oExtractMainPath As String = oRow("PATH_EMAIL_TEMP") Try Dim oSplit As String() Dim oStorage As String @@ -367,7 +365,7 @@ Public Class clsWorkEmail End If End If Catch ex As Exception - Logger.Warn($"Unexpected Error in Extracting Storage from [{oExtractMainPath}]: {ex.Message}") + _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 @@ -376,28 +374,28 @@ Public Class clsWorkEmail 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") + _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") + _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}") + _Logger.Warn($"Unexpected Error in Checking RemainingTotalFreeSpace for Storage [{oExtractMainPath}]: {ex.Message}") End Try - If COPY2HDD(oDataRow("COPY_2_HDD"), oDataRow("PATH_ORIGINAL"), oDataRow("PATH_EMAIL_ERRORS"), True) = True Then - If EXTRACT_ATTACHMENTS(oExtractMainPath, oDataRow("PATH_EMAIL_ERRORS")) = True Then + If COPY2HDD(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 Return True Else - Logger.Warn("!##Returning false from EXTRACT_ATTACHMENTS!##") + _Logger.Warn("!##Returning false from EXTRACT_ATTACHMENTS!##") Return False End If Else @@ -410,17 +408,17 @@ Public Class clsWorkEmail Return True Catch ex As Exception - Logger.Error(ex) + _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 SAVE2TEMP() + Private Function SAVE2TEMP(pCurrentMail As IMail) As Boolean Dim oTempFilename As String Try Dim oTempPath As String = Path.Combine(Path.GetTempPath, "DD_EmailProfiler") - Logger.Debug($"oTempPath is: {oTempPath} ...") + _Logger.Debug($"oTempPath is: {oTempPath} ...") If Directory.Exists(oTempPath) = False Then Directory.CreateDirectory(oTempPath) End If @@ -435,14 +433,15 @@ Public Class clsWorkEmail Next oFileName Dim oResult As Boolean = False - ' Subject can be FILENAME_MAX_LENGTH chars at most, + ' 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(FILENAME_MAX_LENGTH) & ".eml" + 'Dim oSubjectFilename = CURRENT_MAIL_MESSAGE.Subject.Truncate(SUBJECT_MAX_LENGTH) & ".eml" + Dim oSubjectFilename = CURRENT_MAIL_MESSAGE_ID & ".eml" - Logger.Debug($"oSubjectFilename (beforeclean) is: {oSubjectFilename}") + _Logger.Debug($"oSubjectFilename (beforeclean) is: {oSubjectFilename}") oSubjectFilename = RemoveIllegalFileNameChars(oSubjectFilename) oTempFilename = oTempPath & "\" & oSubjectFilename - Logger.Debug($"oTempFilename (afterclean) is: {oTempFilename}") + _Logger.Debug($"oTempFilename (afterclean) is: {oTempFilename}") Dim oCounter As Integer = 1 'If File.Exists(oTempFilename) = True Then @@ -457,14 +456,14 @@ Public Class clsWorkEmail 'End If CURRENT_MAIL_MESSAGE.Save(oTempFilename) CURRENT_TEMP_MAIL_PATH = oTempFilename - Logger.Debug($"Email saved to Temppath {CURRENT_TEMP_MAIL_PATH}") + _Logger.Debug($"Email saved to Temppath {CURRENT_TEMP_MAIL_PATH}") oCounter = 0 Dim oCancel As Boolean Do While File.Exists(CURRENT_TEMP_MAIL_PATH) = False Thread.Sleep(1000) oCounter += 1 If oCounter > 10 Then - Logger.Warn("It took to long to save the mail to Temppath!") + _Logger.Warn("It took to long to save the mail to Temppath!") oCancel = True Exit Do End If @@ -479,40 +478,43 @@ Public Class clsWorkEmail '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}]") + _Logger.Error(ex) + _Logger.Info($"Unexpected error in Save2Temp [{oTempFilename}]") CURRENT_TEMP_MAIL_PATH = 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(pShouldCopyToDisk As Boolean, pPathOriginal 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 + _Logger.Debug("COPY_2_HDD is ACTIVE!") + 'PATH_ERROR = pPathErrors If Directory.Exists(pPathOriginal) Then Dim oTempFilename = pPathOriginal - If pUseMessageIdAsFilename = True Then - Dim oFileName = CURRENT_MAIL_MESSAGE_ID & ".eml" - oTempFilename = Path.Combine(oTempFilename, oFileName) + 'If pUseMessageIdAsFilename = True Then + ' Dim oFileName = CURRENT_MAIL_MESSAGE_ID & ".eml" + ' oTempFilename = Path.Combine(oTempFilename, oFileName) - 'oTempFilename &= "\" & CURRENT_MAIL_MESSAGE_ID & ".eml" - Else - Dim oFileName = CURRENT_MAIL_MESSAGE.Subject.Truncate(FILENAME_MAX_LENGTH).Replace(" ", "") & ".eml" - oTempFilename = Path.Combine(oTempFilename, oFileName) + ' 'oTempFilename &= "\" & CURRENT_MAIL_MESSAGE_ID & ".eml" + 'Else + ' Dim oFileName = CURRENT_MAIL_MESSAGE.Subject.Truncate(SUBJECT_MAX_LENGTH).Replace(" ", "") & ".eml" + ' oTempFilename = Path.Combine(oTempFilename, oFileName) - 'oTempFilename &= "\" & CURRENT_MAIL_MESSAGE.Subject.Replace(" ", "") & ".eml" - End If + ' 'oTempFilename &= "\" & CURRENT_MAIL_MESSAGE.Subject.Replace(" ", "") & ".eml" + 'End If + oTempFilename = Path.Combine(oTempFilename, $"{CURRENT_MAIL_MESSAGE_ID}.eml") 'Dim cleanPath As String = String.Join("", oTempFilename.Split(Path.GetInvalidPathChars())) If File.Exists(oTempFilename) = False Then Try File.Delete(oTempFilename) Catch ex As Exception - Logger.Error(ex) + _Logger.Error(ex) Return False End Try @@ -520,77 +522,42 @@ Public Class clsWorkEmail Dim oFileInfo As New FileInfo(oTempFilename) Dim oFileLenth As Long = oFileInfo.Length If oFileLenth > 0 Then - Logger.Info($"[COPY2HDD] Email saved to ({oTempFilename})") + _Logger.Info($"[COPY2HDD] Email saved to ({oTempFilename})") Return True Else - Logger.Warn($"##!! oFileLenth is 0 !!##") + _Logger.Warn("FileLenth of file [{0}] is 0! File will be deleted.", oTempFilename) Try File.Delete(oTempFilename) Catch ex As Exception - Logger.Error(ex) + _Logger.Error(ex) End Try Return False End If Else - Logger.Info("COPY2HDD (" & CURRENT_MAIL_MESSAGE.Subject & ") already existing in [{oTempFilename}]!", False, "RUN_THREAD.COPY_2_HDD") + _Logger.Info("COPY2HDD (" & CURRENT_MAIL_MESSAGE.Subject & ") already existing in [{oTempFilename}]!", False, "RUN_THREAD.COPY_2_HDD") Return True End If + Else + _Logger.Error("Destination directory [{0}] does not exist!", pPathOriginal) + Return False End If Else Return True End If Catch ex As Exception - Logger.Error(ex) + _Logger.Error(ex) Return False End Try End Function Private Function EXTRACT_BODY() TEMP_HTML_RESULTS.Clear() - Dim oDTFunctionRegex As DataTable = _DB_MSSQL.Return_Datatable("SELECT * FROM TBDD_FUNCTION_REGEX WHERE UPPER(FUNCTION_NAME) IN (UPPER('EMAIL_PROFILER - RemoveHTMLText'),UPPER('EMAIL_PROFILER - RemoveHTMLText1'))") + Dim oDTFunctionRegex As DataTable = _DB_MSSQL.GetDatatable("SELECT * FROM TBDD_FUNCTION_REGEX WHERE UPPER(FUNCTION_NAME) IN (UPPER('EMAIL_PROFILER - RemoveHTMLText'),UPPER('EMAIL_PROFILER - RemoveHTMLText1'))") - - 'Dim oMsg_email As New Independentsoft.Email.Mime.Message(CURRENT_TEMP_MAIL_PATH) Dim oBodyText As String = "" If Not IsNothing(CURRENT_MAIL_MESSAGE.Text) Then CURRENT_MAIL_BODY_ALL = oBodyText End If - 'If IsNothing(oMsg_email.Body) Then - ' Dim oAllBodyParts As New BodyPartCollection() - ' oAllBodyParts.Add(oMsg_email.BodyParts) - ' oAllBodyParts.Add(GetChildren(oMsg_email.BodyParts)) - ' For Each bodyPart As BodyPart In oAllBodyParts - ' If bodyPart.ContentType IsNot Nothing AndAlso bodyPart.ContentType.Type = "text" AndAlso bodyPart.ContentType.SubType = "plain" Then - ' If oBodyText = String.Empty Then - ' Logger.Debug(String.Format("BODY1-Text is....#{0}", bodyPart.Body)) - ' oBodyText = bodyPart.Body - ' Else - ' Continue For - ' End If - ' ElseIf bodyPart.ContentType IsNot Nothing AndAlso bodyPart.ContentType.Type = "text" AndAlso bodyPart.ContentType.SubType = "html" Then - ' If oBodyText = String.Empty Then - ' oBodyText = bodyPart.Body - ' Logger.Debug(String.Format("bodyhtml....#{0}", bodyPart.Body)) - ' Else - ' Continue For - ' End If - ' Logger.Debug(String.Format("bodyhtml....#{0}", bodyPart.Body)) - ' End If - ' Next - ' If oBodyText = "" Then - - ' Else - ' CURRENT_MAIL_BODY_ALL = oBodyText - - ' End If - 'Else - ' CURRENT_MAIL_BODY_ALL = oMsg_email.Body - 'End If - - - - - If Not IsNothing(CURRENT_MAIL_BODY_ALL) Then ' CURRENT_MAIL_BODY_ALL = oMsg_email.Body @@ -607,9 +574,6 @@ Public Class clsWorkEmail oPattern2 = "" End Try - - - Dim oReg As Regex = New Regex(oPattern1, RegexOptions.IgnoreCase) Dim oMatch As Match = oReg.Match(CURRENT_MAIL_BODY_ALL) Dim oClearedBodyText = CURRENT_MAIL_BODY_ALL @@ -617,7 +581,7 @@ Public Class clsWorkEmail oClearedBodyText = oClearedBodyText.Replace(oMatch.Value, "") oMatch = oMatch.NextMatch() Loop - Logger.Debug($"Cleared bodytext after Regex1 is: {oClearedBodyText}") + _Logger.Debug($"Cleared bodytext after Regex1 is: {oClearedBodyText}") Dim oReg2 As Regex = New Regex(oPattern2, RegexOptions.IgnoreCase) Dim oMatch2 As Match = oReg2.Match(oClearedBodyText) @@ -630,56 +594,25 @@ Public Class clsWorkEmail oMatch2 = oMatch2.NextMatch() Loop - Logger.Debug($"Cleared bodytext after Regex2 is: {oClearedBodyText}") + _Logger.Debug($"Cleared bodytext after Regex2 is: {oClearedBodyText}") CURRENT_MAIL_BODY_ALL = oClearedBodyText Else - Logger.Info($"Mailbody still is nothing after bodyExtraction!!") + _Logger.Info($"Mailbody still is nothing after bodyExtraction!!") End If - 'Try - ' Dim pattern1 As String = "" - ' For Each oRow As DataRow In oDTFunctionRegex.Rows - ' If oRow.Item("FUNCTION_NAME").ToString.ToUpper = "EMAIL_PROFILER - RemoveHTMLText".ToUpper Then - ' pattern1 = oRow.Item("REGEX") - - ' End If - ' Next - ' If pattern1 = String.Empty Then - ' Exit Try - ' End If - ' ' Instantiate the regular expression object. - ' Dim r As Regex = New Regex(pattern1, RegexOptions.Multiline) - ' ' Match the regular expression pattern against a text string. - ' Dim m As Match = r.Match(CURRENT_MAIL_BODY_ALL) - ' Dim oClearedBodyText = CURRENT_MAIL_BODY_ALL - ' Do While m.Success - ' oClearedBodyText = oClearedBodyText.Replace(m.Value, "") - ' 'Dim g As Group = m.Groups(1) - ' 'If g.ToString.StartsWith("&") = False Then - ' ' TEMP_HTML_RESULTS.Add(g.ToString()) - ' 'End If - - ' m = m.NextMatch() - ' Loop - ' Logger.Info($"Cleared bodytext is: {oClearedBodyText}") - ' CURRENT_MAIL_BODY_ALL = Trim(oClearedBodyText) - 'Catch ex As Exception - - 'End Try 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") + _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") MessageError = True Return False Else - Logger.Debug($"Length of Body is [{CURRENT_MAIL_BODY_ALL.Length}] - Body Text is [{CURRENT_MAIL_BODY_ALL}]") + _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 - Dim oAnswer2 As String For Each ostr As String In oSplit ostr = ostr.Replace(vbCrLf, "") If ostr = String.Empty Then @@ -704,112 +637,104 @@ Public Class clsWorkEmail Next - Logger.Debug(String.Format("MailBody-ANSWER1:...[{0}]", CURRENT_MAIL_BODY_ANSWER1)) - Logger.Debug(String.Format("MailBody-ANSWER2:...[{0}]", CURRENT_MAIL_BODY_Substr2)) + _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!") + _Logger.Warn("CURRENT_MAIL_BODY_ANSWER1 is String.Empty: So the answer will interpreted as empty!") End If Catch ex As Exception - Logger.Error(ex) + _Logger.Error(ex) 'clsLogger.Add("Unexpected Error in COPY2HDD: " & ex.Message & "MESSAGE_ID: " & CURRENT_MAIL_MESSAGE.MessageID, True) MessageError = True Return False End Try End Function - Private Function EXTRACT_ATTACHMENTS(pathemailtemp As String, pathemail_errors As String) - Logger.Debug("In EXTRACT_ATTACHMENTS...") - PATH_TEMP = pathemailtemp - PATH_ERROR = pathemail_errors - Logger.Debug(String.Format("PATH_TEMP[{0}]", PATH_TEMP)) + Private Function EXTRACT_ATTACHMENTS(pCurrentMail As MailContainer, pExtractPath As String, pErrorPath As String) + _Logger.Debug("In EXTRACT_ATTACHMENTS...") + 'PATH_EXTRACT_ATTACHMENTS = pExtractPath + 'PATH_ERROR = pErrorPath + _Logger.Debug(String.Format("PATH_TEMP[{0}]", pExtractPath)) Dim oAttachmentCount As Integer oAttachmentCount = 0 Try If CURRENT_TEMP_MAIL_PATH <> Nothing Then If File.Exists(CURRENT_TEMP_MAIL_PATH) Then - ' Dim oCurrentMail As New Independentsoft.Email.Mime.Message(CURRENT_TEMP_MAIL_PATH) - - 'For Each mime As MimeData In CURRENT_MAIL_MESSAGE.Attachments - ' mime.Save(mime.SafeFileName) - 'Next - For Each mime As MimeData In CURRENT_MAIL_MESSAGE.Attachments - ' For Each oAttachment As Attachment In oCurrentMail.GetAttachments - Dim oATTFilename = mime.SafeFileName.ToString.ToLower 'oAttachment.GetFileName.ToString.ToLower - Dim oValidExt As Boolean = False - If oATTFilename.EndsWith("pdf") Then - oValidExt = True - ElseIf oATTFilename.EndsWith("xls") Then - oValidExt = True - ElseIf oATTFilename.EndsWith("xlsx") Then - oValidExt = True - ElseIf oATTFilename.EndsWith("doc") Then - oValidExt = True - ElseIf oATTFilename.EndsWith("docx") Then - oValidExt = True - ElseIf oATTFilename.EndsWith("ppt") Then - oValidExt = True - ElseIf oATTFilename.EndsWith("pptx") Then - oValidExt = True - End If + + For Each oAttachment As MimeData In CURRENT_MAIL_MESSAGE.Attachments + Dim oATTFilename = oAttachment.SafeFileName.ToString.ToLower + + Dim oValidExtensions = New List(Of String) From {"pdf", "xls", "xlsx", "doc", "docx", "ppt", "pptx"} + Dim oValidExt = oValidExtensions.Any(Function(ext) oATTFilename.EndsWith(ext)) + If oValidExt = False Then - Logger.Debug(String.Format("Invalid FileExtension [{0}]", oATTFilename)) + _Logger.Debug("Invalid FileExtension [{0}]", oATTFilename) Continue For End If - Dim oAttachmentFileString - Logger.Info(String.Format(" Working on Attachment [{0}]", mime.SafeFileName)) 'oAttachment.GetFileName)) + + Dim oAttachmentFilePath = "" + _Logger.Info("Working on Attachment [{0}]", oAttachment.SafeFileName) Try - Dim oFilename = mime.SafeFileName 'oAttachment.GetFileName - oFilename = CleanInput(oFilename) - Logger.Debug($"oFilename [{oFilename}]") - If oFilename = String.Empty Then - oFilename = mime.SafeFileName 'oAttachment.GetFileName - End If - oAttachmentFileString = Path.Combine(PATH_TEMP, $"{CURRENT_MAIL_MESSAGE_ID}~{oFilename}") - Logger.Debug($"oAttachmentFileString [{oAttachmentFileString}]") + 'Dim oFilename = oAttachment.SafeFileName + 'oFilename = CleanInput(oFilename) + 'Logger.Debug($"oFilename [{oFilename}]") + 'If oFilename = String.Empty Then + ' oFilename = oAttachment.SafeFileName + 'End If + + '05.06.23 + 'The filename of attachments will be HASH~DOMAIN~SUBJECT(0,25) from now on + 'oAttachmentFileString = Path.Combine(PATH_TEMP, $"{CURRENT_MAIL_MESSAGE_ID}~{oFilename}") - If System.IO.File.Exists(oAttachmentFileString) = False Then - Logger.Debug(String.Format("Trying to save attachment [{0}]", oAttachmentFileString)) + Dim oAttachmentFileName = $"{CURRENT_MAIL_MESSAGE_ID}~{pCurrentMail.SenderDomain}~{oAttachment.SafeFileName}" + _Logger.Debug("Final Filename for Attachment: [{0}]", oAttachmentFileName) + + oAttachmentFilePath = Path.Combine(pExtractPath, oAttachmentFileName) + _Logger.Debug("Final Path for Attachment: [{0}]", oAttachmentFilePath) + + If System.IO.File.Exists(oAttachmentFilePath) = False Then + _Logger.Debug(String.Format("Trying to save attachment [{0}]", oAttachmentFilePath)) Try - mime.Save(oAttachmentFileString) + oAttachment.Save(oAttachmentFilePath) 'oAttachment.Save(oAttachmentFileString) - Dim oFileInfo As New FileInfo(oAttachmentFileString) + Dim oFileInfo As New FileInfo(oAttachmentFilePath) Dim oFileLenth As Long = oFileInfo.Length If oFileLenth > 2 Then - Logger.Info(String.Format("Attachment saved to [{0}]", oAttachmentFileString)) - INSERT_HISTORY_FB(CURRENT_MAIL_MESSAGE_ID, mime.SafeFileName) - INSERT_HISTORY_ATTMT_MSSQL(CURRENT_MAIL_MESSAGE_ID, mime.SafeFileName) + _Logger.Info(String.Format("Attachment saved to [{0}]", oAttachmentFilePath)) + INSERT_HISTORY_FB(CURRENT_MAIL_MESSAGE_ID, oAttachment.SafeFileName) + INSERT_HISTORY_ATTMT_MSSQL(CURRENT_MAIL_MESSAGE_ID, oAttachment.SafeFileName) oAttachmentCount += 1 Else - Logger.Warn($"##!! oFileLenth for AttachmentObjects is <2 !!##") + _Logger.Warn($"##!! oFileLenth for AttachmentObjects is <2 !!##") Try - File.Delete(oAttachmentFileString) + File.Delete(oAttachmentFilePath) Catch ex As Exception - Logger.Error(ex) + _Logger.Error(ex) End Try MessageError = True End If Catch ex As Exception - Logger.Warn($"Error while saving attachment-name: {ex.Message} - AttachmentName: {oAttachmentFileString}") + _Logger.Warn($"Error while saving attachment-name: {ex.Message} - AttachmentName: {oAttachmentFilePath}") MessageError = True End Try Else - Logger.Info("EXATTMNT - Attachment (" & oAttachmentFileString & ") already existing!", False, "EXTRACT_ATTACHMENTS") + _Logger.Warn("File [{0}] already exists!", oAttachmentFilePath) oAttachmentCount += 1 End If Catch ex As Exception - Logger.Warn($"Error while creating and saving attachment-name: {ex.Message} - AttachmentName: {oAttachmentFileString}") + _Logger.Warn($"Error while creating and saving attachment-name: {ex.Message} - AttachmentName: {oAttachmentFilePath}") MessageError = True End Try Next Else - Logger.Warn($"If cause 2 EXTRACT_ATTACHMENTS: {CURRENT_TEMP_MAIL_PATH} not existing") + _Logger.Warn($"If cause 2 EXTRACT_ATTACHMENTS: {CURRENT_TEMP_MAIL_PATH} not existing") End If Else - Logger.Warn($"EXTRACT_ATTACHMENTSIf cause 1: CURRENT_TEMP_MAIL_PATH is NOTHING") + _Logger.Warn($"EXTRACT_ATTACHMENTSIf cause 1: CURRENT_TEMP_MAIL_PATH is NOTHING") End If CURRENT_ATTMT_COUNT = oAttachmentCount If MessageError = True Then @@ -818,86 +743,74 @@ Public Class clsWorkEmail Return True End If Catch ex As Exception - Logger.Error(ex) - 'clsLogger.Add("Unexpected Error in COPY2HDD: " & ex.Message & "MESSAGE_ID: " & CURRENT_MAIL_MESSAGE.MessageID, True) + _Logger.Error(ex) MessageError = True Return False End Try End Function - Private Function CleanInput(strIn As String) As String - ' Replace invalid characters with empty strings. - Try - Return Regex.Replace(strIn, "[^\w\.@-]", "") - ' If we timeout when replacing invalid characters, - ' we should return String.Empty. - Catch ex As Exception - Logger.Error(ex) - Return String.Empty - End Try - End Function Private Function INSERT_HISTORY_MSSQL() As Boolean If MessageError = False Then Dim ins = $"INSERT INTO TBEMLP_HISTORY (WORK_PROCESS,EMAIL_MSGID,EMAIL_SUBJECT,EMAIL_DATE,EMAIL_BODY,EMAIL_SUBSTRING1,EMAIL_SUBSTRING2,EMAIL_FROM,PROFILE_ID) VALUES " & - $"('{CURRENT_MAIL_PROCESS_NAME}'," & - $"'{CURRENT_MAIL_MESSAGE_ID}'," & - $"'{CURRENT_MAIL_SUBJECT}'," & - $"'{CURRENT_MAIL_MESSAGE.Date}'," & - $"'{CURRENT_MAIL_BODY_ALL}'," & - $"'{CURRENT_MAIL_BODY_ANSWER1}'," & - $"'{CURRENT_MAIL_BODY_Substr2}'," & - $"'{CURRENT_MAIL_FROM}'," & - $"{CURRENT_PROFILE_GUID})" - Return _DB_MSSQL.Execute_non_Query(ins) + $"('{CurrentMailProcessName}'," & + $"'{CURRENT_MAIL_MESSAGE_ID}'," & + $"'{CURRENT_MAIL_SUBJECT}'," & + $"'{CURRENT_MAIL_MESSAGE.Date}'," & + $"'{CURRENT_MAIL_BODY_ALL}'," & + $"'{CURRENT_MAIL_BODY_ANSWER1}'," & + $"'{CURRENT_MAIL_BODY_Substr2}'," & + $"'{CURRENT_MAIL_FROM}'," & + $"{CURRENT_PROFILE_GUID})" + Return _DB_MSSQL.ExecuteNonQuery(ins) Else - Logger.Info("! No INSERT_HISTORY as MessageError = True") + _Logger.Info("! No INSERT_HISTORY as MessageError = True") Return False End If End Function Private Function INSERT_HISTORY_FB(oGUID As String, ATTMT1 As String) As Boolean - If IsNothing(_firebird) Then - Logger.Info("INSERT_HISTORY_FB: _firebird is nothing ") + If IsNothing(_DB_FIREBIRD) Then + _Logger.Info("INSERT_HISTORY_FB: _firebird is nothing ") Return False End If Try If MessageError = False Then Dim ins = $"INSERT INTO TBEDM_EMAIL_PROFILER_HISTORY (WORK_PROCESS,EMAIL_MSGID,EMAIL_FROM,EMAIL_SUBJECT,EMAIL_DATETIME,EMAIL_BODY,EMAIL_SUBSTRING1,EMAIL_SUBSTRING2,EMAIL_ATTMT1) VALUES " & - $"('{CURRENT_MAIL_PROCESS_NAME}'," & - $"'{oGUID}'," & - $"'{CURRENT_MAIL_FROM}'," & - $"'{CURRENT_MAIL_SUBJECT}'," & - $"'{CURRENT_MAIL_MESSAGE.Date}'," & - $"'{CURRENT_MAIL_BODY_ALL}'," & - $"'{CURRENT_MAIL_BODY_ANSWER1}'," & - $"'{CURRENT_MAIL_BODY_Substr2}'," & - $"'{ATTMT1}')" - Return _firebird.ExecuteNonQuery(ins) + $"('{CurrentMailProcessName}'," & + $"'{oGUID}'," & + $"'{CURRENT_MAIL_FROM}'," & + $"'{CURRENT_MAIL_SUBJECT}'," & + $"'{CURRENT_MAIL_MESSAGE.Date}'," & + $"'{CURRENT_MAIL_BODY_ALL}'," & + $"'{CURRENT_MAIL_BODY_ANSWER1}'," & + $"'{CURRENT_MAIL_BODY_Substr2}'," & + $"'{ATTMT1}')" + Return _DB_FIREBIRD.ExecuteNonQuery(ins) End If Catch ex As Exception - Logger.Error(ex) + _Logger.Error(ex) Return False End Try End Function Private Function INSERT_HISTORY_ATTMT_MSSQL(oMSGID As String, ATTMT1 As String) If IsNothing(_DB_MSSQL) Then - Logger.Info("INSERT_HISTORY_FB: _DB_MSSQL is nothing ") + _Logger.Info("INSERT_HISTORY_FB: _DB_MSSQL is nothing ") Return False End If Try If MessageError = False Then Dim ins = $"INSERT INTO TBEMLP_HISTORY_ATTACHMENT (WORK_PROCESS,EMAIL_MSGID,EMAIL_FROM,EMAIL_SUBJECT,EMAIL_DATETIME,EMAIL_BODY,EMAIL_ATTMT) VALUES " & - $"('{CURRENT_MAIL_PROCESS_NAME}'," & + $"('{CurrentMailProcessName}'," & $"'{oMSGID}'," & $"'{CURRENT_MAIL_FROM}'," & $"'{CURRENT_MAIL_SUBJECT}'," & $"'{CURRENT_MAIL_MESSAGE.Date}'," & $"'{CURRENT_MAIL_BODY_ALL}'," & $"'{ATTMT1}')" - _DB_MSSQL.Execute_non_Query(ins) + _DB_MSSQL.ExecuteNonQuery(ins) End If Catch ex As Exception - Logger.Error(ex) + _Logger.Error(ex) End Try End Function @@ -916,14 +829,14 @@ Public Class clsWorkEmail If CURRENT_MAIL_BODY_ANSWER1.ToUpper = oKeyWord.ToUpper Then _worked_email = True - Logger.Info(String.Format("Found Keyword '{0}' in MessageBody", oKeyWord)) + _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.Return_Datatable(sql) + 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) + _Logger.Info("No Indexing Steps found?! - SQL: " & sql) End If End If @@ -931,13 +844,13 @@ Public Class clsWorkEmail Next If oFoundSomething = False Then - Logger.Info($"None of the keywords was found...Keyword after Regex is '{0}'") + _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.Return_Datatable(sql) + 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...") + _Logger.Info($"An index for direct answer was configured. Therefore it will be used...") End If WORK_INDEXING_STEPS() _worked_email = True @@ -945,7 +858,7 @@ Public Class clsWorkEmail '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 & " - " & CURRENT_MAIL_PROCESS_NAME + Dim msg = Now.ToString & " - " & CurrentMailProcessName IndexFile(WM_VECTOR_LOG, msg, False) End If 'Now indexing the Body-Message Index @@ -957,7 +870,7 @@ Public Class clsWorkEmail Return True Catch ex As Exception MessageError = True - Logger.Error(ex) + _Logger.Error(ex) 'clsLogger.Add("Unexpected Error in WORK_POLL_STEPS: " & ex.Message & "MESSAGE_ID: " & CURRENT_MAIL_MESSAGE.MessageID, True) Return False End Try @@ -968,7 +881,7 @@ Public Class clsWorkEmail 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 _USE_WM Then + If _UseWindream Then IndexFile(INDEXNAME, INDEXVALUE, False) End If @@ -978,7 +891,7 @@ Public Class clsWorkEmail Catch ex As Exception MessageError = True - Logger.Error(ex) + _Logger.Error(ex) 'clsLogger.Add("Unexpected Error in WORK_INDEXING_STEPS: " & ex.Message & "MESSAGE_ID: " & CURRENT_MAIL_MESSAGE.MessageID, True) Return False End Try @@ -1014,8 +927,8 @@ Public Class clsWorkEmail 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!") + _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 @@ -1027,55 +940,55 @@ Public Class clsWorkEmail 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!") + _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() + 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.Return_DatatableCS("SELECT * FROM BaseAttributes WHERE dwDocID = " & oDOC_ID, WM_CON_STRING) + 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.Execute_Scalar(oSql) - Logger.Debug("CURRENT_DOC_PATH is: " & CURRENT_DOC_PATH) + 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) + _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) + _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) + _Logger.Warn("No record found for dwDocID " & oDOC_ID) Return False End If Else - Logger.Warn("DT_BASE_ATTR is nothing") + _Logger.Warn("DT_BASE_ATTR is nothing") Return False End If Else - Logger.Warn("Could not get a DOC-ID via regex!") + _Logger.Warn("Could not get a DOC-ID via regex!") Return False End If Catch ex As Exception - Logger.Error(ex) + _Logger.Error(ex) 'clsLogger.Add("Unexpected Error in GET_DOC_INFO: " & ex.Message & "MESSAGE_ID: " & CURRENT_MAIL_MESSAGE.MessageID) MessageError = True Return False @@ -1084,19 +997,19 @@ Public Class clsWorkEmail Public Function REGEX_CHECK_DOC_ID(SearchString As String) Try Dim regex As Regex = New Regex("\[DID#{1}([0-9]+)]{1}") - Logger.Debug("REGEX_String before replacing: '" & SearchString & "'") + _Logger.Debug("REGEX_String before replacing: '" & SearchString & "'") ' Regulären Ausdruck zum Auslesen der windream-Indexe definieren Dim elements As MatchCollection = regex.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)) + _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 MessageError = True - Logger.Error(ex) + _Logger.Error(ex) 'clsLogger.AddError("Unexpected error: " & ex.Message, "REGEX_CHECK_DOC_ID") Return Nothing End Try diff --git a/App/DigitalData.EMLProfiler/clsWorker.vb b/App/DigitalData.EMLProfiler/clsWorker.vb index 2f7b4f8..d07fe48 100644 --- a/App/DigitalData.EMLProfiler/clsWorker.vb +++ b/App/DigitalData.EMLProfiler/clsWorker.vb @@ -4,37 +4,37 @@ Imports DigitalData.Modules.Messaging Imports Limilabs.Mail Imports Limilabs.Mail.MIME Imports Limilabs.Mail.Headers +Imports DigitalData.Modules.Database + Public Class clsWorker Private Shared Logger As Logger - Private MyLogConfig As LogConfig 'Private _email As clsEmail - Private _emailIMAP As clsEmailIMAP - Private _Database As clsDatabase - Private _USE_WM As Boolean = False - Private _windream As clsWindream_allgemein - Private _windream_index As clsWindream_Index - Private _workmail As clsWorkEmail - Private _wrapper As clsEncryption - Private _POLL_PROFILEID As Integer = 0 - Private Eml_Limitation_Sender As String = "" - Dim cs As String - Sub New(EML_LIMITATION As String, LogConf As LogConfig, ConStr As String, POLL_PROFILEID As Integer, FB_DATASOURCE As String, FB_DATABASE As String, FB_USER As String, FB_PW As String, USE_WM As Boolean, EmailAccountID As Integer, EmlProfPraefix As String, Optional plocaleml As String = "") - MyLogConfig = LogConf - Logger = LogConf.GetLogger - _emailIMAP = New clsEmailIMAP(LogConf, ConStr) - _Database = New clsDatabase(LogConf, ConStr) - cs = ConStr + Private ReadOnly _emailIMAP As clsEmailIMAP + 'Private _Database As clsDatabase + Private ReadOnly _Database As MSSQLServer + Private ReadOnly _USE_WM As Boolean = False + Private ReadOnly _windream As clsWindream_allgemein + Private ReadOnly _windream_index As clsWindream_Index + Private ReadOnly _workmail As clsWorkEmail + Private ReadOnly _wrapper As clsEncryption + Private ReadOnly _POLL_PROFILEID As Integer = 0 + Private ReadOnly Eml_Limitation_Sender As String = "" + Sub New(EML_LIMITATION As String, pLogConfig As LogConfig, ConStr As String, WMConStr As String, POLL_PROFILEID As Integer, FB_DATASOURCE As String, FB_DATABASE As String, FB_USER As String, FB_PW As String, USE_WM As Boolean, EmailAccountID As Integer, EmlProfPraefix As String, Optional plocaleml As String = "") + Logger = pLogConfig.GetLogger + _emailIMAP = New clsEmailIMAP(pLogConfig) + _Database = New MSSQLServer(pLogConfig, ConStr) + _USE_WM = USE_WM Eml_Limitation_Sender = EML_LIMITATION If _USE_WM Then - _windream = New clsWindream_allgemein(LogConf) - _windream_index = New clsWindream_Index(LogConf) + _windream = New clsWindream_allgemein(pLogConfig) + _windream_index = New clsWindream_Index(pLogConfig) End If - _workmail = New clsWorkEmail(LogConf, ConStr, FB_DATASOURCE, FB_DATABASE, FB_USER, FB_PW, USE_WM, EmailAccountID, EmlProfPraefix) - _wrapper = New clsEncryption("!35452didalog=", LogConf) + _workmail = New clsWorkEmail(pLogConfig, ConStr, WMConStr, FB_DATASOURCE, FB_DATABASE, FB_USER, FB_PW, USE_WM, EmailAccountID, EmlProfPraefix) + _wrapper = New clsEncryption("!35452didalog=", pLogConfig) _POLL_PROFILEID = POLL_PROFILEID - ClassCurrent.CURRENT_DEBUG_LOCAL_EMAIL = plocaleml + CURRENT_DEBUG_LOCAL_EMAIL = plocaleml End Sub Public Sub Start_WorkingProfiles(Optional LocalEmail As Boolean = False) @@ -53,7 +53,7 @@ Public Class clsWorker Next TEMP_FILES.Clear() - If _Database.Init(cs) = True Then + If _Database.DBInitialized = True Then Logger.Debug("now windream_init... ") If _USE_WM Then If _windream.Init = False Then @@ -69,8 +69,8 @@ Public Class clsWorker Else osql &= " WHERE GUID = " & _POLL_PROFILEID End If - Dim DT_TBDD_EMAIL As DataTable = _Database.Return_Datatable("SELECT * FROM TBDD_EMAIL_ACCOUNT WHERE ACTIVE = 1") - Dim DT_PROFILES = _Database.Return_Datatable(osql) + Dim DT_TBDD_EMAIL As DataTable = _Database.GetDatatable("SELECT * FROM TBDD_EMAIL_ACCOUNT WHERE ACTIVE = 1") + Dim DT_PROFILES = _Database.GetDatatable(osql) If Not IsNothing(DT_PROFILES) Then If DT_PROFILES.Rows.Count > 0 Then Logger.Debug("count of active profiles: " & DT_PROFILES.Rows.Count.ToString) @@ -78,14 +78,14 @@ Public Class clsWorker CURRENT_PROFILE_GUID = oDR_Profile.Item("GUID") DT_POLL_PROCESS = Nothing Dim sql = String.Format("SELECT * FROM TBEMLP_POLL_PROCESS WHERE PROFILE_ID = {0} AND ACTIVE = 1", CURRENT_PROFILE_GUID) - DT_POLL_PROCESS = _Database.Return_Datatable(sql) + DT_POLL_PROCESS = _Database.GetDatatable(sql) If Not IsNothing(DT_POLL_PROCESS) Then If DT_POLL_PROCESS.Rows.Count = 0 Then Logger.Info("No processes configured for this Email-Profile - " & sql) Continue For Else DT_STEPS = Nothing - DT_STEPS = _Database.Return_Datatable(String.Format("SELECT T.* FROM TBEMLP_POLL_STEPS T,TBEMLP_POLL_PROCESS T1 WHERE T.PROCESS_ID = T1.GUID AND T1.PROFILE_ID = {0} AND T1.ACTIVE = 1", CURRENT_PROFILE_GUID)) + DT_STEPS = _Database.GetDatatable(String.Format("SELECT T.* FROM TBEMLP_POLL_STEPS T,TBEMLP_POLL_PROCESS T1 WHERE T.PROCESS_ID = T1.GUID AND T1.PROFILE_ID = {0} AND T1.ACTIVE = 1", CURRENT_PROFILE_GUID)) End If Else @@ -175,7 +175,7 @@ Public Class clsWorker If Not IsNothing(oEmail) Then If LIMIT_EMAIL_FROM Then - Dim oEmailFrom As String + Dim oEmailFrom As String = "" For Each m As MailBox In oEmail.From oEmailFrom = m.Address Next @@ -185,7 +185,7 @@ Public Class clsWorker End If End If If _workmail.WorkEmailMessage(oEmail, oUID) = True Then - If ClassCurrent.CURRENT_DEBUG_LOCAL_EMAIL = "" Then + If CURRENT_DEBUG_LOCAL_EMAIL = "" Then EMAIL_DELETE() End If End If @@ -216,7 +216,7 @@ Public Class clsWorker Logger.Warn("For the Email-Profile ID " & CURRENT_EMAIL_GUID & " no record could be found!") End If - _Database.Execute_non_Query("UPDATE TBEMLP_POLL_PROFILES SET LAST_TICK = GETDATE() WHERE GUID = " & oDR_Profile.Item("GUID").ToString) + _Database.ExecuteNonQuery("UPDATE TBEMLP_POLL_PROFILES SET LAST_TICK = GETDATE() WHERE GUID = " & oDR_Profile.Item("GUID").ToString) Else Logger.Warn("For the Email-Profile ID " & CURRENT_EMAIL_GUID & " no record could be found! Check wether Email-Profile is active!") End If @@ -245,7 +245,7 @@ Public Class clsWorker End If End If - _Database.Execute_non_Query("UPDATE TBEMLP_CONFIG SET LAST_TICK = GETDATE() WHERE GUID = 1") + _Database.ExecuteNonQuery("UPDATE TBEMLP_CONFIG SET LAST_TICK = GETDATE() WHERE GUID = 1") End If Catch ex As Exception Logger.Error(ex) diff --git a/App/SERV_EMAIL/MyService.vb b/App/SERV_EMAIL/MyService.vb index 18f3e1a..a42cb3b 100644 --- a/App/SERV_EMAIL/MyService.vb +++ b/App/SERV_EMAIL/MyService.vb @@ -1,15 +1,20 @@ Imports System.ComponentModel Imports System.IO Imports DigitalData.EMLProfiler -Imports DigitalData.EMLProfiler.ClassCurrent +Imports DigitalData.Modules.Database Imports DigitalData.Modules.Logging Public Class MyService #Region "+++++ variables +++++" Private _threadRunner As BackgroundWorker - Private MyLogger As LogConfig + Private LogConfig As LogConfig Private Logger As Logger - Private _database As clsDatabase + 'Private _database As clsDatabase Private _workmail As clsWorkEmail + + Private _ConfigManager As ClassConfig + Private _Config As ClassConfig.Config + + Private Database As MSSQLServer #End Region Public Sub New() MyBase.New() @@ -19,22 +24,9 @@ Public Class MyService ' Code zum Starten des Dienstes hier einfügen. Diese Methode sollte Vorgänge ' ausführen, damit der Dienst gestartet werden kann. Try - MyLogger = New LogConfig(LogConfig.PathType.CustomPath, Path.Combine(My.Application.Info.DirectoryPath, "Log"), Nothing, "Digital Data", "DD EmailProfiler") - Logger = MyLogger.GetLogger - - Try - Dim directory As New IO.DirectoryInfo(MyLogger.LogDirectory) - - For Each file As IO.FileInfo In directory.GetFiles - If (Now - file.CreationTime).Days > 29 Then - file.Delete() - Else - Exit For - End If - Next - Catch ex As Exception - - End Try + Dim oLogPath = Path.Combine(My.Application.Info.DirectoryPath, "Log") + LogConfig = New LogConfig(LogConfig.PathType.CustomPath, oLogPath, Nothing, "Digital Data", "DD EmailProfiler", 30) + Logger = LogConfig.GetLogger Logger.Info("## Service started ## ") @@ -43,23 +35,29 @@ Public Class MyService Else If My.Settings.DEBUG = True Then Logger.Info("DEBUG ACTIVATED") - MyLogger.Debug = True + LogConfig.Debug = True Else - MyLogger.Debug = False + LogConfig.Debug = False End If - _database = New clsDatabase(MyLogger, My.Settings.MyConnectionString) + Database = New MSSQLServer(LogConfig, My.Settings.MyConnectionString) + _ConfigManager = New ClassConfig(LogConfig, Database) + _Config = _ConfigManager.GetConfig() + + '_database = New clsDatabase(MyLogger, My.Settings.MyConnectionString) Logger.Debug("_database and _email initialized") - _workmail = New clsWorkEmail(MyLogger, My.Settings.MyConnectionString, My.Settings.FB_DATASOURCE, My.Settings.FB_DATABASE, My.Settings.FB_USER, My.Settings.FB_PW, + _workmail = New clsWorkEmail(LogConfig, My.Settings.MyConnectionString, _Config.WindreamConnectionString, My.Settings.FB_DATASOURCE, My.Settings.FB_DATABASE, My.Settings.FB_USER, My.Settings.FB_PW, My.Settings.USE_WM, My.Settings.EmailAccountID, My.Settings.EmailProfilerPraefix) Logger.Debug("_workmail initialized") - If _database.Init(My.Settings.MyConnectionString) = False Then + + If Database.DBInitialized = False Then Logger.Warn("ATTENTION: No Connection was established '" & My.Settings.MyConnectionString & "'!") Else '### Thread für das nachträgliche Setzen von Rechten generieren - _threadRunner = New BackgroundWorker() - _threadRunner.WorkerReportsProgress = True - _threadRunner.WorkerSupportsCancellation = True + _threadRunner = New BackgroundWorker With { + .WorkerReportsProgress = True, + .WorkerSupportsCancellation = True + } AddHandler _threadRunner.DoWork, AddressOf RUN_THREAD AddHandler _threadRunner.RunWorkerCompleted, AddressOf Thread1_Completed '### Den Timer generieren @@ -67,7 +65,7 @@ Public Class MyService 'Das Event hinterlegen welches bei "Tick" ausgelöst wird AddHandler Timer_Durchlauf.Elapsed, AddressOf Thread_Run ' Set the Interval - Timer_Durchlauf.Interval = (TIMER_INTERVALL * 60000) + Timer_Durchlauf.Interval = (_Config.TimerInterval * 60000) Timer_Durchlauf.Enabled = True Logger.Debug("...Timer started.") ' Und den Durchlauf das erste Mal starten @@ -86,7 +84,7 @@ Public Class MyService Public Sub RUN_THREAD(ByVal sender As Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Try Dim notcompleted As Boolean = False - Dim _work As New clsWorker(My.Settings.EML_LIMITATION_SENDER, MyLogger, My.Settings.MyConnectionString, 0, My.Settings.FB_DATASOURCE, My.Settings.FB_DATABASE, My.Settings.FB_USER, My.Settings.FB_PW, My.Settings.USE_WM, My.Settings.EmailAccountID, My.Settings.EmailProfilerPraefix) + Dim _work As New clsWorker(My.Settings.EML_LIMITATION_SENDER, LogConfig, My.Settings.MyConnectionString, _Config.WindreamConnectionString, 0, My.Settings.FB_DATASOURCE, My.Settings.FB_DATABASE, My.Settings.FB_USER, My.Settings.FB_PW, My.Settings.USE_WM, My.Settings.EmailAccountID, My.Settings.EmailProfilerPraefix) _work.Start_WorkingProfiles() Catch ex As Exception Logger.Error(ex) diff --git a/App/SERV_EMAIL/SERV_EMAIL.vbproj b/App/SERV_EMAIL/SERV_EMAIL.vbproj index 86f0b52..82d9210 100644 --- a/App/SERV_EMAIL/SERV_EMAIL.vbproj +++ b/App/SERV_EMAIL/SERV_EMAIL.vbproj @@ -48,6 +48,12 @@ On + + ..\..\..\DDModules\Base\bin\Debug\DigitalData.Modules.Base.dll + + + ..\wisag_check_Att\bin\Debug\DigitalData.Modules.Database.dll + ..\..\..\DDModules\Language\bin\Debug\DigitalData.Modules.Language.dll