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

Merge branch 'master' of https://vcs.digitaldata.works/AppStd/Modules

Browse Source
This commit is contained in:
Developer01
2026-09-10 14:41:15 +02:00
parent e56be8a6fe 4dc454403b
commit 3c1b51f519
8 changed files with 65 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
Interfaces/My Project/AssemblyInfo.vb
View File

@@ -13,7 +13,7 @@ Imports System.Runtime.InteropServices
<Assembly: AssemblyCompany("Digital Data")>
<Assembly: AssemblyProduct("Modules.Interfaces")>
<Assembly: AssemblyCopyright("Copyright © 2026")>
<Assembly: AssemblyTrademark("2.4.5.0")>
<Assembly: AssemblyTrademark("2.4.6.0")>
<Assembly: ComVisible(False)>
@@ -31,5 +31,5 @@ Imports System.Runtime.InteropServices
' übernehmen, indem Sie "*" eingeben:
' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("2.4.5.0")>
<Assembly: AssemblyFileVersion("2.4.5.0")>
<Assembly: AssemblyVersion("2.4.6.0")>
<Assembly: AssemblyFileVersion("2.4.6.0")>

8
Interfaces/ZUGFeRDInterface.vb
View File

@@ -194,6 +194,14 @@ Public Class ZUGFeRDInterface
}
End Using
oResult = _Validator.ValidateZUGFeRDDocument(oResult)
If oResult.ValidationErrors.Count > 0 Then
_logger.Warn($"XML-Logik - Nach Validator() Errors: {oResult.ValidationErrors.Count}")
Else
_logger.Info($"XML-Logik - Nach Validator() NO Errors.")
End If
Catch ex As ZUGFeRDExecption
' Don't log ZUGFeRD Exceptions here, they should be handled by the calling code.
' It also produces misleading error messages when checking if an attachment is a zugferd file.

4
Interfaces/ZUGFeRDInterface/Validator.vb
View File

@@ -26,6 +26,7 @@ Public Class Validator
For Each oNode As XElement In oDecimalNodes
Dim oParsedValue As Decimal = 0.0
If Decimal.TryParse(oNode.Value, oParsedValue) = False Then
_logger.Warn($"Invalid Decimal Value in {oNode.Name.LocalName}")
pResult.ValidationErrors.Add(New ZugferdValidationError() With {
.ElementName = oNode.Name.LocalName,
.ElementValue = oNode.Value,
@@ -50,6 +51,8 @@ Public Class Validator
For Each oNode As XElement In oCurrencyCodeNodes
Dim oValid = ValidateCurrencyCode(oNode.Value)
If oValid = False Then
_logger.Warn($"Invalid CurrencyCode in {oNode.Name.LocalName}")
pResult.ValidationErrors.Add(New ZugferdValidationError() With {
.ElementName = oNode.Name.LocalName,
.ElementValue = oNode.Value,
@@ -78,6 +81,7 @@ Public Class Validator
Dim oValid = ValidateCurrencyCode(oCurrencyID)
If oValid = False Then
_logger.Warn($"Invalid CurrencyID in {oNode.Name.LocalName}")
pResult.ValidationErrors.Add(New ZugferdValidationError() With {
.ElementName = oNode.Name.LocalName,
.ElementValue = oCurrencyID,

6
Jobs/My Project/AssemblyInfo.vb
View File

@@ -13,7 +13,7 @@ Imports System.Runtime.InteropServices
<Assembly: AssemblyCompany("Digital Data")>
<Assembly: AssemblyProduct("Modules.Jobs")>
<Assembly: AssemblyCopyright("Copyright © 2026")>
<Assembly: AssemblyTrademark("3.8.0")>
<Assembly: AssemblyTrademark("3.8.1.0")>
<Assembly: ComVisible(False)>
@@ -30,5 +30,5 @@ Imports System.Runtime.InteropServices
' Sie können alle Werte angeben oder die standardmäßigen Build- und Revisionsnummern
' übernehmen, indem Sie "*" eingeben:
<Assembly: AssemblyVersion("3.8.0.0")>
<Assembly: AssemblyFileVersion("3.8.0.0")>
<Assembly: AssemblyVersion("3.8.1.0")>
<Assembly: AssemblyFileVersion("3.8.1.0")>

8
Jobs/ZUGFeRD/EmailFunctions.vb
View File

@@ -48,7 +48,7 @@ Namespace ZUGFeRD
Dim intCode As Integer = DirectCast(pErrorCode, Integer)
oErrorCode = $"{EmailStrings.ErrorCodePraefix}{intCode}"
Dim oSQL = $"SELECT COUNT(*) FROM TBDD_GUI_LANGUAGE_PHRASE WHERE TITLE = '{oErrorCode}'"
Dim oSQL = $"SELECT COUNT(*) FROM TBDD_GUI_LANGUAGE_PHRASE WITH (NOLOCK) WHERE TITLE = '{oErrorCode}'"
If _mssql.GetScalarValue(oSQL) > 0 Then
useLegacyMethod = False
Else
@@ -59,7 +59,7 @@ Namespace ZUGFeRD
' Gibt es das Template in TBDD_EMAIL_TEMPLATE?
If useLegacyMethod = False AndAlso pTemplateId > 0 Then
Try
Dim oSQL = $"SELECT COUNT(*) FROM TBDD_EMAIL_TEMPLATE WHERE GUID = {pTemplateId}"
Dim oSQL = $"SELECT COUNT(*) FROM TBDD_EMAIL_TEMPLATE WITH (NOLOCK) WHERE GUID = {pTemplateId}"
If _mssql.GetScalarValue(oSQL) <= 0 Then
_logger.Warn($"EMAIL_TEMPLATE [{pTemplateId}] not found in TBDD_EMAIL_TEMPLATE!")
useLegacyMethod = True
@@ -185,7 +185,7 @@ Namespace ZUGFeRD
_logger.Debug("To: {0}", oEmailTo)
_logger.Debug("Subject: {0}", oSubject)
_logger.Debug("Body {0}", oFinalBodyText)
Dim osql = $"Select MAX(GUID) FROM TBEMLP_HISTORY WHERE EMAIL_MSGID = '{MessageId}'"
Dim osql = $"Select MAX(GUID) FROM TBEMLP_HISTORY WITH (NOLOCK) WHERE EMAIL_MSGID = '{MessageId}'"
Dim oHistoryID = _mssql.GetScalarValue(osql)
If IsNumeric(oHistoryID) Then
@@ -223,7 +223,7 @@ Namespace ZUGFeRD
End Sub
Public Function GetEmailDataForMessageId(MessageId As String) As EmailData
Dim oSQL = $"SELECT EMAIL_FROM, EMAIL_SUBJECT FROM TBEMLP_HISTORY WHERE EMAIL_MSGID = '{MessageId}'"
Dim oSQL = $"SELECT EMAIL_FROM, EMAIL_SUBJECT FROM TBEMLP_HISTORY WITH (NOLOCK) WHERE EMAIL_MSGID = '{MessageId}'"
Try
Dim oDatatable = _mssql.GetDatatable(oSQL)
Dim oRow As DataRow

2
Jobs/ZUGFeRD/ErrorCode.vb
View File

@@ -10,5 +10,5 @@
FileSizeLimitReachedException = 20008
OutOfMemoryException = 20009
UnhandledException = 20010
FileMoveException = 200011
FileMoveException = 20011
End Enum

41
Jobs/ZUGFeRD/FileFunctions.vb
View File

@@ -1,6 +1,8 @@
Imports System.Collections.Generic
Imports System.Globalization
Imports System.IO
Imports System.Linq
Imports System.Text
Imports DigitalData.Modules.Base
Imports DigitalData.Modules.Database
Imports DigitalData.Modules.Interfaces
@@ -91,7 +93,8 @@ Namespace ZUGFeRD
' Write Embedded Files to disk
For Each oResult In pEmbeddedAttachments
Try
Dim oFileName As String = $"{pMessageId}~{oResult.FileName}"
Dim oCleanedFilename As String = BereinigeDateinamenAscii(oResult.FileName)
Dim oFileName As String = $"{pMessageId}~{oCleanedFilename}"
Dim oFilePath As String = Path.Combine(oAttachmentDirectory, oFileName)
If Not File.Exists(oAttachmentDirectory) Then
@@ -208,6 +211,7 @@ Namespace ZUGFeRD
Return False ' Andere Fehler
End Try
End Function
Public Function GetEmailPathWithSubjectAsName(RejectedEmailDirectory As String, UncleanedSubject As String) As String
Dim oCleanSubject = String.Join("", UncleanedSubject.Split(Path.GetInvalidPathChars()))
Dim oAttachmentDirectory = RejectedEmailDirectory
@@ -218,6 +222,41 @@ Namespace ZUGFeRD
Return oAttachmentPath
End Function
''' <summary>
''' 20.8.2026 - In den Dateinamen der Anhänge in einem PDF können Unicode-Zeichen vorkommen
''' die später nicht mehr verarbeitet werden können. sie werden hier rausgefiltert
''' </summary>
''' <param name="pFilename"></param>
''' <returns></returns>
Function BereinigeDateinamenAscii(pFilename As String) As String
If pFilename.IsNullOrEmpty() Then
Return String.Empty
End If
' Restliche Diakritika entfernen (é, à, ñ, etc.)
Dim normalisiert As String = pFilename.Normalize(NormalizationForm.FormD)
Dim sb As New StringBuilder()
For Each c As Char In normalisiert
If CharUnicodeInfo.GetUnicodeCategory(c) = UnicodeCategory.NonSpacingMark Then
Continue For
End If
Dim code As Integer = AscW(c)
If code >= 32 AndAlso code <= 126 Then
If "\/:*?""<>|".Contains(c) Then
sb.Append("_")
Else
sb.Append(c)
End If
End If
' Alles andere (z.B. 你好) wird komplett verworfen
Next
Return sb.ToString()
End Function
End Class
End Namespace

4
Jobs/ZUGFeRD/HashFunctions.vb
View File

@@ -33,7 +33,7 @@ Public Class HashFunctions
End If
' Check if Checksum exists in History Table
Dim oCheckCommand = $"SELECT * FROM TBEMLP_HISTORY WHERE GUID = (SELECT MAX(GUID) FROM TBEMLP_HISTORY WHERE UPPER(MD5HASH) = UPPER('{oMD5CheckSum}'))"
Dim oCheckCommand = $"SELECT * FROM TBEMLP_HISTORY WITH (NOLOCK) WHERE GUID = (SELECT MAX(GUID) FROM TBEMLP_HISTORY WITH (NOLOCK) WHERE UPPER(MD5HASH) = UPPER('{oMD5CheckSum}'))"
Dim oTable As DataTable = Database.GetDatatable(oCheckCommand, MSSQLServer.TransactionMode.NoTransaction)
' If History entries could not be fetched, just return the MD5 Checksum
@@ -94,7 +94,7 @@ Public Class HashFunctions
Public Function GetOriginalFilename(pFilename As String) As String
' Try to get the original filename from Attachment table
' If this fails, falls back to the new filename (<msgid>~Attm<i>.ext)
Dim oSQL = $"SELECT EMAIL_ATTMT FROM TBEMLP_HISTORY_ATTACHMENT WHERE EMAIL_ATTMT_INDEX = '{pFilename}'"
Dim oSQL = $"SELECT EMAIL_ATTMT FROM TBEMLP_HISTORY_ATTACHMENT WITH (NOLOCK) WHERE EMAIL_ATTMT_INDEX = '{pFilename}'"
Dim oEmailAttachment = Database.GetScalarValue(oSQL, MSSQLServer.TransactionMode.NoTransaction)
Dim oOriginalName = ObjectEx.NotNull(oEmailAttachment, pFilename)
Return oOriginalName