VisualBasic Feststellen ob User in Gruppe

[mabstrei]

Hi,

ich such ne Function die mir wenn ein ADS-USER in einer ADS-GRUPPE ist mir nen Wahrheitswert zurückgibt.

z.B.

Function IsinGroup (ByVal Username as String, ByVal Groupname as String) as Boolean
...
End Function

Weis irg. wer da ne möglichkeit finde bei google leider nichts so recht passendes.

mfg
thx

 

[CHaos.Gentle]

Hab ich mal für was ähnliches benötigt.

Da ich nicht weiß, was dein Programm bisher kann hier komplett:

' Definition allg. Variablen und Konstanten *****************************************************************************

' ----- Variablen für die SQL-Abfrage auf das AD
Dim rst             ' Recordset als Ergebnis der SQL-Abfrage
Dim cnn             ' ADODB Connection-Objekt
Dim StrSQL          ' Zeichenfolge für die SQL-Abfrage
Dim x
Dim WSHNetwork As Object
Dim strmember

' ----- Variablen für den Zugriff auf Benutzerobjekte
Dim ADUserPath      ' Pfad zum AD-Benutzerobject
Dim ADAccount       ' AD-Benutzerobject

Function GetDomainName()

    Set oRootDSE = GetObject("LDAP://RootDSE")
    Set oMyDomain = GetObject("LDAP://" & oRootDSE.Get("defaultNamingContext"))
    GetDomainName = oMyDomain.ADSPath
    Set oRootDSE = Nothing
    Set oMyDomain = Nothing
    
End Function

Function GetNTUserName()

    'ermittelt den Anmeldenamen am PC
    Set WSHNetwork = CreateObject("Wscript.Network")
    'GetNTUserName = WSHNetwork.UserName
    GetNTUserName = Cells(1, 4).Value
    Set WSHNetwork = Nothing
    
End Function

Function IsInGroup(strUserName As String, strUserGroup) as boolean'

    GetRecordset strUserName        ' Eigene Funktion - Das Objekt wird gesucht, wo CN = Benutzernamen ist.
    x = 0                       ' Zähler für Anzahl der Datensätze auf "0" setzen
    Count = 1


    ' ----- Das Ergebnis der SQL-Abfrage wird abgearbeitet (Die Anzahl der Datensätze kann nur 1 sein)
    Do Until rst.EOF
        x = x + 1       ' Ist "rst" nicht LEER - wurde der übergebene Benutzername von "GetRecordset" gefunden. x wird um 1 erhöht

        ' ----- Auf das Benutzerobjekt zugreifen
            Err.Clear
            
            ADUserPath = rst.Fields("adspath")  ' Im Ergebnis der SQL-Abfrage liefert das Feld "adspath" den Pfad, um auf einen bestimmten User zuzugreifen
            Set ADAccount = GetObject(ADUserPath) ' Auf das AD-Objekt des Benutzers wird zugegriffen
            
            If Err.Number <> 0 Then
                'GetADEntry = strUserName & " Fehler: Objekt des SQL-Abfrageergebnisses nicht gefunden - " & Err.Number & "/" & Err.Description
                MsgBox "Fehler: Objekt des SQL-Abfrageergebnisses nicht gefunden!"
                Exit Function
            End If
            
            Err.Clear
        ' ----- Ende: Auf das Benutzerobjekt zugreifen

        'On Error Resume Next
        
<-----  An dieser Stelle dann ADAccount.memberof nach der gesuchten Gruppe durchsuchen, Rückgabewert setzen und Funktion beenden ----->

        Err.Clear
        
        ' ----- Ende: Das Benutzerkonto wird geprüft

        ' ----- der nächste Datensatz des Ergebnisses wird gelesen
        
        rst.MoveNext
        
        ' ----- Ende: der nächste Datensatz des Ergebnisses wird gelesen
        
    Loop
    
    ' ----- Ende: Das Ergebnis der SQL-Abfrage wird abgearbeitet (Die Anzahl der Datensätze kann nur 1 sein)

    ' ----- Ist x = 0 hat die SQL-Abfrage kein Ergebnis geliefert - der übergebene Benutzername wurde von "GetRecordset" nicht gefunden
        If x = 0 Then
            GetADEntry = strUserName & " Fehler: Das SQL-Abfrageergebnis ist leer"
            Exit Function
        End If
    ' ----- Ende: Ist x = 0 hat die SQL-Abfrage kein Ergebnis geliefert - der übergebene Benutzername wurde von "GetRecordset" nicht gefunden


    ' ----- Leeren der Variablen
        Set ADAccount = Nothing
    ' ----- Ende: Leeren der Variablen

End Function

Function GetRecordset(strUserName As String)

    On Error Resume Next
    Set cnn = Nothing
    Set rst = Nothing
    ' Die Objekte deren SAMAccountName = dem Benutzernamen ist, werden gesucht.
    StrSQL = "select adspath FROM '" & GetDomainName & "' WHERE SAMAccountName ='" & strUserName & "'"
    Set cnn = CreateObject("ADODB.Connection")
    cnn.provider = "adsDSOObject"
    cnn.Open GetDomainName
    Set rst = CreateObject("ADODB.Recordset")
    rst.Open StrSQL, cnn

End Function

Ich hoffe, ich hab beim flinken rauslöschen der unbenötigten Sachen keinen Fehler gemacht... =)

[EDIT] Ich seh grad, dass ich noch ein wenig zuviel drin gelassen hab, aber damit kommste schon klar, oder?