ToolCollection/ToolCollection/ClassWD_Rechte.vb
Digital Data - Marlon Schreiber 8c82b567f8 SQLLIte
2019-04-12 15:20:54 +02:00

885 lines
38 KiB
VB.net
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

Imports WINDREAMLib
Imports WINDREAMLib.WMCOMEvent
Imports WINDREAMLib.WMEntity
Imports WINDREAMLib.WMObjectEditMode
Imports WINDREAMLib.WMSearchOperator
Imports WINDREAMLib.WMSearchRelation
Imports WMOBRWSLib
Imports DigitalData.Modules.Logging
Public Class ClassWD_Rechte
#Region "+++++ Konstanten +++++"
Const REL_Document_AccessRight = "AccessRight"
Const COL_AccessRight_AccessRightID = "dwAccessRightID"
Const COL_AccessRight_AccessRight = "dwAccessRight"
Const REL_AccessRight_UserOrGroup = "AccessRightUserOrGroup"
Dim dwAccessRight
Const WMAccessRightUndefined = 0
Const WMAccessRightRead = 1
Const WMAccessRightWrite = 2
Const WMAccessRightAdmin = 4
Const WMAccessRightAllRights = 7 ' doc+folder: read, write and admin access
Const WMUserTypeMain = 1
Const WMUserTypeNormal = 4
Const WMUserTypeInactive = 8
Const WMGroupTypeAdmin = 2
Const WMEntityGroups = 13
Const WMEntityUser = 18
Const WMGroupTypeAll = 127
#End Region
#Region "+++++ Variablen +++++"
Public oConnect ' der Typ darf nicht festgelegt werden (warum auch immer... geht sonst nicht)
Public oSession ' der Typ darf nicht festgelegt werden (warum auch immer... geht sonst nicht)
Public oServername As String
Public oBrowser As New WMOBRWSLib.ServerBrowser
Public oDokumentTypen As WINDREAMLib.WMObjects
Public aktivesProfil As ClassNIProfil
Private Shared _Logger As DigitalData.Modules.Logging.Logger
Private Shared _MyLogger As LogConfig
Private _sqlite As ClassSQLITE
#End Region
Sub New(LogConfig As LogConfig, _mysqlite As ClassSQLITE)
_MyLogger = LogConfig
_Logger = _MyLogger.GetLogger
_sqlite = _mysqlite
End Sub
''' <summary>
''' Initialisiert die statische Klasse (Login, Session starten, usw.)
''' </summary>
''' <returns>Liefert True wenn das Anmelden erfolgreich war, sonst False</returns>
''' <remarks></remarks>
Public Function Init() As Boolean
Try
Try
' Session-Objekt instanziieren und mit dem im Client ausgewählten Server belegen
Me.oSession = CreateObject("Windream.WMSession", Me.GetCurrentServer)
oServername = Me.GetCurrentServer()
' Connection-Objekt instanziieren
Me.oConnect = CreateObject("Windream.WMConnect")
'MsgBox("windrem init 'ed")
Catch ex As Exception
Return False
End Try
' wenn windream nicht angemeldet ist
If Not Me.IsLoggedIn Then
' Art der Anmeldung an windream festlegen
' 0x0L (also 0) = Standard windream Benutzer
' WM_MODULE_ID_DOCTYPEEDITOR_LIC = ermöglicht Zugriff auf die windream Management Funktionen (Z.B. zur Verwaltung der windream Dokumententypen, Auswahllisten, etc.)
' WM_MODULE_ID_INDEXSERVICE = ermöglicht der Session die Indexierungs-Events vom windream DMS-Service zu empfangen
Me.oConnect.ModuleID = 0
' setzt die minimal erwartete windream-Version
Me.oConnect.MinReqVersion = "3"
' Verbindung mit Session-Objekt (und dem ausgewählten Server) aufbauen
Me.oConnect.LoginSession(Me.oSession)
If Me.oSession.aLoggedin = False Then
MsgBox("Es konnte keine Verbindung mit dem windream-Server hergestellt werden", MsgBoxStyle.Exclamation, "Verbindung konnte nicht hergestellt werden")
Return False
End If
Try
Me.oSession.SwitchEvents(WMCOMEventWMSessionNeedIndex, False)
' der Parameter WMEntityDocument definiert, dass nur Dokumenttypen und keine
' Ordnertypen ausgelesen werden
Me.oDokumentTypen = Me.oSession.GetWMObjectTypes(WINDREAMLib.WMEntity.WMEntityDocument)
Catch ex As Exception
Return False
End Try
End If
Return True
Catch ex As Exception
If Err.Number = -2147220985 Then
MsgBox("Die installierte windream-Version ist nicht ausreichend für den Betrieb der Tool Collection für windream." & vbNewLine & _
"Bitte kontaktieren Sie Digital Data." & vbNewLine & vbNewLine & "Fehlernachricht:" & vbNewLine & Err.Description, MsgBoxStyle.Exclamation, "Unzureichende windream-Version")
Else
If Not ex.Message.Contains("Already logged in") Then
MsgBox("Fehlernachricht:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Fehler beim Login an windream")
Else
Return True
End If
End If
Return False
End Try
End Function
''' <summary>
''' Liefert den Servernamen an dem windream aktuell angemeldet ist.
''' </summary>
''' <returns>Servername als String</returns>
''' <remarks></remarks>
Public Function GetCurrentServer() As String
Try
Return Me.oBrowser.GetCurrentServer 'ClassWindream.oBrowser.GetCurrentServer
Catch ex As Exception
MsgBox("Der aktuell gewählte windream-Server konnte nicht ausgelesen werden." & vbNewLine & vbNewLine & "Fehlernachricht:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Fehler beim Auslesen des windream-Servers")
End Try
Return ""
End Function
''' <summary>
''' Liefert True wenn die windream-Session angemeldet ist und False für den Fall, dass die Session nicht eingeloggt ist.
''' </summary>
''' <returns>Anmeldestatus als Boolean</returns>
''' <remarks></remarks>
Public Function IsLoggedIn() As Boolean
Try
Return Me.oSession.aLoggedin
Catch ex As Exception
MsgBox("Es konnte nicht erfolgreich geprüft werden, ob das Programm am windream-Server angemeldet ist." & vbNewLine & vbNewLine & "Fehlernachricht:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Fehler bei Loggedin-Prüfung")
End Try
Return False
End Function
Function GetWMSessionAsUser(Domain, ServerName, UserName, Password, _form)
Dim SessionAsUser
Dim aConnect, aUserId, aSession
On Error Resume Next
' Hilfsobjekte erschaffen, um eine Verbindung zum windream Server herzustellen
' mit der gewünschten Benutzer-Identität
aConnect = CreateObject("Windream.WMConnect")
'Bei einer impersonifizierten Session ist zu beachten, dass die ModuleID 9 zu nutzen ist.
'Wird keine Session-ID angegeben, hat die Session die ID 0 (Default).
aConnect.ModuleId = 9
If Err.Number <> 0 Then
Dim msg = "Fehler bei CreateObject (aConnect) - Err.Number: " & Err.Number & vbNewLine & Err.Description
If _form = True Then
MsgBox(msg, MsgBoxStyle.Critical)
Else
_Logger.Warn(msg)
End If
SessionAsUser = Nothing
Return SessionAsUser
End If
aUserId = CreateObject("WMOTool.WMUserIdentity")
If Err.Number <> 0 Then
Dim msg = "Fehler bei CreateObject('WMOTool.WMUserIdentity') - Err.Number: " & Err.Number & vbNewLine & Err.Description
If _form = True Then
MsgBox(msg, MsgBoxStyle.Critical)
Else
_Logger.Warn(msg)
End If
SessionAsUser = Nothing
Return SessionAsUser
End If
aUserId.aDomain = Domain
aUserId.aServerName = ServerName
aUserId.aUserName = UserName
aUserId.aPassword = Password
aSession = aConnect.Login(aUserId)
If Err.Number <> 0 Then
Dim msg = "Fehler bei aConnect.Login(aUserId) - Err.Number: " & Err.Number & vbNewLine & Err.Description
If _form = True Then
MsgBox(msg, MsgBoxStyle.Critical)
Else
_Logger.Warn(msg)
End If
SessionAsUser = Nothing
Return SessionAsUser
Else
SessionAsUser = aSession
If aSession.aLoggedin = True Then
Return SessionAsUser
End If
End If
End Function
Public Function Check_Login_Session(ByVal domain As String, Server As String, Username As String, PW As String) As Boolean
Dim oSession
oSession = GetWMSessionAsUser(domain, Server, Username, PW, True)
If Not (oSession Is Nothing) Then
Return True
Else
Return False
End If
End Function
''' <summary>
''' Setzt das Recht für das entsprechende Objekt (File oder Folder)
''' </summary>
''' <returns>Boolean True wenn erfolgreich</returns>
''' <remarks></remarks>
Public Function FileFolder_DeleteAndOrSetRight(docpath As String, profilID As Integer, regelid As Integer, folgeRegel As Boolean, createdFolder As String, _form As Boolean) As Boolean
_Logger.Info(String.Format("Working on regelid {0}.", regelid.ToString))
On Error Resume Next
Dim deleteRights As Boolean = False
Dim domain, Server, Username, PW As String
Dim _methode As String
Dim _GruppenUserRecht
Dim _UserOrGroup
Dim _lRight As Integer
Dim _Erfolgreich As Boolean = True
Dim DT As DataTable = _sqlite.Return_Datatable("select * from TBNI_NACHBEARBEITUNG_AD WHERE GUID = '" & profilID & "'", _form)
If DT Is Nothing = False Then
If DT.Rows.Count = 1 Then
'Profildaten laden
For Each row As DataRow In DT.Rows
deleteRights = CBool(row.Item("DEL_ALL_RIGHTS"))
domain = row.Item("Domain")
Username = row.Item("Username")
PW = row.Item("Password")
Server = row.Item("Servername")
Next
Dim DTR As DataTable = _sqlite.Return_Datatable("select * from TBNI_NB_STEP_AD WHERE GUID = " & regelid, _form)
If DTR.Rows.Count = 1 Then
For Each row As DataRow In DTR.Rows
_methode = row.Item("Methode")
_GruppenUserRecht = row.Item("RECHTENAME")
_UserOrGroup = row.Item("GROUP_OR_USER")
_lRight = row.Item("ACCESS_RIGHT")
Next
Else
Dim msg = "Fehler in File_Delete_SetRight: Es konnte keine eindeutige AD-Regel gelesen werden!"
If _form = True Then
MsgBox(msg, MsgBoxStyle.Critical)
Else
_Logger.Warn(msg)
End If
Return False
End If
End If
End If
Dim oSession
Dim oWMObject As WINDREAMLib.WMObject
Dim UserGroupRelation
Dim UserOrGroup
Dim oGroup
Dim oUSer
oSession = GetWMSessionAsUser(domain, Server, Username, PW, _form)
If Err.Number <> 0 Then
Dim msg = "Fehler bei Zugriff GetWMSessionAsUser - Err.Number: " & Err.Number & vbNewLine & Err.Description
If _form = True Then
MsgBox(msg, MsgBoxStyle.Critical)
Else
_Logger.Warn(msg)
End If
_Erfolgreich = False
Return _Erfolgreich
End If
If Not (oSession Is Nothing) Then
oWMObject = oSession.GetWMObjectByPath(WMEntityDocumentAndMap, docpath)
If Err.Number <> 0 Then
Dim msg = "Fehler Zugriff GetWMObjectByPath - Err.Number: " & Err.Number & vbNewLine & Err.Description
If _form = True Then
MsgBox(msg, MsgBoxStyle.Critical)
Else
_Logger.Warn(msg)
End If
_Erfolgreich = False
Return _Erfolgreich
End If
'wenn das Recht anhand eine Indexwertes ausgelesen werden soll
If _GruppenUserRecht.ToString.StartsWith("[%") Then
Dim Indexwert As Object
Dim Indexname As String = _GruppenUserRecht.ToString.Substring(2, _GruppenUserRecht.Length - 3)
Dim _WCCase As Integer
'Auf Wildcards prüfen
'Führende und schliessende Wildcard
If Indexname.StartsWith("%") And Indexname.EndsWith("%") Then
_WCCase = 0
ElseIf Indexname.StartsWith("%") Then
_WCCase = 1
ElseIf Indexname.EndsWith("%") Then
_WCCase = 2
Else
_WCCase = 3
End If
_Logger.Info("* AD _WCCase = " & _WCCase)
Indexname = Indexname.Replace("%", "")
Indexwert = oWMObject.GetVariableValue(Indexname)
Dim mask
If Indexwert Is Nothing = False Then
'Maske zusammenbauen
Select Case _WCCase
Case 0
mask = "%" & Indexwert & "%"
Case 1
mask = "%" & Indexwert
Case 2
mask = Indexwert & "%"
Case 3
mask = Indexwert
End Select
_Logger.Info("* AD mask = '" & mask & "'")
Dim _WDRecht = GetWDRightNames_byMask(mask, _UserOrGroup, _form)
If _WDRecht IsNot Nothing And _WDRecht.length > 0 Then
Dim msg As String
Dim anz As Integer = 0
For Each recht As String In _WDRecht
anz += 1
Next
'Genau ein Recht wurde zurückgeliefert
If anz = 1 Then
'Genau ein Recht wurde zurückgeliefert
_GruppenUserRecht = CObj(_WDRecht(0))
ElseIf anz > 1 Then
'FEHLER: mehr als 1 Recht wurde zurückgeliefert
msg = "Achtung: Es wurden mehr als 1 Recht anhand der Maske '" & mask & "' gefunden!"
If _form = True Then
MsgBox(msg, MsgBoxStyle.Critical)
Else
_Logger.Warn(msg)
End If
_Erfolgreich = False
Return _Erfolgreich
End If
Else
Dim msg = "Achtung: Anhand der Maske " & mask & " konnte kein Recht gelesen werden!"
If _form = True Then
MsgBox(msg, MsgBoxStyle.Critical)
Else
_Logger.Warn(msg)
End If
_Erfolgreich = False
Return _Erfolgreich
End If
End If
End If
Dim Object2Change As WINDREAMLib.WMObject
If _methode = "AddRightFolder" Then
Object2Change = oWMObject.aParentWMObject
ElseIf _methode = "AddRightCreatedFolder" Then
If Not createdFolder Is Nothing Then
Object2Change = oSession.GetWMObjectByPath(WMEntityFolder, createdFolder.Substring(2))
If Object2Change Is Nothing Then
Dim msg = "Fehler beim Erzeugen des Objektes Folder - Object2Change is nothing"
If _form = True Then
MsgBox(msg, MsgBoxStyle.Critical)
Else
_Logger.Warn(msg)
End If
_Erfolgreich = False
Return _Erfolgreich
End If
Else
Dim msg = "Fehler bei AddRightCreatedFolder - aktivesProfil.CrFolder_Created_Folder is nothing"
If _form = True Then
MsgBox(msg, MsgBoxStyle.Critical)
Else
_Logger.Warn(msg)
End If
_Erfolgreich = False
Return _Erfolgreich
End If
Else
Object2Change = oWMObject
End If
'If Not Object2Change.aLocked Then
' Object2Change.lock()
'End If
' Objekt muss zur Rechteänderung gelockt werden
Dim lret = Object2Change.LockRights()
If CBool(lret) = False Then
If Not Object2Change.aLocked Then
Object2Change.lock()
If Err.Number <> 0 Then
Dim msg = "Die Datei konnte nicht erfolgreich gelocked werden!: Err.Number: " & Err.Number & vbCrLf & Err.Description
If _form = True Then
MsgBox(msg, MsgBoxStyle.Critical)
Else
_Logger.Warn(msg)
End If
Return False
End If
End If
'Dim msg = "Fehler beim Setzen der Sperre für Rechteänderung: .LockRights - Err.Number: " & Err.Number & vbCrLf & Err.Description
'If _form = True Then
' MsgBox(msg, MsgBoxStyle.Critical)
'Else
' _Logger.Warn(msg)
'End If
'_Erfolgreich = False
'Return _Erfolgreich
End If
'If Err.Number <> 0 Then
' Dim msg = "Fehler beim Setzen der Sperre für Rechteänderung: .LockRights - Err.Number: " & Err.Number & vbCrLf & Err.Description
' If _form = True Then
' MsgBox(msg, MsgBoxStyle.Critical)
' Else
' _Logger.Warn(msg)
' End If
' _Erfolgreich = False
' Return _Erfolgreich
'End If
' Rechteträger-Liste holen
Dim AccessRightsObject2Change
Dim AccessRightsParent
' Das Recht soll auf Ordnerebene gesetzt werden
If _methode = "AddRightFolder" Then
Dim WMParent = oWMObject.aParentWMObject
AccessRightsParent = WMParent.GetWMObjectRelationByName(REL_Document_AccessRight)
ElseIf _methode = "AddRightCreatedFolder" Then
Dim folder = oSession.GetWMObjectByPath(WMEntityFolder, createdFolder.Substring(2))
AccessRightsParent = folder.GetWMObjectRelationByName(REL_Document_AccessRight)
ElseIf _methode = "AddFolderRightsOnly" Then
Dim WMParent
If createdFolder = "" Then
WMParent = oWMObject.aParentWMObject
Else
_Logger.Info(">> CREATED Folder for rightsmanager: " & createdFolder.Substring(2))
WMParent = oSession.GetWMObjectByPath(WMEntityFolder, createdFolder.Substring(2))
End If
AccessRightsParent = WMParent.GetWMObjectRelationByName(REL_Document_AccessRight)
AccessRightsObject2Change = oWMObject.GetWMObjectRelationByName(REL_Document_AccessRight)
Else
Dim WMParent = oWMObject.aParentWMObject
AccessRightsObject2Change = oWMObject.GetWMObjectRelationByName(REL_Document_AccessRight)
AccessRightsParent = WMParent.GetWMObjectRelationByName(REL_Document_AccessRight)
End If
'Bei Fehler in Rechteauswertung
If Err.Number <> 0 Then
Dim msg = "Fehler bei Fehler Zugriff auf REL_Document_AccessRight - Err.Number: " & Err.Number & vbCrLf & Err.Description
If _form = True Then
MsgBox(msg, MsgBoxStyle.Critical)
Else
_Logger.Warn(msg)
End If
_Erfolgreich = False
Return _Erfolgreich
End If
'############################# Rechte löschen ################################################################################
'#############################################################################################################################
If deleteRights = True And folgeRegel = False Then
Dim Object_Rights2Delete
If _methode.ToLower = "AddFolderRightsOnly".ToLower Then
Object_Rights2Delete = AccessRightsObject2Change
Else
Object_Rights2Delete = AccessRightsObject2Change
End If
' und nun jeden Rechteträger verarbeiten
For Each aRightRelation In Object_Rights2Delete
' Auflistung der Rechteträger-Informationen holen
UserGroupRelation = aRightRelation.GetWMObjectRelationByName(REL_AccessRight_UserOrGroup)
If Err.Number <> 0 Then
Dim msg = "Fehler bei Zugriff auf REL_AccessRight_UserOrGroup - Err.Number: " & Err.Number & vbCrLf & Err.Description
If _form = True Then
MsgBox(msg, MsgBoxStyle.Critical)
Else
_Logger.Warn(msg)
End If
_Erfolgreich = False
Return _Erfolgreich
End If
' Zugriff auf das Benutzer/Gruppen-Objekt
UserOrGroup = UserGroupRelation.item(0)
Dim _msg As String
If (UserOrGroup.aWMEntity = WMEntityGroups) Then
_msg = "Right for Group '" & UserOrGroup.aName & "'"""
Else
_msg = "Right for User: '" & UserOrGroup.aName & "'"""
End If
If Err.Number <> 0 Then
Dim msg = "Fehler bei Zugriff auf UserGroupRelation - Err.Number: " & Err.Number & vbCrLf & Err.Description
If _form = True Then
MsgBox(msg, MsgBoxStyle.Critical)
Else
_Logger.Warn(msg)
End If
_Erfolgreich = False
Return _Erfolgreich
End If
'einem Rechteträger ALLE Rechte zu entziehen
'entfernt ihn gleichzeitig aus der Auflistung der Rechteträger
Object_Rights2Delete.Delete2(UserOrGroup, WMAccessRightAllRights)
If Err.Number <> 0 Then
Dim msg = "Fehler bei Zugriff Delete2 - Err.Number: " & Err.Number & vbCrLf & Err.Description
If _form = True Then
MsgBox(msg, MsgBoxStyle.Critical)
Else
_Logger.Warn(msg)
End If
_Erfolgreich = False
Return _Erfolgreich
End If
Next
If _form = False Then
_Logger.Info("* Die Rechte wurden erfolgreich entfernt.")
End If
End If
Err.Clear()
' Wenn ALLE Rechteträger entfernt werden (FOR EACH),
' dann muss mindestens EIN Rechteträger mit dem Recht zur Rechteänderung
' wieder zugefügt werden!!!!!
If _UserOrGroup = "group" Then
' Gruppe holen
oGroup = oSession.GetWMObjectByName(WMEntityGroups, _GruppenUserRecht)
If Err.Number <> 0 Then
Dim msg = "Fehler bei GetWMObjectByName(WMEntityGroups, GruppenUserRecht) - Err.Number: " & Err.Number & vbCrLf & Err.Description
If _form = True Then
MsgBox(msg, MsgBoxStyle.Critical)
Else
_Logger.Warn(msg)
End If
_Erfolgreich = False
Return _Erfolgreich
End If
AccessRightsObject2Change.Insert2(oGroup, _lRight) 'WMAccessRightAllRights)
_Logger.Info(String.Format("GroupRight {0} was set with parameter {1}", _GruppenUserRecht, _lRight))
ElseIf _UserOrGroup = "user" Then
' User holen
oUSer = oSession.GetWMObjectByName(WMEntityUser, _GruppenUserRecht)
If Err.Number <> 0 Then
Dim msg = "Fehler bei GetWMObjectByName(WMEntityUser, GruppenUserRecht) - Err.Number: " & Err.Number & vbCrLf & Err.Description
If _form = True Then
MsgBox(msg, MsgBoxStyle.Critical)
Else
_Logger.Warn(msg)
End If
_Erfolgreich = False
Return _Erfolgreich
End If
AccessRightsObject2Change.Insert2(oUSer, _lRight) 'WMAccessRightAllRights)
_Logger.Info(String.Format("UserRight {0} was set with parameter {1}", _GruppenUserRecht, _lRight))
ElseIf _UserOrGroup = "allfolderrights".ToLower Then
' und nun jeden Rechteträger verarbeiten
For Each aRightRelation In AccessRightsParent
dwAccessRight = aRightRelation.GetVariableValue(COL_AccessRight_AccessRight) 'COL_AccessRight_AccessRight)
Dim _msg As String
If dwAccessRight And WMAccessRightRead Then
_msg = "R"
End If
If dwAccessRight And WMAccessRightWrite Then
_msg = _msg & "W"
End If
If dwAccessRight And WMAccessRightAdmin Then
_msg = _msg & "A"
End If
' Auflistung der Rechteträger-Informationen holen
UserGroupRelation = aRightRelation.GetWMObjectRelationByName(REL_AccessRight_UserOrGroup)
If Err.Number <> 0 Then
Dim msg = "Fehler bei Zugriff auf REL_AccessRight_UserOrGroup (AFRO) - Err.Number: " & Err.Number & vbCrLf & Err.Description
If _form = True Then
MsgBox(msg, MsgBoxStyle.Critical)
Else
_Logger.Info(msg)
End If
Exit_onEror(Object2Change, _form)
_Erfolgreich = False
Return _Erfolgreich
End If
' Zugriff auf das Benutzer/Gruppen-Objekt
UserOrGroup = UserGroupRelation.item(0)
If (UserOrGroup.aWMEntity = WMEntityGroups) Then
_msg = "Right for Group '" & UserOrGroup.aName & "'"""
Else
_msg = "Right for User: '" & UserOrGroup.aName & "'"""
End If
If Err.Number <> 0 Then
Dim msg = "Fehler bei Zugriff auf UserGroupRelation (AFRO) - Err.Number: " & Err.Number & vbCrLf & Err.Description
If _form = True Then
MsgBox(msg & vbNewLine & _msg, MsgBoxStyle.Critical)
Else
_Logger.Info(msg & " // " & _msg)
End If
_Erfolgreich = False
Return _Erfolgreich
End If
If deleteRights = True Then
AccessRightsObject2Change.Insert2(UserOrGroup, dwAccessRight)
Else
If CHECK_Right_Exists(AccessRightsObject2Change, UserOrGroup) = False Then
AccessRightsObject2Change.Insert2(UserOrGroup, dwAccessRight)
End If
End If
_Logger.Info(String.Format("AllFolderRights {0} was set.", _msg))
Next
End If
Err.Clear()
If Err.Number <> 0 Then
Dim msg = "Fehler bei AccessRights.Insert2 - Err.Number: " & Err.Number & vbCrLf & Err.Description
If _form = True Then
MsgBox(msg, MsgBoxStyle.Critical)
Else
_Logger.Info(msg)
End If
_Erfolgreich = False
Return _Erfolgreich
End If
' Speichern nicht vergessen
Object2Change.Save()
If Err.Number <> 0 Then
Dim msg = "UNEXPECTED ERROR IN Object2Change.Save(Err.Number: " & Err.Number & vbCrLf & Err.Description
If _form = True Then
MsgBox(msg, MsgBoxStyle.Critical)
Else
_Logger.Info(msg)
End If
If Object2Change.aLocked = True Then
Object2Change.unlock()
End If
_Erfolgreich = False
Return _Erfolgreich
End If
Err.Clear()
''und der Vollständigkeit halber auch ein Unlock
If Object2Change.aLocked = True Then
Object2Change.unlock()
If Err.Number <> 0 Then
Dim msg = "Fehler bei Unlock - Err.Number: " & Err.Number & vbCrLf & Err.Description
If _form = True Then
MsgBox(msg, MsgBoxStyle.Critical)
Else
_Logger.Info(msg)
End If
_Erfolgreich = False
End If
End If
If _form = False Then
_Logger.Info(">> Das Recht '" & _GruppenUserRecht & "' wurde erfolgreich gesetzt")
End If
'jetzt True zurückgeben
Return _Erfolgreich
Else
Dim msg = "FEHLER : es konnte keine Session erzeugt werden!"
If _form = True Then
MsgBox(msg, MsgBoxStyle.Critical)
Else
_Logger.Warn(msg)
End If
_Erfolgreich = False
Return _Erfolgreich
End If
End Function
Private Function CHECK_Right_Exists(AccessRightsObject As Object, UserOrGroup As Object)
Try
Dim locUserOrGroup
Dim UserGroupRelation
Dim msg As String
If (UserOrGroup.aWMEntity = WMEntityGroups) Then
msg = "Right for Group '" & UserOrGroup.aName & "'"
Else
msg = "Right for User: '" & UserOrGroup.aName & "'"
End If
' Prüfen ob Recht enthalen ist
For Each aRightRelation In AccessRightsObject
dwAccessRight = aRightRelation.GetVariableValue(COL_AccessRight_AccessRight)
' Auflistung der Rechteträger-Informationen holen
UserGroupRelation = aRightRelation.GetWMObjectRelationByName(REL_AccessRight_UserOrGroup)
If Err.Number <> 0 Then
Return False
End If
' Zugriff auf das Benutzer/Gruppen-Objekt
locUserOrGroup = UserGroupRelation.item(0)
If locUserOrGroup.aName = UserOrGroup.aName Then
Console.WriteLine(msg & " already existing!")
Return True
End If
Next
Console.WriteLine(msg & " NOT existing!")
Return False
Catch ex As Exception
_Logger.Error(ex)
Return False
End Try
End Function
Private Sub Exit_onEror(obj As WINDREAMLib.WMObject, _form As Boolean)
Try
' Speichern nicht vergessen
obj.Save()
If Err.Number <> 0 Then
Dim msg = "Fehler bei Object2Change.Save( - Err.Number: " & Err.Number & vbCrLf & Err.Description
If _form = True Then
MsgBox(msg, MsgBoxStyle.Critical)
Else
_Logger.Warn(msg)
End If
End If
Err.Clear()
''und der Vollständigkeit halber auch ein Unlock
If obj.aLocked = True Then
obj.unlock()
If Err.Number <> 0 Then
Dim msg = "Fehler bei Unlock - Err.Number: " & Err.Number & vbCrLf & Err.Description
If _form = True Then
MsgBox(msg, MsgBoxStyle.Critical)
Else
_Logger.Warn(msg)
End If
End If
End If
Catch ex As Exception
End Try
End Sub
''' <summary>
''' Liefert die windream-Gruppen sowie alle Usernamen zurück
''' </summary>
''' <returns>UserGroupNamen als String()</returns>
''' <remarks></remarks>
Public Function GetAll_WDRightNames_AdminUsers(UserGroup As String)
Try
Dim WMObjects As WINDREAMLib.WMObjects
' WMObjects = oSession.GetUsersOrGroups(WMEntityUser, True, "", WMUserTypeMain)
'Dim msg As String
Dim gesamtanzahl As Integer = 0
Dim i As Integer = 0
Dim aRechteNamen() As String
If UserGroup = "group" Then
'==================================================================
' get groups
'==================================================================
WMObjects = oSession.GetUsersOrGroups(WMEntityGroups, vbTrue, "", -4) ' WMGroupTypeAll)
ReDim Preserve aRechteNamen(WMObjects.Count - 1)
'==================================================================
' enumerate the found objects
'==================================================================
If WMObjects Is Nothing = False Then
' Array für Rechte vorbereiten
'msg = "Admin group(s) are: " + vbCrLf + vbCrLf
gesamtanzahl += WMObjects.Count - 1
' ---------------------
' enumerate list
' ---------------------
For Each aWMObject In WMObjects
aRechteNamen(i) = aWMObject.aName
' msg = msg + aWMObject.aName + vbCrLf
i += 1
Next
If i = 1 Then
i = 0
End If
End If
Else
If UserGroup = "user" Then
'==================================================================
' get all users
'==================================================================
'MsgBox("Getting all users ...")
WMObjects = oSession.GetAllObjects(WMEntityUser)
'==================================================================
' enumerate the found objects
'==================================================================
If Not (WMObjects Is Nothing) Then
' msg = "All users: " + vbCrLf + vbCrLf
' ---------------------
' enumerate list
' ---------------------
For Each aWMObject In WMObjects
i += 1
ReDim Preserve aRechteNamen(i)
aRechteNamen(i) = aWMObject.aName
'msg = msg + aWMObject.aName + vbCrLf
Next
'MsgBox(msg)
End If
End If
End If
Return aRechteNamen
Catch ex As Exception
_Logger.Error(ex)
Return Nothing
End Try
End Function
''' <summary>
''' Liefert die windream-Rechte nach einer Maske als String() zurück
''' </summary>
''' <returns>Maske als String(); usrgroup als String</returns>
''' <remarks></remarks>
Public Function GetWDRightNames_byMask(mask As Object, usrgroup As String, Optional _form As Boolean = False)
Try
Dim WMObjects
Dim i As Integer = 0
Dim aRechteNamen() As String
'==================================================================
' get Rechte
'==================================================================
If usrgroup = "group" Then
WMObjects = oSession.GetUsersOrGroups(WMEntityGroups, vbTrue, mask, -4) ' WMEntityGroupsWMGroupTypeAdmin)
Else
'MsgBox(mask)
Dim vbobj As Object
If mask.ToString.Contains("%") Then
vbobj = vbTrue
Else
vbobj = vbFalse
End If
WMObjects = oSession.GetUsersOrGroups(WMEntityUser, vbobj, mask, WMUserTypeNormal) ' WMGroupTypeAdmin)
End If
' Array für Rechte vorbereiten
ReDim Preserve aRechteNamen(WMObjects.Count - 1)
'=======================================
'Durchlaufen der gefundenen Rechte
'=======================================
If WMObjects Is Nothing = False Then
For Each aWMObject In WMObjects
aRechteNamen(i) = aWMObject.aName
i += 1
Next
End If
Return aRechteNamen
Catch ex As Exception
_Logger.Error(ex)
If _form = True Then
MsgBox("Fehler in ClassWD_Rechte - GetWDRightNames_byMask - Fehler: " & vbNewLine & ex.Message, MsgBoxStyle.Critical)
End If
Return Nothing
End Try
End Function
End Class