Старожил
Сообщения: 210
Благодарности: 76
|
Профиль
|
Отправить PM
| Цитировать
Например, так:
читать дальше »
Код:
Dim objRoot, objConnection, objCommand, objRSet, objUser
Dim objFS, objFile, objWShell, strLog, strItem, strList, strTemp, arrTemp
Dim strAttributes, strAttributesAdd
strLog = "Users_Computers.txt"
Set objRoot = GetObject("LDAP://RootDSE")
strDomain = objRoot.Get("DefaultNamingContext")
Set objRoot = Nothing
strAttributes = "cn,whenCreated"
strAttributesAdd = ",mail,distinguishedName"
arrCmdText = Array("<LDAP://" & strDomain & ">;(&(objectCategory=Person)(objectClass=User));" & _
strAttributes & strAttributesAdd & ";Subtree", _
"<LDAP://" & strDomain & ">;(objectCategory=Computer);" & strAttributes & ";Subtree")
arrCapLines = Array("|Пользователь|Дата создания|Адрес эл. почты|Членство в группах", "|Компьютер|Дата создания|")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand = CreateObject("ADODB.Command")
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 30
objCommand.Properties("Sort On") = "cn"
Set objFS = CreateObject("Scripting.FileSystemObject")
strLog = objFS.BuildPath(objFS.GetParentFolderName(WScript.ScriptFullName), strLog)
Set objFile = objFS.CreateTextFile(strLog, True)
On Error Resume Next
For i = 0 To UBound(arrCmdText)
objCommand.CommandText = arrCmdText(i)
Set objRSet = objCommand.Execute
If Err.Number = 0 Then
If objRSet.RecordCount > 0 Then
objFile.WriteLine (arrCapLines(i))
objRSet.MoveFirst
Do Until objRSet.EOF
strItem = "|" & objRSet.Fields("cn").Value & "|" & DateValue(objRSet.Fields("whenCreated").Value) & "|"
If InStr(1, arrCmdText(i), "objectClass=User", vbTextCompare) > 0 Then
strTemp = objRSet.Fields("mail").Value
If Err.Number = 0 Then
strItem = strItem & strTemp & "|"
Else
Err.Clear
End If
Set objUser = GetObject("LDAP://" & objRSet.Fields("distinguishedName").Value)
If Err.Number = 0 Then
strList = vbNullString
arrTemp = objUser.GetEx("memberOf")
If Err.Number = 0 Then
For Each strTemp In arrTemp
strTemp = Mid(Split(strTemp, ",")(0), 4)
strList = strList & strTemp & ";"
Next
strItem = strItem & strList
Else
strItem = strItem & "Значение атрибута MEMBEROF не определено"
Err.Clear
End If
Else
strItem = strItem & "Членство в группах не определено"
Err.Clear
End If
objFile.WriteLine strItem
Else
objFile.WriteLine strItem
End If
objRSet.MoveNext
Loop
Set objUser = Nothing
End If
Else
objFile.WriteLine "Ошибка " & Err.Number & " (" & Err.Description & ")" & vbNewLine & _
" при выполнении запроса: " & arrCmdText(i)
Err.Clear
End If
If i < UBound(arrCmdText) Then objFile.WriteLine
Next
objFile.Close
Set objFile = Nothing
Set objFS = Nothing
Set objRSet = Nothing
Set objCommand = Nothing
objConnection.Close
Set objConnection = Nothing
Set objWShell = CreateObject("WScript.Shell")
objWShell.Run "notepad.exe " & strLog, 1
Set objWShell = Nothing
WScript.Quit 0
|
Отправлено: 16:01, 14-02-2013
| #2
|