Чтение из AD параметров компьютеров (Имя, дата создания объекта, дата последнего входа и т.д.)

'***********************************************************************
' Скрипт вытаcкивает много атрибутов объекта компьютер из домена
' никаких привелегий не требуется кроме пользовательских
'maden by DmiSh
'***********************************************************************
' ----------------------------------------------------------------------
Option Explicit
   '--------------имя файла отчета и его создание
 Const StrNameTextFileReport = "c:\LastLogon.csv"
 Set FSO = WScript.CreateObject("Scripting.FileSystemObject")
Set CSVFile=FSO.OpenTextFile(StrNameTextFileReport, 2 ,true)
    '--------------объявление переменных
Dim objRootDSE, strConfig, objConnection, objCommand, strQuery
Dim objRecordSet, objDC
Dim FSO, CSVFile
Dim strDNSDomain, objShell, lngBiasKey, lngBias, k, arrstrDCs()
Dim strDN, dtmDate, objDate, lngDate, objList, strUser
Dim strBase, strFilter, strAttributes, lngHigh, lngLow
   'переменные строки для временного хранения значений атрибутов
Dim Strcn,StrDescription,StrOperatingSystem,StrOperatingSystemVersion,StrOperatingSystemServicePack,StrWhenCreated,StrLogonCount,StrlastLogoff,StrlastLogon

Dim StrRes

Dim objCN,objdistinguishedName,objDescription,objOperatingSystem,objOperatingSystemVersion,objOperatingSystemServicePack,objWhenCreated,objLogonCount,objlastLogoff,objlastLogon

'----------------------------------------
'-------------- Используем объект dictionary для хранения параметров для каждого компьютера
Set objList = CreateObject("Scripting.Dictionary")
objList.CompareMode = vbTextCompare
'--------------objCN
Set objCN = CreateObject("Scripting.Dictionary")
objCN.CompareMode = vbTextCompare
'--------------objdistinguishedName
Set objdistinguishedName = CreateObject("Scripting.Dictionary")
objdistinguishedName.CompareMode = vbTextCompare
'--------------objDescription
Set objDescription = CreateObject("Scripting.Dictionary")
objDescription.CompareMode = vbTextCompare
'--------------objOperatingSystem
Set objOperatingSystem = CreateObject("Scripting.Dictionary")
objOperatingSystem.CompareMode = vbTextCompare
'--------------objOperatingSystemVersion
Set objOperatingSystemVersion = CreateObject("Scripting.Dictionary")
objOperatingSystemVersion.CompareMode = vbTextCompare
'--------------objOperatingSystemServicePack
Set objOperatingSystemServicePack = CreateObject("Scripting.Dictionary")
objOperatingSystemServicePack.CompareMode = vbTextCompare
'--------------WhenCreated
Set objWhenCreated = CreateObject("Scripting.Dictionary")
objWhenCreated.CompareMode = vbTextCompare
'--------------objLogonCount
Set objLogonCount = CreateObject("Scripting.Dictionary")
objLogonCount.CompareMode = vbTextCompare
'--------------objlastLogoff
Set objlastLogoff = CreateObject("Scripting.Dictionary")
objlastLogoff.CompareMode = vbTextCompare
'--------------objlastLogon
Set objlastLogon = CreateObject("Scripting.Dictionary")
objlastLogon.CompareMode = vbTextCompare
'-------------------------------------
'-------------- Получение настроек о зонах времени из регистра
Set objShell = CreateObject("Wscript.Shell")
lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\" & "TimeZoneInformation\ActiveTimeBias")
If UCase(TypeName(lngBiasKey)) = "LONG" Then
  lngBias = lngBiasKey
ElseIf UCase(TypeName(lngBiasKey)) = "VARIANT()" Then
  lngBias = 0
  For k = 0 To UBound(lngBiasKey)
    lngBias = lngBias + (lngBiasKey(k) * 256^k)
  Next
End If
'-------------------------------------
' Определение контекста конфигурации и DNS из RootDSE object.
Set objRootDSE = GetObject("LDAP://RootDSE")
strConfig = objRootDSE.Get("configurationNamingContext")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
'-------------------------------------
' Используем ADO для поиска Active Directory на передмет ObjectClass nTDSDSA.
' Это определит все контроллеры домена
Set objCommand = CreateObject("ADODB.Command")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
objCommand.ActiveConnection = objConnection
 
strBase = "<LDAP://" & strConfig & ">"
strFilter = "(objectClass=nTDSDSA)"
strAttributes = "AdsPath"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
 
objCommand.CommandText = strQuery
objCommand.Properties("Page Size") = 100
objCommand.Properties("Timeout") = 60
objCommand.Properties("Cache Results") = False
 
Set objRecordSet = objCommand.Execute
'-------------------------------------
' Перечисление родительских оъектов класса nTDSDSA. Save Domain Controller
' AdsPaths в динамическом массиве arrstrDCs.
k = 0
Do Until objRecordSet.EOF
  Set objDC = _
    GetObject(GetObject(objRecordSet.Fields("AdsPath")).Parent)
  ReDim Preserve arrstrDCs(k)
  arrstrDCs(k) = objDC.DNSHostName
  k = k + 1
  objRecordSet.MoveNext
Loop
'-------------------------------------
' Получение атрибутов компьютера на каждом контроллере домена
For k = 0 To Ubound(arrstrDCs)
   strBase = "<LDAP://" & arrstrDCs(k) & "/" & strDNSDomain & ">"
   'strFilter = "(&(objectCategory=person)(objectClass=user))"
   strFilter = "(&(objectCategory=computer)(objectClass=computer))"
   'strAttributes = "distinguishedName,lastLogon"
   strAttributes = "cn,distinguishedName,Description,OperatingSystem,OperatingSystemVersion,OperatingSystemServicePack,WhenCreated,LogonCount,lastLogoff,lastLogon"
   strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
   objCommand.CommandText = strQuery
   On Error Resume Next
   Set objRecordSet = objCommand.Execute
   If Err.Number <> 0 Then
      On Error GoTo 0
      WScript.Echo "Domain Controller not available: " & arrstrDCs(k)
   Else
      On Error GoTo 0
      Do Until objRecordSet.EOF
         strDN = objRecordSet.Fields("distinguishedName")
'         objCN.Add strDN, objRecordSet.Fields("cn")
'         objdistinguishedName.Add strDN, objRecordSet.Fields("distinguishedName")
'         objDescription.Add strDN,objRecordSet.Fields("Description")
'         objOperatingSystem.Add strDN,objRecordSet.Fields("OperatingSystem")
'         objOperatingSystemVersion.Add strDN,objRecordSet.Fields("OperatingSystemVersion")
'         objOperatingSystemServicePack.Add strDN,objRecordSet.Fields("OperatingSystemServicePack")
'         objWhenCreated.Add strDN,objRecordSet.Fields("WhenCreated")
'         objLogonCount.Add strDN,objRecordSet.Fields("LogonCount")
'         objlastLogoff.Add strDN,objRecordSet.Fields("lastLogoff")
         StrCN = objRecordSet.Fields("cn").Value
         StrOperatingSystem = objRecordSet.Fields("OperatingSystem")
         StrOperatingSystemVersion = objRecordSet.Fields("OperatingSystemVersion")
         StrOperatingSystemServicePack = objRecordSet.Fields("OperatingSystemServicePack")
         StrWhenCreated = objRecordSet.Fields("WhenCreated")
         StrLogonCount = objRecordSet.Fields("LogonCount")
         StrlastLogoff = objRecordSet.Fields("lastLogoff")
         StrlastLogon = objRecordSet.Fields("lastLogon")
         '---------------------------- добавление данных в "Scripting.Dictionary"-s
         If objList.Exists(strDN) Then
            If dtmDate > objList(strDN) Then
               objList(strDN) = FuncConvertTime( StrlastLogon ) 'dtmDate
            End If
         Else
            objList.Add strDN, FuncConvertTime( StrlastLogon ) 'dtmDate
         End If
         '----------------------------
         If objCN.Exists(strDN) Then
         Else
            objCN.Add strDN, StrCN
         End If
         '----------------------------
         If objdistinguishedName.Exists(strDN) Then
         Else
            objdistinguishedName.Add strDN, strDN
         End If         
         '----------------------------
               '********************************
         objDescription.Add strDN,FuncGetDescriptionComputerFromAdByDistinguishedName( strDN )
         '----------------------------
         If objOperatingSystem.Exists(strDN) Then
         Else
            objOperatingSystem.Add strDN, StrOperatingSystem
         End If         
         '----------------------------
         If objOperatingSystemVersion.Exists(strDN) Then
         Else
            objOperatingSystemVersion.Add strDN, StrOperatingSystemVersion
         End If         
         '----------------------------
         If objOperatingSystemServicePack.Exists(strDN) Then
         Else
            objOperatingSystemServicePack.Add strDN, StrOperatingSystemServicePack
         End If         
         '----------------------------
         If objWhenCreated.Exists(strDN) Then
         Else
            objWhenCreated.Add strDN, StrWhenCreated
         End If
         '----------------------------
         If objlastLogoff.Exists(strDN) Then
         Else
            objlastLogoff.Add strDN, FuncConvertTime(StrlastLogoff)
         End If      
         '----------------------------
         If objLogonCount.Exists(strDN) Then
         Else
            objLogonCount.Add strDN, StrLogonCount
         End If
         '----------------------------
         objRecordSet.MoveNext
      Loop
   End If
   Exit For
Next
'-------------------------------------
' Вывод даты последнего lastLogon для каждого пользователя
CSVFile.WriteLine("cn;distinguishedName;Description;OperatingSystem;OperatingSystemVersion;OperatingSystemServicePack;WhenCreated;LogonCount;lastLogoff;lastLogon")
For Each strUser In objList
   CSVFile.WriteLine(objCN(strUser) & " ; " & strUser & " ; " & objDescription(strUser) & " ; " & objOperatingSystem(strUser) & " ; " & objOperatingSystemVersion(strUser) & " ; " & objOperatingSystemServicePack(strUser)  & " ; " & objWhenCreated(strUser)  & " ; " & objLogonCount(strUser) & " ; " & objlastLogoff(strUser) & " ; " & objList(strUser))
Next
'-------------------------------------
' Очистка
objConnection.Close
Set objRootDSE = Nothing
Set objConnection = Nothing
Set objCommand = Nothing
Set objRecordSet = Nothing
Set objDC = Nothing
Set objDate = Nothing
Set objList = Nothing
Set objShell = Nothing
WScript.Echo "Файл " & StrNameTextFileReport & " заполнен"
'********************************************************
'функция преобразует дату из числового формата в нормальный
Function FuncConvertTime(x)
' Получение настроек о зонах времени из регистра
         Set objShell = CreateObject("Wscript.Shell")
         lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\" & "TimeZoneInformation\ActiveTimeBias")
         If UCase(TypeName(lngBiasKey)) = "LONG" Then
           lngBias = lngBiasKey
         ElseIf UCase(TypeName(lngBiasKey)) = "VARIANT()" Then
           lngBias = 0
           For k = 0 To UBound(lngBiasKey)
             lngBias = lngBias + (lngBiasKey(k) * 256^k)
           Next
         End If
         On Error Resume Next
         Set objDate = x'lastLogon'lngDate
         If Err.Number <> 0 Then
            On Error GoTo 0
            dtmDate = #1/1/1601#
         Else
            On Error GoTo 0
            lngHigh = objDate.HighPart
            lngLow = objDate.LowPart
            If lngLow < 0 Then
               lngHigh = lngHigh + 1
            End If
            If (lngHigh = 0) And (lngLow = 0 ) Then
               FuncConvertTime = #1/1/1601#
            Else
               FuncConvertTime = #1/1/1601# + (((lngHigh * (2 ^ 32)) + lngLow)/600000000 - lngBias)/1440
            End If
         End If
         
End Function
'********************************************************
'функция возвращает описание компьютера из AD по DistinguishedName
Function FuncGetDescriptionComputerFromAdByDistinguishedName( DN )
   Dim LDAPQuery
   LDAPQuery = "LDAP://" & DN ' & vbCrLf
   'WScript.Echo "<<" & LDAPQuery & ">>"
   Dim objComputer
   Dim StrobjPropertyDescription
   Set objComputer = GetObject( LDAPQuery )
      '--------------Description
   On Error Resume Next
   FuncGetDescriptionComputerFromAdByDistinguishedName = objComputer.Get("Description")
   If IsNull(FuncGetDescriptionComputerFromAdByDistinguishedName) Then
      FuncGetDescriptionComputerFromAdByDistinguishedName = "-"
   Else
   End If
   StrobjPropertyDescription = Null
End Function