347 lines
17 KiB
VB.net
347 lines
17 KiB
VB.net
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()
|
|
If My.Settings.FB_ConnString <> String.Empty Then
|
|
_firebird = New Firebird(MyLoConfig, My.Settings.FB_ConnString, My.Settings.FB_DATABASE, My.Settings.FB_USER, My.Settings.FB_PW)
|
|
End If
|
|
_Email = New Email(MyLoConfig)
|
|
_EmailAlt = New clsEmail(MyLoConfig)
|
|
If My.Settings.SQLSERVER_CS <> String.Empty Then
|
|
_MSSQL = New MSSQLServer(MyLoConfig, My.Settings.SQLSERVER_CS)
|
|
End If
|
|
|
|
If (_firebird._DBInitialized = True Or _MSSQL.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)
|
|
If My.Settings.FB_ConnString <> String.Empty Then
|
|
_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()
|
|
End If
|
|
If My.Settings.SQLSERVER_CS <> String.Empty Then
|
|
_MSSQL = New MSSQLServer(MyLoConfig, My.Settings.SQLSERVER_CS)
|
|
If _MSSQL.DBInitialized = False Then
|
|
myLogger.Warn("SQL-DB could not be intitialized!")
|
|
Exit Sub
|
|
End If
|
|
SEND_FROM_MSSQL()
|
|
End If
|
|
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]", "<a href=""" & link & """>hier</a>")
|
|
'End If
|
|
'If oBody.Contains("[%PMOLINK_EN]") Or oBody.Contains("[%PMOLINK_US]") Then
|
|
' oBody = oBody.Replace("[%PMOLINK_EN]", "<a href=""" & link & """>here</a>")
|
|
' oBody = oBody.Replace("[%PMOLINK_US]", "<a href=""" & link & """>here</a>")
|
|
'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
|