MONSTER: Rename Monorepo to Modules, only keep Projects under Modules.*

This commit is contained in:
Jonathan Jenne
2022-09-29 13:46:00 +02:00
parent e87b97bfec
commit fc6c73ab6d
1557 changed files with 379 additions and 160016 deletions

View File

@@ -0,0 +1,315 @@
Imports System.DirectoryServices
Imports System.DirectoryServices.AccountManagement
Imports System.Text.RegularExpressions
Imports DigitalData.Modules.Database
Imports DigitalData.Modules.Logging
Public Class ActiveDirectoryInterface
Private _logConfig As LogConfig
Private _logger As Logger
Private ReadOnly _rootPath As String
Private _rootNode As DirectoryEntry
Private Const SEARCH_LIMIT = 50000
Private Const SAMACCOUNTNAME = "samaccountname"
Private Const OBJECTCLASS = "objectClass"
Private Const CN = "cn"
Private Const DESCRIPTION = "description"
Private Const DISINGUISHEDNAME = "distinguishedName"
Private Const NAME = "name"
Private Const OBJECTCATEGORY = "objectCategory"
Public Const DEFAULT_USER_FILTER = "(&(objectClass=user)(samAccountName=@SAMACCOUNTNAME)(!(UserAccountControl:1.2.840.113556.1.4.803:=2)))"
Public Const DEFAULT_GROUP_FILTER = "(&(objectClass=group) (samAccountName=*))"
Public Sub New(LogConfig As LogConfig, Optional RootPath As String = Nothing)
_logConfig = LogConfig
_logger = _logConfig.GetLogger()
If RootPath Is Nothing Then
_rootPath = $"LDAP://{Environment.UserDomainName}"
Else
_rootPath = RootPath
End If
_logger.Info("Using RootPath {0}", _rootPath)
End Sub
Public Function SyncUsersForGroup(GroupName As String, Firebird As Firebird, MSSQL As MSSQLServer) As List(Of ADUser)
Try
Return SyncUsersForGroup(GroupName, New List(Of AttributeMapping), Firebird, MSSQL)
Catch ex As Exception
_logger.Error(ex)
Return Nothing
End Try
End Function
Public Function SyncUsersForGroup(GroupName As String, AttributeMappings As List(Of AttributeMapping), Firebird As Firebird, MSSQL As MSSQLServer, Optional Filter As String = DEFAULT_USER_FILTER) As List(Of ADUser)
Dim oUsers As New List(Of ADUser)
Dim oSyncedUsers As New List(Of ADUser)
Dim oGroupId As Int64 = Nothing
Dim oFirebirdSync As New SyncUsers.SyncUsersFirebird(_logConfig, Firebird)
Dim oSQLSync As New SyncUsers.SyncUsersMSSQL(_logConfig, MSSQL)
Dim oSyncedUsersFirebird, oSyncedUsersMSSQL As List(Of ADUser)
Try
_logger.Debug("Fetching users from ActiveDirectory")
oUsers = ListUsers(GroupName, AttributeMappings, Filter)
_logger.Debug("Found {0} users", oUsers.Count)
Catch ex As Exception
_logger.Error(ex)
Return Nothing
End Try
' Do the actual sync into firebird
If Firebird IsNot Nothing Then
oSyncedUsersFirebird = oFirebirdSync.SyncUsers(GroupName, oUsers, AttributeMappings)
If oSyncedUsersFirebird.Count > 0 Then
_logger.Debug("Synced {0} users to Firebird", oSyncedUsersFirebird.Count)
End If
Else
_logger.Debug("SyncUsersForGroup: _firebird is nothing. ")
End If
' Do the actual sync into MSSQL
If MSSQL IsNot Nothing Then
oSyncedUsersMSSQL = oSQLSync.SyncUsers(GroupName, oUsers, AttributeMappings)
If oSyncedUsersMSSQL.Count > 0 Then
_logger.Debug("Synced {0} users to MSSQLServer", oSyncedUsersMSSQL.Count)
End If
Else
_logger.Debug("SyncUsersForGroup: _mssql is nothing. ")
End If
Return oUsers
End Function
Public Function Authenticate() As Boolean
Try
Dim oEntry = GetRootNode()
oEntry.RefreshCache()
_rootNode = oEntry
Return True
Catch ex As Exception
_logger.Error(ex)
_logger.Warn("Could not authenticate with Active Directory.")
Return False
End Try
End Function
Public Function Authenticate(Username As String, Password As String) As Boolean
Try
Dim oEntry = GetRootNode(Username, Password)
oEntry.RefreshCache()
_rootNode = oEntry
Return True
Catch ex As Exception
_logger.Error(ex)
_logger.Warn("Could not authenticate with Active Directory.")
Return False
End Try
End Function
Public Function ListGroups(Optional Query As String = DEFAULT_GROUP_FILTER) As List(Of ADGroup)
Return ListGroups(_rootNode, Query)
End Function
Public Async Function ListGroupsAsync(Optional Query As String = DEFAULT_GROUP_FILTER) As Task(Of List(Of ADGroup))
Return Await Task.Run(Function() ListGroups(Query))
End Function
Public Function ListGroups(RootNode As DirectoryEntry, Optional Query As String = DEFAULT_GROUP_FILTER) As List(Of ADGroup)
Dim oGroups As New List(Of ADGroup)
Try
Dim oDirectorySearcher As New DirectorySearcher(RootNode) With {
.SearchScope = SearchScope.Subtree,
.SizeLimit = SEARCH_LIMIT,
.Filter = Query
}
Dim oResults As SearchResultCollection = oDirectorySearcher.FindAll()
_logger.Info("Found {0} Groups.", oResults.Count)
Return GroupResultsToList(oResults)
Catch ex As Exception
_logger.Error(ex)
Return oGroups
End Try
End Function
Public Function ListUsers(GroupName As String, Optional Filter As String = DEFAULT_USER_FILTER) As List(Of ADUser)
Return ListUsers(GroupName, New List(Of AttributeMapping), Filter)
End Function
Public Async Function ListUsersAsync(GroupName As String, Optional Filter As String = DEFAULT_USER_FILTER) As Task(Of List(Of ADUser))
Return Await Task.Run(Function() ListUsers(GroupName, Filter))
End Function
Public Function ListUsers(GroupName As String, AttributeMappings As List(Of AttributeMapping), Optional Filter As String = DEFAULT_USER_FILTER) As List(Of ADUser)
Dim oUsers As New List(Of ADUser)
Try
Using oContext As New PrincipalContext(ContextType.Domain)
Using oGroupPrincipal As GroupPrincipal = GroupPrincipal.FindByIdentity(oContext, IdentityType.Name, GroupName)
If oGroupPrincipal Is Nothing Then
_logger.Debug("Group {0} does not exist.", GroupName)
Return oUsers
End If
_logger.Debug("Listing members of Group {0}", GroupName)
Using oMembers = oGroupPrincipal.GetMembers(True)
For Each oMember As Principal In oMembers
Try
If TypeOf oMember Is UserPrincipal Then
Dim oUser As UserPrincipal = DirectCast(oMember, UserPrincipal)
Dim oUserEx As UserPrincipalEx = UserPrincipalEx.FindByIdentity(oContext, IdentityType.SamAccountName, oUser.SamAccountName)
Dim oCustomAttributes As New List(Of ADUser.CustomAttribute)
Dim oUserFound = FindUserWithFilter(oUserEx, Filter)
If oUserFound = False Then
_logger.Debug("User [{0}] was skipped out due to user filter.", oUserEx.SamAccountName)
Continue For
End If
_logger.Debug("User [{0}] passed the filter.", oUserEx.SamAccountName)
' TODO: Figure out why oUserEx can be nothing for certain users
If oUserEx IsNot Nothing Then
For Each oMap As AttributeMapping In AttributeMappings
Dim oAttributeValue = oUserEx.GetAttributeValue(oMap.AttributeName)
If oAttributeValue <> String.Empty Then
_logger.Debug("Attribute [{0}] is not empty.", oMap.AttributeName)
oCustomAttributes.Add(New ADUser.CustomAttribute() With {
.Name = oMap.AttributeName,
.Value = oAttributeValue,
.FirebirdSyskey = oMap.FirebirdSyskey,
.MSSQLColumn = oMap.MSSQLColumn
})
End If
Next
Else
_logger.Debug("Could not fetch CustomAttributes for user [{0}]", oUser)
End If
_logger.Debug("Trying to add User [{0}] to user list", oUser)
Dim oNewUser As New ADUser With {
.SId = oUser.Sid,
.samAccountName = oUser.SamAccountName,
.Middlename = oUser.MiddleName,
.GivenName = oUser.GivenName,
.Surname = oUser.Surname,
.GUID = oUser.Guid,
.Email = oUser.EmailAddress,
.CustomAttributes = oCustomAttributes
}
oUsers.Add(oNewUser)
End If
Catch ex As Exception
_logger.Warn("User could not be processed")
_logger.Error(ex)
End Try
Next
End Using
End Using
End Using
Return oUsers
Catch ex As Exception
_logger.Error(ex)
Return oUsers
End Try
End Function
Public Function FindUserWithFilter(User As UserPrincipalEx, Filter As String) As Boolean
Try
Dim oRootPath = String.Join(","c, User.DistinguishedName.Split(","c).Skip(1))
Dim oPlaceholder = "@SAMACCOUNTNAME"
Dim oProtocol = "LDAP://"
Dim oEntry As New DirectoryEntry(oProtocol & oRootPath) With {
.Username = Nothing,
.Password = Nothing,
.AuthenticationType = AuthenticationTypes.Secure
}
If Filter = String.Empty Then
_logger.Debug("FindUserWithFilter: Filter was empty, returning True for User [{0}]", User.SamAccountName)
Return True
End If
If Filter.Contains(oPlaceholder) Then
Filter = Filter.Replace(oPlaceholder, User.SamAccountName)
Else
_logger.Warn("FindUserWithFilter: Placeholder [{0}] was not found in filter. Results may not be correct.")
End If
Dim oSearcher As New DirectorySearcher(oEntry, Filter)
Dim oResult As SearchResult = oSearcher.FindOne()
If oResult IsNot Nothing AndAlso oResult.Path.Replace(oProtocol, String.Empty) = User.DistinguishedName Then
Return True
Else
Return False
End If
Catch ex As Exception
_logger.Warn("FindUserWithFilter: Unhandled exception.")
_logger.Error(ex)
Return False
End Try
End Function
Private Function GetRootNode() As DirectoryEntry
Dim oEntry As New DirectoryEntry(_rootPath) With {
.AuthenticationType = AuthenticationTypes.Secure,
.Password = Nothing,
.Username = Nothing
}
Return oEntry
End Function
Private Function GetRootNode(Username As String, Password As String) As DirectoryEntry
Dim oEntry As New DirectoryEntry(_rootPath) With {
.AuthenticationType = AuthenticationTypes.Secure,
.Password = Username,
.Username = Password
}
Return oEntry
End Function
Private Function GroupResultsToList(Results As SearchResultCollection) As List(Of ADGroup)
Dim oGroups As New List(Of ADGroup)
For Each oResult As SearchResult In Results
oGroups.Add(New ADGroup() With {
.Name = TryGetProperty(oResult, NAME),
.SAMAccountName = TryGetProperty(oResult, SAMACCOUNTNAME),
.CN = TryGetProperty(oResult, CN),
.Description = TryGetProperty(oResult, DESCRIPTION),
.DistinguishedName = TryGetProperty(oResult, DISINGUISHEDNAME),
.ObjectCategory = TryGetProperty(oResult, OBJECTCATEGORY),
.ObjectClass = TryGetProperty(oResult, OBJECTCLASS)
})
Next
Return oGroups
End Function
Private Function TryGetProperty(Result As SearchResult, PropertyName As String) As String
Try
Return Result.Properties.Item(PropertyName).Item(0)
Catch ex As Exception
_logger.Debug("Property {0} not found", PropertyName)
Return String.Empty
End Try
End Function
End Class

View File

@@ -0,0 +1,13 @@
Public Class ADGroup
Public Property SAMAccountName As String
Public Property ObjectClass As String
Public Property CN As String
Public Property Description As String
Public Property DistinguishedName As String
Public Property Name As String
Public Property ObjectCategory As String
Public Overrides Function ToString() As String
Return SAMAccountName
End Function
End Class

View File

@@ -0,0 +1,28 @@
Imports System.Security.Principal
Public Class ADUser
Public Property GUID As Guid
Public Property samAccountName As String
Public Property SId As SecurityIdentifier
Public Property Surname As String
Public Property GivenName As String
Public Property Middlename As String
Public Property Email As String
Public CustomAttributes As List(Of CustomAttribute)
Public Overrides Function Equals(obj As Object) As Boolean
Return DirectCast(obj, ADUser).samAccountName
End Function
Public Overrides Function ToString() As String
Return samAccountName
End Function
Public Class CustomAttribute
Public Name As String
Public Value As Object
Public MSSQLColumn As String
Public FirebirdSyskey As String
End Class
End Class

View File

@@ -0,0 +1,5 @@
Public Class AttributeMapping
Public AttributeName As String
Public FirebirdSyskey As String
Public MSSQLColumn As String
End Class

View File

@@ -0,0 +1,8 @@
Public Interface ISyncUsers
Function SyncUsers(GroupName As String, Users As List(Of ADUser), PropertyMapping As List(Of AttributeMapping)) As List(Of ADUser)
Function GetGroupId(GroupName As String) As Integer
Function GetUserId(UserName As String) As Integer
Function CreateUser(User As ADUser) As Integer
Function AddUserToGroup(UserId As Integer, GroupId As Integer) As Boolean
Sub AddCustomAttributesToUser(User As ADUser, UserId As Integer)
End Interface

View File

@@ -0,0 +1,145 @@
Imports DigitalData.Modules.Database
Imports DigitalData.Modules.Interfaces
Imports DigitalData.Modules.Logging
Namespace SyncUsers
Public Class SyncUsersFirebird
Implements ISyncUsers
Private ReadOnly _logConfig As LogConfig
Private ReadOnly _logger As Logger
Private ReadOnly _firebird As Database.Firebird
Public Sub New(LogConfig As LogConfig, Firebird As Database.Firebird)
_logConfig = LogConfig
_logger = LogConfig.GetLogger()
_firebird = Firebird
End Sub
Public Function SyncUsers(GroupName As String, Users As List(Of ADUser), PropertyMapping As List(Of AttributeMapping)) As List(Of ADUser) Implements ISyncUsers.SyncUsers
Dim oGroupId As Integer
Dim oSyncedUsers As New List(Of ADUser)
Try
_logger.Debug("Getting group Id for group [{0}]", GroupName)
oGroupId = GetGroupId(GroupName)
If oGroupId = 0 Then
_logger.Debug("Group [{0}] does not exist in database or is not enabled for sync.", GroupName)
Return oSyncedUsers
End If
_logger.Debug("Using group Id [{0}]", oGroupId)
Catch ex As Exception
_logger.Error(ex)
Return oSyncedUsers
End Try
For Each oUser In Users
Dim oUserId As Int64
Dim oUserExists As Boolean = False
' Check if user already exists
Try
_logger.Debug("Checking if user [{0}] exists", oUser)
oUserId = GetUserId(oUser.samAccountName)
oUserExists = Not IsNothing(oUserId)
_logger.Debug("User [{0}] exists in database: ", oUser, oUserExists)
Catch ex As Exception
_logger.Error(ex)
_logger.Warn("Could not get UserId for user. Skipping")
Continue For
End Try
' I user does not exist, create a new user
Try
If Not oUserExists Then
_logger.Debug("Creating new user for [{0}]", oUser)
oUserId = CreateUser(oUser)
_logger.Debug("User created with Id [{0}]", oUserId)
End If
Catch ex As Exception
_logger.Error(ex)
_logger.Warn("Could not create user. Skipping")
Continue For
End Try
' Add the user to group
Try
AddUserToGroup(oUserId, oGroupId)
Catch ex As Exception
_logger.Error(ex)
_logger.Warn("Could not add user to group. Skipping")
Continue For
End Try
oSyncedUsers.Add(oUser)
Next
Return oSyncedUsers
End Function
Private Function AddUserToGroup(UserId As Integer, GroupId As Integer) As Boolean Implements ISyncUsers.AddUserToGroup
Try
Dim oSQL = $"SELECT FNICM_RADM_NEW_USER2GROUP({UserId}, {GroupId}, 'AD-Sync') from RDB$DATABASE"
Dim oRecordId = _firebird.GetScalarValue(oSQL)
If IsDBNull(oRecordId) Then
_logger.Warn("UserId {0} - GroupId {1} relation already exists.", UserId, GroupId)
Return False
End If
Return True
Catch ex As Exception
_logger.Error(ex)
Throw ex
End Try
End Function
Private Function GetGroupId(GroupName As String) As Integer Implements ISyncUsers.GetGroupId
Try
Dim oSQL As String = $"SELECT FNICM_GET_RECORD4SYSKEY('{GroupName}','002-NAME') from RDB$DATABASE"
Dim oGroupId = _firebird.GetScalarValue(oSQL)
If IsDBNull(oGroupId) OrElse oGroupId = 0 Then
_logger.Debug("Group {0} not found in database", GroupName)
Return Nothing
End If
Return oGroupId
Catch ex As Exception
_logger.Error(ex)
Throw ex
End Try
End Function
Private Function GetUserId(UserName As String) As Integer Implements ISyncUsers.GetUserId
Try
Dim oSQL As String = $"SELECT FNICM_GET_RECORD4SYSKEY('{UserName}','001-USRNAME') from RDB$DATABASE"
Dim oResult = _firebird.GetScalarValue(oSQL)
If IsDBNull(oResult) Then
Return Nothing
End If
Return oResult
Catch ex As Exception
_logger.Error(ex)
Throw ex
End Try
End Function
Private Function CreateUser(User As ADUser) As Integer Implements ISyncUsers.CreateUser
Try
Dim oSQL = $"SELECT FNICM_RADM_NEW_USER('{User?.GivenName}', '{User?.Surname}', '{User?.samAccountName}', 'AD-Sync') from RDB$DATABASE"
Dim oUserId As Integer = _firebird.GetScalarValue(oSQL)
Return oUserId
Catch ex As Exception
_logger.Error(ex)
Throw ex
End Try
End Function
Public Sub AddCustomAttributesToUser(User As ADUser, UserId As Integer) Implements ISyncUsers.AddCustomAttributesToUser
Throw New NotImplementedException()
End Sub
End Class
End Namespace

View File

@@ -0,0 +1,284 @@
Imports DigitalData.Modules.Database
Imports DigitalData.Modules.Logging
Imports DigitalData.Modules.Language
Namespace SyncUsers
Public Class SyncUsersMSSQL
Implements ISyncUsers
Private _logConfig As LogConfig
Private _logger As Logger
Private _mssql As MSSQLServer
Private Const ADDED_WHO = "Active Directory Sync"
Public Sub New(LogConfig As LogConfig, MSSQL As MSSQLServer)
_logConfig = LogConfig
_logger = LogConfig.GetLogger()
_mssql = MSSQL
End Sub
Public Function SyncUsers(GroupName As String, Users As List(Of ADUser), PropertyMapping As List(Of AttributeMapping)) As List(Of ADUser) Implements ISyncUsers.SyncUsers
Dim oGroupId As Integer
Dim oSyncedUsers As New List(Of ADUser)
Dim oSyncedUserIds As New List(Of Int64)
Dim oCreatedUsers As New List(Of ADUser)
Dim oUpdatedUsers As New List(Of ADUser)
Try
_logger.Debug("Getting group Id for group {0}", GroupName)
oGroupId = GetGroupId(GroupName)
If oGroupId = 0 Then
_logger.Debug("Group {0} does not exist in database. Exiting.", GroupName)
Return oSyncedUsers
End If
_logger.Debug("Using group Id {0}", oGroupId)
Catch ex As Exception
_logger.Error(ex)
Return oSyncedUsers
End Try
For Each oUser In Users
Dim oUserId As Int64
Dim oUserExists As Boolean
' Check if user already exists
Try
_logger.Debug("Checking if user [{0}] exists", oUser)
oUserId = GetUserId(oUser.samAccountName)
oUserExists = oUserId > 0
_logger.Debug("User [{0}] exists in database: [{1}]", oUser, oUserExists)
Catch ex As Exception
_logger.Error(ex)
_logger.Warn("Could not get UserId for user. Skipping.")
Continue For
End Try
' Collect user ids from existing users
If oUserExists Then
oSyncedUserIds.Add(oUserId)
End If
' Create or update user
Try
If Not oUserExists Then
_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)
oCreatedUsers.Add(oUser)
Else
_logger.Debug("Updating user [{0}]", oUser)
oUserId = UpdateUser(oUser)
If oUserId <> 0 Then
_logger.Debug("User created with Id [{0}]", oUserId)
_logger.Info("Updated User [{0}]", oUser.samAccountName)
oUpdatedUsers.Add(oUser)
End If
End If
Catch ex As Exception
_logger.Error(ex)
_logger.Warn("Could Not create/update user [{0}]. Skipping.", oUser.samAccountName)
Continue For
End Try
' Add custom attributes to user
Try
AddCustomAttributesToUser(oUser, oUserId)
Catch ex As Exception
_logger.Error(ex)
_logger.Debug("Could Not add custom attributes to user {0}. Continuing.", oUser)
End Try
' Add the user to group
Try
If AddUserToGroup(oUserId, oGroupId) Then
_logger.Info("User [{0}] added to group [{1}]", oUser.samAccountName, GroupName)
End If
Catch ex As Exception
_logger.Error(ex)
_logger.Warn("Could Not add user {0} to group {1}. Skipping.", oUser, GroupName)
Continue For
End Try
oSyncedUsers.Add(oUser)
Next
' Delete users that are assigned to the group but no longer exist in active directory
Dim oUserIdString = String.Join(",", oSyncedUserIds)
If oSyncedUserIds.Count = 0 Then
_logger.Info("Group {0} does not contain any users.", GroupName)
oUserIdString = 0
End If
Dim oSQL As String = $"DELETE FROM TBDD_GROUPS_USER WHERE USER_ID NOT IN ({oUserIdString}) AND GROUP_ID = {oGroupId}"
Dim oDeletedRelations = _mssql.GetScalarValue(oSQL)
If oCreatedUsers.Count > 0 Then
_logger.Info("Created [{0}] new users", oCreatedUsers.Count)
End If
_logger.Info("Updated [{0}] users", oUpdatedUsers.Count)
If oDeletedRelations > 0 Then
_logger.Info("Removed [{0}] users from Group [{1}]", oDeletedRelations, GroupName)
End If
Return oSyncedUsers
End Function
Private Function AddUserToGroup(UserId As Integer, GroupId As Integer) As Boolean Implements ISyncUsers.AddUserToGroup
Try
Dim oSQL = $"SELECT COUNT(*) FROM TBDD_GROUPS_USER WHERE USER_ID = {UserId} And GROUP_ID = {GroupId}"
Dim oResult = True
If _mssql.GetScalarValue(oSQL) = 0 Then
oSQL = $"INSERT INTO TBDD_GROUPS_USER (USER_ID, GROUP_ID, ADDED_WHO) VALUES ({UserId}, {GroupId}, '{ADDED_WHO}')"
oResult = _mssql.ExecuteNonQuery(oSQL)
Else
_logger.Debug($"UserGroup-Relation [{UserId}/{GroupId}] already existing")
Return False
End If
If oResult = False Then
Throw New Exception("Error while adding user to group!")
End If
Return True
Catch ex As Exception
_logger.Error(ex)
Throw ex
End Try
End Function
Private Function GetGroupId(GroupName As String) As Integer Implements ISyncUsers.GetGroupId
Try
Dim oSQL As String = $"SELECT GUID FROM TBDD_GROUPS WHERE UPPER(NAME) = UPPER('{GroupName}') AND AD_SYNC = 1 AND ACTIVE = 1"
Dim oGroupId = _mssql.GetScalarValue(oSQL)
If IsDBNull(oGroupId) OrElse oGroupId = 0 Then
_logger.Debug("Group {0} not found in database.", GroupName)
Return 0
End If
Return oGroupId
Catch ex As Exception
_logger.Error(ex)
Throw ex
End Try
End Function
Private Function GetUserId(UserName As String) As Integer Implements ISyncUsers.GetUserId
Try
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
Return 0
End If
Return oUserId
Catch ex As Exception
_logger.Error(ex)
Throw ex
End Try
End Function
Private Function CreateUser(User As ADUser) As Integer Implements ISyncUsers.CreateUser
Try
If User Is Nothing Then
_logger.Warn("Argument [User] is nothing. Exiting.")
Throw New ArgumentNullException("User")
End If
Dim oUserId As Integer = GetUserId(User.samAccountName)
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 oResult = _mssql.ExecuteNonQuery(oSQL)
If oResult = True Then
oUserId = _mssql.GetScalarValue("SELECT MAX(GUID) FROM TBDD_USER")
Return oUserId
Else
Throw New Exception($"Error while inserting user {User.samAccountName}!")
End If
Else
Return oUserId
End If
Catch ex As Exception
_logger.Error(ex)
Throw ex
End Try
End Function
Private Function UpdateUser(User As ADUser) As Integer
Try
If User Is Nothing Then
_logger.Warn("Error in UpdateUser - User object is nothing")
Return 0
End If
If User.samAccountName Is Nothing Then
_logger.Warn("Error in UpdateUser - User samAccountName is nothing")
Return 0
End If
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 oSQL As String = $"UPDATE TBDD_USER SET PRENAME = '{oGivenName}', NAME = '{oSurname}', EMAIL = '{oEmail}', CHANGED_WHO = '{ADDED_WHO}' WHERE GUID = {oUserId}"
Dim oResult = _mssql.ExecuteNonQuery(oSQL)
If oResult = True Then
Return oUserId
Else
Throw New Exception($"Error while updating user {User.samAccountName}!")
End If
Else
Return oUserId
End If
Else
_logger.Warn("Error in UpdateUser - Could not get a userid for samAccountName: " + User.samAccountName)
Return 0
End If
Catch ex As Exception
_logger.Error(ex)
Throw ex
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
_logger.Debug("Adding {0} Custom Attributes to User {1}", oCustomAttributes.Count, User)
For Each oAttribute In oCustomAttributes
_logger.Debug("Adding Custom Attribute [{0}] with value [{1}] to User [{2}]", oAttribute.MSSQLColumn, oAttribute.Value, User)
Dim oSQL As String = $"UPDATE TBDD_USER SET {oAttribute.MSSQLColumn} = '{oAttribute.Value}', CHANGED_WHO = '{ADDED_WHO}' WHERE GUID = {UserId}"
Dim oResult = _mssql.ExecuteNonQuery(oSQL)
If oResult = False Then
_logger.Debug("Custom Attribute {0} could not be added to user {1}", oAttribute.Name, User.samAccountName)
Continue For
End If
Next
End Sub
End Class
End Namespace

View File

@@ -0,0 +1,19 @@
Imports DigitalData.Modules.Interfaces
Public Class UserEqualityComparer
Implements IEqualityComparer(Of ADUser)
Public Overloads Function Equals(x As ADUser, y As ADUser) As Boolean Implements IEqualityComparer(Of ADUser).Equals
If ReferenceEquals(x, y) Then Return True
If x Is Nothing Or y Is Nothing Then Return False
Return x.SId = y.SId
End Function
Public Overloads Function GetHashCode(obj As ADUser) As Integer Implements IEqualityComparer(Of ADUser).GetHashCode
If obj Is Nothing Then Return 0
Dim oHashCode = obj.SId.GetHashCode()
Return oHashCode
End Function
End Class

View File

@@ -0,0 +1,36 @@
Imports System.DirectoryServices.AccountManagement
<DirectoryRdnPrefix("CN")>
<DirectoryObjectClass("Person")>
Public Class UserPrincipalEx
Inherits UserPrincipal
Public Sub New(Context As PrincipalContext)
MyBase.New(Context)
End Sub
Public Sub New(Context As PrincipalContext, samAccountName As String, Password As String, Enabled As Boolean)
MyBase.New(Context, samAccountName, Password, Enabled)
End Sub
Public Overloads Shared Function FindByIdentity(ByVal Context As PrincipalContext, ByVal IdentityValue As String) As UserPrincipalEx
Return CType(FindByIdentityWithType(Context, GetType(UserPrincipalEx), IdentityValue), UserPrincipalEx)
End Function
Public Overloads Shared Function FindByIdentity(ByVal Context As PrincipalContext, ByVal IdentityType As IdentityType, ByVal IdentityValue As String) As UserPrincipalEx
Return CType(FindByIdentityWithType(Context, GetType(UserPrincipalEx), IdentityType, IdentityValue), UserPrincipalEx)
End Function
Public Function GetAttributeValue(AttributeName As String) As String
Return TryGetAttribute(AttributeName)
End Function
Private Function TryGetAttribute(AttributeName As String) As String
Dim oAttribute = ExtensionGet(AttributeName)
If oAttribute.Length <> 1 Then
Return String.Empty
End If
Return CStr(oAttribute(0))
End Function
End Class

Binary file not shown.

Binary file not shown.

Binary file not shown.

View File

@@ -0,0 +1,4 @@
Public Class LoginData
Public email As String
Public token As String
End Class

View File

@@ -0,0 +1,3 @@
Public Class LogoutData
Public email As String
End Class

View File

@@ -0,0 +1,5 @@
Public Class QueryData
Public query As String
Public operationName As String
Public variables As New Object
End Class

View File

@@ -0,0 +1,181 @@
Imports System.IO
Imports System.Net
Imports System.Security.Cryptography.X509Certificates
Imports System.Text
Imports DigitalData.Modules.Logging
Imports Newtonsoft.Json
Public Class GraphQLInterface
Private _logConfig As LogConfig
Private _logger As Logger
Private _baseUrl As String
Private _userEmail As String
Private _userPassword As String
Private _certificate As X509Certificate2
Private _cookieJar As CookieContainer
Private _Encoding As New UTF8Encoding
Private Const MAX_COOKIE_SIZE As Integer = 32768
Private Const MAX_COOKIE_COUNT As Integer = 300
Private Const MAX_COOKIE_COUNT_PER_DOMAIN As Integer = 20
Public Property Proxy As WebProxy
Public Property Credentials As NetworkCredential
Public Sub New(LogConfig As LogConfig, BaseUrl As String, Email As String, Password As String, CertificateFingerprint As String)
Try
_logConfig = LogConfig
_logger = LogConfig.GetLogger()
_baseUrl = BaseUrl
_userEmail = Email
_userPassword = Password
Dim oStore As New X509Store(StoreName.Root, StoreLocation.CurrentUser)
oStore.Open(OpenFlags.ReadOnly)
_logger.Debug("Available Certificates ({0}):", oStore.Certificates.Count)
For Each oCert In oStore.Certificates
_logger.Debug("FriendlyName: {0}", oCert.FriendlyName)
_logger.Debug("IssuerName: {0}", oCert.IssuerName.Name)
_logger.Debug("SubjectName: {0}", oCert.SubjectName.Name)
_logger.Debug("Fingerprint: {0}", oCert.Thumbprint)
Next
_logger.Debug("Looking for Certificate with Fingerprint [{0}]", CertificateFingerprint)
Dim oFoundCerts = oStore.Certificates.Find(X509FindType.FindByThumbprint, CertificateFingerprint, False)
If oFoundCerts.Count = 0 Then
_logger.Warn("Certificate could not be found! Exiting.")
Exit Sub
End If
_certificate = oFoundCerts.Item(0)
Catch ex As Exception
_logger.Error(ex)
End Try
End Sub
Public Sub SaveCookies(Cookie As Cookie)
GetCookies().Add(Cookie)
End Sub
Public Function Login() As HttpWebResponse
Try
Dim oLoginData As New LoginData() With {.email = _userEmail, .token = _userPassword}
Dim oBytes As Byte() = ToBytes(JsonConvert.SerializeObject(oLoginData))
Dim oRequest As HttpWebRequest = GetRequest("/login", oBytes)
Using oStream = oRequest.GetRequestStream()
oStream.Write(oBytes, 0, oBytes.Length)
End Using
Return oRequest.GetResponse()
Catch ex As Exception
_logger.Error(ex)
Throw ex
End Try
End Function
Public Function Logout() As HttpWebResponse
Try
Dim oLogoutData As New LogoutData() With {.email = _userEmail}
Dim oBytes As Byte() = ToBytes(JsonConvert.SerializeObject(oLogoutData))
Dim oRequest As HttpWebRequest = GetRequest("/logout", oBytes)
Using stream = oRequest.GetRequestStream()
stream.Write(oBytes, 0, oBytes.Length)
End Using
Return oRequest.GetResponse()
Catch ex As Exception
_logger.Error(ex)
Throw ex
End Try
End Function
Public Function GetData(Query As String, OperationName As String) As HttpWebResponse
Try
Dim oQueryData As New QueryData() With {
.operationName = OperationName,
.query = Query,
.variables = New Object
}
Dim oJson = JsonConvert.SerializeObject(oQueryData)
Dim oBytes = ToBytes(oJson)
Dim oRequest = GetRequest("/graphql", oBytes)
Using stream = oRequest.GetRequestStream()
stream.Write(oBytes, 0, oBytes.Length)
End Using
Return oRequest.GetResponse()
Catch ex As Exception
_logger.Error(ex)
Throw ex
End Try
End Function
Public Function ReadJSONPathFragmented(pObject As Linq.JObject, pJsonPath As String)
Dim oSplitPath As List(Of String) = pJsonPath.Split(".").ToList()
Dim oCurrentPath As String = String.Empty
For Each oPart In oSplitPath
If oCurrentPath = String.Empty Then
oCurrentPath = oPart
Else
oCurrentPath &= "." & oPart
End If
_logger.Debug("Selecting Path Fragment [{0}]", oCurrentPath)
Try
pObject.SelectToken(oCurrentPath, errorWhenNoMatch:=True)
Catch ex As Exception
_logger.Warn("Path Fragment [{0}] did not return a valid token", oCurrentPath)
Return False
End Try
Next
Return True
End Function
Private Function GetRequest(Url As String, PostData As Byte()) As HttpWebRequest
Try
Dim oRequest As HttpWebRequest = WebRequest.Create($"{_baseUrl}{Url}")
oRequest.Method = "POST"
oRequest.ContentType = "application/json"
oRequest.ContentLength = PostData.Length
oRequest.ClientCertificates.Add(_certificate)
oRequest.CookieContainer = GetCookies()
oRequest.Proxy = Nothing
If Proxy Is Nothing Then
oRequest.Proxy = Nothing
Else
oRequest.Proxy = Proxy
oRequest.Credentials = Credentials
End If
Return oRequest
Catch ex As Exception
_logger.Error(ex)
Throw ex
End Try
End Function
Private Function GetCookies() As CookieContainer
If _cookieJar Is Nothing Then
_cookieJar = New CookieContainer(MAX_COOKIE_COUNT, MAX_COOKIE_COUNT_PER_DOMAIN, MAX_COOKIE_SIZE)
End If
Return _cookieJar
End Function
Private Function ToBytes(Str As String) As Byte()
Return _Encoding.GetBytes(Str)
End Function
End Class

View File

@@ -0,0 +1,169 @@
<?xml version="1.0" encoding="utf-8"?>
<Project ToolsVersion="15.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<Import Project="$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props" Condition="Exists('$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props')" />
<PropertyGroup>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<ProjectGuid>{AB6F09BF-E794-4F6A-94BB-C97C0BA84D64}</ProjectGuid>
<OutputType>Library</OutputType>
<RootNamespace>DigitalData.Modules.Interfaces</RootNamespace>
<AssemblyName>DigitalData.Modules.Interfaces</AssemblyName>
<FileAlignment>512</FileAlignment>
<MyType>Windows</MyType>
<TargetFrameworkVersion>v4.6.1</TargetFrameworkVersion>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<DebugSymbols>true</DebugSymbols>
<DebugType>full</DebugType>
<DefineDebug>true</DefineDebug>
<DefineTrace>true</DefineTrace>
<OutputPath>bin\Debug\</OutputPath>
<DocumentationFile>DigitalData.Modules.Interfaces.xml</DocumentationFile>
<NoWarn>42016,41999,42017,42018,42019,42032,42036,42020,42021,42022</NoWarn>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<DebugType>pdbonly</DebugType>
<DefineDebug>false</DefineDebug>
<DefineTrace>true</DefineTrace>
<Optimize>true</Optimize>
<OutputPath>bin\Release\</OutputPath>
<DocumentationFile>DigitalData.Modules.Interfaces.xml</DocumentationFile>
<NoWarn>42016,41999,42017,42018,42019,42032,42036,42020,42021,42022</NoWarn>
</PropertyGroup>
<PropertyGroup>
<OptionExplicit>On</OptionExplicit>
</PropertyGroup>
<PropertyGroup>
<OptionCompare>Binary</OptionCompare>
</PropertyGroup>
<PropertyGroup>
<OptionStrict>Off</OptionStrict>
</PropertyGroup>
<PropertyGroup>
<OptionInfer>On</OptionInfer>
</PropertyGroup>
<ItemGroup>
<Reference Include="GdPicture.NET.14">
<HintPath>D:\ProgramFiles\GdPicture.NET 14\Redist\GdPicture.NET (.NET Framework 4.5)\GdPicture.NET.14.dll</HintPath>
</Reference>
<Reference Include="Microsoft.CSharp" />
<Reference Include="Newtonsoft.Json, Version=12.0.0.0, Culture=neutral, PublicKeyToken=30ad4fe6b2a6aeed, processorArchitecture=MSIL">
<HintPath>..\packages\Newtonsoft.Json.12.0.3\lib\net45\Newtonsoft.Json.dll</HintPath>
</Reference>
<Reference Include="NLog, Version=4.0.0.0, Culture=neutral, PublicKeyToken=5120e14c03d0593c, processorArchitecture=MSIL">
<HintPath>..\packages\NLog.4.7.15\lib\net45\NLog.dll</HintPath>
</Reference>
<Reference Include="System" />
<Reference Include="System.Configuration" />
<Reference Include="System.Data" />
<Reference Include="System.DirectoryServices" />
<Reference Include="System.DirectoryServices.AccountManagement" />
<Reference Include="System.IO.Compression" />
<Reference Include="System.Runtime.Serialization" />
<Reference Include="System.ServiceModel" />
<Reference Include="System.Transactions" />
<Reference Include="System.Xml" />
<Reference Include="System.Core" />
<Reference Include="System.Xml.Linq" />
<Reference Include="System.Data.DataSetExtensions" />
<Reference Include="System.Net.Http" />
</ItemGroup>
<ItemGroup>
<Import Include="Microsoft.VisualBasic" />
<Import Include="System" />
<Import Include="System.Collections" />
<Import Include="System.Collections.Generic" />
<Import Include="System.Data" />
<Import Include="System.Diagnostics" />
<Import Include="System.Linq" />
<Import Include="System.Xml.Linq" />
<Import Include="System.Threading.Tasks" />
</ItemGroup>
<ItemGroup>
<Compile Include="ActiveDirectoryInterface.vb" />
<Compile Include="ActiveDirectoryInterface\ActiveDirectoryGroup.vb" />
<Compile Include="ActiveDirectoryInterface\ActiveDirectoryUser.vb" />
<Compile Include="ActiveDirectoryInterface\AttributeMap.vb" />
<Compile Include="ActiveDirectoryInterface\ISyncUsers.vb" />
<Compile Include="ActiveDirectoryInterface\SyncUsers.Firebird.vb" />
<Compile Include="ActiveDirectoryInterface\SyncUsers.MSSQL.vb" />
<Compile Include="ActiveDirectoryInterface\UserEqualityComparer.vb" />
<Compile Include="ActiveDirectoryInterface\UserPrincipalEx.vb" />
<Compile Include="GraphQLInterface.vb" />
<Compile Include="GrapQLInterface\LoginData.vb" />
<Compile Include="GrapQLInterface\LogoutData.vb" />
<Compile Include="GrapQLInterface\QueryData.vb" />
<Compile Include="ZUGFeRDInterface\Exceptions.vb" />
<Compile Include="My Project\AssemblyInfo.vb" />
<Compile Include="My Project\Application.Designer.vb">
<AutoGen>True</AutoGen>
<DependentUpon>Application.myapp</DependentUpon>
</Compile>
<Compile Include="My Project\Resources.Designer.vb">
<AutoGen>True</AutoGen>
<DesignTime>True</DesignTime>
<DependentUpon>Resources.resx</DependentUpon>
</Compile>
<Compile Include="My Project\Settings.Designer.vb">
<AutoGen>True</AutoGen>
<DependentUpon>Settings.settings</DependentUpon>
<DesignTimeSharedInput>True</DesignTimeSharedInput>
</Compile>
<Compile Include="ZUGFeRDInterface\Version1.0\CrossIndustryDocumentType.vb" />
<Compile Include="ZUGFeRDInterface.vb" />
<Compile Include="ZUGFeRDInterface\FileGroups.vb" />
<Compile Include="ZUGFeRDInterface\PDFEmbeds.vb" />
<Compile Include="ZUGFeRDInterface\PropertyValues.vb" />
<Compile Include="ZUGFeRDInterface\Version2.0\CrossIndustryInvoiceType.vb" />
<Compile Include="ZUGFeRDInterface\Version2.1.1\CrossIndustryInvoiceType.vb" />
<Compile Include="ZUGFeRDInterface\Version2.2_FacturX\CrossIndustryInvoiceType.vb" />
<Compile Include="ZUGFeRDInterface\XmlItemProperty.vb" />
</ItemGroup>
<ItemGroup>
<EmbeddedResource Include="My Project\Resources.resx">
<Generator>VbMyResourcesResXFileCodeGenerator</Generator>
<LastGenOutput>Resources.Designer.vb</LastGenOutput>
<CustomToolNamespace>My.Resources</CustomToolNamespace>
<SubType>Designer</SubType>
</EmbeddedResource>
</ItemGroup>
<ItemGroup>
<None Include="app.config" />
<None Include="My Project\Application.myapp">
<Generator>MyApplicationCodeGenerator</Generator>
<LastGenOutput>Application.Designer.vb</LastGenOutput>
</None>
<None Include="My Project\Settings.settings">
<Generator>SettingsSingleFileGenerator</Generator>
<CustomToolNamespace>My</CustomToolNamespace>
<LastGenOutput>Settings.Designer.vb</LastGenOutput>
</None>
<None Include="packages.config" />
</ItemGroup>
<ItemGroup>
<AdditionalFiles Include="GdPicture.NET.14.filters.dll">
<CopyToOutputDirectory>PreserveNewest</CopyToOutputDirectory>
</AdditionalFiles>
<AdditionalFiles Include="GdPicture.NET.14.image.gdimgplug.dll">
<CopyToOutputDirectory>PreserveNewest</CopyToOutputDirectory>
</AdditionalFiles>
<AdditionalFiles Include="GdPicture.NET.14.Imaging.Rendering.Skia.dll">
<CopyToOutputDirectory>PreserveNewest</CopyToOutputDirectory>
</AdditionalFiles>
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\Database\Database.vbproj">
<Project>{eaf0ea75-5fa7-485d-89c7-b2d843b03a96}</Project>
<Name>Database</Name>
</ProjectReference>
<ProjectReference Include="..\Language\Language.vbproj">
<Project>{d3c8cfed-d6f6-43a8-9bdf-454145d0352f}</Project>
<Name>Language</Name>
</ProjectReference>
<ProjectReference Include="..\Logging\Logging.vbproj">
<Project>{903b2d7d-3b80-4be9-8713-7447b704e1b0}</Project>
<Name>Logging</Name>
</ProjectReference>
</ItemGroup>
<Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" />
</Project>

View File

@@ -0,0 +1,13 @@
'------------------------------------------------------------------------------
' <auto-generated>
' Dieser Code wurde von einem Tool generiert.
' Laufzeitversion:4.0.30319.42000
'
' Änderungen an dieser Datei können falsches Verhalten verursachen und gehen verloren, wenn
' der Code erneut generiert wird.
' </auto-generated>
'------------------------------------------------------------------------------
Option Strict On
Option Explicit On

View File

@@ -0,0 +1,10 @@
<?xml version="1.0" encoding="utf-8"?>
<MyApplicationData xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema">
<MySubMain>false</MySubMain>
<SingleInstance>false</SingleInstance>
<ShutdownMode>0</ShutdownMode>
<EnableVisualStyles>true</EnableVisualStyles>
<AuthenticationMode>0</AuthenticationMode>
<ApplicationType>1</ApplicationType>
<SaveMySettingsOnExit>true</SaveMySettingsOnExit>
</MyApplicationData>

View File

@@ -0,0 +1,35 @@
Imports System
Imports System.Reflection
Imports System.Runtime.InteropServices
' Allgemeine Informationen über eine Assembly werden über die folgenden
' Attribute gesteuert. Ändern Sie diese Attributwerte, um die Informationen zu ändern,
' die einer Assembly zugeordnet sind.
' Werte der Assemblyattribute überprüfen
<Assembly: AssemblyTitle("Modules.Interfaces")>
<Assembly: AssemblyDescription("")>
<Assembly: AssemblyCompany("Digital Data")>
<Assembly: AssemblyProduct("Modules.Interfaces")>
<Assembly: AssemblyCopyright("Copyright © 2021")>
<Assembly: AssemblyTrademark("1.7.0.0")>
<Assembly: ComVisible(False)>
'Die folgende GUID bestimmt die ID der Typbibliothek, wenn dieses Projekt für COM verfügbar gemacht wird.
<Assembly: Guid("f0de0536-a336-40cb-bb8b-957942174eed")>
' Versionsinformationen für eine Assembly bestehen aus den folgenden vier Werten:
'
' Hauptversion
' Nebenversion
' Buildnummer
' Revision
'
' Sie können alle Werte angeben oder Standardwerte für die Build- und Revisionsnummern verwenden,
' übernehmen, indem Sie "*" eingeben:
' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("1.7.1.0")>
<Assembly: AssemblyFileVersion("1.7.1.0")>

View File

@@ -0,0 +1,63 @@
'------------------------------------------------------------------------------
' <auto-generated>
' Dieser Code wurde von einem Tool generiert.
' Laufzeitversion:4.0.30319.42000
'
' Änderungen an dieser Datei können falsches Verhalten verursachen und gehen verloren, wenn
' der Code erneut generiert wird.
' </auto-generated>
'------------------------------------------------------------------------------
Option Strict On
Option Explicit On
Imports System
Namespace My.Resources
'Diese Klasse wurde von der StronglyTypedResourceBuilder automatisch generiert
'-Klasse über ein Tool wie ResGen oder Visual Studio automatisch generiert.
'Um einen Member hinzuzufügen oder zu entfernen, bearbeiten Sie die .ResX-Datei und führen dann ResGen
'mit der /str-Option erneut aus, oder Sie erstellen Ihr VS-Projekt neu.
'''<summary>
''' Eine stark typisierte Ressourcenklasse zum Suchen von lokalisierten Zeichenfolgen usw.
'''</summary>
<Global.System.CodeDom.Compiler.GeneratedCodeAttribute("System.Resources.Tools.StronglyTypedResourceBuilder", "15.0.0.0"), _
Global.System.Diagnostics.DebuggerNonUserCodeAttribute(), _
Global.System.Runtime.CompilerServices.CompilerGeneratedAttribute(), _
Global.Microsoft.VisualBasic.HideModuleNameAttribute()> _
Friend Module Resources
Private resourceMan As Global.System.Resources.ResourceManager
Private resourceCulture As Global.System.Globalization.CultureInfo
'''<summary>
''' Gibt die zwischengespeicherte ResourceManager-Instanz zurück, die von dieser Klasse verwendet wird.
'''</summary>
<Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Friend ReadOnly Property ResourceManager() As Global.System.Resources.ResourceManager
Get
If Object.ReferenceEquals(resourceMan, Nothing) Then
Dim temp As Global.System.Resources.ResourceManager = New Global.System.Resources.ResourceManager("DigitalData.Modules.Interfaces.Resources", GetType(Resources).Assembly)
resourceMan = temp
End If
Return resourceMan
End Get
End Property
'''<summary>
''' Überschreibt die CurrentUICulture-Eigenschaft des aktuellen Threads für alle
''' Ressourcenzuordnungen, die diese stark typisierte Ressourcenklasse verwenden.
'''</summary>
<Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Friend Property Culture() As Global.System.Globalization.CultureInfo
Get
Return resourceCulture
End Get
Set
resourceCulture = value
End Set
End Property
End Module
End Namespace

View File

@@ -0,0 +1,117 @@
<?xml version="1.0" encoding="utf-8"?>
<root>
<!--
Microsoft ResX Schema
Version 2.0
The primary goals of this format is to allow a simple XML format
that is mostly human readable. The generation and parsing of the
various data types are done through the TypeConverter classes
associated with the data types.
Example:
... ado.net/XML headers & schema ...
<resheader name="resmimetype">text/microsoft-resx</resheader>
<resheader name="version">2.0</resheader>
<resheader name="reader">System.Resources.ResXResourceReader, System.Windows.Forms, ...</resheader>
<resheader name="writer">System.Resources.ResXResourceWriter, System.Windows.Forms, ...</resheader>
<data name="Name1"><value>this is my long string</value><comment>this is a comment</comment></data>
<data name="Color1" type="System.Drawing.Color, System.Drawing">Blue</data>
<data name="Bitmap1" mimetype="application/x-microsoft.net.object.binary.base64">
<value>[base64 mime encoded serialized .NET Framework object]</value>
</data>
<data name="Icon1" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>[base64 mime encoded string representing a byte array form of the .NET Framework object]</value>
<comment>This is a comment</comment>
</data>
There are any number of "resheader" rows that contain simple
name/value pairs.
Each data row contains a name, and value. The row also contains a
type or mimetype. Type corresponds to a .NET class that support
text/value conversion through the TypeConverter architecture.
Classes that don't support this are serialized and stored with the
mimetype set.
The mimetype is used for serialized objects, and tells the
ResXResourceReader how to depersist the object. This is currently not
extensible. For a given mimetype the value must be set accordingly:
Note - application/x-microsoft.net.object.binary.base64 is the format
that the ResXResourceWriter will generate, however the reader can
read any of the formats listed below.
mimetype: application/x-microsoft.net.object.binary.base64
value : The object must be serialized with
: System.Serialization.Formatters.Binary.BinaryFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.soap.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Soap.SoapFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.bytearray.base64
value : The object must be serialized into a byte array
: using a System.ComponentModel.TypeConverter
: and then encoded with base64 encoding.
-->
<xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata">
<xsd:element name="root" msdata:IsDataSet="true">
<xsd:complexType>
<xsd:choice maxOccurs="unbounded">
<xsd:element name="metadata">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" />
<xsd:attribute name="type" type="xsd:string" />
<xsd:attribute name="mimetype" type="xsd:string" />
</xsd:complexType>
</xsd:element>
<xsd:element name="assembly">
<xsd:complexType>
<xsd:attribute name="alias" type="xsd:string" />
<xsd:attribute name="name" type="xsd:string" />
</xsd:complexType>
</xsd:element>
<xsd:element name="data">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
<xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" msdata:Ordinal="1" />
<xsd:attribute name="type" type="xsd:string" msdata:Ordinal="3" />
<xsd:attribute name="mimetype" type="xsd:string" msdata:Ordinal="4" />
</xsd:complexType>
</xsd:element>
<xsd:element name="resheader">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" />
</xsd:complexType>
</xsd:element>
</xsd:choice>
</xsd:complexType>
</xsd:element>
</xsd:schema>
<resheader name="resmimetype">
<value>text/microsoft-resx</value>
</resheader>
<resheader name="version">
<value>2.0</value>
</resheader>
<resheader name="reader">
<value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<resheader name="writer">
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
</root>

View File

@@ -0,0 +1,73 @@
'------------------------------------------------------------------------------
' <auto-generated>
' Dieser Code wurde von einem Tool generiert.
' Laufzeitversion:4.0.30319.42000
'
' Änderungen an dieser Datei können falsches Verhalten verursachen und gehen verloren, wenn
' der Code erneut generiert wird.
' </auto-generated>
'------------------------------------------------------------------------------
Option Strict On
Option Explicit On
Namespace My
<Global.System.Runtime.CompilerServices.CompilerGeneratedAttribute(), _
Global.System.CodeDom.Compiler.GeneratedCodeAttribute("Microsoft.VisualStudio.Editors.SettingsDesigner.SettingsSingleFileGenerator", "15.7.0.0"), _
Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Partial Friend NotInheritable Class MySettings
Inherits Global.System.Configuration.ApplicationSettingsBase
Private Shared defaultInstance As MySettings = CType(Global.System.Configuration.ApplicationSettingsBase.Synchronized(New MySettings()),MySettings)
#Region "Automatische My.Settings-Speicherfunktion"
#If _MyType = "WindowsForms" Then
Private Shared addedHandler As Boolean
Private Shared addedHandlerLockObject As New Object
<Global.System.Diagnostics.DebuggerNonUserCodeAttribute(), Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Private Shared Sub AutoSaveSettings(sender As Global.System.Object, e As Global.System.EventArgs)
If My.Application.SaveMySettingsOnExit Then
My.Settings.Save()
End If
End Sub
#End If
#End Region
Public Shared ReadOnly Property [Default]() As MySettings
Get
#If _MyType = "WindowsForms" Then
If Not addedHandler Then
SyncLock addedHandlerLockObject
If Not addedHandler Then
AddHandler My.Application.Shutdown, AddressOf AutoSaveSettings
addedHandler = True
End If
End SyncLock
End If
#End If
Return defaultInstance
End Get
End Property
End Class
End Namespace
Namespace My
<Global.Microsoft.VisualBasic.HideModuleNameAttribute(), _
Global.System.Diagnostics.DebuggerNonUserCodeAttribute(), _
Global.System.Runtime.CompilerServices.CompilerGeneratedAttribute()> _
Friend Module MySettingsProperty
<Global.System.ComponentModel.Design.HelpKeywordAttribute("My.Settings")> _
Friend ReadOnly Property Settings() As Global.DigitalData.Modules.Interfaces.My.MySettings
Get
Return Global.DigitalData.Modules.Interfaces.My.MySettings.Default
End Get
End Property
End Module
End Namespace

View File

@@ -0,0 +1,7 @@
<?xml version='1.0' encoding='utf-8'?>
<SettingsFile xmlns="http://schemas.microsoft.com/VisualStudio/2004/01/settings" CurrentProfile="(Default)" UseMySettingsClassName="true">
<Profiles>
<Profile Name="(Default)" />
</Profiles>
<Settings />
</SettingsFile>

View File

@@ -0,0 +1,207 @@
Imports System.IO
Imports System.Xml
Imports System.Xml.Serialization
Imports System.Xml.XPath
Imports System.Xml.Xsl
Imports DigitalData.Modules.Interfaces.Exceptions
Imports DigitalData.Modules.Logging
Imports GdPicture14
Public Class ZUGFeRDInterface
Private _logConfig As LogConfig
Private _logger As Logger
Public Enum ErrorType
NoValidFile
NoZugferd
NoValidZugferd
MissingProperties
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
_logger = _logConfig.GetLogger()
FileGroup = New FileGroups(_logConfig)
PropertyValues = New PropertyValues(_logConfig)
Try
Dim oLicenseManager As New LicenseManager
oLicenseManager.RegisterKEY(GDPictureKey)
Catch ex As Exception
_logger.Warn("GDPicture License could not be registered!")
_logger.Error(ex)
End Try
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
Dim oXmlDocument = ValidateZUGFeRDFileWithGDPicture(Path)
If IsNothing(oXmlDocument) Then
Throw New ZUGFeRDExecption(ErrorType.NoZugferd, "Datei ist keine ZUGFeRD Datei.")
End If
Return SerializeZUGFeRDDocument(oXmlDocument)
End Function
''' <summary>
''' Validates a ZUGFeRD File and extracts the XML Document from it
''' </summary>
''' <param name="Stream"></param>
''' <exception cref="ZUGFeRDExecption"></exception>
''' <returns></returns>
Public Function ExtractZUGFeRDFileWithGDPicture(Stream As Stream) As Object
Dim oXmlDocument = ValidateZUGFeRDFileWithGDPicture(Stream)
If IsNothing(oXmlDocument) Then
Throw New ZUGFeRDExecption(ErrorType.NoZugferd, "Datei ist keine ZUGFeRD Datei.")
End If
Return SerializeZUGFeRDDocument(oXmlDocument)
End Function
''' <summary>
''' Validates a ZUGFeRD File and extracts the XML Document from it
''' </summary>
''' <param name="Stream"></param>
''' <exception cref="ZUGFeRDExecption"></exception>
''' <returns></returns>
Public Function ValidateZUGFeRDFileWithGDPicture(Stream As Stream) As XPathDocument
Dim oEmbedExtractor = New PDFEmbeds(_logConfig)
Dim oAllowedExtensions = New List(Of String) From {"xml"}
Try
Dim oFiles = oEmbedExtractor.Extract(Stream, oAllowedExtensions)
' Attachments are in this case the files that are embedded into a pdf file,
' like for example the zugferd-invoice.xml file
Return HandleEmbeddedFiles(oFiles)
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.
Throw ex
Catch ex As Exception
_logger.Error(ex)
Throw ex
End Try
End Function
Public Function ValidateZUGFeRDFileWithGDPicture(Path As String) As XPathDocument
Dim oEmbedExtractor = New PDFEmbeds(_logConfig)
Dim oAllowedExtensions = New List(Of String) From {"xml"}
Try
Dim oFiles = oEmbedExtractor.Extract(Path, oAllowedExtensions)
' Attachments are in this case the files that are embedded into a pdf file,
' like for example the zugferd-invoice.xml file
Return HandleEmbeddedFiles(oFiles)
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.
Throw ex
Catch ex As Exception
_logger.Error(ex)
Throw ex
End Try
End Function
Private Function HandleEmbeddedFiles(Results As List(Of PDFEmbeds.EmbeddedFile)) As XPathDocument
Dim oXmlDocument As XPathDocument
If Results 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
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)).
FirstOrDefault()
If oFoundResult Is Nothing Then
Throw New ZUGFeRDExecption(ErrorType.NoZugferd, "Datei ist keine ZUGFeRD Datei, weil die zugferd-invoice.xml nicht gefunden wurde.")
End If
Try
Using oStream As New MemoryStream(oFoundResult.FileContents)
oXmlDocument = 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.
Throw ex
Catch ex As Exception
_logger.Error(ex)
Throw New ZUGFeRDExecption(ErrorType.NoValidZugferd, "Datei ist eine ungültige ZUGFeRD Datei.")
End Try
End Function
Public Function SerializeZUGFeRDDocument(Document As XPathDocument) As Object
Try
Dim oNavigator As XPathNavigator = Document.CreateNavigator()
Dim oReader As XmlReader
Dim oResult = Nothing
Dim oTypes As New List(Of Type) From {
GetType(ZUGFeRD.Version1_0.CrossIndustryDocumentType),
GetType(ZUGFeRD.Version2_0.CrossIndustryInvoiceType),
GetType(ZUGFeRD.Version2_1_1.CrossIndustryInvoiceType),
GetType(ZUGFeRD.Version2_2_FacturX.CrossIndustryInvoiceType)
}
For Each oType In oTypes
_logger.Debug("Trying Type [{0}]", oType.FullName)
Dim oSerializer As New XmlSerializer(oType)
Try
oReader = oNavigator.ReadSubtree()
oResult = oSerializer.Deserialize(oReader)
_logger.Debug("Serializing with type [{0}] succeeded", oType.FullName)
Exit For
Catch ex As Exception
_logger.Debug("Serializing with type [{0}] failed", oType.FullName)
_logger.Debug(ex.Message)
_logger.Error(ex.InnerException?.Message)
End Try
Next
If oResult Is Nothing Then
Throw New ApplicationException("No Types matched the given document. Document could not be serialized.")
End If
Return oResult
Catch ex As Exception
_logger.Error(ex)
Throw New ZUGFeRDExecption(ErrorType.NoValidZugferd, "Datei ist eine ungültige ZUGFeRD Datei.")
End Try
End Function
End Class

View File

@@ -0,0 +1,13 @@
Public Class Exceptions
Public Class ZUGFeRDExecption
Inherits ApplicationException
Public ReadOnly Property ErrorType() As ZUGFeRDInterface.ErrorType
Public Sub New(ErrorType As ZUGFeRDInterface.ErrorType, Message As String)
MyBase.New(Message)
_ErrorType = ErrorType
End Sub
End Class
End Class

View File

@@ -0,0 +1,82 @@
Imports System.IO
Imports System.Text.RegularExpressions
Imports DigitalData.Modules.Logging
Public Class FileGroups
Private _logger As Logger
Public Sub New(LogConfig As LogConfig)
_logger = LogConfig.GetLogger()
End Sub
''' <summary>
''' Group files by message id. Message id is extracted from filename.
''' Filename is expected to be in the form: 1234@subdomain.company.com
''' <param name="Files">The list of files to process</param>
''' </summary>
Public Function GroupFiles(Files As List(Of FileInfo)) As Dictionary(Of String, List(Of FileInfo))
Dim oGrouped As New Dictionary(Of String, List(Of FileInfo))
If Files.Count = 0 Then
Return oGrouped
End If
For Each oFile In Files
Dim oMessageId = GetMessageIdFromFileName(oFile.Name)
If oMessageId Is Nothing Then
_logger.Warn("File {0} did not have the required filename-format!", oMessageId)
Continue For
End If
If oGrouped.ContainsKey(oMessageId) Then
oGrouped.Item(oMessageId).Add(oFile)
Else
oGrouped.Add(oMessageId, New List(Of FileInfo) From {oFile})
End If
Next
Return oGrouped
End Function
''' <summary>
''' Group files by message id. Message id is created from `FakeMessageIdDomain` and a random string
''' </summary>
''' <param name="Files">The list of files to process</param>
''' <param name="FakeMessageIdDomain">Arbitrary domain for message id generation. Example: sub.company.com</param>
''' <returns></returns>
Public Function GroupFiles(Files As List(Of FileInfo), FakeMessageIdDomain As String) As Dictionary(Of String, List(Of FileInfo))
Dim oGrouped As New Dictionary(Of String, List(Of FileInfo))
If Files.Count = 0 Then
Return oGrouped
End If
For Each oFile In Files
Dim oIdentifier = Guid.NewGuid().ToString()
Dim oMessageId = $"{oIdentifier}@{FakeMessageIdDomain}"
If oGrouped.ContainsKey(oMessageId) Then
oGrouped.Item(oMessageId).Add(oFile)
Else
oGrouped.Add(oMessageId, New List(Of FileInfo) From {oFile})
End If
Next
Return oGrouped
End Function
Private Function GetMessageIdFromFileName(Filename As String) As String
' Regex to find MessageId
' See also: https://stackoverflow.com/questions/3968500/regex-to-validate-a-message-id-as-per-rfc2822
Dim oRegex = "(((([a-zA-Z0-9!#$%&'*+/=?^_`{|}~-]+(\.[a-zA-Z0-9!#$%&'*+/=?^_`{|}~-]+)*)|(""(([\x01-\x08\x0B\x0C\x0E-\x1F\x7F]|[\x21\x23-\x5B\x5D-\x7E])|(\\[\x01-\x09\x0B\x0C\x0E-\x7F]))*""))@(([a-zA-Z0-9!#$%&'*+/=?^_`{|}~-]+(\.[a-zA-Z0-9!#$%&'*+/=?^_`{|}~-]+)*)|(\[(([\x01-\x08\x0B\x0C\x0E-\x1F\x7F]|[\x21-\x5A\x5E-\x7E])|(\\[\x01-\x09\x0B\x0C\x0E-\x7F]))*\]))))~.+"
Dim oMatch = Regex.Match(Filename, oRegex, RegexOptions.IgnoreCase)
If oMatch.Success Then
Dim oMessageId = oMatch.Groups(1).Value
Return oMessageId
Else
Return Nothing
End If
End Function
End Class

View File

@@ -0,0 +1,150 @@
Imports System.Collections.Generic
Imports System.IO
Imports DigitalData.Modules.Logging
Imports GdPicture14
Public Class PDFEmbeds
Private ReadOnly Logger As Logger
Public Const ZUGFERD_XML_FILENAME = "ZUGFeRD-invoice.xml"
Public Const FACTUR_X_XML_FILENAME_FR = "factur-x.xml"
Public Const FACTUR_X_XML_FILENAME_DE = "xrechnung.xml"
Public Class EmbeddedFile
Public FileName As String
Public FileContents As Byte()
End Class
Public Sub New(LogConfig As LogConfig)
Logger = LogConfig.GetLogger
End Sub
''' <summary>
''' Extracts all embedded files from a PDF file.
''' Note: This does NOT filter out `ZUGFeRD-invoice.xml` anymore to allow for a more generic use.
''' </summary>
''' <param name="FilePath">Filepath of the pdf</param>
''' <param name="AllowedExtensions">List of allowed extensions to be extracted</param>
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))
Logger.Debug("Extracting embedded files from [{0}]", FilePath)
Try
oFileInfo = New FileInfo(FilePath)
Logger.Debug("Filename: {0}", oFileInfo.Name)
Logger.Debug("Filesize: {0} bytes", oFileInfo.Length)
Logger.Debug("Exists: {0}", oFileInfo.Exists)
Catch ex As Exception
Logger.Warn("File information for [{0}] could not be read!", FilePath)
Logger.Error(ex)
End Try
Try
Using oGDPicturePDF As New GdPicturePDF()
If oGDPicturePDF.LoadFromFile(FilePath, False) = GdPictureStatus.OK Then
oFile = DoExtract(oGDPicturePDF, oExtensions)
Else
Dim oMessage = String.Format("The file [{0}] can't be loaded. Status: [{1}]", FilePath, oGDPicturePDF.GetStat().ToString())
Throw New ApplicationException(oMessage)
End If
End Using
Return oFile
Catch ex As Exception
Logger.Warn("Unexpected Error while Extracting attachments from File [{0}]", FilePath)
Logger.Error(ex)
Return Nothing
End Try
End Function
''' <summary>
''' Extracts all embedded files from a PDF file.
''' Note: This does NOT filter out `ZUGFeRD-invoice.xml` anymore to allow for a more generic use.
''' </summary>
''' <param name="Stream">Filestream of the pdf</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)
Dim oResults As New List(Of EmbeddedFile)
Dim oExtensions = AllowedExtensions.ConvertAll(New Converter(Of String, String)(Function(ext) ext.ToUpper))
Logger.Debug("Extracting embedded files from stream")
Try
Using oGDPicturePDF As New GdPicturePDF()
If oGDPicturePDF.LoadFromStream(Stream, False) = GdPictureStatus.OK Then
oResults = DoExtract(oGDPicturePDF, oExtensions)
Else
Dim oMessage = String.Format("The filestream can't be loaded. Status: [{0}]", oGDPicturePDF.GetStat().ToString())
Throw New ApplicationException(oMessage)
End If
End Using
Return oResults
Catch ex As Exception
Logger.Warn("Unexpected Error while Extracting attachments from Filestream")
Logger.Error(ex)
Return Nothing
End Try
End Function
Private Function DoExtract(GDPicturePDF As GdPicturePDF, pExtensions As List(Of String)) As List(Of EmbeddedFile)
Dim oResults As New List(Of EmbeddedFile)
Dim oEmbeddedFileCount As Integer = GDPicturePDF.GetEmbeddedFileCount()
If GDPicturePDF.GetStat() = GdPictureStatus.OK Then
Logger.Debug("Embedded file count is: [{0}]", oEmbeddedFileCount)
If oEmbeddedFileCount > 0 Then
For oIndex = 0 To oEmbeddedFileCount - 1
Dim oFileName As String = GDPicturePDF.GetEmbeddedFileName(oIndex)
If GDPicturePDF.GetStat() = GdPictureStatus.OK Then
Logger.Debug("Extracting embedded file [{0}]", oFileName)
Dim oExtension = New FileInfo(oFileName).Extension.ToUpper.Substring(1)
If pExtensions.Contains(oExtension) Then
Dim oFileSize As Integer = GDPicturePDF.GetEmbeddedFileSize(oIndex)
If GDPicturePDF.GetStat() = GdPictureStatus.OK Then
Logger.Debug("Filesize of embedded file is [{0}]", oFileSize)
Dim oFileData As Byte() = New Byte(oFileSize) {}
Dim oStatus As GdPictureStatus = GDPicturePDF.ExtractEmbeddedFile(oIndex, oFileData)
If oStatus = GdPictureStatus.OK Then
Logger.Debug("Embedded file [{0}] extracted sucessfully!", oFileName)
oResults.Add(New EmbeddedFile() With {
.FileContents = oFileData,
.FileName = oFileName
})
Else
Logger.Error("The embedded file [{0}] has failed to extract. Status: {1}", oFileName, GDPicturePDF.GetStat().ToString())
Continue For
End If
Else
Logger.Error("An error occurred getting the file size for [{0}]. Status: {1}", oFileName, GDPicturePDF.GetStat().ToString())
Continue For
End If
Else
Logger.Debug("File [{0}] was skipped because its extension [{1}] is not allowed.", oFileName, oExtension)
Continue For
End If
Else
Logger.Error("An error occurred getting the file name for [{0}]. Status: {1}", oFileName, GDPicturePDF.GetStat().ToString())
Continue For
End If
Next
End If
Return oResults
Else
Dim oMessage = String.Format("An error occurred getting the number of embedded files. Status: {0}", GDPicturePDF.GetStat().ToString())
Throw New ApplicationException(oMessage)
End If
End Function
End Class

View File

@@ -0,0 +1,325 @@
Imports System.Reflection
Imports System.Text.RegularExpressions
Imports DigitalData.Modules.Logging
Public Class PropertyValues
Private _logger As Logger
Private _logConfig As LogConfig
Private _indexPattern = "\((\d+)\)"
Private _indexRegex As New Regex(_indexPattern)
Public Sub New(LogConfig As LogConfig)
_logConfig = LogConfig
_logger = LogConfig.GetLogger()
End Sub
Public Class CheckPropertyValuesResult
Public MissingProperties As New List(Of String)
Public ValidProperties As New List(Of ValidProperty)
End Class
Public Class ValidProperty
Public MessageId As String
Public TableName As String
Public TableColumn As String
Public ISRequired As Boolean
Public GroupCounter As Integer = -1
Public Description As String
Public Value As String
End Class
Public Function CheckPropertyValues(Document As Object, PropertyMap As Dictionary(Of String, XmlItemProperty), MessageId As String) As CheckPropertyValuesResult
Dim oGlobalGroupCounter = 0
Dim oMissingProperties As New List(Of String)
Dim oResult As New CheckPropertyValuesResult()
' PropertyMap items with `IsGrouped = False` are handled normally
Dim oDefaultProperties As Dictionary(Of String, XmlItemProperty) = PropertyMap.
Where(Function(Item) Item.Value.IsGrouped = False).
ToDictionary(Function(Item) Item.Key,
Function(Item) Item.Value)
_logger.Debug("Found {0} default properties.", oDefaultProperties.Count)
' PropertyMap items with `IsGrouped = True` are grouped by group scope
Dim oGroupedProperties = PropertyMap.
Where(Function(Item) Item.Value.IsGrouped = True).
ToLookup(Function(Item) Item.Value.GroupScope, ' Lookup key is group scope
Function(Item) Item)
_logger.Debug($"Found [{PropertyMap.Count - oDefaultProperties.Count}] properties grouped in [{oGroupedProperties.Count}] group(s)")
' Iterate through groups to get group scope and group items
For Each oGroup In oGroupedProperties
Dim oGroupScope As String = oGroup.Key
Dim oPropertyList As New Dictionary(Of XmlItemProperty, List(Of Object))
Dim oRowCount = 0
_logger.Debug($"Fetching Property values for group [{oGroupScope}].")
' get properties as a nested object, see `oPropertyList`
For Each oProperty As KeyValuePair(Of String, XmlItemProperty) In oGroup
Dim oPropertyValues As List(Of Object)
_logger.Debug($"Fetching value for itemSpecification [{oProperty.Value.TableColumn}].")
Try
oPropertyValues = GetPropValue(Document, oProperty.Key)
Catch ex As Exception
_logger.Warn($"{MessageId} - Unknown error occurred while fetching property/TColumn [{0}] in group [{1}]:", oProperty.Value.TableColumn, oGroupScope)
_logger.Error(ex)
oPropertyValues = New List(Of Object)
End Try
' Flatten result value
oPropertyValues = GetFinalPropValue(oPropertyValues)
' Add to list
oPropertyList.Add(oProperty.Value, oPropertyValues)
' check the first batch of values to determine the row count
If oRowCount = 0 Then
oRowCount = oPropertyValues.Count
End If
Next
' Structure of oPropertyList
' [ # Propertyname # Row 1 # Row 2
' PositionsMenge: [BilledQuantity1, BilledQuantity2, ...],
' PositionsSteuersatz: [ApplicablePercent1, ApplicablePercent2, ...],
' ...
' ]
For oRowIndex = 0 To oRowCount - 1
_logger.Debug("Processing row {0}", oRowIndex)
For Each oColumn As KeyValuePair(Of XmlItemProperty, List(Of Object)) In oPropertyList
Dim oTableName As String = oColumn.Key.TableName
Dim oTableColumn As String = oColumn.Key.TableColumn
Dim oIsRequired As Boolean = oColumn.Key.IsRequired
Dim oPropertyDescription As String = oColumn.Key.Description
Dim oRowCounter = oRowIndex + oGlobalGroupCounter + 1
If IsNothing(oRowCounter) Then
End If
' Returns nothing if oColumn.Value contains an empty list
Dim oPropertyValue = oColumn.Value.ElementAtOrDefault(oRowIndex)
_logger.Debug("Processing itemSpecification *TableColumn* [{0}].", oTableColumn)
If IsNothing(oPropertyValue) OrElse String.IsNullOrEmpty(oPropertyValue) Then
If oColumn.Key.IsRequired Then
_logger.Warn($"{MessageId} # oPropertyValue for specification [{oTableColumn}] is empty or not found but is required. Continuing with Empty String.")
oResult.MissingProperties.Add(oPropertyDescription)
Else
_logger.Debug($"{MessageId} # oPropertyValue for specification [{oTableColumn}] is empty or not found. Continuing with Empty String.")
End If
oPropertyValue = String.Empty
End If
_logger.Debug("ItemSpecification [{0}] has value '{1}'", oTableColumn, oPropertyValue)
oResult.ValidProperties.Add(New ValidProperty() With {
.MessageId = MessageId,
.Description = oPropertyDescription,
.Value = oPropertyValue,
.GroupCounter = oRowCounter,
.TableName = oTableName,
.TableColumn = oTableColumn,
.ISRequired = oIsRequired
})
Next
Next
oGlobalGroupCounter += oRowCount
Next
' Iterate through default properties
For Each oItem As KeyValuePair(Of String, XmlItemProperty) In oDefaultProperties
Dim oPropertyValueList As List(Of Object)
Dim oTableColumn As String = oItem.Value.TableColumn
Dim oPropertyValue As Object = Nothing
Dim oTableName = oItem.Value.TableName
Dim oIsRequired = oItem.Value.IsRequired
Dim oDescription = oItem.Value.Description
Try
oPropertyValueList = GetPropValue(Document, oItem.Key)
Catch ex As Exception
_logger.Warn("{2} # Unknown error occurred while fetching specification [{0}] in group [{1}]:", oTableColumn, oItem.Value.GroupScope, MessageId)
_logger.Error(ex)
oPropertyValueList = New List(Of Object)
End Try
Try
If IsNothing(oPropertyValueList) Then
oPropertyValue = Nothing
ElseIf TypeOf oPropertyValueList Is List(Of Object) Then
Select Case oPropertyValueList.Count
Case 0
oPropertyValue = Nothing
Case Else
Dim oList As List(Of Object) = DirectCast(oPropertyValueList, List(Of Object))
oPropertyValue = oList.Item(0)
' This should hopefully show config errors
If TypeOf oPropertyValue Is List(Of Object) Then
_logger.Warn("Item with TableColumn [{0}] may be configured incorrectly", oTableColumn)
oPropertyValue = Nothing
End If
End Select
End If
Catch ex As Exception
_logger.Warn("Unknown error occurred while processing specification [{0}]:", oTableColumn)
_logger.Error(ex)
oPropertyValue = Nothing
End Try
If IsNothing(oPropertyValue) OrElse String.IsNullOrEmpty(oPropertyValue) Then
If oItem.Value.IsRequired Then
_logger.Warn("{0} # Specification [{1}] is empty, but marked as required! Skipping.", MessageId, oTableColumn)
oResult.MissingProperties.Add(oTableColumn)
Continue For
Else
_logger.Debug("{0} # oPropertyValue for specification [{1}] is empty or not found. Skipping.", MessageId, oTableColumn)
Continue For
End If
End If
oResult.ValidProperties.Add(New ValidProperty() With {
.MessageId = MessageId,
.Description = oDescription,
.Value = oPropertyValue,
.TableName = oTableName,
.TableColumn = oTableColumn,
.ISRequired = oIsRequired
})
Next
Return oResult
End Function
Public Function GetPropValue(Obj As Object, PropertyName As String) As List(Of Object)
Dim oNameParts As String() = PropertyName.Split("."c)
If IsNothing(Obj) Then
_logger.Debug("`Obj` is Nothing. Exiting.")
Return New List(Of Object)
End If
If oNameParts.Length = 1 Then
Dim oPropInfo As PropertyInfo = Obj.GetType().GetProperty(PropertyName)
If IsNothing(oPropInfo) Then
_logger.Debug("Property [{0}] does not exist(1).", PropertyName)
Return New List(Of Object)
Else
Dim oPropValue = oPropInfo.GetValue(Obj, Nothing)
Return New List(Of Object) From {oPropValue}
End If
End If
For Each oPart As String In oNameParts
Dim oType As Type = Obj.GetType()
Dim oPartName = oPart
Dim oIndex As Integer = Nothing
Dim oHasIndex As Boolean = HasIndex(oPartName)
If oHasIndex Then
oPartName = StripIndex(oPart)
oIndex = GetIndex(oPart)
End If
Dim oInfo As PropertyInfo = oType.GetProperty(oPartName)
If IsNothing(oInfo) OrElse IsNothing(oInfo.GetValue(Obj, Nothing)) Then
_logger.Debug("Property [{0}] does not exist(2).", oPartName)
Return New List(Of Object)
End If
Obj = oInfo.GetValue(Obj, Nothing)
If oHasIndex Then
Obj = Obj(0)
End If
If IsArray(Obj) And Not oHasIndex Then
Dim oCurrentPart As String = oPart
Dim oSplitString As String() = New String() {oCurrentPart & "."}
Dim oPathFragments = PropertyName.Split(oSplitString, StringSplitOptions.None)
Dim oResults As New List(Of Object)
' if path has no more subitems, return an empty list
If oPathFragments.Length = 1 Then
Return oResults
End If
For Each oArrayItem In Obj
Dim oResult As List(Of Object) = GetPropValue(oArrayItem, oPathFragments(1))
If Not IsNothing(oResult) Then
oResults.Add(oResult)
End If
Next
Return oResults
End If
Next
Return New List(Of Object) From {Obj}
End Function
Public Function GetFinalPropValue(List As List(Of Object)) As List(Of Object)
Dim oResult As New List(Of Object)
For Each Item In List
Dim oItemValue = DoGetFinalPropValue(Item)
If Not IsNothing(oItemValue) Then
oResult.Add(oItemValue)
End If
Next
Return oResult
End Function
Private Function DoGetFinalPropValue(Value As Object) As String
If TypeOf Value Is List(Of Object) Then
Dim oList = DirectCast(Value, List(Of Object))
Dim oCount = oList.Count
Select Case oCount
Case 0
Return Nothing
Case Else
Return DoGetFinalPropValue(oList.First())
End Select
Return DoGetFinalPropValue(Value)
Else
Return Value.ToString
End If
End Function
Private Function GetIndex(Prop As String) As Integer
If Regex.IsMatch(Prop, _indexPattern) Then
Dim oMatch = _indexRegex.Match(Prop)
Dim oGroup = oMatch.Groups.Item(1)
Dim oValue = oGroup.Value
Return Integer.Parse(oValue)
End If
Return Nothing
End Function
Private Function StripIndex(Prop As String) As String
Return Regex.Replace(Prop, _indexPattern, "")
End Function
Private Function HasIndex(Prop As String) As Boolean
Return Regex.IsMatch(Prop, _indexPattern)
End Function
End Class

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,8 @@
Public Class XmlItemProperty
Public TableName As String
Public TableColumn As String
Public Description As String
Public IsRequired As Boolean
Public IsGrouped As Boolean
Public GroupScope As String
End Class

11
Interfaces/app.config Normal file
View File

@@ -0,0 +1,11 @@
<?xml version="1.0" encoding="utf-8"?>
<configuration>
<runtime>
<assemblyBinding xmlns="urn:schemas-microsoft-com:asm.v1">
<dependentAssembly>
<assemblyIdentity name="FirebirdSql.Data.FirebirdClient" publicKeyToken="3750abcc3150b00c" culture="neutral" />
<bindingRedirect oldVersion="0.0.0.0-7.5.0.0" newVersion="7.5.0.0" />
</dependentAssembly>
</assemblyBinding>
</runtime>
</configuration>

View File

@@ -0,0 +1,5 @@
<?xml version="1.0" encoding="utf-8"?>
<packages>
<package id="Newtonsoft.Json" version="12.0.3" targetFramework="net461" />
<package id="NLog" version="4.7.15" targetFramework="net461" />
</packages>