AppStd/Modules
8
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Merge branch 'master' of http://dd-vmp07-com04:3000/AppStd/Monorepo

Browse Source
This commit is contained in:
Jonathan Jenne 2020-01-07 15:19:23 +01:00
commit 310086820f
6 changed files with 272 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
DDEmailService/EmailService.vb
View File

@ -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

1
DDEmailService/ProjectInstaller.Designer.vb generated
View File

@ -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"
'

39
Modules.Config/ConfigManager.vb
View File

@ -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)
MyClass.New(LogConfig, ConfigPath, ConfigPath, ForceUserConfig:=True)
Public Sub New(LogConfig As LogConfig, ConfigPath As String, ApplicationStartupPath As String)
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

98
Modules.Jobs/EDMI/ZUGFeRD/ImportZUGFeRDFiles.vb
View File

@ -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()

2
Modules.Logging/LogConfig.vb
View File

@ -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

135
Modules.Messaging/Email.vb
View File

@ -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