MS: Emailservice und Logging

DDEmailService/EmailService.vb

@@ -64,6 +64,7 @@ Public Class EmailService
             End If
 
             If My.Settings.SQLSERVER_CS_TEST <> String.Empty Then
+
                 _MSSQL_Test = New MSSQLServer(_LogConfig, My.Settings.SQLSERVER_CS_TEST)
 
                 If _MSSQL_Test.DBInitialized = False Then
@@ -128,7 +129,7 @@ Public Class EmailService
     Private Sub QueueTimer_Elapsed(sender As Object, e As ElapsedEventArgs)
         If Not _EmailQueue.IsBusy Then
             _EmailQueue.RunWorkerAsync()
-            _Logger.Info("Worker is ready, executing.")
+            _Logger.Debug("Worker is ready, executing.")
         Else
             _Logger.Info("Worker is busy, skipping execution.")
         End If
@@ -137,17 +138,17 @@ Public Class EmailService
     Private Sub EmailQueue_DoWork(sender As Object, e As DoWorkEventArgs)
         Try
             If _Firebird?._DBInitialized Then
-                _Logger.Info("Starting Firebird Sending")
+                _Logger.Debug("Starting Firebird Sending")
                 SendEmailFrom(DatabaseType.Firebird, Nothing)
             End If
 
             If _MSSQL?.DBInitialized Then
-                _Logger.Info("Starting MSSQL Sending")
+                _Logger.Debug("Starting MSSQL Sending")
                 SendEmailFrom(DatabaseType.MSSQL, _MSSQL)
             End If
 
             If _MSSQL_Test?.DBInitialized Then
-                _Logger.Info("Starting MSSQL Test Sending")
+                _Logger.Debug("Starting MSSQL Test Sending")
                 SendEmailFrom(DatabaseType.MSSQL, _MSSQL_Test)
             End If
         Catch ex As Exception
@@ -197,7 +198,7 @@ Public Class EmailService
             End If
 
             If oEmailQueue.Rows.Count = 0 Then
-                _Logger.Info("Email Queue is empty. Exiting.")
+                _Logger.Debug("Email Queue is empty. Exiting.")
                 Return False
             End If
 
@@ -295,9 +296,10 @@ Public Class EmailService
                 End If
 
                 Dim oEmailSent As Boolean = False
-                oEmailSent = _Email.NewEmail(oEmailTo, oSubject, oBody, oMailFrom, oMailSMTP, oMailport, oMailUser, oMailPW, oAuthType, "DDEmailService", oAttachment)
+                oEmailSent = _Email.New_EmailISoft(oSubject, oBody, oEmailTo, oMailFrom, oMailSMTP, oMailport, oMailUser, oMailPW, oAuthType, "DDEmailService", oAttachment)
 
                 If oEmailSent Then
+
                     Select Case Database
                         Case DatabaseType.Firebird
                             oSQL = $"UPDATE TBEDM_EMAIL_QUEUE SET EMAIL_SENT = CURRENT_TIMESTAMP,COMMENT = '{oComment}' WHERE GUID = {oGuid}"
@@ -312,12 +314,14 @@ Public Class EmailService
                             End If
                             MSSQLInstance.NewExecutenonQuery(oSQL)
                     End Select
+                    _Logger.Info($"Email has been send to: {oEmailTo} - Subject: {oSubject}")
+                    Threading.Thread.Sleep(500)
                 End If
             Next
 
             Return True
         Catch ex As Exception
-            _Logger.Warn("Error in SendEmailFromFirebird. Email was not sent.")
+            _Logger.Warn("Error in SendEmailFrom. Email was not sent.")
             _Logger.Error(ex)
             Return False
         End Try

DDEmailService/ProjectInstaller.Designer.vb

@@ -32,6 +32,7 @@
         '
         'ServiceInstaller1
         '
+        Me.ServiceInstaller1.Description = "Sends all emails from Digital Data Modules"
         Me.ServiceInstaller1.DisplayName = "Digital Data Email Service"
         Me.ServiceInstaller1.ServiceName = "DDEmailService"
         '

Modules.Config/ConfigManager.vb

@@ -16,6 +16,7 @@ Public Class ConfigManager(Of T)
     Private ReadOnly _UserConfigPath As String
     Private ReadOnly _ComputerDirectory As String
     Private ReadOnly _ComputerConfigPath As String
+    Private ReadOnly _AppConfigPath As String
 
     Private ReadOnly _TestMode As Boolean = False
 
@@ -56,6 +57,11 @@ Public Class ConfigManager(Of T)
             Return _ComputerConfigPath
         End Get
     End Property
+    Public ReadOnly Property AppConfigPath As String
+        Get
+            Return _AppConfigPath
+        End Get
+    End Property
 
     ''' <summary>
     ''' Creates a new instance of the ConfigManager
@@ -65,7 +71,7 @@ Public Class ConfigManager(Of T)
     ''' <param name="UserConfigPath">The path to check for a user config file, eg. AppData (Usually Application.UserAppDataPath or Application.LocalUserAppDataPath)</param>
     ''' <param name="ComputerConfigPath">The path to check for a computer config file, eg. ProgramData (Usually Application.CommonAppDataPath)</param>
     ''' <param name="ForceUserConfig">Override values from ComputerConfig with UserConfig</param>
-    Public Sub New(LogConfig As LogConfig, UserConfigPath As String, ComputerConfigPath As String, Optional ForceUserConfig As Boolean = False)
+    Public Sub New(LogConfig As LogConfig, UserConfigPath As String, ComputerConfigPath As String, ApplicationStartupPath As String, Optional ForceUserConfig As Boolean = False)
         _LogConfig = LogConfig
         _Logger = LogConfig.GetLogger()
         _File = New Filesystem.File(_LogConfig)
@@ -80,6 +86,7 @@ Public Class ConfigManager(Of T)
 
         _UserConfigPath = Path.Combine(_UserDirectory, USER_CONFIG_NAME)
         _ComputerConfigPath = Path.Combine(_ComputerDirectory, COMPUTER_CONFIG_NAME)
+        _AppConfigPath = Path.Combine(ApplicationStartupPath, "AppConfig.xml")
 
         Config = LoadConfig()
     End Sub
@@ -89,8 +96,8 @@ Public Class ConfigManager(Of T)
     ''' </summary>
     ''' <param name="LogConfig">LogConfig instance</param>
     ''' <param name="ConfigPath">The path to check for a user config file, eg. AppData (Usually Application.UserAppDataPath or Application.LocalUserAppDataPath)</param>
-    Public Sub New(LogConfig As LogConfig, ConfigPath As String)
+    Public Sub New(LogConfig As LogConfig, ConfigPath As String, ApplicationStartupPath As String)
-        MyClass.New(LogConfig, ConfigPath, ConfigPath, ForceUserConfig:=True)
+        MyClass.New(LogConfig, ConfigPath, ConfigPath, ApplicationStartupPath, ForceUserConfig:=True)
     End Sub
 
     ''' <summary>
@@ -155,13 +162,35 @@ Public Class ConfigManager(Of T)
     Private Function LoadConfig() As T
         ' first create an empty/default config object
         Dim oConfig = Activator.CreateInstance(_BlueprintType)
-        ' then Try to load computer config
+
-        oConfig = LoadComputerConfig(oConfig)
+        oConfig = LoadAppConfig(oConfig)
+        If oConfig Is Nothing Then
+            oConfig = Activator.CreateInstance(_BlueprintType)
+            ' then Try to load computer config
+            oConfig = LoadComputerConfig(oConfig)
+        End If
+
         ' now try to load userconfig
         oConfig = LoadUserConfig(oConfig)
         Return oConfig
     End Function
+    Private Function LoadAppConfig(ByVal Config As T) As T
+        If File.Exists(_AppConfigPath) Then
+            Try
+                Dim oAppConfig = ReadFromFile(_AppConfigPath)
+                CopyValues(oAppConfig, Config)
+            Catch ex As Exception
+                _Logger.Error(ex)
+                _Logger.Warn("ApplicationConfig could not be loaded!")
+            End Try
+        Else
+            _Logger.Debug("ApplicationConfig does not exist.")
+            _ForceUserConfig = True
+            Return Nothing
+        End If
 
+        Return Config
+    End Function
 
     Private Function LoadComputerConfig(ByVal Config As T) As T
         If File.Exists(_ComputerConfigPath) Then

Modules.Jobs/EDMI/ZUGFeRD/ImportZUGFeRDFiles.vb

@@ -150,7 +150,17 @@ Public Class ImportZUGFeRDFiles
         Return oEmailData
     End Function
 
-    Private Sub AddToEmailQueue(MessageId As String, BodyText As String, EmailData As EmailData)
+    Private Sub AddRejectedState(oMessageID As String, oTitle As String, oTitle1 As String, oComment As String)
+        Try
+            Dim oSQL = $"EXEC PRCUST_ADD_HISTORY_STATE '{oMessageID}','{oTitle}','{oTitle1}','{oComment}'"
+            _mssql.NewExecutenonQuery(oSQL)
+            '@MessageID VARCHAR(250), @TITLE1 VARCHAR(250), @TITLE2 VARCHAR(250)
+        Catch ex As Exception
+            _logger.Error(ex)
+        End Try
+    End Sub
+
+    Private Sub AddToEmailQueueFB(MessageId As String, BodyText As String, EmailData As EmailData)
         If EmailData Is Nothing Then
             _logger.Warn("EmailData is empty. Email will not be sent!")
             Exit Sub
@@ -182,6 +192,7 @@ Public Class ImportZUGFeRDFiles
             Dim osql = $"select * from TBEDM_EMAIL_QUEUE where REFERENCE1 = '{oReference} and EMAIL_TO = ''{oEmailTo}' and EMAIL_SUBJ = '{oSubject}'"
 
             Dim oDTResult As DataTable = _firebird.GetDatatable(osql)
+
             If oDTResult.Rows.Count = 0 Then
                 Dim oSQLInsert = $"INSERT INTO TBEDM_EMAIL_QUEUE "
                 oSQLInsert &= "(JOB_ID, REFERENCE1, EMAIL_ACCOUNT_ID, EMAIL_TO, EMAIL_SUBJ, EMAIL_BODY, CREATEDWHO, EMAIL_ATTMT1) VALUES "
@@ -195,7 +206,73 @@ Public Class ImportZUGFeRDFiles
             _logger.Error(ex)
         End Try
     End Sub
+    Private Sub AddToEmailQueueMSSQL(MessageId As String, BodyText As String, EmailData As EmailData, SourceProcedure As String)
+        If EmailData Is Nothing Then
+            _logger.Warn("EmailData is empty. Email will not be sent!")
+            Exit Sub
+        End If
 
+        Try
+            Dim oJobId = RandomValue(1, 10000)
+            Dim oReference = MessageId
+            Dim oEmailTo = ""
+            Dim oSubject = EMAIL_SUBJECT
+            Dim oAccountId = 1
+            Dim oCreatedWho = "ZUGFeRD Service"
+            Dim oFinalBodyText = String.Format(EMAIL_WRAPPING_TEXT, BodyText)
+
+            Dim oEmailAddress = EmailData.From
+            Dim oAttachment = EmailData.Attachment
+
+            If IsNothing(oEmailAddress) OrElse String.IsNullOrWhiteSpace(oEmailAddress) Then
+                _logger.Warn("Could not find email-address for MessageId {0}", MessageId)
+                oEmailTo = String.Empty
+            Else
+                oEmailTo = oEmailAddress
+            End If
+
+            _logger.Debug("Generated Email:")
+            _logger.Debug("To: {0}", oEmailTo)
+            _logger.Debug("Subject: {0}", oSubject)
+            _logger.Debug("Body {0}", oFinalBodyText)
+            Dim osql = $"Select MAX(GUID) FROM TBEMLP_HSITORY WHERE EMAIL_MSG_ID = '{MessageId}'"
+            Dim oHistoryID = _mssql.GetScalarValue(osql)
+
+            osql = $"select * from TBEDM_EMAIL_QUEUE where REFERENCE_ID = {oHistoryID} and EMAIL_ADRESS = '{oEmailTo}' and EMAIL_SUBJ = '{oSubject}'"
+
+            Dim oDTResult As DataTable = _mssql.GetDatatable(osql)
+
+            If IsNumeric(oHistoryID) And oDTResult.Rows.Count = 0 Then
+                Dim oInsert = $"INSERT INTO [dbo].[TBEMLP_EMAIL_OUT] ([REMINDER_TYPE_ID],[SENDING_PROFILE],
+                       ,[REFERENCE_ID]
+                       ,[REFERENCE_STRING]
+                       ,[EMAIL_ADRESS]
+                       ,[EMAIL_SUBJ]
+                       ,[EMAIL_BODY]
+                       ,[COMMENT]
+                       ,[ADDED_WHO])
+                 VALUES
+                       (99
+                       ,{oAccountId}
+                       ,{oHistoryID}
+                       ,'{MessageId}'
+                       ,'{oEmailTo}'
+                       ,'{oSubject}'
+                       ,'{oFinalBodyText}'
+                       ,'{SourceProcedure}'
+                       ,'{oCreatedWho}'"
+                _mssql.ExecuteNonQuery(oInsert)
+            Else
+                If oDTResult.Rows.Count = 0 Then
+                    _logger.Debug("Email has already been sent!!")
+                Else
+                    _logger.Debug("Could not get oHistoryID!!")
+                End If
+            End If
+        Catch ex As Exception
+            _logger.Error(ex)
+        End Try
+    End Sub
     Private Function GetMessageIdFromFileName(Filename As String) As String
         ' Regex to find MessageId
         ' See also: https://stackoverflow.com/questions/3968500/regex-to-validate-a-message-id-as-per-rfc2822
@@ -562,8 +639,8 @@ Public Class ImportZUGFeRDFiles
 
                             Dim oBody = EMAIL_MD5_ERROR
                             Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oFileGroupId)
-                            AddToEmailQueue(oFileGroupId, oBody, oEmailData)
+                            AddToEmailQueueMSSQL(oFileGroupId, oBody, oEmailData, "MD5HashException")
-
+                            AddRejectedState(oFileGroupId, "MD5HashException", "Die gesendete Rechnung wurde bereits verarbeitet!", "")
                         Catch ex As InvalidFerdException
                             _logger.Error(ex)
 
@@ -572,7 +649,8 @@ Public Class ImportZUGFeRDFiles
                             _firebird.ExecuteNonQuery(oSQL)
                             Dim oBody = EMAIL_INVALID_DOCUMENT
                             Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oFileGroupId)
-                            AddToEmailQueue(oFileGroupId, oBody, oEmailData)
+                            AddToEmailQueueMSSQL(oFileGroupId, oBody, oEmailData, "InvalidFerdException")
+                            AddRejectedState(oFileGroupId, "InvalidFerdException", "Inkorrekte Formate", "")
                         Catch ex As TooMuchFerdsException
                             _logger.Error(ex)
 
@@ -581,7 +659,8 @@ Public Class ImportZUGFeRDFiles
                             _firebird.ExecuteNonQuery(oSQL)
                             Dim oBody = EMAIL_TOO_MUCH_FERDS
                             Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oFileGroupId)
-                            AddToEmailQueue(oFileGroupId, oBody, oEmailData)
+                            AddToEmailQueueMSSQL(oFileGroupId, oBody, oEmailData, "TooMuchFerdsException")
+                            AddRejectedState(oFileGroupId, "TooMuchFerdsException", "Email enthielt mehr als ein ZUGFeRD-Dokument", "")
                         Catch ex As NoFerdsException
                             _logger.Error(ex)
 
@@ -590,7 +669,8 @@ Public Class ImportZUGFeRDFiles
                             _firebird.ExecuteNonQuery(oSQL)
                             Dim oBody = EMAIL_NO_FERDS
                             Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oFileGroupId)
-                            AddToEmailQueue(oFileGroupId, oBody, oEmailData)
+                            AddToEmailQueueMSSQL(oFileGroupId, oBody, oEmailData, "NoFerdsException")
+                            AddRejectedState(oFileGroupId, "NoFerdsException", " Email enthielt keine ZUGFeRD-Dokumente", "")
                         Catch ex As MissingValueException
                             _logger.Error(ex)
 
@@ -604,14 +684,16 @@ Public Class ImportZUGFeRDFiles
 
                             Dim oBody = CreateBodyForMissingProperties(ex.File.Name, oMissingProperties)
                             Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oFileGroupId)
-                            AddToEmailQueue(oFileGroupId, oBody, oEmailData)
+                            AddToEmailQueueMSSQL(oFileGroupId, oBody, oEmailData, "MissingValueException")
+                            AddRejectedState(oFileGroupId, "MissingValueException", "Es fehlten ZugferdSpezifikationen", oMessage)
+
                         Catch ex As Exception
                             _logger.Warn("Unknown Error occurred: {0}", ex.Message)
                             _logger.Error(ex)
                             Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - Unknown error occured' WHERE GUID = '{HISTORY_ID}'"
                             _firebird.ExecuteNonQuery(oSQL)
-
                             oMoveDirectory = oArgs.ErrorDirectory
+                            AddRejectedState(oFileGroupId, "UnexpectedException", "", ex.Message)
                         Finally
                             oConnection.Close()
 

Modules.Logging/LogConfig.vb

@@ -156,7 +156,7 @@ Public Class LogConfig
         End Get
         Set(isDebug As Boolean)
             Me.isDebug = isDebug
-            GetLogger().Info("=> Debug is now {0}", isDebug)
+            'GetLogger().Debug("=> Debug is now {0}", isDebug)
             ReloadConfig(isDebug)
         End Set
     End Property

Modules.Messaging/Email.vb

@@ -360,7 +360,142 @@ Public Class Email
         End Try
 
     End Function
+    Public Function New_EmailISoft(ByVal mailSubject As String, ByVal mailBody As String, mailto As String,
+                                                     mailfrom As String, mailsmtp As String, mailport As Integer, mailUser As String, mailPW As String,
+                                                     AUTH_TYPE As String, SENDER_INSTANCE As String, Optional attment As String = "")
+        Try
+            ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls12
+            _logger.Debug($"in Email_Send_Independentsoft..")
+            Dim empfaenger As String()
+            If mailto.Contains(";") Then
+                empfaenger = mailto.Split(";")
+            Else
+                ReDim Preserve empfaenger(0)
+                empfaenger(0) = mailto
+            End If
+            Dim _error As Boolean = False
+            'Für jeden Empfänger eine Neue Mail erzeugen
+            For Each _mailempfaenger As String In empfaenger
+                _logger.Debug($"Working on email for {_mailempfaenger}..")
+                Try
+                    Dim message As New Message()
+                    message.From = New Mailbox(mailfrom, mailfrom)
+                    message.[To].Add(New Mailbox(_mailempfaenger))
+                    message.Subject = mailSubject
+                    _logger.Debug($"Message created..")
+                    Dim textBodyPart As New BodyPart()
+                    textBodyPart.ContentType = New ContentType("text", "html", "utf-8")
+                    textBodyPart.ContentTransferEncoding = ContentTransferEncoding.QuotedPrintable
+                    textBodyPart.Body = mailBody
+                    message.BodyParts.Add(textBodyPart)
+                    If attment <> String.Empty Then
+                        If System.IO.File.Exists(attment) Then
+                            Dim attachment1 As New Independentsoft.Email.Mime.Attachment(attment)
+                            If attment.ToLower.EndsWith("pdf") Then
+                                attachment1.ContentType = New ContentType("application", "pdf")
+                            ElseIf attment.ToLower.EndsWith("jpg") Then
+                                attachment1.ContentType = New ContentType("application", "jpg")
+                            ElseIf attment.ToLower.EndsWith("docx") Then
+                                attachment1.ContentType = New ContentType("application", "MS-word")
+                            End If
+                            message.BodyParts.Add(attachment1)
+                        Else
+                            _logger.Warn($"Attachment {attment.ToString} is not existing!")
+                        End If
+                    End If
+                    Dim client As Independentsoft.Email.Smtp.SmtpClient
+                    Try
+                        client = New Independentsoft.Email.Smtp.SmtpClient(mailsmtp, mailport)
+                    Catch ex As Exception
+                        _logger.Warn("clsEmail.Create Client: " & ex.Message)
+                        _error = True
+                        Continue For
+                    End Try
+                    Try
+                        client.Connect()
+                    Catch ex As Exception
+                        _logger.Warn("clsEmail.Client.Connect1: " & ex.Message)
+                        _logger.Debug("Error in ClientConnect - but still trying to send")
+                        _error = True
+                        ' Continue For
+                    End Try
+                    _logger.Debug("Connected to Client!")
+                    If AUTH_TYPE = "SSL" Then
+                        client.EnableSsl = True
+                        'client.ValidateRemoteCertificate = True
+                        _logger.Debug("Authentification via SSL.")
+                    ElseIf AUTH_TYPE = "TLS" Then
+                        ' client.ValidateRemoteCertificate = False
+                        client.StartTls()
+                        client.EnableSsl = False
+                        _logger.Debug("Authentification via TLS. SSL disabled")
+                    Else
+                        client.EnableSsl = False
+                        _logger.Debug("Authentification NONE. SSL disabled")
+                    End If
+                    Try
 
+                        client.Connect()
+                    Catch ex As Exception
+                        _logger.Warn("clsEmail.Client.Connect: " & ex.Message)
+                        _error = True
+                        ' Continue For
+                    End Try
+                    Try
+                        If mailsmtp.Contains("office365.com") Then
+                            client.Login(mailUser, mailPW, AuthenticationType.None)
+                        Else
+                            client.Login(mailUser, mailPW)
+                        End If
+
+                        _logger.Debug("Logged in!")
+                    Catch ex As Exception
+                        Try
+                            If mailsmtp.Contains("office365.com") Then
+                                client.Login(mailUser, mailPW, AuthenticationType.Login)
+                            Else
+                                client.Login(mailUser, mailPW, AuthenticationType.Anonymous)
+                            End If
+
+                        Catch ex1 As Exception
+                            Try
+                                client.Login(mailUser, mailPW, AuthenticationType.Login)
+                            Catch ex2 As Exception
+                                _logger.Warn("clsEmail.Client.Login: " & ex.Message)
+                                _error = True
+                                client.Disconnect()
+                                Continue For
+                            End Try
+                        End Try
+                    End Try
+                    Try
+                        client.Send(message)
+                        _logger.Info("Message to " & _mailempfaenger & " has been send.")
+                        _error = False
+                    Catch ex As Exception
+                        _logger.Warn("clsEmail.Client.Send: " & ex.Message)
+                        _error = True
+                        client.Disconnect()
+                        Continue For
+                    End Try
+                    client.Disconnect()
+
+                Catch ex As Exception
+                    _logger.Error(ex)
+                    _error = True
+                End Try
+            Next
+
+            If _error = True Then
+                Return False
+            Else
+                Return True
+            End If
+        Catch ex As Exception
+            _logger.Error(ex)
+            Return False
+        End Try
+    End Function
     Public Function DELETE_EMAIL(POLLTYPE As String, msgid As String, MYMAIL_SERVER As String, MYMAIL_PORT As Integer, MYMAIL_USER As String, MYMAIL_USER_PW As String)
         Try
             If POLLTYPE = "POP" Then