blog :: dejan @ fejst.net

Osebni spletni dnevnik z zaznamki in dogodki s potovanja moje življenske poti.

AD telefonski imenik (rekurzivno)  

Kar nekaj časa sem porabil, da sem doumel, da se z enostavnimi triki da iskati tudi rekurzivno po AD imeniku. Problem sem imel, ko sem hotel z getObject pridobivati atribute, ki pa na enostaven način ne pozna rekurzive. Torej najlažje to dosežemo tako, da za rekuzivno iskanje uporabimo ADO, kjer določimo iskalne kriterije in s subtree določimo rekurzivnost iskanja ter na to posredujemo dn (distinguished name) loop zanki, ki za vsak najden objekt naredi getObject.

Primer skripte je spodaj:


Option Explicit
Dim adoCommand, adoConnection, strBase, strFilter, strAttributes
Dim objRootDSE, strDNSDomain, strQuery, adoRecordset

Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection

Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
strBase = ""

Dim srchUser
srchUser = "*"
strFilter = "(&(objectCategory=user)(telephoneNumber=*)(cn=" & srchUser & "))"
strAttributes = "sAMAccountName,cn,distinguishedName"

strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 500
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False

Dim strName, strCN, arrGroups, strGroup
Dim strUserDN
Set adoRecordset = adoCommand.Execute
adoRecordset.MoveFirst
Dim strFile, objFSO, objFile
strFile = "c:\temp\interni-imenik.csv"
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strFile) THEN
On Error Resume Next
objFSO.DeleteFile(strFileName)
Set objFile = objFSO.CreateTextFile(strFile)
Else
Set objFile = objFSO.CreateTextFile(strFile)
End If
Do Until adoRecordset.EOF
strName = adoRecordset.Fields("sAMAccountName").Value
strCN = adoRecordset.Fields("cn").value
Wscript.Echo "Izpis: " & strName & ", " & strCN
strUserDN = adoRecordset.Fields("distinguishedName").Value
strUserDN = Replace(strUserDN, "/", "\/")
Dim strLine
strLine = retriveuserDetails(strUserDN)
Wscript.echo strLine
'ForAppending = 8 ForReading = 1, ForWriting = 2
Const ForAppending = 8
Set objFile = objFSO.OpenTextFile(strFile, ForAppending, True)
objFile.Write strLine
objFile.Write vbcrlf
objFile.Close
adoRecordset.MoveNext
Loop
adoRecordset.Close
adoConnection.Close

Function retriveUserDetails(strDN)
Dim objUser
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("DefaultNamingContext")
Set objUser = GetObject("LDAP://" & strDN)
retriveUserDetails = Chr(34) & _
objUser.FullName & """,""" & _
objUser.sn & """,""" & _
objUser.middleName & """,""" & _
objUser.givenName & """,""" & _
objUser.telephoneNumber & """,""" & _
objUser.mobile & """,""" & _
objUser.ipPhone & """,""" & _
objUser.facsimileTelephoneNumber & """,""" & _
objUser.description & """,""" & _
objUser.title & """,""" & _
objUser.department & """,""" & _
objUser.physicalDeliveryOfficeName & """,""" & _
objUser.mail & chr(34)
End Function
WScript.Quit

AddThis Social Bookmark Button

0 komentarji

Objavite komentar