From a6ae874873bde62a6496bf75b79c560e31791828 Mon Sep 17 00:00:00 2001 From: Developer01 Date: Tue, 3 Nov 2026 10:36:24 +0100 Subject: [PATCH] Verbesserung der Fehlerbehandlung und Protokollierung MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Neue Konstanten und Wiederholungslogik in `ActiveDirectoryInterface.vb` hinzugefügt, um vorübergehende AD-Fehler zu handhaben. Funktion `IsTransientAdException` implementiert. Verbesserte Benutzer-Synchronisierungslogik in `SyncUsers.MSSQL.vb`, um unnötige Löschvorgänge zu vermeiden. Versionsnummern in `AssemblyInfo.vb` aktualisiert. Warnmeldungen und Index-Typ-Überprüfung in `Windream.vb` verbessert. NLog-Verwaltung in `Windream.vbproj` auf NuGet umgestellt und entsprechende Referenz aus `packages.config` entfernt. --- Interfaces/ActiveDirectoryInterface.vb | 182 ++++++++++-------- .../SyncUsers.MSSQL.vb | 54 +++--- Interfaces/My Project/AssemblyInfo.vb | 6 +- Windream/My Project/AssemblyInfo.vb | 4 +- Windream/Windream.vb | 50 +++-- Windream/Windream.vbproj | 8 +- Windream/packages.config | 1 - 7 files changed, 179 insertions(+), 126 deletions(-) diff --git a/Interfaces/ActiveDirectoryInterface.vb b/Interfaces/ActiveDirectoryInterface.vb index ff5ea47a..6165631a 100644 --- a/Interfaces/ActiveDirectoryInterface.vb +++ b/Interfaces/ActiveDirectoryInterface.vb @@ -1,6 +1,8 @@ Imports System.DirectoryServices Imports System.DirectoryServices.AccountManagement +Imports System.Runtime.InteropServices Imports System.Text.RegularExpressions +Imports System.Threading Imports DigitalData.Modules.Database Imports DigitalData.Modules.Logging @@ -13,6 +15,9 @@ Public Class ActiveDirectoryInterface Private _rootNode As DirectoryEntry Private Const SEARCH_LIMIT = 50000 + Private Const AD_RETRY_COUNT = 3 + Private Const AD_RETRY_DELAY_MS = 5000 + Private Const LDAP_SERVER_NOT_OPERATIONAL As Integer = &H8007203A Private Const SAMACCOUNTNAME = "samaccountname" Private Const OBJECTCLASS = "objectClass" @@ -47,9 +52,7 @@ Public Class ActiveDirectoryInterface End Function Public Function SyncUsersForGroup(GroupName As String, AttributeMappings As List(Of AttributeMapping), 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 oUsers As List(Of ADUser) Dim oSQLSync As New SyncUsers.SyncUsersMSSQL(_logConfig, MSSQL) Dim oSyncedUsersMSSQL As List(Of ADUser) @@ -57,13 +60,18 @@ Public Class ActiveDirectoryInterface Try _logger.Debug("Fetching users from ActiveDirectory") oUsers = ListUsers(GroupName, AttributeMappings, Filter) + + If oUsers Is Nothing Then + _logger.Warn("ActiveDirectory query failed for group [{0}]. Sync skipped.", GroupName) + Return Nothing + End If + _logger.Debug("Found {0} users", oUsers.Count) Catch ex As Exception _logger.Error(ex) Return Nothing End Try - ' Do the actual sync into MSSQL If MSSQL IsNot Nothing Then oSyncedUsersMSSQL = oSQLSync.SyncUsers(GroupName, oUsers, AttributeMappings) If oSyncedUsersMSSQL.Count > 0 Then @@ -138,88 +146,112 @@ Public Class ActiveDirectoryInterface 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) + For oAttempt As Integer = 1 To AD_RETRY_COUNT + Try + 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 + 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) + _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) + 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) + Dim oUserFound = FindUserWithFilter(oUserEx, Filter) - If oUserFound = False Then - _logger.Debug("User [{0}] was skipped out due to user filter.", oUserEx.SamAccountName) - Continue For + If oUserFound = False Then + _logger.Debug("User [{0}] was skipped out due to user filter.", oUserEx.SamAccountName) + Continue For + End If + + If oUserEx IsNot Nothing Then + For Each oMap As AttributeMapping In AttributeMappings + Dim oAttributeValue = oUserEx.GetAttributeValue(oMap.AttributeName) + + If oAttributeValue <> String.Empty Then + oCustomAttributes.Add(New ADUser.CustomAttribute() With { + .Name = oMap.AttributeName, + .Value = oAttributeValue, + .FirebirdSyskey = oMap.FirebirdSyskey, + .MSSQLColumn = oMap.MSSQLColumn + }) + End If + Next + End If + + oUsers.Add(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 + }) 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 - }) - Else - _logger.Debug("Attribute [{0}] is empty.", oMap.AttributeName) - 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 + Catch ex As Exception + _logger.Warn("User could not be processed") + _logger.Error(ex) + End Try + Next + End Using End Using End Using - End Using - Return oUsers - Catch ex As Exception - _logger.Error(ex) - Return oUsers - End Try + Return oUsers + Catch ex As Exception + If IsTransientAdException(ex) AndAlso oAttempt < AD_RETRY_COUNT Then + _logger.Warn("ActiveDirectory unavailable (attempt {0}/{1}) for group [{2}]. Retrying in {3} ms.", oAttempt, AD_RETRY_COUNT, GroupName, AD_RETRY_DELAY_MS) + Thread.Sleep(AD_RETRY_DELAY_MS) + Continue For + End If + + _logger.Error(ex) + + If IsTransientAdException(ex) Then + _logger.Warn("ActiveDirectory unavailable after {0} attempts for group [{1}]. Returning Nothing.", AD_RETRY_COUNT, GroupName) + Return Nothing + End If + + Return New List(Of ADUser) + End Try + Next + + Return Nothing End Function + Private Function IsTransientAdException(ex As Exception) As Boolean + Dim oCurrent = ex + + While oCurrent IsNot Nothing + If TypeOf oCurrent Is COMException Then + Dim oComEx = DirectCast(oCurrent, COMException) + If oComEx.ErrorCode = LDAP_SERVER_NOT_OPERATIONAL Then + Return True + End If + End If + + If oCurrent.Message IsNot Nothing AndAlso oCurrent.Message.IndexOf("The server is not operational", StringComparison.OrdinalIgnoreCase) >= 0 Then + Return True + End If + + oCurrent = oCurrent.InnerException + End While + + Return False + End Function + Private Function GetPartFromFirstOU(dnString As String) As String Dim keyword As String = "OU=" Dim index As Integer = dnString.IndexOf(keyword) diff --git a/Interfaces/ActiveDirectoryInterface/SyncUsers.MSSQL.vb b/Interfaces/ActiveDirectoryInterface/SyncUsers.MSSQL.vb index 72f27164..af16cedc 100644 --- a/Interfaces/ActiveDirectoryInterface/SyncUsers.MSSQL.vb +++ b/Interfaces/ActiveDirectoryInterface/SyncUsers.MSSQL.vb @@ -26,6 +26,11 @@ Namespace SyncUsers Dim oCreatedUsers As New List(Of ADUser) Dim oUpdatedUsers As New List(Of ADUser) + If Users Is Nothing Then + _logger.Warn("SyncUsers aborted: Users is Nothing. Skipping sync and delete step for group [{0}].", GroupName) + Return oSyncedUsers + End If + Try _logger.Debug("Getting group Id for group {0}", GroupName) oGroupId = GetGroupId(GroupName) @@ -45,7 +50,6 @@ Namespace SyncUsers Dim oUserId As Long Dim oUserExists As Boolean - ' Check if user already exists Try _logger.Debug("Checking if user [{0}] exists", oUser) oUserId = GetUserId(oUser.samAccountName) @@ -57,38 +61,32 @@ Namespace SyncUsers 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) - 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.Debug("User updated with Id [{0}]", oUserId) _logger.Info("Updated User [{0}]", oUser) - oUpdatedUsers.Add(oUser) End If End If - Catch ex As Exception _logger.Error(ex) _logger.Warn("Could Not create/update user [{0}]. Skipping.", oUser) Continue For End Try - ' Add custom attributes to user + If oUserId > 0 Then + oSyncedUserIds.Add(oUserId) + End If + Try AddCustomAttributesToUser(oUser, oUserId) Catch ex As Exception @@ -96,7 +94,6 @@ Namespace SyncUsers _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, GroupName) @@ -110,26 +107,33 @@ Namespace SyncUsers 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 + ' Safety: never delete relations on empty source result + If Users.Count = 0 Then + _logger.Warn("Safety stop: AD returned 0 users for group [{0}]. Delete step skipped.", GroupName) + Return oSyncedUsers 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 oSyncedUserIds.Count > 0 Then + Dim oUserIdString = String.Join(",", oSyncedUserIds.Distinct()) + Dim oSQL As String = $"DELETE FROM TBDD_GROUPS_USER WHERE USER_ID NOT IN ({oUserIdString}) AND GROUP_ID = {oGroupId}" + Dim oDeleteResult = _mssql.ExecuteNonQuery(oSQL) + + If oDeleteResult Then + _logger.Info("User-group relations cleanup executed for group [{0}].", GroupName) + Else + _logger.Warn("User-group relations cleanup failed for group [{0}].", GroupName) + End If + Else + _logger.Warn("Safety stop: No synced user IDs collected for group [{0}]. Delete step skipped.", GroupName) + End If + 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}" diff --git a/Interfaces/My Project/AssemblyInfo.vb b/Interfaces/My Project/AssemblyInfo.vb index 5eeee53a..c1309105 100644 --- a/Interfaces/My Project/AssemblyInfo.vb +++ b/Interfaces/My Project/AssemblyInfo.vb @@ -13,7 +13,7 @@ Imports System.Runtime.InteropServices - + @@ -31,5 +31,5 @@ Imports System.Runtime.InteropServices ' übernehmen, indem Sie "*" eingeben: ' - - + + diff --git a/Windream/My Project/AssemblyInfo.vb b/Windream/My Project/AssemblyInfo.vb index ca954227..33759c18 100644 --- a/Windream/My Project/AssemblyInfo.vb +++ b/Windream/My Project/AssemblyInfo.vb @@ -31,5 +31,5 @@ Imports System.Runtime.InteropServices ' übernehmen, indem Sie "*" eingeben: ' - - + + diff --git a/Windream/Windream.vb b/Windream/Windream.vb index 9cd377f8..dde4c2cf 100644 --- a/Windream/Windream.vb +++ b/Windream/Windream.vb @@ -1244,7 +1244,7 @@ Public Class Windream Dim oWMObject As IWMObject6 = GetFileByPath(Path) If LockObject(oWMObject, WMObjectEditModeIndexEdit) = False Then - _logger.Warn("File {0} could not be locked") + _logger.Warn("File {0} could not be locked", Path) Return False End If @@ -1254,22 +1254,26 @@ Public Class Windream Try Dim oType As Integer = GetIndexType(pIndexName) - If Not IsNothing(oType) Then - Dim oConvertedValue As Object = Helpers.ConvertIndexValue(oType, pStringValue) - oWMObject.SetVariableValue(pIndexName, oConvertedValue) - oWMObject.Save() - - If UnlockObject(oWMObject) = False Then - _logger.Warn("File {0} could not be unlocked", Path) - End If - - Return True - Else + ' IsNothing() schlägt bei Integer (Werttyp) nie an – stattdessen auf Undefined (0) prüfen + If oType = WMObjectVariableValueTypeUndefined Then + _logger.Warn("Index '{0}' not found or has undefined type – SetFileIndex aborted for file '{1}'", pIndexName, Path) + UnlockObject(oWMObject) Return False End If + Dim oConvertedValue As Object = Helpers.ConvertIndexValue(oType, pStringValue) + + oWMObject.SetVariableValue(pIndexName, oConvertedValue) + oWMObject.Save() + + If UnlockObject(oWMObject) = False Then + _logger.Warn("File {0} could not be unlocked", Path) + End If + + Return True Catch ex As Exception + _logger.Warn("Could not set value '{0}' for index '{1}' on file '{2}'", pStringValue, pIndexName, Path) _logger.Error(ex) UnlockObject(oWMObject) Return False @@ -1285,6 +1289,7 @@ Public Class Windream _logger.Warn("File '{0}' does not exist", pPath) Return False End If + Dim oWMObject As IWMObject6 Try @@ -1295,9 +1300,10 @@ Public Class Windream _logger.Warn(ex.Message) Return False End Try + 'Lock WMObject for changes If LockObject(oWMObject, WMObjectEditModeIndexEdit) = False Then - _logger.Warn("File {0} could not be locked") + _logger.Warn("File '{0}' could not be locked", pPath) Return False End If @@ -1307,9 +1313,18 @@ Public Class Windream Try Dim oType As Integer = GetIndexType(pIndexName) - Dim oConvertedValues As New List(Of String) - Dim oArray As Object + + ' Gleicher Bug wie in SetFileIndex: Integer-Werttyp – IsNothing() greift nie + ' Stattdessen auf Undefined (0) prüfen + If oType = WMObjectVariableValueTypeUndefined Then + _logger.Warn("Index '{0}' not found or has undefined type – SetFileIndexLoS aborted for file '{1}'", pIndexName, pPath) + UnlockObject(oWMObject) + Return False + End If + _logger.Debug("SetFileIndexLoS '{0}' - Indextype: {1} - Values.Count: {2} ... ", pIndexName, oType, pAttributeValues.Count) + + Dim oArray As Object ReDim oArray(pAttributeValues.Count - 1) For oIndex = 0 To pAttributeValues.Count - 1 @@ -1322,13 +1337,14 @@ Public Class Windream oWMObject.Save() If UnlockObject(oWMObject) = False Then - _logger.Warn("File {0} could not be unlocked", pPath) + _logger.Warn("File '{0}' could not be unlocked", pPath) End If Return True Catch ex As Exception + _logger.Warn("Could not set value for index '{0}' on file '{1}'", pIndexName, pPath) _logger.Error(ex) - + UnlockObject(oWMObject) Return False End Try End Function diff --git a/Windream/Windream.vbproj b/Windream/Windream.vbproj index 05d37e4b..ab869f03 100644 --- a/Windream/Windream.vbproj +++ b/Windream/Windream.vbproj @@ -65,9 +65,6 @@ True - - ..\packages\NLog.5.0.5\lib\net46\NLog.dll - @@ -81,6 +78,11 @@ + + + 5.0.5 + + diff --git a/Windream/packages.config b/Windream/packages.config index b610ae85..ad9dd6de 100644 --- a/Windream/packages.config +++ b/Windream/packages.config @@ -1,5 +1,4 @@  - \ No newline at end of file