Imports System.ComponentModel Imports DigitalData.Modules.Logging Imports DigitalData.Modules.Database Imports DigitalData.Modules.Messaging Imports DigitalData.EMLProfiler Imports System.IO Public Class MyComService Private myLogger As Logger Private MyLoConfig As LogConfig Private _firebird As Firebird Private _MSSQL As MSSQLServer Private _Email As Email Private _EmailAlt As clsEmail Public Shared threadEmailQueue As BackgroundWorker Protected Overrides Sub OnStart(ByVal args() As String) ' Code zum Starten des Dienstes hier einfügen. Diese Methode sollte Vorgänge ' ausführen, damit der Dienst gestartet werden kann. Try MyLoConfig = New LogConfig(LogConfig.PathType.CustomPath, Path.Combine(My.Application.Info.DirectoryPath, "Log")) If My.Settings.LOG_ERRORS_ONLY = False Then MyLoConfig.Debug = True Else MyLoConfig.Debug = False End If myLogger = MyLoConfig.GetLogger() _firebird = New Firebird(MyLoConfig, My.Settings.FB_ConnString, My.Settings.FB_DATABASE, My.Settings.FB_USER, My.Settings.FB_PW) _Email = New Email(MyLoConfig) _EmailAlt = New clsEmail(MyLoConfig) _MSSQL = New MSSQLServer(MyLoConfig, My.Settings.SQLSERVER_CS) If _firebird._DBInitialized = True Then MyComService.threadEmailQueue = New BackgroundWorker() MyComService.threadEmailQueue.WorkerReportsProgress = True MyComService.threadEmailQueue.WorkerSupportsCancellation = True AddHandler threadEmailQueue.DoWork, AddressOf RunThread_EmailQueue AddHandler threadEmailQueue.RunWorkerCompleted, AddressOf ThreadEMailQueue_Completed ' Und den Durchlauf das erste Mal starten threadEmailQueue.RunWorkerAsync() '### Den Timer generieren Dim Timer1_OneMinute As New System.Timers.Timer() 'Das Event hinterlegen welches bei "Tick" ausgelöst wird AddHandler Timer1_OneMinute.Elapsed, AddressOf Timer1_Tick ' Set the Interval Timer1_OneMinute.Interval = 60000 'ClassLogger.Add("Timer - Intervall: " & clsSQLITE.konf_intervall & " Minuten", False) Timer1_OneMinute.Enabled = True myLogger.Debug("Timer1_OneMinute started...") End If Catch ex As Exception If Not IsNothing(MyLoConfig.LogFile) And File.Exists(MyLoConfig.LogFile) Then myLogger.Error(ex) End If End Try End Sub Public Sub Timer1_Tick() If Not threadEmailQueue.IsBusy Then threadEmailQueue.RunWorkerAsync() End If End Sub Protected Overrides Sub OnStop() Try ' Hier Code zum Ausführen erforderlicher Löschvorgänge zum Beenden des Dienstes einfügen. myLogger.Warn("Service has been stopped!") Catch ex As Exception myLogger.Error(ex) End Try End Sub Public Sub RunThread_EmailQueue(ByVal sender As Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Try MyLoConfig = New LogConfig(LogConfig.PathType.CustomPath, Path.Combine(My.Application.Info.DirectoryPath, "Log")) myLogger = MyLoConfig.GetLogger() If My.Settings.LOG_ERRORS_ONLY = False Then MyLoConfig.Debug = True Else MyLoConfig.Debug = False End If _Email = New Email(MyLoConfig) _firebird = New Firebird(MyLoConfig, My.Settings.FB_ConnString, My.Settings.FB_DATABASE, My.Settings.FB_USER, My.Settings.FB_PW) If _firebird._DBInitialized = False Then myLogger.Warn("Firebird-DB could not be intitialized!") Exit Sub End If SEND_FROM_FBDB() SEND_FROM_MSSQL() Catch ex As Exception myLogger.Error(ex) End Try End Sub Private Function SEND_FROM_FBDB() Try Dim oComment As String Dim oSQL = "SELECT * FROM TBEDM_EMAIL_ACCOUNT WHERE ACTIVE = True" Dim oDT_EMAIL_ACCOUNT As DataTable = _firebird.GetDatatable(oSQL) If IsNothing(oDT_EMAIL_ACCOUNT) Then myLogger.Warn("DT_EMAIL_ACCOUNT is nothing!") Return False End If oSQL = "SELECT * FROM TBEDM_EMAIL_QUEUE WHERE EMAIL_SENT IS NULL and EMAIL_TO <> ''" Dim oDT_EMAIL_QUEUE As DataTable = _firebird.GetDatatable(oSQL) If Not IsNothing(oDT_EMAIL_QUEUE) And oDT_EMAIL_ACCOUNT.Rows.Count >= 1 Then Dim oEmailTo, oSubject, oBody As String Dim oEMAILACCOUNT_ID, oGUID, oJOB_ID As Integer For Each oNewEmailTo_Row As DataRow In oDT_EMAIL_QUEUE.Rows oEMAILACCOUNT_ID = oNewEmailTo_Row.Item("EMAIL_ACCOUNT_ID") Dim oMailFrom, oMailSMTP, oMailport, oMailUser, oMailPW, oAuthType, oAttachment Dim oACCOUNT_MATCH As Boolean = False For Each oEmailAccountRow As DataRow In oDT_EMAIL_ACCOUNT.Rows If oEmailAccountRow.Item("GUID") = oEMAILACCOUNT_ID Then oACCOUNT_MATCH = True oMailFrom = oEmailAccountRow.Item("EMAIL_FROM") oMailSMTP = oEmailAccountRow.Item("SERVER_OUT") oMailport = oEmailAccountRow.Item("PORT_OUT") oMailUser = oEmailAccountRow.Item("EMAIL_USER") oAuthType = oEmailAccountRow.Item("AUTH_TYPE") oMailPW = oEmailAccountRow.Item("EMAIL_PW") Dim owrapper As New clsEncryption("!35452didalog=") Dim oPWPlain = owrapper.DecryptData(oMailPW) If Not IsNothing(oPWPlain) Then oMailPW = oPWPlain Else myLogger.Warn("PWPlain is Nothing - Could not decrypt password..") Return False End If End If Next If IsNothing(oMailFrom) Or IsNothing(oMailPW) Then If oACCOUNT_MATCH = True Then myLogger.Warn("ACCOUNT-Infos are nothing!") Else myLogger.Warn($"EMAIL_ACCOUNT_ID {oEMAILACCOUNT_ID} is not matching the configuration!") End If Return False End If oGUID = oNewEmailTo_Row.Item("GUID") oEmailTo = oNewEmailTo_Row.Item("EMAIL_TO") myLogger.Debug($"oEmailTo: {oEmailTo}") oSubject = oNewEmailTo_Row.Item("EMAIL_SUBJ") myLogger.Debug($"oSubject: {oSubject}") oBody = oNewEmailTo_Row.Item("EMAIL_BODY") myLogger.Debug($"oBody: {oBody}") oJOB_ID = oNewEmailTo_Row.Item("JOB_ID") myLogger.Debug($"oJOB_ID: {oJOB_ID}") oAttachment = oNewEmailTo_Row.Item("EMAIL_ATTMT1") myLogger.Debug($"Now checking the attachment") If IsDBNull(oAttachment) Then oAttachment = String.Empty Else If oAttachment <> String.Empty Then If File.Exists(oAttachment) = False Then myLogger.Warn($"Email Attachment FB FileNotFound Exception!") oComment = "Email Attachment FB FileNotFound Exception" oAttachment = String.Empty Else myLogger.Debug("Email Attachment is: {0}", oAttachment.ToString) End If End If End If 'Dim link As String = "pmo://" & oJOB_ID & "-" & oNewEmailTo_Row.Item("REFERENCE1") 'If oBody.Contains("[%PMOLINK_GER]") Then ' oBody = oBody.Replace("[%PMOLINK_GER]", "hier") 'End If 'If oBody.Contains("[%PMOLINK_EN]") Or oBody.Contains("[%PMOLINK_US]") Then ' oBody = oBody.Replace("[%PMOLINK_EN]", "here") ' oBody = oBody.Replace("[%PMOLINK_US]", "here") 'End If Dim oSendResult As Boolean = False oSendResult = _EmailAlt.Email_Send_Independentsoft(oSubject, oBody, oEmailTo, oMailFrom, oMailSMTP, oMailport, oMailUser, oMailPW, oAuthType, oAttachment) If oSendResult = False Then oSendResult = _Email.NewEmail(oEmailTo, oSubject, oBody, oMailFrom, oMailSMTP, oMailport, oMailUser, oMailPW, oAuthType, "DDEDMI_ComService", oAttachment.ToString) End If If oSendResult = True Then Dim upd = $"UPDATE TBEDM_EMAIL_QUEUE SET EMAIL_SENT = CURRENT_TIMESTAMP,COMMENT = '{oComment}' WHERE GUID = {oGUID}" If upd.Contains(",COMMENT = ''") Then upd.Replace(",COMMENT = ''", "") End If _firebird.ExecuteNonQuery(upd) End If Next Return True Else If oDT_EMAIL_ACCOUNT.Rows.Count = 0 Then myLogger.Warn("Check the Email_Config Table TBDD_EMAIL_ACCOUNT. The table seems to be empty.") ElseIf IsNothing(oDT_EMAIL_QUEUE) Then myLogger.Warn($"DT_EMAIL_QUEUE is nothing: {oSQL}") End If End If Catch ex As Exception myLogger.Error(ex) End Try End Function Private Function SEND_FROM_MSSQL() Try If _MSSQL.DBInitialized = False Then Return False End If Dim oSQL = "SELECT * FROM TBDD_EMAIL_ACCOUNT WHERE ACTIVE = 1" Dim oDT_EMAIL_ACCOUNT As DataTable = _MSSQL.GetDatatable(oSQL) If IsNothing(oDT_EMAIL_ACCOUNT) Then myLogger.Warn("DT_EMAIL_ACCOUNT is nothing!") Return False End If oSQL = "SELECT * FROM TBEMLP_EMAIL_OUT WHERE EMAIL_SENT IS NULL and EMAIL_ADRESS <> ''" Dim oDT_EMAIL_QUEUE As DataTable = _MSSQL.GetDatatable(oSQL) If Not IsNothing(oDT_EMAIL_QUEUE) And oDT_EMAIL_ACCOUNT.Rows.Count >= 1 Then Dim oEmailTo, oSubject, oBody As String Dim oEMAILACCOUNT_ID, oGUID, oJOB_ID As Integer For Each oEmail_Row As DataRow In oDT_EMAIL_QUEUE.Rows oEMAILACCOUNT_ID = oEmail_Row.Item("SENDING_PROFILE") Dim oMailFrom, oMailSMTP, oMailport, oMailUser, oMailPW, oAuthType, oAttachment Dim oACCOUNT_MATCH As Boolean = False For Each oAccountRow As DataRow In oDT_EMAIL_ACCOUNT.Rows If oAccountRow.Item("GUID") = oEMAILACCOUNT_ID Then oACCOUNT_MATCH = True oMailFrom = oAccountRow.Item("EMAIL_FROM") oMailSMTP = oAccountRow.Item("EMAIL_SMTP") oMailport = oAccountRow.Item("PORT") oMailUser = oAccountRow.Item("EMAIL_USER") oAuthType = oAccountRow.Item("AUTH_TYPE") oMailPW = oAccountRow.Item("EMAIL_PW") Dim owrapper As New clsEncryption("!35452didalog=") Dim oPWPlain = owrapper.DecryptData(oMailPW) If Not IsNothing(oPWPlain) Then oMailPW = oPWPlain Else myLogger.Warn("PWPlain is Nothing - Could not decrypt password..") Return False End If End If Next If IsNothing(oMailFrom) Or IsNothing(oMailPW) Then If oACCOUNT_MATCH = True Then myLogger.Warn("ACCOUNT-Infos are nothing!") Else myLogger.Warn($"EMAIL_ACCOUNT_ID {oEMAILACCOUNT_ID} is not matching the configuration!") End If Return False End If oGUID = oEmail_Row.Item("GUID") oEmailTo = oEmail_Row.Item("EMAIL_ADRESS") myLogger.Debug($"oEmailTo: {oEmailTo}") oSubject = oEmail_Row.Item("EMAIL_SUBJ") myLogger.Debug($"oSubject: {oSubject}") oBody = oEmail_Row.Item("EMAIL_BODY") myLogger.Debug($"oBody: {oBody}") oJOB_ID = oEmail_Row.Item("REFERENCE_ID") myLogger.Debug($"oJOB_ID: {oJOB_ID}") oAttachment = oEmail_Row.Item("EMAIL_ATTMT1") Try myLogger.Debug($"Now checking the attachment") If IsDBNull(oAttachment) Then oAttachment = String.Empty Else If oAttachment <> String.Empty Then If File.Exists(oAttachment) = False Then myLogger.Warn($"Email Attachment MSSQL FileNotFound Exception!") oAttachment = String.Empty Else myLogger.Debug("Email Attachment is: {0}", oAttachment.ToString) End If End If End If Catch ex As Exception oAttachment = String.Empty End Try Dim oSendResult As Boolean = False oSendResult = _EmailAlt.Email_Send_Independentsoft(oSubject, oBody, oEmailTo, oMailFrom, oMailSMTP, oMailport, oMailUser, oMailPW, oAuthType, oAttachment) If oSendResult = False Then oSendResult = _Email.NewEmail(oEmailTo, oSubject, oBody, oMailFrom, oMailSMTP, oMailport, oMailUser, oMailPW, oAuthType, "DDEDMI_ComService", oAttachment.ToString) End If If oSendResult = True Then Dim oUpdCommand = "UPDATE TBEMLP_EMAIL_OUT SET EMAIL_SENT = GETDATE() WHERE GUID = " & oGUID _MSSQL.NewExecutenonQuery(oUpdCommand) End If Next Else If oDT_EMAIL_ACCOUNT.Rows.Count = 0 Then myLogger.Warn("Check the Email_Config Table TBEDM_EMAIL_ACCOUNT. The table seems to be empty.") ElseIf IsNothing(oDT_EMAIL_QUEUE) Then myLogger.Warn($"DT_EMAIL_QUEUE is nothing: {oSQL}") End If End If Catch ex As Exception myLogger.Error(ex) End Try End Function #Region "*** BackgroundWorker Stop/Completed ***" Private Sub ThreadEMailQueue_Completed(ByVal sender As Object, ByVal e As System.ComponentModel.RunWorkerCompletedEventArgs) 'Handles threadDateiimport.RunWorkerCompleted ' This event fires when the DoWork event completes Try Dim result As String = "" If e.Cancelled Then myLogger.Warn("ThreadEMailQueue has been cancelled manually...") ElseIf e.Error IsNot Nothing Then myLogger.Warn("Unexpected error in running thread: " & e.Error.Message) End If Catch ex As Exception myLogger.Error(ex) End Try End Sub #End Region End Class