استخراج بيانات المستخدمين من اكتف دايركتوري

هذا السكربت يقوم باستخراج خصائص المستخدمين من اكتف دايركتوري ويوجد مثله الكثير على الانترنت ولكن الخاصية المميزة له هو قدرته على استخراج المجموعات التي ينتمي لها المستخدم

 Option Explicit  
 ‘ By Mohammad Selim  
 Private Const m_strLDAPPrefix = “LDAP://”  
 Call Main()  
 Private Sub Main()  
 Dim strPath  
 strPath = GetCurrentPath() & “sample.csv”  
 Call WriteADContentToLog(strPath)  
 Msgbox “Operation completed successfully !” & _  
 vbCrLf & _  
 strPath, _  
 vbOKOnly + vbInformation  
 End Sub  
 Private Sub WriteADContentToLog(p_strPath)  
 Dim cn  
 Dim cmd  
 Dim rs  
 Dim fso  
 Dim ts  
 Dim strContent, membership, groupstr, group  
 Set fso = CreateObject(“Scripting.FileSystemObject”)  
 Set ts = fso.CreateTextFile(p_strPath, True, True)  
 Set cn = CreateObject(“ADODB.Connection”)  
 With cn  
 .Provider = “ADSDSOObject”  
 Call .Open  
 End With  
 Set cmd = CreateObject(“ADODB.Command”)  
 Set cmd.ActiveConnection = cn  
 With cmd  
 .CommandText = “SELECT sAMAccountName, givenName, sn, cn, displayName, mail, mailNickname, company, department, manager, homeDirectory, homeDrive, scriptPath, ProfilePath, physicalDeliveryOfficeName, telephoneNumber, memberOf ” & _  
 “FROM ‘” & m_strLDAPPrefix & GetOrgAndSiteName() & “‘ ” & _  
 “WHERE objectCategory=’person’ AND objectClass=’user’ ” & _  
 “ORDER BY cn”  
 .Properties(“Page Size”) = 100000  
 .Properties(“Timeout”) = 30000  
 .Properties(“searchscope”) = 2 ‘ADS_SCOPE_SUBTREE  
 End With  
 Set rs = cmd.Execute()  
 With rs  
 Do Until .EOF  
 membership = .Fields(“memberOf”)  
 if isempty(membership) then  
 elseif (typename(membership) =”String”) Then  
 strContent = .Fields(“sAMAccountName”) & _  
 vbTab & _  
 .Fields(“givenName”) & _  
 vbTab & _  
 .Fields(“sn”) & _  
 vbTab & _  
 .Fields(“cn”) & _  
 vbTab & _  
 .Fields(“displayName”) & _  
 vbTab & _  
 .Fields(“mail”) & _  
 vbTab & _  
 .Fields(“mailNickname”) & vbtab & _  
 .Fields(“company”) & vbtab _  
 .Fields(“department”) & vbtab & _  
 .Fields(“manager”) & vbtab & _  
 .Fields(“homeDirectory”) & vbtab & _  
 .Fields(“homeDrive”) & vbtab & _  
 .Fields(“scriptPath”) & vbtab & _  
 .Fields(“ProfilePath”) & vbtab & _  
 .Fields(“physicalDeliveryOfficeName”) & vbtab & _  
 .Fields(“telephoneNumber”) & vbtab & _  
 membership  
 Call ts.WriteLine(strContent)  
 elseif (typename(membership) = “Variant()”) then  
 for each group in membership  
 strContent = .Fields(“sAMAccountName”) & _  
 vbTab & _  
 .Fields(“givenName”) & _  
 vbTab & _  
 .Fields(“sn”) & _  
 vbTab & _  
 .Fields(“cn”) & _  
 vbTab & _  
 .Fields(“displayName”) & _  
 vbTab & _  
 .Fields(“mail”) & _  
 vbTab & _  
 .Fields(“mailNickname”) & vbtab & _  
 .Fields(“company”) & vbtab & _  
 .Fields(“department”) & vbtab &_  
 .Fields(“manager”) & vbtab &_  
 .Fields(“homeDirectory”) & vbtab &_  
 .Fields(“homeDrive”) & vbtab &_  
 .Fields(“scriptPath”) & vbtab & _  
 .Fields(“ProfilePath”) & vbtab & _  
 .Fields(“physicalDeliveryOfficeName”) & vbtab & _  
 .Fields(“telephoneNumber”) & vbtab & _  
 group  
 Call ts.WriteLine(strContent)  
 next  
 end if  
 Call .MoveNext  
 Loop  
 Call .Close  
 End With  
 Set rs = Nothing  
 Set cmd = Nothing  
 Call cn.Close()  
 Set cn = Nothing  
 Call ts.Close()  
 Set ts = Nothing  
 Set fso = Nothing  
 set membership = nothing  
 End Sub  
 Private Function GetOrgAndSiteName()  
 GetOrgAndSiteName = GetObject(m_strLDAPPrefix & “RootDSE”). _  
 Get(“defaultNamingContext”)  
 End Function  
 Private Function GetCurrentPath()  
 Dim strCurrentPath  
 With WScript  
 strCurrentPath = Replace(.ScriptFullName, _  
 .ScriptName, _  
 vbNullString, _  
 vbTextCompare)  
 End With  
 If Right(strCurrentPath, 1) <> “\” Then  
 strCurrentPath = strCurrentPath & “\”  
 End If  
 GetCurrentPath = strCurrentPath  
 End Function