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 Return True
Catch ex As Exception Catch ex As Exception
Logger.Error(ex) 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 Return False
Finally Finally
MaybeCommitTransaction(oTransaction, pTransactionMode) MaybeCommitTransaction(oTransaction, pTransactionMode)

View File

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

View File

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

View File

@@ -42,7 +42,7 @@ Namespace SyncUsers
End Try End Try
For Each oUser In Users For Each oUser In Users
Dim oUserId As Int64 Dim oUserId As Long
Dim oUserExists As Boolean Dim oUserExists As Boolean
' Check if user already exists ' Check if user already exists
@@ -68,7 +68,7 @@ Namespace SyncUsers
_logger.Debug("Creating new user for [{0}]", oUser) _logger.Debug("Creating new user for [{0}]", oUser)
oUserId = CreateUser(oUser) oUserId = CreateUser(oUser)
_logger.Debug("User created with Id [{0}]", oUserId) _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) oCreatedUsers.Add(oUser)
Else Else
@@ -76,7 +76,7 @@ Namespace SyncUsers
oUserId = UpdateUser(oUser) oUserId = UpdateUser(oUser)
If oUserId <> 0 Then If oUserId <> 0 Then
_logger.Debug("User created with Id [{0}]", oUserId) _logger.Debug("User created with Id [{0}]", oUserId)
_logger.Info("Updated User [{0}]", oUser.samAccountName) _logger.Info("Updated User [{0}]", oUser)
oUpdatedUsers.Add(oUser) oUpdatedUsers.Add(oUser)
End If End If
@@ -84,7 +84,7 @@ Namespace SyncUsers
Catch ex As Exception Catch ex As Exception
_logger.Error(ex) _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 Continue For
End Try End Try
@@ -99,7 +99,7 @@ Namespace SyncUsers
' Add the user to group ' Add the user to group
Try Try
If AddUserToGroup(oUserId, oGroupId) Then 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 End If
Catch ex As Exception Catch ex As Exception
_logger.Error(ex) _logger.Error(ex)
@@ -175,7 +175,8 @@ Namespace SyncUsers
Dim oSQL As String = $"SELECT GUID FROM TBDD_USER WHERE UPPER(USERNAME) = UPPER('{UserName}')" Dim oSQL As String = $"SELECT GUID FROM TBDD_USER WHERE UPPER(USERNAME) = UPPER('{UserName}')"
Dim oUserId = _mssql.GetScalarValue(oSQL) 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 Return 0
End If End If
@@ -194,9 +195,15 @@ Namespace SyncUsers
End If End If
Dim oUserId As Integer = GetUserId(User.samAccountName) Dim oUserId As Integer = GetUserId(User.samAccountName)
_logger.Debug("UserId of User [{0}] is [{1}]", User, oUserId)
If oUserId = 0 Then 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) Dim oResult = _mssql.ExecuteNonQuery(oSQL)
If oResult = True Then If oResult = True Then
@@ -230,11 +237,11 @@ Namespace SyncUsers
Dim oUserId As Integer = GetUserId(User.samAccountName) Dim oUserId As Integer = GetUserId(User.samAccountName)
If Not IsNothing(oUserId) Then If Not IsNothing(oUserId) Then
If oUserId > 0 Then If oUserId > 0 Then
Dim oGivenName As String = EscapeQuotes(User.GivenName) Dim oPrename = User.GivenName.EscapeForSQL()
Dim oSurname As String = EscapeQuotes(User.Surname) Dim oSurname = User.Surname.EscapeForSQL()
Dim oEmail As String = EscapeQuotes(User.Email) 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) Dim oResult = _mssql.ExecuteNonQuery(oSQL)
If oResult = True Then If oResult = True Then
@@ -256,11 +263,6 @@ Namespace SyncUsers
End Try End Try
End Function 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 Public Sub AddCustomAttributesToUser(User As ADUser, UserId As Integer) Implements ISyncUsers.AddCustomAttributesToUser
Dim oCustomAttributes = User.CustomAttributes Dim oCustomAttributes = User.CustomAttributes

View File

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

View File

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

View File

@@ -8,45 +8,91 @@ Imports DigitalData.Modules.Logging
Imports GdPicture14 Imports GdPicture14
Public Class ZUGFeRDInterface Public Class ZUGFeRDInterface
Private _logConfig As LogConfig Private ReadOnly _logConfig As LogConfig
Private _logger As Logger 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 Public Enum ErrorType
NoValidFile NoValidFile
NoZugferd NoZugferd
NoValidZugferd NoValidZugferd
MissingProperties MissingProperties
UnsupportedFormat
UnknownError
End Enum End Enum
Public ReadOnly Property FileGroup As FileGroups Public ReadOnly Property FileGroup As FileGroups
Public ReadOnly Property PropertyValues As PropertyValues Public ReadOnly Property PropertyValues As PropertyValues
Public Sub New(LogConfig As LogConfig, GDPictureKey As String) Public Class ZugferdOptions
_logConfig = LogConfig 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() _logger = _logConfig.GetLogger()
If pOptions Is Nothing Then
_Options = New ZugferdOptions()
Else
_Options = pOptions
End If
ApplyFilenameOptions(_Options)
FileGroup = New FileGroups(_logConfig) FileGroup = New FileGroups(_logConfig)
PropertyValues = New PropertyValues(_logConfig) PropertyValues = New PropertyValues(_logConfig)
Try Try
Dim oLicenseManager As New LicenseManager Dim oLicenseManager As New LicenseManager
oLicenseManager.RegisterKEY(GDPictureKey) oLicenseManager.RegisterKEY(pGDPictureKey)
Catch ex As Exception Catch ex As Exception
_logger.Warn("GDPicture License could not be registered!") _logger.Warn("GDPicture License could not be registered!")
_logger.Error(ex) _logger.Error(ex)
End Try End Try
End Sub 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> ''' <summary>
''' Validates a ZUGFeRD File and extracts the XML Document from it ''' Validates a ZUGFeRD File and extracts the XML Document from it
''' </summary> ''' </summary>
''' <param name="Path"></param> ''' <param name="Path"></param>
''' <exception cref="ZUGFeRDExecption"></exception> ''' <exception cref="ZUGFeRDExecption"></exception>
''' <returns></returns> Public Function ExtractZUGFeRDFileWithGDPicture(Path As String) As Tuple(Of String, Object)
Public Function ExtractZUGFeRDFileWithGDPicture(Path As String) As Object
Dim oXmlDocument = ValidateZUGFeRDFileWithGDPicture(Path) Dim oXmlDocument = ValidateZUGFeRDFileWithGDPicture(Path)
If IsNothing(oXmlDocument) Then If IsNothing(oXmlDocument.Item2) Then
Throw New ZUGFeRDExecption(ErrorType.NoZugferd, "Datei ist keine ZUGFeRD Datei.") Throw New ZUGFeRDExecption(ErrorType.NoZugferd, "Datei ist keine ZUGFeRD Datei.")
End If End If
@@ -58,11 +104,10 @@ Public Class ZUGFeRDInterface
''' </summary> ''' </summary>
''' <param name="Stream"></param> ''' <param name="Stream"></param>
''' <exception cref="ZUGFeRDExecption"></exception> ''' <exception cref="ZUGFeRDExecption"></exception>
''' <returns></returns> Public Function ExtractZUGFeRDFileWithGDPicture(Stream As Stream) As Tuple(Of String, Object)
Public Function ExtractZUGFeRDFileWithGDPicture(Stream As Stream) As Object
Dim oXmlDocument = ValidateZUGFeRDFileWithGDPicture(Stream) Dim oXmlDocument = ValidateZUGFeRDFileWithGDPicture(Stream)
If IsNothing(oXmlDocument) Then If IsNothing(oXmlDocument.Item2) Then
Throw New ZUGFeRDExecption(ErrorType.NoZugferd, "Datei ist keine ZUGFeRD Datei.") Throw New ZUGFeRDExecption(ErrorType.NoZugferd, "Datei ist keine ZUGFeRD Datei.")
End If End If
@@ -72,15 +117,15 @@ Public Class ZUGFeRDInterface
''' <summary> ''' <summary>
''' Validates a ZUGFeRD File and extracts the XML Document from it ''' Validates a ZUGFeRD File and extracts the XML Document from it
''' </summary> ''' </summary>
''' <param name="Stream"></param> ''' <param name="pStream"></param>
''' <exception cref="ZUGFeRDExecption"></exception> ''' <exception cref="ZUGFeRDExecption"></exception>
''' <returns></returns> ''' <returns>The embedded xml data as an XPath document</returns>
Public Function ValidateZUGFeRDFileWithGDPicture(Stream As Stream) As XPathDocument Public Function ValidateZUGFeRDFileWithGDPicture(pStream As Stream) As Tuple(Of String, XPathDocument)
Dim oEmbedExtractor = New PDFEmbeds(_logConfig) Dim oEmbedExtractor = New PDFEmbeds(_logConfig)
Dim oAllowedExtensions = New List(Of String) From {"xml"}
Try 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, ' Attachments are in this case the files that are embedded into a pdf file,
' like for example the zugferd-invoice.xml file ' like for example the zugferd-invoice.xml file
@@ -97,12 +142,18 @@ Public Class ZUGFeRDInterface
End Try End Try
End Function 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 oEmbedExtractor = New PDFEmbeds(_logConfig)
Dim oAllowedExtensions = New List(Of String) From {"xml"}
Try 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, ' Attachments are in this case the files that are embedded into a pdf file,
' like for example the zugferd-invoice.xml file ' like for example the zugferd-invoice.xml file
@@ -119,38 +170,39 @@ Public Class ZUGFeRDInterface
End Try End Try
End Function End Function
Private Function HandleEmbeddedFiles(Results As List(Of PDFEmbeds.EmbeddedFile)) As XPathDocument Private Function HandleEmbeddedFiles(pResults As List(Of PDFEmbeds.EmbeddedFile)) As Tuple(Of String, XPathDocument)
Dim oXmlDocument As XPathDocument If pResults Is Nothing Then
If Results Is Nothing Then
Throw New ZUGFeRDExecption(ErrorType.NoZugferd, "Datei ist keine ZUGFeRD Datei, weil die Attachments nicht gelesen werden konnten.") Throw New ZUGFeRDExecption(ErrorType.NoZugferd, "Datei ist keine ZUGFeRD Datei, weil die Attachments nicht gelesen werden konnten.")
End If 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.") Throw New ZUGFeRDExecption(ErrorType.NoZugferd, "Datei ist keine ZUGFeRD Datei, weil sie keine Attachments enthält.")
End If 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 ' Find the first file which filename matches the valid filenames for embedded invoice files
Dim oFoundResult As PDFEmbeds.EmbeddedFile = Results. Dim oValidResult As PDFEmbeds.EmbeddedFile = pResults.
Where(Function(result) oValidFilenames.Contains(result.FileName.ToUpper)). Where(Function(f) ValidFilenames.Contains(f.FileName.ToUpper)).
FirstOrDefault() FirstOrDefault()
If oFoundResult Is Nothing Then If oValidResult Is Nothing Then
Throw New ZUGFeRDExecption(ErrorType.NoZugferd, "Datei ist keine ZUGFeRD Datei, weil die zugferd-invoice.xml nicht gefunden wurde.") 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 End If
Try Try
Using oStream As New MemoryStream(oFoundResult.FileContents) Using oStream As New MemoryStream(oAllowedResult.FileContents)
oXmlDocument = New XPathDocument(oStream) Return New Tuple(Of String, XPathDocument)(oAllowedResult.FileName, New XPathDocument(oStream))
End Using End Using
Return oXmlDocument
Catch ex As ZUGFeRDExecption Catch ex As ZUGFeRDExecption
' Don't log ZUGFeRD Exceptions here, they should be handled by the calling code. ' 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. ' 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 Try
End Function 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 Try
Dim oNavigator As XPathNavigator = Document.CreateNavigator() Dim oNavigator As XPathNavigator = pDocument.Item2.CreateNavigator()
Dim oReader As XmlReader Dim oReader As XmlReader
Dim oResult = Nothing Dim oResult = Nothing

View File

@@ -4,10 +4,23 @@
Public ReadOnly Property ErrorType() As ZUGFeRDInterface.ErrorType 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) Public Sub New(ErrorType As ZUGFeRDInterface.ErrorType, Message As String)
MyBase.New(Message) MyBase.New(Message)
_ErrorType = ErrorType _ErrorType = ErrorType
End Sub 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
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) Public Function Extract(FilePath As String, AllowedExtensions As List(Of String)) As List(Of EmbeddedFile)
Dim oFile As New List(Of EmbeddedFile) Dim oFile As New List(Of EmbeddedFile)
Dim oFileInfo As FileInfo 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) 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> ''' <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) Public Function Extract(Stream As Stream, AllowedExtensions As List(Of String)) As List(Of EmbeddedFile)
Dim oResults As New 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") Logger.Debug("Extracting embedded files from stream")

View File

@@ -8,4 +8,4 @@
</dependentAssembly> </dependentAssembly>
</assemblyBinding> </assemblyBinding>
</runtime> </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"?> <?xml version="1.0" encoding="utf-8"?>
<configuration> <configuration>
<startup> <startup>
<supportedRuntime version="v4.0" sku=".NETFramework,Version=v4.6.2"/> <supportedRuntime version="v4.0" sku=".NETFramework,Version=v4.6.1"/>
</startup> </startup>
<runtime> <runtime>
<assemblyBinding xmlns="urn:schemas-microsoft-com:asm.v1"> <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 Sub
End Class 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 Public Class NoFerdsException
Inherits ApplicationException 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 Name As String
Public Property ConnectionId As String = "" Public Property ConnectionId As String = ""
Public Property ClearBeforeFill As Boolean = False Public Property ClearBeforeFill As Boolean = False
Public Property ClearCommand As String = ""
Public Property QueryString As String = "" Public Property QueryString As String = ""
Public Property QueryConstraint As String = ""
Public Property OperationName As String = "" Public Property OperationName As String = ""
Public Property DestinationTable As String = "" Public Property DestinationTable As String = ""

View File

@@ -1,8 +1,19 @@
Imports System.Collections.Generic Imports System.Collections.Generic
Public Class JobConfig Public Class JobConfig
Public Enabled As Boolean Public Property Name As JobType
Public StartImmediately As Boolean Public Property Enabled As Boolean = False
Public CronExpression As String Public Property StartWithoutDelay As Boolean = False
Public Arguments As Dictionary(Of String, String) 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 End Class

View File

@@ -13,46 +13,17 @@ Public Class JobConfigParser
''' </summary> ''' </summary>
''' <param name="ConfigString"></param> ''' <param name="ConfigString"></param>
''' <returns>A populated JobConfig object</returns> ''' <returns>A populated JobConfig object</returns>
Public Shared Function ParseConfig(ConfigString As String) As JobConfig Public Shared Function ParseConfig(pJobConfig As JobConfig) As JobConfig
If JobOptionsRegex.IsMatch(ConfigString) Then
Dim oMatches = JobOptionsRegex.Matches(ConfigString)
Dim oOptions As New 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 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) Private Shared Function ParseOptionalArguments(ArgsString As String) As Dictionary(Of String, String)
Dim oArgsDictionary As New Dictionary(Of String, String) Dim oArgsDictionary As New Dictionary(Of String, String)

View File

@@ -10,7 +10,7 @@
<AssemblyName>DigitalData.Modules.Jobs</AssemblyName> <AssemblyName>DigitalData.Modules.Jobs</AssemblyName>
<FileAlignment>512</FileAlignment> <FileAlignment>512</FileAlignment>
<MyType>Empty</MyType> <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> <NoWarn>42016,41999,42017,42018,42019,42032,42036,42020,42021,42022</NoWarn>
<AutoGenerateBindingRedirects>true</AutoGenerateBindingRedirects> <AutoGenerateBindingRedirects>true</AutoGenerateBindingRedirects>
<TargetFrameworkProfile /> <TargetFrameworkProfile />
@@ -91,17 +91,17 @@
</ProjectReference> </ProjectReference>
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<Compile Include="EDMI\ADSync\ADSyncArgs.vb" /> <Compile Include="ADSync\ADSyncArgs.vb" />
<Compile Include="EDMI\ADSync\ADSyncJob.vb" /> <Compile Include="ADSync\ADSyncJob.vb" />
<Compile Include="EDMI\GraphQL\GraphQLArgs.vb" /> <Compile Include="GraphQL\GraphQLArgs.vb" />
<Compile Include="EDMI\GraphQL\GraphQLConfig.vb" /> <Compile Include="GraphQL\GraphQLConfig.vb" />
<Compile Include="EDMI\GraphQL\GraphQLJob.vb" /> <Compile Include="GraphQL\GraphQLJob.vb" />
<Compile Include="EDMI\GraphQL\GraphQLQuery.vb" /> <Compile Include="GraphQL\GraphQLQuery.vb" />
<Compile Include="EDMI\ZUGFeRD\EmailData.vb" /> <Compile Include="ZUGFeRD\EmailData.vb" />
<Compile Include="EDMI\ZUGFeRD\EmailFunctions.vb" /> <Compile Include="ZUGFeRD\EmailFunctions.vb" />
<Compile Include="EDMI\ZUGFeRD\EmailStrings.vb" /> <Compile Include="ZUGFeRD\EmailStrings.vb" />
<Compile Include="EDMI\ZUGFeRD\ImportZUGFeRDFiles.vb" /> <Compile Include="ZUGFeRD\ImportZUGFeRDFiles.vb" />
<Compile Include="EDMI\ZUGFeRD\WorkerArgs.vb" /> <Compile Include="ZUGFeRD\WorkerArgs.vb" />
<Compile Include="Exceptions.vb" /> <Compile Include="Exceptions.vb" />
<Compile Include="JobInterface.vb" /> <Compile Include="JobInterface.vb" />
<Compile Include="JobBase.vb" /> <Compile Include="JobBase.vb" />
@@ -116,6 +116,10 @@
</Compile> </Compile>
</ItemGroup> </ItemGroup>
<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"> <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> <HintPath>..\packages\FirebirdSql.Data.FirebirdClient.7.5.0\lib\net452\FirebirdSql.Data.FirebirdClient.dll</HintPath>
</Reference> </Reference>

View File

@@ -12,8 +12,8 @@ Imports System.Runtime.InteropServices
<Assembly: AssemblyDescription("")> <Assembly: AssemblyDescription("")>
<Assembly: AssemblyCompany("Digital Data")> <Assembly: AssemblyCompany("Digital Data")>
<Assembly: AssemblyProduct("Modules.Jobs")> <Assembly: AssemblyProduct("Modules.Jobs")>
<Assembly: AssemblyCopyright("Copyright © 2021")> <Assembly: AssemblyCopyright("Copyright © 2022")>
<Assembly: AssemblyTrademark("")> <Assembly: AssemblyTrademark("1.10.0.2")>
<Assembly: ComVisible(False)> <Assembly: ComVisible(False)>
@@ -30,5 +30,5 @@ Imports System.Runtime.InteropServices
' Sie können alle Werte angeben oder die standardmäßigen Build- und Revisionsnummern ' Sie können alle Werte angeben oder die standardmäßigen Build- und Revisionsnummern
' übernehmen, indem Sie "*" eingeben: ' übernehmen, indem Sie "*" eingeben:
<Assembly: AssemblyVersion("1.8.6.0")> <Assembly: AssemblyVersion("1.10.0.2")>
<Assembly: AssemblyFileVersion("1.8.6.0")> <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 oFinalBodyText = String.Format(EmailStrings.EMAIL_WRAPPING_TEXT.Replace(EmailStrings.constNAME_ZUGFERD_PORTAL, NamePortal), oCompleteBodyText)
Dim oEmailAddress = pEmailData.From Dim oEmailAddress = pEmailData.From
Dim oAttachment = pEmailData.Attachment Dim oAttachmentPath = pEmailData.Attachment
If oAttachment <> String.Empty Then If oAttachmentPath <> String.Empty Then
_logger.Debug($"Attachment_String [{oAttachment}]!") _logger.Debug($"Attachment_String [{oAttachmentPath}]!")
If IO.File.Exists(oAttachment) = False Then If IO.File.Exists(oAttachmentPath) = False Then
_logger.Info($"Attachment.File [{oAttachment}] is not existing!!!") _logger.Info($"Attachment.File [{oAttachmentPath}] is not existing!!!")
End If End If
End If End If
Dim oAttachmentPathEscaped = oAttachmentPath.Replace("'", "''")
If IsNothing(oEmailAddress) OrElse String.IsNullOrWhiteSpace(oEmailAddress) Then If IsNothing(oEmailAddress) OrElse String.IsNullOrWhiteSpace(oEmailAddress) Then
_logger.Warn("Could not find email-address for MessageId {0}", MessageId) _logger.Warn("Could not find email-address for MessageId {0}", MessageId)
@@ -133,7 +134,7 @@ Public Class EmailFunctions
,'{oFinalBodyText}' ,'{oFinalBodyText}'
,'{SourceProcedure}' ,'{SourceProcedure}'
,'{oCreatedWho}' ,'{oCreatedWho}'
,'{oAttachment}')" ,'{oAttachmentPathEscaped}')"
_mssql.ExecuteNonQuery(oInsert) _mssql.ExecuteNonQuery(oInsert)
Else Else
'If oDTResult.Rows.Count = 0 Then '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> <li>Betrags-Werte weisen ungültiges Format auf (25,01 anstatt 25.01)</li>
</ul></p> </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 End Class

View File

@@ -26,35 +26,33 @@ Public Class ImportZUGFeRDFiles
Private Const DIRECTORY_DONT_MOVE = "DIRECTORY_DONT_MOVE" Private Const DIRECTORY_DONT_MOVE = "DIRECTORY_DONT_MOVE"
' List of allowed extensions for PDF/A Attachments ' List of allowed extensions for PDF/A Attachments
' This list should not contain xml so the zugferd xml file will be filtered out ' 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 _logger As Logger
Private ReadOnly _logConfig As LogConfig Private ReadOnly _logConfig As LogConfig
Private ReadOnly _zugferd As ZUGFeRDInterface
Private ReadOnly _firebird As Firebird Private ReadOnly _firebird As Firebird
Private ReadOnly _filesystem As Filesystem.File Private ReadOnly _filesystem As Filesystem.File
Private ReadOnly _EmailOutAccountId As Integer
Private ReadOnly _mssql As MSSQLServer Private ReadOnly _mssql As MSSQLServer
Private ReadOnly _email As EmailFunctions 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 _logConfig = LogConfig
_logger = LogConfig.GetLogger() _logger = LogConfig.GetLogger()
_firebird = Firebird _firebird = Firebird
_filesystem = New Filesystem.File(_logConfig) _filesystem = New Filesystem.File(_logConfig)
_mssql = MSSQL _mssql = MSSQL
_EmailOutAccountId = pEmailOutAccount
_email = New EmailFunctions(LogConfig, _mssql, _firebird) _email = New EmailFunctions(LogConfig, _mssql, _firebird)
_logger.Debug("Registering GDPicture License") _logger.Debug("Registering GDPicture License")
If _mssql IsNot Nothing Then If _mssql IsNot Nothing Then
Dim oSQL = "SELECT LICENSE FROM TBDD_3RD_PARTY_MODULES WHERE NAME = 'GDPICTURE'" Dim oSQL = "SELECT LICENSE FROM TBDD_3RD_PARTY_MODULES WHERE NAME = 'GDPICTURE'"
Dim oLicenseKey As String = _mssql.GetScalarValue(oSQL) _gdpictureLicenseKey = _mssql.GetScalarValue(oSQL)
_zugferd = New ZUGFeRDInterface(_logConfig, oLicenseKey)
Else Else
_logger.Warn("GDPicture License could not be registered! MSSQL is not enabled!") _logger.Warn("GDPicture License could not be registered! MSSQL is not enabled!")
Throw New ArgumentNullException("MSSQL") Throw New ArgumentNullException("MSSQL")
@@ -125,6 +123,14 @@ Public Class ImportZUGFeRDFiles
Dim oPropertyExtractor = New PropertyValues(_logConfig) Dim oPropertyExtractor = New PropertyValues(_logConfig)
Dim oAttachmentExtractor = New PDFEmbeds(_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) _logger.Debug("Starting Job {0}", [GetType].Name)
Try Try
@@ -199,7 +205,9 @@ Public Class ImportZUGFeRDFiles
For Each oFile In oFileGroupFiles For Each oFile In oFileGroupFiles
' 09.12.2021: oDocument is now an Object, because have different classes corresponding to the ' 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. ' different versions of ZUGFeRD and the type is unknown at compile-time.
Dim oDocument As Object ' 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 ' Start a global group counter for each file
Dim oGlobalGroupCounter = 0 Dim oGlobalGroupCounter = 0
@@ -238,6 +246,10 @@ Public Class ImportZUGFeRDFiles
oEmailAttachmentFiles.Add(oFile) oEmailAttachmentFiles.Add(oFile)
Continue For 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 Case ZUGFeRDInterface.ErrorType.NoValidZugferd
_logger.Warn("File [{0}] is an Incorrectly formatted ZUGFeRD document!", oFile.Name) _logger.Warn("File [{0}] is an Incorrectly formatted ZUGFeRD document!", oFile.Name)
Throw New InvalidFerdException() Throw New InvalidFerdException()
@@ -380,6 +392,18 @@ Public Class ImportZUGFeRDFiles
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "MD5HashException", _EmailOutAccountId, oArgs.NamePortal) _email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "MD5HashException", _EmailOutAccountId, oArgs.NamePortal)
AddRejectedState(oMessageId, "MD5HashException", "Die gesendete Rechnung wurde bereits verarbeitet!", "", oSQLTransaction) 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 Catch ex As InvalidFerdException
_logger.Error(ex) _logger.Error(ex)

View File

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

View File

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

View File

@@ -12,4 +12,14 @@ Public Module StringEx
If String.IsNullOrEmpty(pString) Then Return pString If String.IsNullOrEmpty(pString) Then Return pString
Return pString.Substring(0, Math.Min(pLength, pString.Length)) Return pString.Substring(0, Math.Min(pLength, pString.Length))
End Function 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 End Module

View File

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

View File

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