Imports System.ComponentModel Imports DigitalData.Modules.Logging Imports DigitalData.Modules.Database Imports DigitalData.Modules.Messaging Imports System.IO Public Class MyComService Private _Logger As Logger Private _MyLogger As LogConfig Private _firebird As Firebird Private _Email As Email 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 _MyLogger = New LogConfig(LogConfig.PathType.CustomPath, Path.Combine(My.Application.Info.DirectoryPath, "Log")) _Logger = _MyLogger.GetLogger() _firebird = New Firebird(_MyLogger, My.Settings.FB_ConnString, My.Settings.FB_DATABASE, My.Settings.FB_USER, My.Settings.FB_PW) _Email = New Email(_MyLogger) 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 _Logger.Debug("Timer1_OneMinute started...") End If Catch ex As Exception If Not IsNothing(_MyLogger.LogFile) And File.Exists(_MyLogger.LogFile) Then _Logger.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. _Logger.Warn("Service has been stopped!") Catch ex As Exception _Logger.Error(ex) End Try End Sub Public Sub RunThread_EmailQueue(ByVal sender As Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Try _MyLogger = New LogConfig(LogConfig.PathType.CustomPath, Path.Combine(My.Application.Info.DirectoryPath, "Log")) _Logger = _MyLogger.GetLogger() _MyLogger.Debug = My.Settings.LOG_ERRORS_ONLY _firebird = New Firebird(_MyLogger, My.Settings.FB_ConnString, My.Settings.FB_DATABASE, My.Settings.FB_USER, My.Settings.FB_PW) If _firebird._DBInitialized = False Then _Logger.Warn("Firebird-DB could not be intitialized!") Exit Sub End If 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 _Logger.Warn("DT_EMAIL_ACCOUNT is nothing!") Exit Sub 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 oEmail_Row As DataRow In oDT_EMAIL_QUEUE.Rows oEMAILACCOUNT_ID = oEmail_Row.Item("EMAIL_ACCOUNT_ID") Dim oMailFrom, oMailSMTP, oMailport, oMailUser, oMailPW, oAuthType As String 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("SERVER_OUT") oMailport = oAccountRow.Item("PORT_OUT") 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 _Logger.Warn("PWPlain is Nothing - Could not decrypt password..") Exit Sub End If End If Next If IsNothing(oMailFrom) Or IsNothing(oMailPW) Then If oACCOUNT_MATCH = True Then _Logger.Warn("ACCOUNT-Infos are nothing!") Else _Logger.Warn($"EMAIL_ACCOUNT_ID {oEMAILACCOUNT_ID} is not matching the configuration!") End If Exit Sub End If oGUID = oEmail_Row.Item("GUID") oEmailTo = oEmail_Row.Item("EMAIL_TO") oSubject = oEmail_Row.Item("EMAIL_SUBJ") oBody = oEmail_Row.Item("EMAIL_BODY") oJOB_ID = oEmail_Row.Item("JOB_ID") Dim link As String = "pmo://" & oJOB_ID & "-" & oEmail_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 If _Email.NewEmail(oEmailTo, oSubject, oBody, oMailFrom, oMailSMTP, oMailport, oMailUser, oMailPW, oAuthType, "DDEDMI_ComService") = True Then Dim upd = "UPDATE TBEDM_EMAIL_QUEUE SET EMAIL_SENT = CURRENT_TIMESTAMP WHERE GUID = " & oGUID _firebird.ExecuteNonQuery(upd) End If Next Else If oDT_EMAIL_ACCOUNT.Rows.Count = 0 Then _Logger.Warn("Check the Email_Config Table TBEDM_EMAIL_ACCOUNT. The table seems to be empty.") ElseIf IsNothing(oDT_EMAIL_QUEUE) Then _Logger.Warn($"DT_EMAIL_QUEUE is nothing: {oSQL}") End If End If Catch ex As Exception _Logger.Error(ex) End Try End Sub #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 _Logger.Warn("ThreadEMailQueue has been cancelled manually...") ElseIf e.Error IsNot Nothing Then _Logger.Warn("Unexpected error in running thread: " & e.Error.Message) End If Catch ex As Exception _Logger.Error(ex) End Try End Sub #End Region End Class