29 Commits

Author SHA1 Message Date
Jonathan Jenne
dbbacd2623 Jobs: Version 1.10.0.2 2022-11-25 10:56:30 +01:00
Jonathan Jenne
7d86d583de Jobs: Fix typo 2022-11-25 10:56:07 +01:00
Jonathan Jenne
5c4b302aa7 Jobs: Version 1.10.0.1 2022-11-25 10:29:51 +01:00
Jonathan Jenne
1d8a0faeee Database: Version 2.2.7.6 2022-11-25 10:29:18 +01:00
Jonathan Jenne
ca92abbee5 Jobs: WIP GraphQL Job, fix logic errors, improve logging 2022-11-25 10:28:52 +01:00
Jonathan Jenne
8267ecb72d Database: Fix logging 2022-11-25 10:28:20 +01:00
Jonathan Jenne
86ca1011df Jobs: Version 1.10.0.0 2022-11-24 14:28:39 +01:00
Jonathan Jenne
b1aba0a80d Jobs: Add exception for unsupported zugferd documents 2022-11-24 14:26:42 +01:00
Jonathan Jenne
a8862709d8 Jobs: Update to use Job Runner Table 2022-11-24 14:24:59 +01:00
Jonathan Jenne
36fe39ee66 Merge branch 'master' of http://git.dd:3000/AppStd/Modules 2022-11-24 11:24:37 +01:00
Jonathan Jenne
ddc11b62a5 Database: Small stuff 2022-11-24 11:24:26 +01:00
Jonathan Jenne
7ba516fcd1 Interfaces: Version 1.8.1.0 2022-11-24 11:20:31 +01:00
Jonathan Jenne
05a92c3181 Language: Version 1.6.2.0 2022-11-24 11:20:00 +01:00
Jonathan Jenne
7d63718e96 Interfaces/ActiveDirectory: Improve logging 2022-11-24 11:19:22 +01:00
Jonathan Jenne
8af67ef883 Language: Improve StringEx 2022-11-24 11:14:20 +01:00
6ed636bca0 Merge branch 'master' of http://git.dd:3000/AppStd/Modules 2022-11-17 17:09:16 +01:00
5f8e1a8608 MS windream Mod 2022-11-17 17:09:07 +01:00
Jonathan Jenne
e424402d63 Interfaces: Version 1.8.0.0 2022-11-16 16:34:46 +01:00
Jonathan Jenne
9d6dd695e4 Jobs: 1.9.0.0 2022-11-16 16:34:10 +01:00
Jonathan Jenne
0410e11b59 ZUGFeRD: WIP Allow blocking factur-x and xrechnung invoice files with config flags 2022-11-16 16:33:35 +01:00
Jonathan Jenne
f4adba98eb Interfaces: Version 1.7.5.0 2022-11-14 11:46:08 +01:00
Jonathan Jenne
1dba028deb Interfaces: Add errortype unknownerror 2022-11-14 11:45:20 +01:00
Jonathan Jenne
3a26343083 Merge branch 'Database_SqlConnection' 2022-11-02 16:20:43 +01:00
Jonathan Jenne
1e732a036a Revert all modules to .NET 4.6.1 2022-11-02 14:35:43 +01:00
Jonathan Jenne
41165a470d Language: Version 1.6.1.0 2022-11-02 13:36:52 +01:00
Jonathan Jenne
8128987be4 Language: Add EscapeForSQL string extension method 2022-11-02 13:36:29 +01:00
Jonathan Jenne
6ebd3b82b6 Messaging: Improve logging 2022-11-02 13:36:00 +01:00
Jonathan Jenne
d18ebfe912 Jobs: 1.8.7.0 2022-11-02 13:35:04 +01:00
Jonathan Jenne
b614b3f140 Jobs: escape attachment paths 2022-11-02 13:34:33 +01:00
33 changed files with 627 additions and 394 deletions

View File

@@ -437,7 +437,7 @@ Public Class MSSQLServer
Return True
Catch ex As Exception
Logger.Error(ex)
Logger.Warn("ExecuteNonQueryWithConnectionObject: Error in ExecuteNonQueryWithConnectionObject while executing command: [{0}]-[{1}]", SqlCommand, SqlConnection.ConnectionString)
Logger.Warn("ExecuteNonQueryWithConnectionObject: Error in ExecuteNonQueryWithConnectionObject while executing command: [{0}]", pSqlCommandObject.CommandText)
Return False
Finally
MaybeCommitTransaction(oTransaction, pTransactionMode)

View File

@@ -127,7 +127,7 @@ Public Class Oracle
End Try
End Function
Public Function GetDatatable(pSQLCommand As String, pTimeout As Integer) As DataTable Implements IDatabase.GetDatatable
Public Function GetDatatable(pSQLCommand As String, Optional pTimeout As Integer = Constants.DEFAULT_TIMEOUT) As DataTable Implements IDatabase.GetDatatable
Try
Using oConnection = GetConnection(CurrentConnectionString)
Dim oSQLCommand As OracleCommand
@@ -151,8 +151,8 @@ Public Class Oracle
End Try
End Function
Private Function GetDatatable(pSQLCommand As String) As DataTable Implements IDatabase.GetDatatable
Return GetDatatable(pSQLCommand, _Timeout)
Public Function GetDatatable(SqlCommand As SqlClient.SqlCommand, Optional Timeout As Integer = 120) As DataTable Implements IDatabase.GetDatatable
Throw New NotImplementedException()
End Function
Public Function ExecuteNonQuery(pSQLCommand As String, pTimeout As Integer) As Boolean Implements IDatabase.ExecuteNonQuery
@@ -250,4 +250,6 @@ Public Class Oracle
Return "Invalid ConnectionString"
End Try
End Function
End Class

View File

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

View File

@@ -42,7 +42,7 @@ Namespace SyncUsers
End Try
For Each oUser In Users
Dim oUserId As Int64
Dim oUserId As Long
Dim oUserExists As Boolean
' Check if user already exists
@@ -68,7 +68,7 @@ Namespace SyncUsers
_logger.Debug("Creating new user for [{0}]", oUser)
oUserId = CreateUser(oUser)
_logger.Debug("User created with Id [{0}]", oUserId)
_logger.Info("Added new User [{0}]", oUser.samAccountName)
_logger.Info("Added new User [{0}]", oUser)
oCreatedUsers.Add(oUser)
Else
@@ -76,7 +76,7 @@ Namespace SyncUsers
oUserId = UpdateUser(oUser)
If oUserId <> 0 Then
_logger.Debug("User created with Id [{0}]", oUserId)
_logger.Info("Updated User [{0}]", oUser.samAccountName)
_logger.Info("Updated User [{0}]", oUser)
oUpdatedUsers.Add(oUser)
End If
@@ -84,7 +84,7 @@ Namespace SyncUsers
Catch ex As Exception
_logger.Error(ex)
_logger.Warn("Could Not create/update user [{0}]. Skipping.", oUser.samAccountName)
_logger.Warn("Could Not create/update user [{0}]. Skipping.", oUser)
Continue For
End Try
@@ -99,7 +99,7 @@ Namespace SyncUsers
' Add the user to group
Try
If AddUserToGroup(oUserId, oGroupId) Then
_logger.Info("User [{0}] added to group [{1}]", oUser.samAccountName, GroupName)
_logger.Info("User [{0}] added to group [{1}]", oUser, GroupName)
End If
Catch ex As Exception
_logger.Error(ex)
@@ -175,7 +175,8 @@ Namespace SyncUsers
Dim oSQL As String = $"SELECT GUID FROM TBDD_USER WHERE UPPER(USERNAME) = UPPER('{UserName}')"
Dim oUserId = _mssql.GetScalarValue(oSQL)
If IsDBNull(oUserId) OrElse oUserId = 0 Then
If IsDBNull(oUserId) OrElse IsNothing(oUserId) OrElse oUserId = 0 Then
_logger.Debug("User [{0}] does not exist", UserName)
Return 0
End If
@@ -194,9 +195,15 @@ Namespace SyncUsers
End If
Dim oUserId As Integer = GetUserId(User.samAccountName)
_logger.Debug("UserId of User [{0}] is [{1}]", User, oUserId)
If oUserId = 0 Then
Dim oSQL As String = $"INSERT INTO TBDD_USER (PRENAME, NAME, USERNAME, EMAIL, ADDED_WHO) VALUES ('{User?.GivenName}', '{User?.Surname?.Replace("'", "''")}', UPPER('{User?.samAccountName?.Replace("'", "''")}'), '{User?.Email?.Replace("'", "''")}', '{ADDED_WHO}')"
Dim oPrename = User.GivenName.EscapeForSQL()
Dim oSurname = User.Surname.EscapeForSQL()
Dim oUsername = User.samAccountName.EscapeForSQL()
Dim oEmail = User.Email.EscapeForSQL()
Dim oSQL As String = $"INSERT INTO TBDD_USER (PRENAME, NAME, USERNAME, EMAIL, ADDED_WHO) VALUES ('{oPrename}', '{oSurname}', UPPER('{oUsername}'), '{oEmail}', '{ADDED_WHO}')"
Dim oResult = _mssql.ExecuteNonQuery(oSQL)
If oResult = True Then
@@ -230,11 +237,11 @@ Namespace SyncUsers
Dim oUserId As Integer = GetUserId(User.samAccountName)
If Not IsNothing(oUserId) Then
If oUserId > 0 Then
Dim oGivenName As String = EscapeQuotes(User.GivenName)
Dim oSurname As String = EscapeQuotes(User.Surname)
Dim oEmail As String = EscapeQuotes(User.Email)
Dim oPrename = User.GivenName.EscapeForSQL()
Dim oSurname = User.Surname.EscapeForSQL()
Dim oEmail = User.Email.EscapeForSQL()
Dim oSQL As String = $"UPDATE TBDD_USER SET PRENAME = '{oGivenName}', NAME = '{oSurname}', EMAIL = '{oEmail}', CHANGED_WHO = '{ADDED_WHO}' WHERE GUID = {oUserId}"
Dim oSQL As String = $"UPDATE TBDD_USER SET PRENAME = '{oPrename}', NAME = '{oSurname}', EMAIL = '{oEmail}', CHANGED_WHO = '{ADDED_WHO}' WHERE GUID = {oUserId}"
Dim oResult = _mssql.ExecuteNonQuery(oSQL)
If oResult = True Then
@@ -256,11 +263,6 @@ Namespace SyncUsers
End Try
End Function
Private Function EscapeQuotes(pString As String)
Dim oString = Utils.NotNull(pString, String.Empty)
Return oString.Replace("'", "''")
End Function
Public Sub AddCustomAttributesToUser(User As ADUser, UserId As Integer) Implements ISyncUsers.AddCustomAttributesToUser
Dim oCustomAttributes = User.CustomAttributes

View File

@@ -10,7 +10,7 @@
<AssemblyName>DigitalData.Modules.Interfaces</AssemblyName>
<FileAlignment>512</FileAlignment>
<MyType>Windows</MyType>
<TargetFrameworkVersion>v4.6.2</TargetFrameworkVersion>
<TargetFrameworkVersion>v4.6.1</TargetFrameworkVersion>
<TargetFrameworkProfile />
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">

View File

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

View File

@@ -8,45 +8,91 @@ Imports DigitalData.Modules.Logging
Imports GdPicture14
Public Class ZUGFeRDInterface
Private _logConfig As LogConfig
Private _logger As Logger
Private ReadOnly _logConfig As LogConfig
Private ReadOnly _logger As Logger
Private ReadOnly _Options As ZugferdOptions
Private ReadOnly ValidFilenames As New List(Of String) From {
PDFEmbeds.ZUGFERD_XML_FILENAME.ToUpper,
PDFEmbeds.FACTUR_X_XML_FILENAME_DE.ToUpper,
PDFEmbeds.FACTUR_X_XML_FILENAME_FR.ToUpper
}
Private AllowedFilenames As New List(Of String)
Public Enum ErrorType
NoValidFile
NoZugferd
NoValidZugferd
MissingProperties
UnsupportedFormat
UnknownError
End Enum
Public ReadOnly Property FileGroup As FileGroups
Public ReadOnly Property PropertyValues As PropertyValues
Public Sub New(LogConfig As LogConfig, GDPictureKey As String)
_logConfig = LogConfig
Public Class ZugferdOptions
Public Property AllowFacturX_Filename As Boolean = True
Public Property AllowXRechnung_Filename As Boolean = True
End Class
''' <summary>
''' Create a new instance of ZUGFeRDInterface
''' </summary>
''' <param name="pLogConfig">A LogConfig object</param>
''' <param name="pGDPictureKey">A valid GDPicture License</param>
''' <param name="pOptions">Optional parameters to control various settings</param>
Public Sub New(pLogConfig As LogConfig, pGDPictureKey As String, Optional pOptions As ZugferdOptions = Nothing)
_logConfig = pLogConfig
_logger = _logConfig.GetLogger()
If pOptions Is Nothing Then
_Options = New ZugferdOptions()
Else
_Options = pOptions
End If
ApplyFilenameOptions(_Options)
FileGroup = New FileGroups(_logConfig)
PropertyValues = New PropertyValues(_logConfig)
Try
Dim oLicenseManager As New LicenseManager
oLicenseManager.RegisterKEY(GDPictureKey)
oLicenseManager.RegisterKEY(pGDPictureKey)
Catch ex As Exception
_logger.Warn("GDPicture License could not be registered!")
_logger.Error(ex)
End Try
End Sub
Private Sub ApplyFilenameOptions(pOptions As ZugferdOptions)
Dim oAllowedFilenames As List(Of String) = ValidFilenames
If pOptions.AllowFacturX_Filename = False Then
oAllowedFilenames = oAllowedFilenames.
Except(New List(Of String) From {PDFEmbeds.FACTUR_X_XML_FILENAME_FR}).ToList()
End If
If pOptions.AllowXRechnung_Filename = False Then
oAllowedFilenames = oAllowedFilenames.
Except(New List(Of String) From {PDFEmbeds.FACTUR_X_XML_FILENAME_DE}).ToList()
End If
AllowedFilenames = oAllowedFilenames
End Sub
''' <summary>
''' Validates a ZUGFeRD File and extracts the XML Document from it
''' </summary>
''' <param name="Path"></param>
''' <exception cref="ZUGFeRDExecption"></exception>
''' <returns></returns>
Public Function ExtractZUGFeRDFileWithGDPicture(Path As String) As Object
Public Function ExtractZUGFeRDFileWithGDPicture(Path As String) As Tuple(Of String, Object)
Dim oXmlDocument = ValidateZUGFeRDFileWithGDPicture(Path)
If IsNothing(oXmlDocument) Then
If IsNothing(oXmlDocument.Item2) Then
Throw New ZUGFeRDExecption(ErrorType.NoZugferd, "Datei ist keine ZUGFeRD Datei.")
End If
@@ -58,11 +104,10 @@ Public Class ZUGFeRDInterface
''' </summary>
''' <param name="Stream"></param>
''' <exception cref="ZUGFeRDExecption"></exception>
''' <returns></returns>
Public Function ExtractZUGFeRDFileWithGDPicture(Stream As Stream) As Object
Public Function ExtractZUGFeRDFileWithGDPicture(Stream As Stream) As Tuple(Of String, Object)
Dim oXmlDocument = ValidateZUGFeRDFileWithGDPicture(Stream)
If IsNothing(oXmlDocument) Then
If IsNothing(oXmlDocument.Item2) Then
Throw New ZUGFeRDExecption(ErrorType.NoZugferd, "Datei ist keine ZUGFeRD Datei.")
End If
@@ -72,15 +117,15 @@ Public Class ZUGFeRDInterface
''' <summary>
''' Validates a ZUGFeRD File and extracts the XML Document from it
''' </summary>
''' <param name="Stream"></param>
''' <param name="pStream"></param>
''' <exception cref="ZUGFeRDExecption"></exception>
''' <returns></returns>
Public Function ValidateZUGFeRDFileWithGDPicture(Stream As Stream) As XPathDocument
''' <returns>The embedded xml data as an XPath document</returns>
Public Function ValidateZUGFeRDFileWithGDPicture(pStream As Stream) As Tuple(Of String, XPathDocument)
Dim oEmbedExtractor = New PDFEmbeds(_logConfig)
Dim oAllowedExtensions = New List(Of String) From {"xml"}
Try
Dim oFiles = oEmbedExtractor.Extract(Stream, oAllowedExtensions)
' Extract XML attachments only!
Dim oFiles = oEmbedExtractor.Extract(pStream, New List(Of String) From {"xml"})
' Attachments are in this case the files that are embedded into a pdf file,
' like for example the zugferd-invoice.xml file
@@ -97,12 +142,18 @@ Public Class ZUGFeRDInterface
End Try
End Function
Public Function ValidateZUGFeRDFileWithGDPicture(Path As String) As XPathDocument
''' <summary>
''' Validates a ZUGFeRD File and extracts the XML Document from it
''' </summary>
''' <param name="pPath"></param>
''' <exception cref="ZUGFeRDExecption"></exception>
''' <returns>The embedded xml data as an XPath document</returns>
Public Function ValidateZUGFeRDFileWithGDPicture(pPath As String) As Tuple(Of String, XPathDocument)
Dim oEmbedExtractor = New PDFEmbeds(_logConfig)
Dim oAllowedExtensions = New List(Of String) From {"xml"}
Try
Dim oFiles = oEmbedExtractor.Extract(Path, oAllowedExtensions)
' Extract XML attachments only!
Dim oFiles = oEmbedExtractor.Extract(pPath, New List(Of String) From {"xml"})
' Attachments are in this case the files that are embedded into a pdf file,
' like for example the zugferd-invoice.xml file
@@ -119,38 +170,39 @@ Public Class ZUGFeRDInterface
End Try
End Function
Private Function HandleEmbeddedFiles(Results As List(Of PDFEmbeds.EmbeddedFile)) As XPathDocument
Dim oXmlDocument As XPathDocument
If Results Is Nothing Then
Private Function HandleEmbeddedFiles(pResults As List(Of PDFEmbeds.EmbeddedFile)) As Tuple(Of String, XPathDocument)
If pResults Is Nothing Then
Throw New ZUGFeRDExecption(ErrorType.NoZugferd, "Datei ist keine ZUGFeRD Datei, weil die Attachments nicht gelesen werden konnten.")
End If
If Results.Count = 0 Then
If pResults.Count = 0 Then
Throw New ZUGFeRDExecption(ErrorType.NoZugferd, "Datei ist keine ZUGFeRD Datei, weil sie keine Attachments enthält.")
End If
Dim oValidFilenames As New List(Of String) From {
PDFEmbeds.ZUGFERD_XML_FILENAME.ToUpper,
PDFEmbeds.FACTUR_X_XML_FILENAME_DE.ToUpper,
PDFEmbeds.FACTUR_X_XML_FILENAME_FR.ToUpper
}
' Find the first file which filename matches the valid filenames for embedded invoice files
Dim oFoundResult As PDFEmbeds.EmbeddedFile = Results.
Where(Function(result) oValidFilenames.Contains(result.FileName.ToUpper)).
Dim oValidResult As PDFEmbeds.EmbeddedFile = pResults.
Where(Function(f) ValidFilenames.Contains(f.FileName.ToUpper)).
FirstOrDefault()
If oFoundResult Is Nothing Then
Throw New ZUGFeRDExecption(ErrorType.NoZugferd, "Datei ist keine ZUGFeRD Datei, weil die zugferd-invoice.xml nicht gefunden wurde.")
If oValidResult Is Nothing Then
Throw New ZUGFeRDExecption(ErrorType.NoZugferd, "Datei ist keine ZUGFeRD Datei, weil keine entsprechende XML-Datei gefunden wurde.")
End If
' Search the embedded files for the ones which are allowed as per the configuration.
' The config might say, allow ZUGFeRD but not Factur-X.
Dim oAllowedResult As PDFEmbeds.EmbeddedFile = pResults.
Where(Function(f) AllowedFilenames.Contains(f.FileName.ToUpper)).
FirstOrDefault()
If oAllowedResult Is Nothing Then
Throw New ZUGFeRDExecption(ErrorType.UnsupportedFormat, "Datei ist eine ZUGFeRD Datei, aber das Format wird nicht unterstützt.", oAllowedResult.FileName)
End If
Try
Using oStream As New MemoryStream(oFoundResult.FileContents)
oXmlDocument = New XPathDocument(oStream)
Using oStream As New MemoryStream(oAllowedResult.FileContents)
Return New Tuple(Of String, XPathDocument)(oAllowedResult.FileName, New XPathDocument(oStream))
End Using
Return oXmlDocument
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.
@@ -162,9 +214,9 @@ Public Class ZUGFeRDInterface
End Try
End Function
Public Function SerializeZUGFeRDDocument(Document As XPathDocument) As Object
Public Function SerializeZUGFeRDDocument(pDocument As Tuple(Of String, XPathDocument)) As Tuple(Of String, Object)
Try
Dim oNavigator As XPathNavigator = Document.CreateNavigator()
Dim oNavigator As XPathNavigator = pDocument.Item2.CreateNavigator()
Dim oReader As XmlReader
Dim oResult = Nothing

View File

@@ -4,10 +4,23 @@
Public ReadOnly Property ErrorType() As ZUGFeRDInterface.ErrorType
''' <summary>
''' Contains the name of the extracted xml file if already extracted.
''' </summary>
''' <returns>A filename like zugferd-invoice.xml</returns>
Public ReadOnly Property XmlFile As String = String.Empty
Public Sub New(ErrorType As ZUGFeRDInterface.ErrorType, Message As String)
MyBase.New(Message)
_ErrorType = ErrorType
End Sub
Public Sub New(ErrorType As ZUGFeRDInterface.ErrorType, Message As String, pXmlFileName As String)
MyBase.New(Message)
_ErrorType = ErrorType
_XmlFile = pXmlFileName
End Sub
End Class
End Class

View File

@@ -28,7 +28,7 @@ Public Class PDFEmbeds
Public Function Extract(FilePath As String, AllowedExtensions As List(Of String)) As List(Of EmbeddedFile)
Dim oFile As New List(Of EmbeddedFile)
Dim oFileInfo As FileInfo
Dim oExtensions = AllowedExtensions.ConvertAll(New Converter(Of String, String)(Function(ext) ext.ToUpper))
Dim oExtensions = AllowedExtensions.Select(Function(ext) ext.ToUpper).ToList()
Logger.Debug("Extracting embedded files from [{0}]", FilePath)
@@ -69,7 +69,7 @@ Public Class PDFEmbeds
''' <param name="AllowedExtensions">List of allowed extensions to be extracted</param>
Public Function Extract(Stream As Stream, AllowedExtensions As List(Of String)) As List(Of EmbeddedFile)
Dim oResults As New List(Of EmbeddedFile)
Dim oExtensions = AllowedExtensions.ConvertAll(New Converter(Of String, String)(Function(ext) ext.ToUpper))
Dim oExtensions = AllowedExtensions.Select(Function(ext) ext.ToUpper).ToList()
Logger.Debug("Extracting embedded files from stream")

View File

@@ -8,4 +8,4 @@
</dependentAssembly>
</assemblyBinding>
</runtime>
<startup><supportedRuntime version="v4.0" sku=".NETFramework,Version=v4.6.2"/></startup></configuration>
<startup><supportedRuntime version="v4.0" sku=".NETFramework,Version=v4.6.1"/></startup></configuration>

View File

@@ -1,7 +1,7 @@
<?xml version="1.0" encoding="utf-8"?>
<configuration>
<startup>
<supportedRuntime version="v4.0" sku=".NETFramework,Version=v4.6.2"/>
<supportedRuntime version="v4.0" sku=".NETFramework,Version=v4.6.1"/>
</startup>
<runtime>
<assemblyBinding xmlns="urn:schemas-microsoft-com:asm.v1">

View File

@@ -1,223 +0,0 @@
Option Explicit On
Imports System.IO
Imports DigitalData.Modules.Interfaces
Imports DigitalData.Modules.Jobs
Imports DigitalData.Modules.Config
Imports DigitalData.Modules.Logging
Imports Newtonsoft.Json.Linq
Imports System.Collections.Generic
Imports System.Linq
Imports System.Text.RegularExpressions
Imports DigitalData.Modules.Database
Imports System.Data
Public Class GraphQLJob
Inherits JobBase
Implements IJob(Of GraphQLArgs)
Private _GraphQL As GraphQLInterface = Nothing
Private Const PLACEHOLDER_STATIC = "STATIC:"
Public Sub New(LogConfig As LogConfig, MSSQL As MSSQLServer)
MyBase.New(LogConfig, Nothing, MSSQL)
End Sub
Public Sub Start(Args As GraphQLArgs) Implements IJob(Of GraphQLArgs).Start
Try
Dim oConfigPath As String = Args.QueryConfigPath
Dim oConfigManager As New ConfigManager(Of GraphQLConfig)(_LogConfig, oConfigPath)
With oConfigManager.Config
_GraphQL = New GraphQLInterface(_LogConfig, .BaseUrl, .Email, .Password, .CertificateFingerprint)
End With
' Login to get cookie
_Logger.Debug("Logging in")
Dim oLoginResponse = _GraphQL.Login()
' save cookie for future requests
_GraphQL.SaveCookies(oLoginResponse.Cookies.Item(0))
_Logger.Debug("Loading Queries")
' Load query data from TBCUST_JOBRUNNER_QUERY
Dim oQueryTable As DataTable = _MSSQL.GetDatatable("SELECT * FROM TBCUST_JOBRUNNER_QUERY ORDER BY OPERATION_NAME, CLEAR_BEFORE_FILL ASC")
Dim oQueryList As New List(Of GraphQL.Query)
' Save query data to business objects
For Each oRow As DataRow In oQueryTable.Rows
Dim oQuery As New GraphQL.Query With {
.Id = oRow.Item("GUID"),
.Name = oRow.Item("TITLE"),
.ClearBeforeFill = oRow.Item("CLEAR_BEFORE_FILL"),
.ConnectionId = oRow.Item("CON_ID"), ' TODO: Connection String?
.DestinationTable = oRow.Item("DESTINATION_TABLE"),
.OperationName = oRow.Item("OPERATION_NAME"),
.MappingBasePath = oRow.Item("MAPPING_BASE_PATH"),
.QueryString = oRow.Item("QUERY_STRING"),
.QueryConstraint = oRow.Item("QUERY_CONSTRAINT")
}
oQueryList.Add(oQuery)
Next
_Logger.Debug("Getting the data from GraphQL")
For Each oQuery As GraphQL.Query In oQueryList
Try
_Logger.NewBlock($"Query [{oQuery.Name}]")
Dim oConnectionId As Integer = oQuery.ConnectionId
Dim oConnectionString = _MSSQL.Get_ConnectionStringforID(oConnectionId)
Dim oDatabase As New MSSQLServer(_LogConfig, oConnectionString)
' Reset all records to status = 0
_Logger.Info("Resetting data with constraint [{1}]", oQuery.Name, oQuery.QueryConstraint)
Dim oResetSQL = $"UPDATE {oQuery.DestinationTable} SET STATUS = 0"
If oQuery.QueryConstraint <> String.Empty Then
oResetSQL &= $" WHERE {oQuery.QueryConstraint}"
End If
_MSSQL.ExecuteNonQuery(oResetSQL)
_Logger.Info("Getting data..", oQuery.Name)
' get the data from GraphQL
Dim oDataResponse = _GraphQL.GetData(oQuery.QueryString, oQuery.OperationName)
Dim oResult As String
' write data to string
Using oStream = oDataResponse.GetResponseStream()
Using oReader As New StreamReader(oStream)
oResult = oReader.ReadToEnd()
End Using
End Using
' Fill the query object with field mapping data from TBCUST_JOBRUNNER_QUERY_MAPPING
Dim oSQL As String = "SELECT t2.* FROM TBCUST_JOBRUNNER_QUERY_MAPPING t
JOIN TBCUST_JOBRUNNER_MAPPING t2 ON t.MAPPING_ID = t2.GUID
WHERE t.QUERY_ID = {0}"
Dim oMappingTable As DataTable = _MSSQL.GetDatatable(String.Format(oSQL, oQuery.Id))
For Each oMapping As DataRow In oMappingTable.Rows
oQuery.MappingFields.Add(New GraphQL.FieldMapping With {
.DestinationColumn = oMapping.Item("DestinationColumn"),
.SourcePath = oMapping.Item("SourcePath")
})
Next
' Handle the response from GraphQL and insert Data
Dim oQueryHandleResult = HandleResponse(oResult, oQuery, oDatabase)
If IsNothing(oQueryHandleResult) Then
Continue For
End If
' Finally delete all old records
Dim oDeleteSQL = $"DELETE FROM {oQuery.DestinationTable} WHERE STATUS = 0"
If oQuery.QueryConstraint <> String.Empty Then
oDeleteSQL &= $" AND {oQuery.QueryConstraint}"
End If
_Logger.Info("Success, deleting old records..", oQuery.Name)
_MSSQL.ExecuteNonQuery(oDeleteSQL)
Catch ex As Exception
_Logger.Warn("Error while getting Data for Name/OperationName [{0}]/[{1}]", oQuery.Name, oQuery.OperationName)
_Logger.Error(ex)
_Logger.Info("Failure, deleting new records..", oQuery.Name)
' If a crash happens, delete all records which were inserted in this run,
' thus going back to the previous state
Dim oDeleteSQL = $"DELETE FROM {oQuery.DestinationTable} WHERE STATUS = 1"
If oQuery.QueryConstraint <> String.Empty Then
oDeleteSQL &= $" AND {oQuery.QueryConstraint}"
End If
_MSSQL.ExecuteNonQuery(oDeleteSQL)
Finally
_Logger.EndBlock()
End Try
Next
' logout
_Logger.Debug("Logging out")
Dim oLogoutResponse = _GraphQL.Logout()
Catch ex As Exception
_Logger.Error(ex)
Throw ex
End Try
End Sub
Private Function HandleResponse(JsonString As String, QueryData As GraphQL.Query, DB As Database.MSSQLServer) As GraphQL.Query
Dim oObj As JObject = JObject.Parse(JsonString)
Dim oResultList As JToken
If _GraphQL.ReadJSONPathFragmented(oObj, QueryData.MappingBasePath) = False Then
_Logger.Warn("There is an error in the MappingBasePath [{1}] configuration of query [{0}]", QueryData.Name, QueryData.MappingBasePath)
End If
Try
oResultList = oObj.SelectToken(QueryData.MappingBasePath, errorWhenNoMatch:=True)
Catch ex As Exception
_Logger.Warn("HandleResponse: Could not find BasePath: [{0}] for query [{1}]", QueryData.MappingBasePath, QueryData.Name)
_Logger.Error(ex)
Return Nothing
End Try
If oResultList Is Nothing Then
_Logger.Warn("HandleResponse: Could not find BasePath: [{0}] for query [{1}]", QueryData.MappingBasePath, QueryData.Name)
Return Nothing
End If
_Logger.Info("HandleResponse: Processing Queue [{0}] with [{1}] Items", QueryData.Name, oResultList.Count)
For Each oResultItem As JToken In oResultList
Try
Dim oValues As New List(Of String)
Dim oKeys As New List(Of String)
For Each oMapping In QueryData.MappingFields
Dim oValue As String = String.Empty
If oMapping.SourcePath.StartsWith(PLACEHOLDER_STATIC) Then
oValue = oMapping.SourcePath.Replace(PLACEHOLDER_STATIC, String.Empty)
Else
Dim oToken = oResultItem.SelectToken(oMapping.SourcePath)
If oToken Is Nothing Then
_Logger.Warn("HandleResponse: Could not find value at SourcePath: {0}", oMapping.SourcePath)
oValue = String.Empty
Else
oValue = oToken.ToString
End If
End If
oValues.Add(oValue)
oKeys.Add(oMapping.DestinationColumn)
Next
Dim oColumnValues = oValues.
Select(Function(Value) Regex.Replace(Value, "'", "''")).
Select(Function(Value) $"'{Value}'").
ToList()
Dim oValueString = String.Join(",", oColumnValues)
Dim oColumns = String.Join(",", oKeys.ToArray)
Dim oSQL As String = $"INSERT INTO {QueryData.DestinationTable} ({oColumns}) VALUES ({oValueString})"
DB.ExecuteNonQuery(oSQL)
Catch ex As Exception
_Logger.Error(ex)
End Try
Next
Return QueryData
End Function
Public Function ShouldStart(Arguments As GraphQLArgs) As Boolean Implements IJob(Of GraphQLArgs).ShouldStart
Return Arguments.Enabled
End Function
End Class

View File

@@ -40,6 +40,17 @@ Public Class Exceptions
End Sub
End Class
Public Class UnsupportedFerdException
Inherits ApplicationException
Public ReadOnly Property XmlFile As String
Public Sub New(pXmlFile As String)
MyBase.New("ZUGFeRD document found but is not supported!")
_XmlFile = pXmlFile
End Sub
End Class
Public Class NoFerdsException
Inherits ApplicationException

284
Jobs/GraphQL/GraphQLJob.vb Normal file
View File

@@ -0,0 +1,284 @@
Option Explicit On
Imports System.Collections.Generic
Imports System.Data
Imports System.IO
Imports System.Linq
Imports System.Net.NetworkInformation
Imports DigitalData.Modules.Config
Imports DigitalData.Modules.Database
Imports DigitalData.Modules.Interfaces
Imports DigitalData.Modules.Jobs.GraphQL
Imports DigitalData.Modules.Language
Imports DigitalData.Modules.Logging
Imports Newtonsoft.Json.Linq
Public Class GraphQLJob
Inherits JobBase
Implements IJob(Of GraphQLArgs)
Private _GraphQL As GraphQLInterface = Nothing
Private Const PLACEHOLDER_STATIC = "STATIC:"
Private Const JOB_NAME = "GraphQL Job"
Public Sub New(LogConfig As LogConfig, MSSQL As MSSQLServer)
MyBase.New(LogConfig, Nothing, MSSQL)
End Sub
Public Sub Start(Args As GraphQLArgs) Implements IJob(Of GraphQLArgs).Start
Try
Dim oConfigPath As String = Args.QueryConfigPath
Dim oConfigManager As New ConfigManager(Of GraphQLConfig)(_LogConfig, oConfigPath)
With oConfigManager.Config
_GraphQL = New GraphQLInterface(_LogConfig, .BaseUrl, .Email, .Password, .CertificateFingerprint)
End With
' Login to get cookie
_Logger.Debug("Logging in")
Dim oLoginResponse = _GraphQL.Login()
' save cookie for future requests
_GraphQL.SaveCookies(oLoginResponse.Cookies.Item(0))
_Logger.Debug("Loading Queries")
' Load query data from TBCUST_JOBRUNNER_QUERY
Dim oQueryTable As DataTable = _MSSQL.GetDatatable("SELECT * FROM TBCUST_JOBRUNNER_QUERY ORDER BY SEQUENCE")
Dim oQueryList As New List(Of Query)
' Save query data to business objects
For Each oRow As DataRow In oQueryTable.Rows
Dim oQuery As New Query With {
.Id = oRow.Item("GUID"),
.Name = oRow.Item("TITLE"),
.ClearBeforeFill = oRow.ItemEx("CLEAR_BEFORE_FILL", False),
.ConnectionId = oRow.ItemEx("CON_ID", 1), ' TODO: Connection String?
.DestinationTable = oRow.ItemEx("DESTINATION_TABLE", String.Empty),
.OperationName = oRow.ItemEx("OPERATION_NAME", String.Empty),
.MappingBasePath = oRow.ItemEx("MAPPING_BASE_PATH", String.Empty),
.QueryString = oRow.ItemEx("QUERY_STRING", String.Empty)
}
If oQuery.DestinationTable = String.Empty Then
_Logger.Warn("Value [DestinationTable] could not be read. Configuration incomplete.")
End If
If oQuery.OperationName = String.Empty Then
_Logger.Warn("Value [OperationName] could not be read. Configuration incomplete.")
End If
If oQuery.MappingBasePath = String.Empty Then
_Logger.Warn("Value [MappingBasePath] could not be read. Configuration incomplete.")
End If
If oQuery.QueryString = String.Empty Then
_Logger.Warn("Value [QueryString] could not be read. Configuration incomplete.")
End If
oQueryList.Add(oQuery)
Next
_Logger.Debug("Running [{0}] queries.", oQueryList.Count)
' run
For Each oQuery As Query In oQueryList
_Logger.Debug("Running Query [{0}].", oQuery.Name)
Dim oQueryResult = RunQuery(oQuery)
_Logger.Info("Query [{0}] finished with Result [{1}]", oQuery.Name, oQueryResult)
Next
' logout
_Logger.Debug("Logging out")
Dim oLogoutResponse = _GraphQL.Logout()
_Logger.Info("Finished GraphQL Job")
Catch ex As Exception
_Logger.Warn("Finished GraphQL Job with errors")
_Logger.Error(ex)
Throw ex
End Try
End Sub
Private Function RunQuery(pQuery As Query)
Try
_Logger.Info("Executing Query [{0}]", pQuery.Name)
Dim oConnectionId As Integer = pQuery.ConnectionId
Dim oConnectionString = _MSSQL.Get_ConnectionStringforID(oConnectionId)
If oConnectionString = String.Empty Then
_Logger.Warn("Could not get Connection String for ConnectionId [{0}]", oConnectionId)
End If
Dim oDatabase As New MSSQLServer(_LogConfig, oConnectionString)
'TODO: ONly set status when clear before fill is false
'TODO: ADDED_WHO which contains the query id which inserted the rows
' Clear Table before inserting
If pQuery.ClearBeforeFill = True Then
If DeleteWithQueryName(pQuery) Then
Throw New ApplicationException($"Error while clearing table before fill for Query [{pQuery.Name}]")
End If
End If
' Reset all records to status = 0
If pQuery.ClearBeforeFill = False Then
_Logger.Info("Resetting data for Query [{0}]", pQuery.Name)
If UpdateWithStatus(pQuery, 0) = False Then
Throw New ApplicationException($"Error while resetting status of current Records for Query [{pQuery.Name}]")
End If
End If
' get the data from GraphQL
_Logger.Info("Getting data..", pQuery.Name)
Dim oDataResponse = _GraphQL.GetData(pQuery.QueryString, pQuery.OperationName)
Dim oResult As String
' write data to string
Using oStream = oDataResponse.GetResponseStream()
Using oReader As New StreamReader(oStream)
oResult = oReader.ReadToEnd()
End Using
End Using
' Fill the query object with field mapping data from TBCUST_JOBRUNNER_QUERY_MAPPING
Dim oSQL As String = "SELECT t2.* FROM TBCUST_JOBRUNNER_QUERY_MAPPING t
JOIN TBCUST_JOBRUNNER_MAPPING t2 ON t.MAPPING_ID = t2.GUID
WHERE t.QUERY_ID = {0}"
Dim oMappingTable As DataTable = _MSSQL.GetDatatable(String.Format(oSQL, pQuery.Id))
For Each oMapping As DataRow In oMappingTable.Rows
pQuery.MappingFields.Add(New GraphQL.FieldMapping With {
.DestinationColumn = oMapping.Item("DestinationColumn"),
.SourcePath = oMapping.Item("SourcePath")
})
Next
' Handle the response from GraphQL and insert Data
Dim oWriteDataResult As GraphQL.Query = WriteNewQueryData(oResult, pQuery, oDatabase)
If IsNothing(oWriteDataResult) Then
Throw New ApplicationException($"Error while handling Result of Query [{pQuery.Name}]")
End If
_Logger.Info("New Data successfully inserted for Query [{0}]", pQuery.Name)
' Finally delete all old records
If pQuery.ClearBeforeFill = False Then
_Logger.Info("Deleting old records for Query [{0}].", pQuery.Name)
If DeleteWithStatus(pQuery, 0) = False Then
Throw New ApplicationException($"Error while deleting current Records for Query [{pQuery.Name}]")
End If
End If
Return True
Catch ex As Exception
_Logger.Warn("Error while getting Data for Name/OperationName [{0}]/[{1}]", pQuery.Name, pQuery.OperationName)
_Logger.Error(ex)
' If a crash happens, delete all records which were inserted in this run,
' thus going back to the previous state
_Logger.Info("Failure, deleting new records..", pQuery.Name)
If pQuery.ClearBeforeFill = False Then
If DeleteWithStatus(pQuery, 1) = False Then
Throw New ApplicationException($"Error while deleting new Records for Query [{pQuery.Name}]")
End If
End If
Return False
Finally
_Logger.Debug("Finished running Query [{0}].", pQuery.Name)
End Try
End Function
Private Function DeleteWithQueryName(pQuery)
Dim oDeleteSQL = $"DELETE FROM {pQuery.DestinationTable}"
Return _MSSQL.ExecuteNonQuery(oDeleteSQL)
End Function
Private Function DeleteWithStatus(pQuery As Query, pStatus As Integer)
Dim oDeleteSQL = $"DELETE FROM {pQuery.DestinationTable} WHERE STATUS = {pStatus} AND ADDED_QUERY_ID = '{pQuery.Id}'"
Return _MSSQL.ExecuteNonQuery(oDeleteSQL)
End Function
Private Function UpdateWithStatus(pQuery As Query, pStatus As Integer)
Dim oResetSQL = $"UPDATE {pQuery.DestinationTable} SET STATUS = {pStatus} WHERE ADDED_QUERY_ID = '{pQuery.Id}'"
Return _MSSQL.ExecuteNonQuery(oResetSQL)
End Function
Private Function WriteNewQueryData(JsonString As String, QueryData As GraphQL.Query, DB As Database.MSSQLServer) As GraphQL.Query
Dim oObj As JObject = JObject.Parse(JsonString)
Dim oResultList As JToken
If _GraphQL.ReadJSONPathFragmented(oObj, QueryData.MappingBasePath) = False Then
_Logger.Warn("There is an error in the MappingBasePath [{1}] configuration of query [{0}]", QueryData.Name, QueryData.MappingBasePath)
End If
Try
oResultList = oObj.SelectToken(QueryData.MappingBasePath, errorWhenNoMatch:=True)
Catch ex As Exception
_Logger.Warn("HandleResponse: Could not find BasePath: [{0}] for query [{1}]", QueryData.MappingBasePath, QueryData.Name)
_Logger.Error(ex)
Return Nothing
End Try
If oResultList Is Nothing Then
_Logger.Warn("HandleResponse: Could not find BasePath: [{0}] for query [{1}]", QueryData.MappingBasePath, QueryData.Name)
Return Nothing
End If
_Logger.Info("HandleResponse: Processing Queue [{0}] with [{1}] Items", QueryData.Name, oResultList.Count)
For Each oResultItem As JToken In oResultList
Try
' ADDED_WHO, ADDED_QUERY_ID are system fields which are used to correctly fill
' and delete rows in the destination table without touching rows from other queries
Dim oKeys As New List(Of String) From {"ADDED_WHO", "ADDED_QUERY_ID"}
Dim oValues As New List(Of String) From {JOB_NAME, QueryData.Id}
For Each oMapping In QueryData.MappingFields
Dim oValue As String = String.Empty
If oMapping.SourcePath.StartsWith(PLACEHOLDER_STATIC) Then
oValue = oMapping.SourcePath.Replace(PLACEHOLDER_STATIC, String.Empty)
Else
Dim oToken = oResultItem.SelectToken(oMapping.SourcePath)
If oToken Is Nothing Then
_Logger.Warn("HandleResponse: Could not find value at SourcePath: {0}", oMapping.SourcePath)
oValue = String.Empty
Else
oValue = oToken.ToString
End If
End If
oValues.Add(oValue)
oKeys.Add(oMapping.DestinationColumn)
Next
Dim oColumnString = String.Join(",", oKeys.ToArray)
Dim oValueList = oValues.Select(Function(Value) $"'{Value.EscapeForSQL}'").ToList()
Dim oValueString = String.Join(",", oValueList)
Dim oSQL As String = $"INSERT INTO {QueryData.DestinationTable} ({oColumnString}) VALUES ({oValueString})"
DB.ExecuteNonQuery(oSQL)
Catch ex As Exception
_Logger.Error(ex)
End Try
Next
Return QueryData
End Function
Public Function ShouldStart(Arguments As GraphQLArgs) As Boolean Implements IJob(Of GraphQLArgs).ShouldStart
Return Arguments.Enabled
End Function
End Class

View File

@@ -6,9 +6,7 @@ Namespace GraphQL
Public Property Name As String
Public Property ConnectionId As String = ""
Public Property ClearBeforeFill As Boolean = False
Public Property ClearCommand As String = ""
Public Property QueryString As String = ""
Public Property QueryConstraint As String = ""
Public Property OperationName As String = ""
Public Property DestinationTable As String = ""

View File

@@ -1,8 +1,19 @@
Imports System.Collections.Generic
Public Class JobConfig
Public Enabled As Boolean
Public StartImmediately As Boolean
Public CronExpression As String
Public Arguments As Dictionary(Of String, String)
Public Property Name As JobType
Public Property Enabled As Boolean = False
Public Property StartWithoutDelay As Boolean = False
Public Property CronSchedule As String = ""
Public Property ArgsString As String = ""
<Xml.Serialization.XmlIgnore>
Public Property Args As New Dictionary(Of String, String)
Public Enum JobType
ADSync
GraphQL
Test
End Enum
End Class

View File

@@ -13,46 +13,17 @@ Public Class JobConfigParser
''' </summary>
''' <param name="ConfigString"></param>
''' <returns>A populated JobConfig object</returns>
Public Shared Function ParseConfig(ConfigString As String) As JobConfig
If JobOptionsRegex.IsMatch(ConfigString) Then
Dim oMatches = JobOptionsRegex.Matches(ConfigString)
Dim oOptions As New JobConfig
Public Shared Function ParseConfig(pJobConfig As JobConfig) As JobConfig
Dim oSplitOptions As String() = ConfigString.Split(ARGS_LIST_DELIMITER)
' 24.11.2022: This only parses the optional Job arguments,
' everything is comparmentalized in the Service config
pJobConfig.Args = ParseOptionalArguments(pJobConfig.ArgsString)
Return pJobConfig
If oSplitOptions.Length = 3 Then
oOptions = ParseEnabled(oSplitOptions(0), oOptions)
oOptions.CronExpression = oSplitOptions(1)
oOptions.Arguments = ParseOptionalArguments(oSplitOptions(2))
ElseIf oSplitOptions.Length = 2 Then
oOptions = ParseEnabled(oSplitOptions(0), oOptions)
oOptions.CronExpression = oSplitOptions(1)
oOptions.Arguments = New Dictionary(Of String, String)
Else
Throw New ArgumentException("Config Malformed")
End If
Return oOptions
Else
Throw New ArgumentException("Config Malformed")
End If
End Function
Public Shared Function ParseEnabled(EnabledValue As String, Options As JobConfig) As JobConfig
Select Case EnabledValue
Case "True"
Options.Enabled = True
Options.StartImmediately = False
Case "Debug"
Options.Enabled = True
Options.StartImmediately = True
Case Else
Options.Enabled = False
Options.StartImmediately = False
End Select
Return Options
End Function
Private Shared Function ParseOptionalArguments(ArgsString As String) As Dictionary(Of String, String)
Dim oArgsDictionary As New Dictionary(Of String, String)

View File

@@ -10,7 +10,7 @@
<AssemblyName>DigitalData.Modules.Jobs</AssemblyName>
<FileAlignment>512</FileAlignment>
<MyType>Empty</MyType>
<TargetFrameworkVersion>v4.6.2</TargetFrameworkVersion>
<TargetFrameworkVersion>v4.6.1</TargetFrameworkVersion>
<NoWarn>42016,41999,42017,42018,42019,42032,42036,42020,42021,42022</NoWarn>
<AutoGenerateBindingRedirects>true</AutoGenerateBindingRedirects>
<TargetFrameworkProfile />
@@ -91,17 +91,17 @@
</ProjectReference>
</ItemGroup>
<ItemGroup>
<Compile Include="EDMI\ADSync\ADSyncArgs.vb" />
<Compile Include="EDMI\ADSync\ADSyncJob.vb" />
<Compile Include="EDMI\GraphQL\GraphQLArgs.vb" />
<Compile Include="EDMI\GraphQL\GraphQLConfig.vb" />
<Compile Include="EDMI\GraphQL\GraphQLJob.vb" />
<Compile Include="EDMI\GraphQL\GraphQLQuery.vb" />
<Compile Include="EDMI\ZUGFeRD\EmailData.vb" />
<Compile Include="EDMI\ZUGFeRD\EmailFunctions.vb" />
<Compile Include="EDMI\ZUGFeRD\EmailStrings.vb" />
<Compile Include="EDMI\ZUGFeRD\ImportZUGFeRDFiles.vb" />
<Compile Include="EDMI\ZUGFeRD\WorkerArgs.vb" />
<Compile Include="ADSync\ADSyncArgs.vb" />
<Compile Include="ADSync\ADSyncJob.vb" />
<Compile Include="GraphQL\GraphQLArgs.vb" />
<Compile Include="GraphQL\GraphQLConfig.vb" />
<Compile Include="GraphQL\GraphQLJob.vb" />
<Compile Include="GraphQL\GraphQLQuery.vb" />
<Compile Include="ZUGFeRD\EmailData.vb" />
<Compile Include="ZUGFeRD\EmailFunctions.vb" />
<Compile Include="ZUGFeRD\EmailStrings.vb" />
<Compile Include="ZUGFeRD\ImportZUGFeRDFiles.vb" />
<Compile Include="ZUGFeRD\WorkerArgs.vb" />
<Compile Include="Exceptions.vb" />
<Compile Include="JobInterface.vb" />
<Compile Include="JobBase.vb" />
@@ -116,6 +116,10 @@
</Compile>
</ItemGroup>
<ItemGroup>
<Reference Include="DigitalData.Modules.Language, Version=1.6.2.0, Culture=neutral, processorArchitecture=MSIL">
<SpecificVersion>False</SpecificVersion>
<HintPath>..\Interfaces\bin\Debug\DigitalData.Modules.Language.dll</HintPath>
</Reference>
<Reference Include="FirebirdSql.Data.FirebirdClient, Version=7.5.0.0, Culture=neutral, PublicKeyToken=3750abcc3150b00c, processorArchitecture=MSIL">
<HintPath>..\packages\FirebirdSql.Data.FirebirdClient.7.5.0\lib\net452\FirebirdSql.Data.FirebirdClient.dll</HintPath>
</Reference>

View File

@@ -12,8 +12,8 @@ Imports System.Runtime.InteropServices
<Assembly: AssemblyDescription("")>
<Assembly: AssemblyCompany("Digital Data")>
<Assembly: AssemblyProduct("Modules.Jobs")>
<Assembly: AssemblyCopyright("Copyright © 2021")>
<Assembly: AssemblyTrademark("")>
<Assembly: AssemblyCopyright("Copyright © 2022")>
<Assembly: AssemblyTrademark("1.10.0.2")>
<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("1.8.6.0")>
<Assembly: AssemblyFileVersion("1.8.6.0")>
<Assembly: AssemblyVersion("1.10.0.2")>
<Assembly: AssemblyFileVersion("1.10.0.2")>

View File

@@ -83,13 +83,14 @@ Public Class EmailFunctions
Dim oFinalBodyText = String.Format(EmailStrings.EMAIL_WRAPPING_TEXT.Replace(EmailStrings.constNAME_ZUGFERD_PORTAL, NamePortal), oCompleteBodyText)
Dim oEmailAddress = pEmailData.From
Dim oAttachment = pEmailData.Attachment
If oAttachment <> String.Empty Then
_logger.Debug($"Attachment_String [{oAttachment}]!")
If IO.File.Exists(oAttachment) = False Then
_logger.Info($"Attachment.File [{oAttachment}] is not existing!!!")
Dim oAttachmentPath = pEmailData.Attachment
If oAttachmentPath <> String.Empty Then
_logger.Debug($"Attachment_String [{oAttachmentPath}]!")
If IO.File.Exists(oAttachmentPath) = False Then
_logger.Info($"Attachment.File [{oAttachmentPath}] is not existing!!!")
End If
End If
Dim oAttachmentPathEscaped = oAttachmentPath.Replace("'", "''")
If IsNothing(oEmailAddress) OrElse String.IsNullOrWhiteSpace(oEmailAddress) Then
_logger.Warn("Could not find email-address for MessageId {0}", MessageId)
@@ -133,7 +134,7 @@ Public Class EmailFunctions
,'{oFinalBodyText}'
,'{SourceProcedure}'
,'{oCreatedWho}'
,'{oAttachment}')"
,'{oAttachmentPathEscaped}')"
_mssql.ExecuteNonQuery(oInsert)
Else
'If oDTResult.Rows.Count = 0 Then

View File

@@ -37,4 +37,8 @@
<li>Betrags-Werte weisen ungültiges Format auf (25,01 anstatt 25.01)</li>
</ul></p>
"
Public Const EMAIL_UNSUPPORTED_DOCUMENT = "
<p>Ihre Email enthielt ein ZUGFeRD Dokument ({0}), welches zur Zeit noch nicht unsterstützt wird.</p>
"
End Class

View File

@@ -26,35 +26,33 @@ Public Class ImportZUGFeRDFiles
Private Const DIRECTORY_DONT_MOVE = "DIRECTORY_DONT_MOVE"
' List of allowed extensions for PDF/A Attachments
' This list should not contain xml so the zugferd xml file will be filtered out
Private ReadOnly AllowedExtensions As List(Of String) = New List(Of String) From {"docx", "doc", "pdf", "xls", "xlsx", "ppt", "pptx", "txt"}
Private ReadOnly AllowedExtensions As New List(Of String) From {"docx", "doc", "pdf", "xls", "xlsx", "ppt", "pptx", "txt"}
Private ReadOnly _logger As Logger
Private ReadOnly _logConfig As LogConfig
Private ReadOnly _zugferd As ZUGFeRDInterface
Private ReadOnly _firebird As Firebird
Private ReadOnly _filesystem As Filesystem.File
Private ReadOnly _EmailOutAccountId As Integer
Private ReadOnly _mssql As MSSQLServer
Private ReadOnly _email As EmailFunctions
Private ReadOnly _gdpictureLicenseKey As String
Private _zugferd As ZUGFeRDInterface
Private _EmailOutAccountId As Integer
Public Sub New(LogConfig As LogConfig, Firebird As Firebird, pEmailOutAccount As Integer, pPortalName As String, Optional MSSQL As MSSQLServer = Nothing)
Public Sub New(LogConfig As LogConfig, Firebird As Firebird, Optional MSSQL As MSSQLServer = Nothing)
_logConfig = LogConfig
_logger = LogConfig.GetLogger()
_firebird = Firebird
_filesystem = New Filesystem.File(_logConfig)
_mssql = MSSQL
_EmailOutAccountId = pEmailOutAccount
_email = New EmailFunctions(LogConfig, _mssql, _firebird)
_logger.Debug("Registering GDPicture License")
If _mssql IsNot Nothing Then
Dim oSQL = "SELECT LICENSE FROM TBDD_3RD_PARTY_MODULES WHERE NAME = 'GDPICTURE'"
Dim oLicenseKey As String = _mssql.GetScalarValue(oSQL)
_zugferd = New ZUGFeRDInterface(_logConfig, oLicenseKey)
_gdpictureLicenseKey = _mssql.GetScalarValue(oSQL)
Else
_logger.Warn("GDPicture License could not be registered! MSSQL is not enabled!")
Throw New ArgumentNullException("MSSQL")
@@ -125,6 +123,14 @@ Public Class ImportZUGFeRDFiles
Dim oPropertyExtractor = New PropertyValues(_logConfig)
Dim oAttachmentExtractor = New PDFEmbeds(_logConfig)
_EmailOutAccountId = oArgs.EmailOutProfileId
Dim oOptions As New ZUGFeRDInterface.ZugferdOptions() With {
.AllowFacturX_Filename = oArgs.AllowFacturX,
.AllowXRechnung_Filename = oArgs.AllowXRechnung
}
_zugferd = New ZUGFeRDInterface(_logConfig, _gdpictureLicenseKey, oOptions)
_logger.Debug("Starting Job {0}", [GetType].Name)
Try
@@ -198,8 +204,10 @@ Public Class ImportZUGFeRDFiles
Try
For Each oFile In oFileGroupFiles
' 09.12.2021: oDocument is now an Object, because have different classes corresponding to the
' different versions of ZUGFeRD and the type is unknown at compile-time.
Dim oDocument As Object
' different versions of ZUGFeRD and the type is unknown at compile-time.
' 17.11.2022: oDocument is now a Tuple of (String, Object), to be able to return the filename
' of the extracted xml file.
Dim oDocument As Tuple(Of String, Object)
' Start a global group counter for each file
Dim oGlobalGroupCounter = 0
@@ -238,6 +246,10 @@ Public Class ImportZUGFeRDFiles
oEmailAttachmentFiles.Add(oFile)
Continue For
Case ZUGFeRDInterface.ErrorType.UnsupportedFormat
_logger.Info("File [{0}/{1}] is an unsupported ZUFeRD document format!", oFile.Name, ex.XmlFile)
Throw New UnsupportedFerdException(ex.XmlFile)
Case ZUGFeRDInterface.ErrorType.NoValidZugferd
_logger.Warn("File [{0}] is an Incorrectly formatted ZUGFeRD document!", oFile.Name)
Throw New InvalidFerdException()
@@ -380,6 +392,18 @@ Public Class ImportZUGFeRDFiles
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "MD5HashException", _EmailOutAccountId, oArgs.NamePortal)
AddRejectedState(oMessageId, "MD5HashException", "Die gesendete Rechnung wurde bereits verarbeitet!", "", oSQLTransaction)
Catch ex As UnsupportedFerdException
_logger.Error(ex)
' When UnsupportedFerdException is thrown, we don't have a MD5Hash yet.
' That 's why we set it to String.Empty here.
Create_HistoryEntry(oMessageId, String.Empty, "REJECTED - ZUGFeRD yes but unsupported format", oFBTransaction)
Dim oBody As String = String.Format(EmailStrings.EMAIL_UNSUPPORTED_DOCUMENT, ex.XmlFile)
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "UnsupportedFerdException", _EmailOutAccountId, oArgs.NamePortal)
AddRejectedState(oMessageId, "UnsupportedFerdException", "Nicht unterstütztes Datenformat", "", oSQLTransaction)
Catch ex As InvalidFerdException
_logger.Error(ex)

View File

@@ -14,10 +14,16 @@ Public Class WorkerArgs
' Property Parameter
Public PropertyMap As New Dictionary(Of String, XmlItemProperty)
' Email Parameter
Public EmailOutProfileId As Integer = 0
' Misc Flag Parameters
Public InsertIntoSQLServer As Boolean = False
Public ExceptionEmailAddress As String = Nothing
Public IgnoreRejectionStatus As Boolean = False
Public MaxAttachmentSizeInMegaBytes As Integer = -1
Public NamePortal As String = "NO PORTAL_NAME IN CONFIG"
Public AllowFacturX As Boolean = True
Public AllowXRechnung As Boolean = True
End Class

View File

@@ -13,7 +13,7 @@ Imports System.Runtime.InteropServices
<Assembly: AssemblyCompany("")>
<Assembly: AssemblyProduct("Language")>
<Assembly: AssemblyCopyright("Copyright © 2022")>
<Assembly: AssemblyTrademark("")>
<Assembly: AssemblyTrademark("1.6.2.0")>
<Assembly: ComVisible(False)>
@@ -31,5 +31,5 @@ Imports System.Runtime.InteropServices
' übernehmen, indem Sie "*" eingeben:
' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("1.6.0.0")>
<Assembly: AssemblyFileVersion("1.6.0.0")>
<Assembly: AssemblyVersion("1.6.2.0")>
<Assembly: AssemblyFileVersion("1.6.2.0")>

View File

@@ -12,4 +12,14 @@ Public Module StringEx
If String.IsNullOrEmpty(pString) Then Return pString
Return pString.Substring(0, Math.Min(pLength, pString.Length))
End Function
''' <summary>
''' Replaces single quotes in text for SQL Commands.
''' </summary>
''' <param name="pString">The string</param>
''' <returns>The escaped string.</returns>
<Extension()>
Public Function EscapeForSQL(pString As String) As String
Return Utils.NotNull(pString, String.Empty).Replace("'", "''")
End Function
End Module

View File

@@ -113,17 +113,21 @@ Public Class Limilab
End Try
End Function
Public Function IMAPGetMessageIDs_AllMails() As List(Of Long)
Dim oListuids As New List(Of Long)
Logger.Debug("Starting IMAPGetMessageIDs ...")
If Initialized = False Then
Return Nothing
End If
Try
Dim oConnect As Boolean = ImapConnect()
Dim oConnectionSuccessful As Boolean = ImapConnect()
Dim oListuids As List(Of Long)
If oConnect = True Then
If oConnectionSuccessful = True Then
Logger.Debug("Checking for new messages..")
oListuids = ImapGetMessageIDs_All()
CURR_ListUIDs = oListuids
Else
Logger.Warn("Connection was NOT successful. Returning Nothing.")
Return Nothing
End If
Return oListuids
Catch ex As Exception
@@ -223,10 +227,13 @@ Public Class Limilab
Private Function ImapGetMessageIDs_All() As List(Of Long)
Dim oListuids As New List(Of Long)
Try
Logger.Debug("Opening Inbox..")
CurrentImapObject.SelectInbox()
Logger.Debug("Searching messages..")
oListuids = CurrentImapObject.Search(Flag.All)
Logger.Debug("[{0}] messages found.", oListuids.Count)
Return oListuids
Catch ex As Exception
Logger.Error(ex)

View File

@@ -31,5 +31,5 @@ Imports System.Runtime.InteropServices
' übernehmen, indem Sie "*" eingeben:
' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("1.3.0.0")>
<Assembly: AssemblyFileVersion("1.3.0.0")>
<Assembly: AssemblyVersion("1.6.0.0")>
<Assembly: AssemblyFileVersion("1.6.0.0")>

View File

@@ -114,6 +114,7 @@ Public Class Windream
Public ReadOnly Property SessionServername As String
Public ReadOnly Property UsesDriveLetter As Boolean = True
Public Property NewDocumentID As Int32 = 0
''' <returns>A list of object types that are available</returns>
Public ReadOnly Property ObjectTypes As List(Of String)
@@ -243,14 +244,45 @@ Public Class Windream
Return oItems
End Try
End Function
Public Function CheckFileExistsinWM(pPath As String) As Boolean
If TestSessionLoggedIn() = False Then
Return Nothing
End If
pPath = GetNormalizedPath(pPath, False)
_logger.Info($"CheckFileExistsinWM: {pPath} ...")
Dim oWMObject As WMObject
Try
oWMObject = Session.GetWMObjectByPath(WMEntityDocument, pPath)
Return True
Catch ex As Exception
_logger.Info($"Unexpected Error in windream.GetFileByPath: {ex.Message}")
_logger.Error(ex)
Return False
End Try
End Function
Public Function GetFileByPath(pPath As String) As WMObject
If TestSessionLoggedIn() = False Then
Return Nothing
End If
pPath = GetNormalizedPath(pPath)
pPath = GetNormalizedPath(pPath, False)
Dim oWMObject As WMObject
Try
oWMObject = Session.GetWMObjectByPath(WMEntityDocument, pPath)
Return oWMObject
Catch ex As Exception
_logger.Info($"Unexpected Error in windream.GetFileByPath: {ex.Message}")
_logger.Error(ex)
Return Nothing
End Try
End Function
Public Function GetFileByPathObj6(pPath As String) As IWMObject6
If TestSessionLoggedIn() = False Then
Return Nothing
End If
pPath = GetNormalizedPath(pPath, False)
Dim oWMObject As IWMObject6
Try
oWMObject = Session.GetWMObjectByPath(WMEntityDocument, pPath)
Return oWMObject
@@ -283,7 +315,7 @@ Public Class Windream
End If
Try
Path = GetNormalizedPath(Path)
Path = GetNormalizedPath(Path, False)
Dim oWMObject As WMObject = Session.GetWMObjectByPath(WMEntityDocument, Path)
If oWMObject Is Nothing Then
@@ -628,7 +660,7 @@ Public Class Windream
End If
Try
Path = GetNormalizedPath(Path)
Path = GetNormalizedPath(Path, True)
Dim oFolders As List(Of String) = Path.Split("\").ToList()
Dim oFolderObject As WMObject
Dim oCurrentPath As String = String.Empty
@@ -637,6 +669,8 @@ Public Class Windream
For Each oFolder In oFolders
If oFolder.ToString.EndsWith(pExtension) Then
Exit For
ElseIf oFolder = String.Empty Then
Continue For
End If
oCurrentPath = Combine(oCurrentPath, oFolder)
@@ -659,7 +693,7 @@ Public Class Windream
End If
Try
Path = GetNormalizedPath(Path)
Path = GetNormalizedPath(Path, False)
Dim oFileObject As IWMObject6
oFileObject = GetObjectByPath(Path, WMEntityDocument)
oFileObject.CreateVersion2(False, Constants.HISTORY_NEW_FROM_VERSION, Comment)
@@ -671,6 +705,7 @@ Public Class Windream
End Function
Public Function NewFileStream(ByVal FilenameSource As String, ByVal FilenameTarget As String) As Boolean
NewDocumentID = 0
Dim oExtension As String = Path.GetExtension(FilenameSource)
If Not TestSessionLoggedIn() Then
@@ -678,7 +713,7 @@ Public Class Windream
End If
Dim oTargetDrive As String = Path.GetDirectoryName(FilenameTarget)
FilenameTarget = GetNormalizedPath(FilenameTarget)
FilenameTarget = GetNormalizedPath(FilenameTarget, True)
_logger.NewBlock("File Stream")
_logger.Debug($"Preparing to stream file from {FilenameSource} to {FilenameTarget}")
@@ -687,6 +722,8 @@ Public Class Windream
Dim oFileIO As WMFileIO
Dim oWMStream As WMStream
NewFolder(FilenameTarget, oExtension)
'Indexierungsdialog der Session unterdrücken
Session.SwitchEvents(Constants.COM_EVENT_SESSION_NEED_INDEX, False)
@@ -749,6 +786,11 @@ Public Class Windream
End Try
_logger.Info($"File '{FilenameTarget}' was streamed.")
Dim oDocid = GetIndexValue(FilenameTarget, "Dokument-ID")
If Not IsNothing(oDocid) Then
NewDocumentID = oDocid(0)
End If
_logger.EndBlock()
Return True
@@ -774,11 +816,13 @@ Public Class Windream
End Try
End Function
Public Function GetNormalizedPath(Path As String) As String
'Dim oNormalizedPath = GetCleanedPath(Path)
Dim oNormalizedPath = Language.Utils.RemoveInvalidCharacters(Path)
_logger.Debug("Normalizing Path: [{0}]", oNormalizedPath)
Public Function GetNormalizedPath(Path As String, pCleanPath As Boolean) As String
_logger.Debug("Normalizing Path: [{0}]", Path)
Dim oNormalizedPath As String = Path
If pCleanPath = True Then
oNormalizedPath = Language.Utils.RemoveInvalidCharacters(Path)
_logger.Debug("path after RemoveInvalidCharacters: [{0}]", oNormalizedPath)
End If
Try
' Convert any forward slashes / and double slashes \\ into backslashes \
' See: https://stackoverflow.com/questions/3144492/how-do-i-get-nets-path-combine-to-convert-forward-slashes-to-backslashes
@@ -788,8 +832,8 @@ Public Class Windream
' Remove Driveletter, eg. W:\
If oNormalizedPath.StartsWith($"{ClientDriveLetter}:\") Then
_logger.Debug($"Replacing ClientDriveLetter: [{ClientDriveLetter}]")
oNormalizedPath = oNormalizedPath.Substring(ClientDriveLetter.Length + 2)
_logger.Debug($"path after replaced ClientDriveLetter: [{oNormalizedPath}]")
End If
' Remove Windream Base Path, eg. \\windream\objects\
@@ -804,7 +848,9 @@ Public Class Windream
_logger.Warn($"Check Your config ClientDriveLetter [{ClientDriveLetter}] // ClientBasePath [{ClientBasePath}]")
oNormalizedPath = oNormalizedPath.Substring(3)
End If
If oNormalizedPath.StartsWith("\") = False Then
oNormalizedPath = $"\{oNormalizedPath}"
End If
_logger.Debug($"oNormalizedPath: [{oNormalizedPath}]")
Return oNormalizedPath
@@ -1041,7 +1087,7 @@ Public Class Windream
End If
Try
FolderPath = GetNormalizedPath(FolderPath)
FolderPath = GetNormalizedPath(FolderPath, False)
If TestFolderExists(FolderPath) = False Then
_logger.Warn("Folder {0} does not exist!", FolderPath)
@@ -1312,13 +1358,22 @@ Public Class Windream
Exportpath &= "\"
End If
Dim oWMObject As WMObject = GetFileByPath(WMPath)
Dim oWMObject As Object = GetFileByPath(WMPath)
If IsNothing(oWMObject) Then
Return False
'_logger.Debug("GetFileByPath failed - Trying GetFileByPathObj6...")
'oWMObject = GetFileByPathObj6(WMPath)
'If IsNothing(oWMObject) Then
' Return False
'End If
_logger.Debug("(Export_WMFile)Working on file: " & oWMObject.aName)
End If
_logger.Debug("(Export_WMFile) Working on file: " & oWMObject.aName)
Dim ExportFileIO = New WMOTOOLLib.WMFileIO ' CreateObject("WMOTOOLLib.WMFileIO") ' New WMOTOOLLib.WMFileIO
_logger.Debug("(Export_WMFile)ExportFileIO created...")
_logger.Debug("(Export_WMFile) ExportFileIO created...")
' Stream Interface bereitstellen
oWMObject.LockFor(WMObjectEditModeFileSystem)
Try
@@ -1354,12 +1409,13 @@ Public Class Windream
oWMObject.unlock()
_logger.Info($"WMFile has been exported to {tempFilename} ")
Return True
Return tempFilename
Catch ex As Exception
_logger.Error(ex)
Return False
End Try
End Function
Public Function Export_WMFile_DocID(WMPath As String, Exportpath As String, DocId As Integer)
Try
@@ -1454,11 +1510,11 @@ Public Class Windream
'Return rNewFilepath
End Function
Public Function TestFolderExists(Path As String) As Boolean
Return TestObjectExists(GetNormalizedPath(Path), WMEntityFolder)
Return TestObjectExists(GetNormalizedPath(Path, False), WMEntityFolder)
End Function
Public Function TestFileExists(Path As String) As Boolean
Return TestObjectExists(GetNormalizedPath(Path), WMEntityDocument)
Return TestObjectExists(GetNormalizedPath(Path, False), WMEntityDocument)
End Function
Public Function TestUserExists(Username As String) As Boolean
@@ -1530,7 +1586,7 @@ Public Class Windream
End If
Try
Dim oNormalizedPath = GetNormalizedPath(ObjectPath)
Dim oNormalizedPath = GetNormalizedPath(ObjectPath, False)
Dim oWMObject As WMObject = Session.GetWMObjectByPath(ObjectType, oNormalizedPath)
Return oWMObject
Catch ex As Exception