Startseite > .NET > Informationen aus dem Active Directory ziehen mit VB.NET und ADO

Informationen aus dem Active Directory ziehen mit VB.NET und ADO


Und hier ist die VB.NET Version als Konsolenprogramm.
Das Programm kann man mit folgendem Befehl kompilieren.

vbc ldap.vb /out:LDAP.exe /reference:"C:\windows\assembly\GAC\ADODB\7.0.3300.0__b03f5f7f11d50a3a\adodb.dll"

vbc findet man unter
C:\Windows\Microsoft.NET\Framework[64]\[.NET Version]

imports System
imports system.text
imports system.runtime.interopservices
imports System.DirectoryServices

Public Class LDAP

    Private Const MAX_STRING_LENGTH As Integer = 100
    Private Const TITLE_LENGTH As Integer = 30

    ' 1 = name, id, department
    ' 2 = all
    ' 4 = max
    ' 8 = acc

    Private Shared ReturnType As Integer = 1

    Public Shared Sub Main()

        Dim queryParam As String = ""
        Dim args() As String = split(command(), " ")

        For i As Integer = 0 To args.Getupperbound(0)
            Select Case args(i)
                Case "-help" : ShowHelp() : End
                Case "-all" : ReturnType += 2
                Case "-max" : ReturnType += 4
                Case "-acc" : ReturnType += 8
                Case "-user" : If args.getupperbound(0) >= i + 1 Then AddQueryParam(queryparam, "name=" & args(i + 1))
                Case "-lname" : If args.getupperbound(0) >= i + 1 Then AddQueryParam(queryparam, "sn=" & args(i + 1))
                Case "-fname" : If args.getupperbound(0) >= i + 1 Then AddQueryParam(queryparam, "givenName=" & args(i + 1))
                Case "-dept" : If args.getupperbound(0) >= i + 1 Then AddQueryParam(queryparam, "ou=" & args(i + 1))
            End Select
        Next
        If queryParam.Trim().Length > 0 Then
            ShowADInfo(queryParam)
        Else
            If args.GetUpperBound(0) >= 0 Then
                AddQueryParam(queryParam, "sn=" & args(0))
                ShowADInfo(queryParam)
            End If
        End If
        console.writeline("")
    End Sub

    Private Shared Sub AddQueryParam(ByRef queryParam As String, ByVal argument As String)

        If queryParam.Trim().Length = 0 Then
            queryParam = "(" & argument & ")"
        Else
            queryParam &= " (" & argument & ")"
        End If

    End Sub

    Private Shared Sub ShowADInfo(ByVal queryParam As String)

        Dim oCon As adodb.connection = New adodb.connection()
        Dim rs As adodb.recordset = New adodb.recordset()
        Dim oRoot As Object = Nothing
        Dim oDomain As Object = Nothing
        Dim sConCommand As String = ""

        Try

            oRoot = GetObject("LDAP://rootDSE")
            oDomain = GetObject("LDAP://" & oRoot.get("defaultNamingContext"))
            sConCommand = "<" & oDomain.adspath & ">;" & _
              "(&(objectCategory=person) " & queryParam & ");" & _
              "adsPath;subTree"

            oCon.Provider = "ADsDSOObject"
            oCon.Open("Active Directory")
            rs = oCon.Execute(sConCommand)

            If rs.recordcount = 1 Then
                ConsoleWrite("\nFound Entry: " & rs.recordcount.tostring & "\n")
            Else
                ConsoleWrite("\nFound Entries: " & rs.recordcount.tostring & "\n")
            End If

            rs.movefirst()
            Do While Not (rs.eof)

                ConsoleWrite("=============================================")

                If ((ReturnType And 1) = 1) And Not ((ReturnType And 4) = 4) Then
                    With GetObject(rs.fields("adsPath").value.tostring)
                        ConsoleWrite("Full Name", .fullname)
                        ConsoleWrite("User ID", .name)
                        ConsoleWrite("Department", .department)

                        ConsoleWrite("Account Expiration Date", .AccountExpirationDate)
                        ConsoleWrite("Division", .division)
                        ConsoleWrite("Email Address", .emailaddress)
                        ConsoleWrite("Phone Number", .telephonenumber)
                        ConsoleWrite("Mobile Number", .TelephoneMobile)
                    End With
                End If

                If (ReturnType And 4) = 4 Then

                    With GetObject(rs.fields("adsPath").value.tostring)

                        ConsoleWrite("Title", .Title)
                        ConsoleWrite("Name Prefix", .NamePrefix)
                        ConsoleWrite("Name Suffix", .NameSuffix)
                        ConsoleWrite("First Name", .firstname)
                        ConsoleWrite("Last Name", .lastname)
                        ConsoleWrite("Other Name", .othername)
                        ConsoleWrite("User ID", .name)
                        ConsoleWrite("Department", .department)

                        ConsoleWrite("Division", .division)
                        ConsoleWrite("Email Address", .emailaddress)
                        ConsoleWrite("Phone Number", .telephonenumber)
                        ConsoleWrite("Mobile Number", .TelephoneMobile)
                        ConsoleWrite("Phone Home", .TelephoneHome)
                        ConsoleWrite("Fax Number", .Faxnumber)
                        ConsoleWrite("Pager", .TelephonePager)
                        ConsoleWrite("Employee ID", .EmployeeID)
                        ConsoleWrite("Languages", Join(.languages, ", "))
                        ConsoleWrite("Manager", .manager)

                        ConsoleWrite("Postal Addresses", .PostalAddresses)
                        ConsoleWrite("Postal Codes", .PostalCodes)
                        ConsoleWrite("Office Locations", .OfficeLocations)

                    End With
                End If

                If (ReturnType And 8) = 8 Then
                    With GetObject(rs.fields("adsPath").value.tostring)

                        ConsoleWrite("Account Disabled", .AccountDisabled)
                        ConsoleWrite("Account Expiration Date", .AccountExpirationDate)
                        ConsoleWrite("Bad Login Address", .BadLoginAddress)
                        ConsoleWrite("Bad Login Count", .BadLoginCount)
                        ConsoleWrite("Class", .Class)
                        ConsoleWrite("Description", .Description)
                        ConsoleWrite("Grace Logins Allowed", .GraceLoginsAllowed)
                        ConsoleWrite("Grace Logins Remaining", .GraceLoginsRemaining)
                        ConsoleWrite("GUID", .GUID)
                        ConsoleWrite("Home Directory", .HomeDirectory)

                        ConsoleWrite("Home Page", .HomePage)
                        ConsoleWrite("Is Account Locked", .IsAccountLocked)
                        ConsoleWrite("Last Failed Login", .LastFailedLogin)
                        ConsoleWrite("Last Login", .LastLogin)
                        ConsoleWrite("Last Logoff", .LastLogoff)
                        ConsoleWrite("Login Hours", .LoginHours)
                        ConsoleWrite("Login Script", .LoginScript)
                        ConsoleWrite("Login Workstations", .LoginWorkstations)
                        ConsoleWrite("Max Logins", .MaxLogins)
                        ConsoleWrite("Parent", .Parent)
                        ConsoleWrite("Password Expiration Date", .PasswordExpirationDate)
                        ConsoleWrite("Password Last Changed", .PasswordLastChanged)
                        ConsoleWrite("Password Mininmum Length", .PasswordMinimumLength)
                        ConsoleWrite("Password Required", .PasswordRequired)
                        ConsoleWrite("Profile", .Profile)
                        ConsoleWrite("Required Unique Password", .RequireUniquePassword)
                        ConsoleWrite("Schema", .Schema)
                        ConsoleWrite("SeeAlso", .SeeAlso)

                    End With
                End If

                If (ReturnType And 2) = 2 Then
                    Dim userEntry As DirectoryEntry = New DirectoryEntry(rs.fields("adsPath").value.tostring)
                    For Each Key As String In userEntry.properties.propertynames
                        If LCase(userEntry.Properties(Key).Value.gettype.tostring) = "system.byte[]" Then
                            ConsoleWrite(Key, ToHex(CType(userEntry.properties(Key).value, Byte())))

                        ElseIf LCase(userEntry.properties(Key).value.gettype.tostring) = "system.__comobject" Then
                            ConsoleWrite(Key, _
                            DateTime.FromFileTimeUtc(GetInt64FromLargeInteger(userEntry.properties(Key).value)).ToLocalTime & _
                            " (" & GetInt64FromLargeInteger(userEntry.properties(Key).value) & ")")

                        ElseIf LCase(userEntry.properties(Key).value.gettype.tostring) = "system.object[]" Then
                            Dim i As Integer = 1
                            ConsoleWrite(Fill(Key))
                            For Each x As Object In userEntry.properties(Key).value
                                ConsoleWrite(i, x.ToString)
                                i += 1
                            Next

                        Else
                            ConsoleWrite(Key, userEntry.Properties(Key).Value.ToString())

                        End If
                    Next
                    userEntry.dispose()
                End If

                rs.movenext()
            Loop
            Err.Clear()

        Catch e As Exception
            ConsoleWrite(e.Message)

        Finally

            If rs IsNot Nothing Then
                If rs.state <> 0 Then rs.close()
                rs = Nothing
            End If

            If oCon IsNot Nothing Then
                If oCon.state <> 0 Then oCon.close()
                oCon = Nothing
            End If

            oRoot = Nothing
            oDomain = Nothing

        End Try

    End Sub

    Private Shared Function ToHex(ByVal bByte() As Byte) As String
        Dim str As String = ""
        For i As Integer = 0 To bbyte.getupperbound(0)
            str &= Hex(bByte(i)).PadLeft(2, CChar("0"))
        Next
        Return str
    End Function

    Private Shared Sub ShowHelp()
        ConsoleWrite("PARAMETERS:")
        ConsoleWrite("-help \t Shows Help")
        ConsoleWrite("-user \t Finds the user via UID")
        ConsoleWrite("-lname \t Finds every matching user via last name")
        ConsoleWrite("-fname \t Finds every matching user via first name")
        ConsoleWrite("-dept \t Finds every matching user via department")
        ConsoleWrite("-all \t All information")
        ConsoleWrite("-max \t Minimal information")
        ConsoleWrite("-acc \t Account Information")
        consolewrite("\nUSAGE:")
        consolewrite("ldap -max -lname doe")
        consolewrite("ldap -max -lname doe -fname j*")
        consolewrite("\nDEFAULTS:")
        consolewrite("""ldap doe"" is the same as ""ldap -lname doe""\n")
    End Sub

#Region "Fill"
    Private Overloads Shared Function Fill() As String
        Return Fill("")
    End Function

    Private Overloads Shared Function Fill(ByVal C As Char) As String
        Return Fill("", C)
    End Function

    Private Overloads Shared Function Fill(ByVal sString As String) As String
        If sString.Length > TITLE_LENGTH Then
            Return Left(sString, TITLE_LENGTH)
        Else
            Return sString.PadRight(TITLE_LENGTH, CChar("."))
        End If
    End Function

    Private Overloads Shared Function Fill(ByVal sString As String, ByVal C As Char) As String
        If sString.Length > TITLE_LENGTH Then
            Return Left(sString, TITLE_LENGTH)
        Else
            Return sString.PadRight(TITLE_LENGTH, C)
        End If
    End Function
#End Region

#Region "Console Write"
    Private Overloads Shared Sub ConsoleWrite(ByVal sName As String, ByVal sText As String)
        If sText.Length > MAX_STRING_LENGTH Then
            Dim iCut As Integer = CInt((sText.Length / MAX_STRING_LENGTH) - 1)
            If iCut < 0 Then iCut = 0
            Console.WriteLine(Fill(sName) & Mid(sText, 1, MAX_STRING_LENGTH))
            If iCut > 0 Then
                For i As Integer = 1 To iCut
                    Console.WriteLine(Fill(CChar(" ")) & Mid(sText, i * MAX_STRING_LENGTH + 1, MAX_STRING_LENGTH))
                Next
            End If
        Else
            Console.WriteLine(Fill(sName) & sText)
        End If
    End Sub

    Private Overloads Shared Sub ConsoleWrite(ByVal int As Integer, ByVal sText As String)
        If sText.Length > MAX_STRING_LENGTH Then
            Dim iCut As Integer = CInt((sText.Length / MAX_STRING_LENGTH) - 1)
            If iCut < 0 Then iCut = 0
            Console.WriteLine((CStr(int.ToString) & ". ").PadLeft(TITLE_LENGTH, CChar(" ")) & Mid(sText, 1, MAX_STRING_LENGTH))
            If iCut > 0 Then
                For i As Integer = 1 To iCut
                    Console.WriteLine(Fill(CChar(" ")) & Mid(sText, i * MAX_STRING_LENGTH + 1, MAX_STRING_LENGTH))
                Next
            End If
        Else
            Console.WriteLine((CStr(int.ToString) & ". ").PadLeft(TITLE_LENGTH, CChar(" ")) & sText)
        End If
    End Sub

    Private Overloads Shared Sub ConsoleWrite(ByVal sText As String)
        sText = Replace(sText, "\t", vbTab)
        sText = Replace(sText, "\n", vbNewLine)
        Console.WriteLine(sText)
    End Sub
#End Region

    ' http://www.eggheadcafe.com/software/aspnet/31107648/systembyte-and-systemcomobject-in-ad-ldap-browser.aspx
#Region "Converters"
    Private Shared Function GetInt64FromLargeInteger(ByVal largeInteger As Object) As Int64

        Dim low As Int32
        Dim high As Int32
        Dim valBytes(7) As Byte

        Dim longInt As IADsLargeInteger = CType(largeInteger, IADsLargeInteger)
        low = longInt.LowPart
        high = longInt.HighPart

        BitConverter.GetBytes(low).CopyTo(valBytes, 0)
        BitConverter.GetBytes(high).CopyTo(valBytes, 4)

        Return BitConverter.ToInt64(valBytes, 0)

    End Function

    <ComImport(), Guid("9068270b-0939-11D1-8be1-00c04fd8d503"), InterfaceTypeAttribute(ComInterfaceType.InterfaceIsDual)> _
    Private Interface IADsLargeInteger
        Property HighPart() As Int32
        Property LowPart() As Int32
    End Interface
#End Region

End Class

Advertisements
Kategorien:.NET Schlagwörter:
  1. Es gibt noch keine Kommentare.
  1. No trackbacks yet.

Kommentar verfassen

Trage deine Daten unten ein oder klicke ein Icon um dich einzuloggen:

WordPress.com-Logo

Du kommentierst mit Deinem WordPress.com-Konto. Abmelden / Ändern )

Twitter-Bild

Du kommentierst mit Deinem Twitter-Konto. Abmelden / Ändern )

Facebook-Foto

Du kommentierst mit Deinem Facebook-Konto. Abmelden / Ändern )

Google+ Foto

Du kommentierst mit Deinem Google+-Konto. Abmelden / Ändern )

Verbinde mit %s

%d Bloggern gefällt das: