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

Verbesserung der Fehlerbehandlung und Protokollierung

Browse Source 
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.
This commit is contained in:
Developer01
2026-11-03 10:36:24 +01:00
parent 24417da48c
commit a6ae874873
7 changed files with 179 additions and 126 deletions
Download Patch File Download Diff File Expand all files Collapse all files

182
Interfaces/ActiveDirectoryInterface.vb
View File

@@ -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)

54
Interfaces/ActiveDirectoryInterface/SyncUsers.MSSQL.vb
View File

@@ -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}"

6
Interfaces/My Project/AssemblyInfo.vb
View File

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

4
Windream/My Project/AssemblyInfo.vb
View File

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

50
Windream/Windream.vb
View File

@@ -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

8
Windream/Windream.vbproj
View File

@@ -65,9 +65,6 @@
<EmbedInteropTypes>True</EmbedInteropTypes>
</Reference>
<Reference Include="Microsoft.CSharp" />
<Reference Include="NLog, Version=5.0.0.0, Culture=neutral, PublicKeyToken=5120e14c03d0593c, processorArchitecture=MSIL">
<HintPath>..\packages\NLog.5.0.5\lib\net46\NLog.dll</HintPath>
</Reference>
<Reference Include="System" />
<Reference Include="System.Configuration" />
<Reference Include="System.Data" />
@@ -81,6 +78,11 @@
<Reference Include="System.Data.DataSetExtensions" />
<Reference Include="System.Net.Http" />
</ItemGroup>
<ItemGroup>
<PackageReference Include="NLog">
<Version>5.0.5</Version>
</PackageReference>
</ItemGroup>
<ItemGroup>
<Import Include="Microsoft.VisualBasic" />
<Import Include="System" />

1
Windream/packages.config
View File

@@ -1,5 +1,4 @@
<?xml version="1.0" encoding="utf-8"?>
<packages>
<package id="DigitalData.Modules.Logging" version="2.6.5" targetFramework="net462" />
<package id="NLog" version="5.0.5" targetFramework="net461" />
</packages>