Страница 1 из 1

Как загрузить реестр на компьютер в локальной сети

Добавлено: 26 май 2009 10:40, Вт
UncleFather

Можно воспользоваться встроенной в Windows утилитой reg, например

Код: Выделить всё

reg copy \\SourceComp\HKLM\SOFTWARE\Policies\Microsoft\Windows\WindowsUpdate \\DestComp\HKLM\SOFTWARE\Policies\Microsoft\Windows\WindowsUpdate /s

, а можно скачать скрипт отсюда.
Второй вариант гораздо удобнее, поскольку позволяет производить записи в реестр сразу нескольким компьютерам и не имеет ограничений на разделы реестра.
Для запуска скрипта applyreg.vbs нужны два файла. Один - файл с расширением reg - это то, что мы будем загружать в реестр (его можно сделать простым экспортированием нужного подраздела реестра). Второй файл - список компьютеров, на которых будут произвиться обновления. Вот пример файла:

Код: Выделить всё

distinguishedName
"CN=Comp01,OU=Admin Computers,DC=domain,DC=local",
"CN=Comp02,OU=Domain Computers,DC=domain,DC=local",

Этот файл можно сформировать при помощи скрипта ComputerSearch.vbs, взятого отсюда.
Формат запуска ComputerSearch.vbs:

Код: Выделить всё

cscript ComputerSearch.vbs [/r:role]

Где role может принимать значения: “DC” для контроллеров домена либо “MC” для рабочих станций домена.
Формат запуска applyreg.vbs:

Код: Выделить всё

cscript applyreg.vbs /r:update.reg /f:computers.txt

Подробное описание данного метода приведено здесь.


Добавлено: 26 май 2009 10:44, Вт
Bibigool

Листинг скрипта applyreg.vbs:

Код: Выделить всё

'Add computer can't be found in AD when the binding operation fails

'**************************************************************************
'*  File:           ApplyReg.vbs                                          *
'*  Created:        April 2003                                            *
'*  Version:        1.0                                                   *
'*                                                                        *
'*  Description:    Utility that applies the contents of a .reg file to   *
'*                  the registry of each available and accessible         *
'*                  computer specified in the csv report created manually * 
'*                  or by the ComputerSearch.vbs script.                  * 
'*                  This script generates a report that includes the      *
'*                  name of each computer where the .reg file import      *
'*                  was attempted and whether the application was         *
'*                  successful at applying the change.                    *
'*                                                                        *
'*  Compatibility:  This script requires WSH 5.6, CScript, ADSI, WMI      *
'*                  and access to Active Directory                        *
'**************************************************************************
Option Explicit

'Define constants
Const ForReading = 1
Const TristateUseDefault = -2
Const ForAppending = 8

'Declare global variables
Dim objArgs,strRptFileName,strRegFileName
Dim objDictionary,strFileName,objFSO,objFile,objRegFile
Dim objRptFile,objRegExp,objShell,iRecord,strLine
Dim arrComptInfo,strDN,strComputer,strNotes
Dim objExec,strPingStdOut,objRegistry
Dim objTextStream,ColRootKey,Key,strKey,strKeyPath
Dim strStatus,iCnt

Call CheckForCScript()

'Use Named Arguments collection for the command line argument.
'The WSHArguments Object is included in WSH version 5.6 and later
Set objArgs = WScript.Arguments.Named
strRptFileName = objArgs.Item("f")
strRegFileName = objArgs.Item("r")

If WScript.Arguments.Named.Count < 2 Then
	WScript.Echo "You must specify a csv file name " & VBCrLf & _
	  "of a file created manually or by ComputerSearch.vbs and " & VbCrLf & _
	  "the name of the .reg file to apply." & VbCrLf & VbCrLf & _
	  SampleCommandLine()
	WScript.Quit
End If

'Use a dictionary object for the constants that define
'the root keys
Set objDictionary = CreateObject("Scripting.Dictionary")
objDictionary.Add "HKEY_LOCAL_MACHINE",&h80000002
objDictionary.Add "HKEY_CLASSES_ROOT",&h80000000
objDictionary.Add "HKEY_CURRENT_USER",&h80000001
objDictionary.Add "HKEY_USERS",&h80000003
objDictionary.Add "HKEY_CURRENT_CONFIG",&h80000005

'Call the GenFileName function to create a unique file name for the report
strFileName = GenFileName("ApplyReg")

'Create a text file (.csv format) to hold the  
'results of the report.
Set objFSO = CreateObject("Scripting.FileSystemObject")
'This will overwrite the file if it already exists.
Set objFile = objFSO.CreateTextFile(strFileName,True)
objFile.Close
Set objFile = objFSO.OpenTextFile(strFileName,ForAppending)
'Write the headings for this csv file
objFile.WriteLine "DistinguishedName," & _
  "Computer Name,Status,Notes"
  
'Get the registry file
Set objRegFile = objFSO.GetFile(strRegFileName)

Добавлено: 26 май 2009 10:45, Вт
UncleFather

Продолжение:

Код: Выделить всё

'Open the computer search report file for reading
Set objRptFile = objFSO.OpenTextFile(strRptFileName,ForReading)
'Skip the header row of the report
objRptFile.SkipLine

'Create the Regular Expression object
Set objRegExp = New RegExp
'Set some global properties for the RegExp object
objRegExp.IgnoreCase = FALSE
objRegExp.Global = TRUE
objRegExp.MultiLine = FALSE

'Create the Wscript.Shell object for accessing the Exec method
Set objShell = CreateObject("WScript.Shell")

iRecord = 1
WScript.Echo "Report records processed: " 
Do While objRptFile.AtEndOfStream <> TRUE
  strLine = objRptFile.ReadLine
  
  'Bind to dn of a computer listed in the report file.
  arrComptInfo = Split(BindDN(strLine),"||")
  strDN = arrComptInfo(0)
  strComputer = arrComptInfo(1)
  
  'An invalid dn is specified in the report file
  If strComputer = "None" Then
    strNotes = arrComptInfo(2) & " distinguished name specified"
    strStatus = "Unable to connect to the specified dn." 
  Else
    strNotes = arrComptInfo(2) & " name used for remote connection."
  
    'Before connecting to the computer, use ping to see if you get a response.
    'A WMI connection attempt is not used because WMI's connection timeout interval 
    'is too long 
    Set objExec = objShell.Exec("ping -n 2 -w 1000 " & strComputer)
    strPingStdOut = LCase(objExec.StdOut.ReadAll)
    
    'Test whether ping was successful
    If InStr(strPingStdOut, "Reply from ") Then
	    'Attempt to connect to the registry provider on a remote computer
      Set objRegistry=GetObject("winmgmts:{impersonationLevel=impersonate}!\" &_ 
        strComputer & "\root\default:StdRegProv")
	    On Error Resume Next
	    If Err.Number <> 0 Then
		    'Store the following line to write to the status column for this computer.
		    'Typical causes of failure: 
		    'WMI not running or operator does not have permission to make a remote connection.
		    strStatus = Err.Description
		    Err.Clear
	      On Error GoTo 0
	    Else
		    'Perform the registry update
		    Set objTextStream = objRegFile.OpenAsTextStream(ForReading, TristateUseDefault)
		    Do While objTextStream.AtEndOfStream <> TRUE
          'Read a line of data
          strLine = objTextStream.ReadLine
          
          'Match root keys and paths
          objRegExp.Pattern = "(^\[HKEY_\w+[^\\])(.*)"
          If objRegExp.Test(strLine) = TRUE Then 'Create the key
            Set ColRootKey = objRegExp.Execute(strLine)
            For Each Key in ColRootKey
              strKey = Mid(Key.SubMatches(0),2)
              strKeyPath = Mid(Key.SubMatches(1),2,Len(Trim(Key.SubMatches(1)))-2)
              objRegistry.CreateKey objDictionary(strKey),strKeyPath
            Next

Добавлено: 26 май 2009 10:46, Вт
Bibigool

Продолжение:

Код: Выделить всё

          Else 'Create value names and values for the key
            
            'Match strings: "valuename"="value"
            objRegExp.Pattern = "(\x22.*\x22=\x22)(.*)" 
            If objRegExp.Test(strLine) = TRUE Then
              Call CreateString(strLine)
            End If
            
            'Match Binary data: "valuename"=hex:
            objRegExp.Pattern = "(\x22.*\x22=hex:)(.*)"
            If objRegExp.Test(strLine) = TRUE Then
              Call CreateBinary(strLine)
            End If
            
            'Match DWORD data: "valuename"=dword:
            objRegExp.Pattern = "(\x22.*\x22=dword:)(.*)"
            If objRegExp.Test(strLine) = TRUE Then
              Call CreateDWORD(strLine)
            End If
            
            'Match Expandable string: "valuename"=hex(2):
            objRegExp.Pattern = "(\x22.*\x22=hex\(2\):)(.*)"
            If objRegExp.Test(strLine) = TRUE Then
              Call CreateExpString(strLine)
            End If
          
            'Match Multistring: "valuename"=hex(7):
            objRegExp.Pattern = "(\x22.*\x22=hex\(7\):)(.*)"
            If objRegExp.Test(strLine) = TRUE Then
              Call CreateMultiString(strLine)
            End If
          'The registry Key pattern is true. Therefore, the script has encountered 
          'another registry key to apply.
          End If 
        Loop
        strStatus = "Registry update applied."
	    End If
    Else
	    'Store the following line to write to the status and notes columns for this computer
	    strStatus = "Host unreachable"
	    strNotes = "Verify that this host is online."
    End If
  End If
  
  objFile.WriteLine Chr(34) & strDN & Chr(34) & "," & strComputer & _
	  "," & strStatus & "," & strNotes
	  
	'Display a record counter
	For iCnt = 1 to Len(iRecord)
    WScript.StdOut.Write Chr(8)
  Next
  WScript.StdOut.Write iRecord
  iRecord = iRecord + 1
Loop

WScript.Echo VbCrLf & VbCrLf & "The report data has been saved to: " & _
 strfileName & "." & VbCrLf & _
 "Import or open the CSV data in a spreadsheet" & VbCrLf & _
 "or database program to determine which computers were updated."

Добавлено: 26 май 2009 10:47, Вт
UncleFather

Продолжение:

Код: Выделить всё


'**********************************************************************
'* Routine: CreateString
'**********************************************************************
Sub CreateString(Line)
  Dim ColEntries,Entry,strValueName,strValue
  Set ColEntries = objRegExp.Execute(Line)
  For Each Entry in ColEntries
    strValueName = Mid(Entry.SubMatches(0),2,Len(Trim(Entry.Submatches(0)))-4)
    strValue = Mid(Entry.SubMatches(1),1,Len(Trim(Entry.Submatches(1)))-1)
    objRegistry.SetStringValue objDictionary(strKey),strKeyPath,strValueName,strValue
  Next
End Sub

'**********************************************************************
'* Routine: CreateBinary
'**********************************************************************
Sub CreateBinary(Line)
  Dim arrValue(),ColEntries,Entry,strValueName,arrHexValue,i,HexVal
  Set ColEntries = objRegExp.Execute(Line)
  For Each Entry in ColEntries
    strValueName = Mid(Entry.SubMatches(0),2,Len(Trim(Entry.Submatches(0)))-7)
    'Use the split function to create an array so that each hex value can be
    'appended with an &h value in the next For Each statement
    arrHexValue = Split(Trim(Entry.SubMatches(1)),",")
    'Declare a dynamic array to hold the properly formatted hex values to
    'be passed to the WMI SetBinaryValue method.
    i=0
    For Each HexVal in arrHexValue
      Redim Preserve arrValue(i)
      arrValue(i) = "&h" & HexVal
      i=i + 1
    Next
    objRegistry.SetBinaryValue objDictionary(strKey),strKeyPath,strValueName,arrValue
    Redim arrValue(0)
  Next
End Sub

'**********************************************************************
'* Routine: CreateDWORD
'**********************************************************************
Sub CreateDWORD(Line)
  Dim ColEntries,Entry,strValueName,intValue
  Set ColEntries = objRegExp.Execute(Line)
  For Each Entry in ColEntries
    strValueName = Mid(Entry.Submatches(0),2,Len(Trim(Entry.Submatches(0)))-9)
    'Convert the hex value that will be passed to the WMI 
    'SetDWORDValue method, to a decimal data type
    intValue = CInt("&h" & Trim(Entry.SubMatches(1)))
    objRegistry.SetDWORDValue objDictionary(strKey),strKeyPath,strValueName,intValue
  Next
End Sub

'**********************************************************************
'* Routine: CreateExpString
'**********************************************************************
Sub CreateExpString(Line)
  Dim arrValue(),ColEntries,Entry,strValueName,strValueFirstLine
  Dim strValueMiddleLines,strValueLastLine,strExpandableString,HexVal
  Dim strExpandableStringFormatted,arrItems
  
  Set ColEntries = objRegExp.Execute(Line)
  For Each Entry in ColEntries
    strValueName = Mid(Entry.SubMatches(0),2,Len(Trim(Entry.Submatches(0)))-10)
    strValueFirstLine = Trim(Entry.SubMatches(1))
  Next
  'Read another line to test for data that might belong to an expandable string entry
  strLine = objTextStream.ReadLine

Добавлено: 26 май 2009 10:48, Вт
Bibigool

Продолжение:

Код: Выделить всё

  'Match additional lines of expandable-string data:   nn,nn,nn...\  objRegExp.Pattern = "(^\s{2}[0-9{1,2}|a-f{1,2},]+\\$)"

  Do While objRegExp.Test(strLine) = TRUE
    Set ColEntries = objRegExp.Execute(strLine)
    For Each Entry in ColEntries
      strValueMiddleLines = strValueMiddleLines & Trim(Entry.SubMatches(0))
    Next
    'Read another line to test for data that might belong to the middle lines of
    'an expandable string entry
    strLine = objTextStream.ReadLine
  Loop
  'Match the last line of a expandable-string expression
  objRegExp.Pattern = "(^\s{2}[0-9{1,2},|a-f{1,2},]+[0-9{1,2}$|a-f{1,2}$])"

  If objRegExp.Test(strLine) Then
    Set ColEntries = objRegExp.Execute(strLine)
    For Each Entry in ColEntries
      strValueLastLine = Trim(Entry.SubMatches(0))
    Next
  End If

  'Combine the expandable-string value
  strExpandableString = strValueFirstLine & strValueMiddleLines & strValueLastLine

  'Remove the "" character from strExpandableStringValue
  objRegExp.Pattern = "\"
  strExpandableStringFormatted = objRegExp.Replace(strExpandableString,"")

  'Convert to an array for formatting each value
  arrItems = Split(strExpandableStringFormatted,",")
  For Each HexVal in arrItems
    Redim Preserve arrValue(i)
    If HexVal <> "00" Then
      arrValue(i) = CStr(Chr(CInt("&h" & HexVal)))
      strData = strData & arrValue(i)
      i= i + 1
    End If
  Next
  'Add the expandable string to the registry
  objRegistry.SetExpandedStringValue objDictionary(strKey),strKeyPath,strValueName,strData
End Sub

'**********************************************************************
'* Routine: CreateMultiString
'**********************************************************************
Sub CreateMultiString(Line)
  Dim arrArgData(),ColEntries,Entry,strValueName,strValueFirstLine
  Dim strValueMiddleLines,strValueLastLine,strMultiString
  Dim strMultiStringFormatted,arrLine,iArgs
  Dim HexVal,arrItems,arrValue,strData
  
  Set ColEntries = objRegExp.Execute(Line)
  For Each Entry in ColEntries
    strValueName = Mid(Entry.SubMatches(0),2,Len(Trim(Entry.Submatches(0)))-10)
    strValueFirstLine = Trim(Entry.SubMatches(1))
  Next
  'Read another line to test for data that might belong to a multistring entry
  strLine = objTextStream.ReadLine
  
  'Match additional lines of multi-string data:   nn,nn,nn...\  objRegExp.Pattern = "(^\s{2}[0-9{1,2}|a-f{1,2},]+\\$)"
  
  Do While objRegExp.Test(strLine) = TRUE
    Set ColEntries = objRegExp.Execute(strLine)
    For Each Entry in ColEntries
      strValueMiddleLines = strValueMiddleLines & Trim(Entry.SubMatches(0))
    Next
    'Read another line to test for data that might belong to the middle
    'lines of a multistring entry
    strLine = objTextStream.ReadLine
  Loop
  
  'Match the last line of a Multistring expression
  objRegExp.Pattern = "(^\s{2}[0-9{1,2},|a-f{1,2},]+[0-9{1,2}$|a-f{1,2}$])"

Добавлено: 26 май 2009 10:49, Вт
UncleFather

Продолжение:

Код: Выделить всё

  
  If objRegExp.Test(strLine) Then
    Set ColEntries = objRegExp.Execute(strLine)
    For Each Entry in ColEntries
      strValueLastLine = Trim(Entry.SubMatches(0))
    Next
  End If
    
  'Combine the expandable-string value
  strMultiString = strValueFirstLine & strValueMiddleLines & strValueLastLine

  'Remove the "" character from strMultiStringValue
  objRegExp.Pattern = "\"
  strMultiStringFormatted = objRegExp.Replace(strMultiString,"")
  
  'Each line is delimited by "00,00,00". Create seperate strings for each line.
  'Each line is an argument in the array supplied to the SetMultiStringValue method.
  arrLine = Split(strMultiStringFormatted,"00,00,00")
    
  iArgs = 0
  'Convert each item in each line to string data
  For Each Line in arrLine
    If Line <> "" AND Trim(Line) <> "," Then
      'Remove commas padding the beginning and/or the end.
      If Instr(1,Line,",") = 1 Then
        Line = Mid(Line,2)
      End If
      If Instr(Len(Line),Line,",") = Len(Line) Then
        Line = Mid(Line,1,Len(Line) - 1)
      End If

      'Split each item in each line for conversion.
      arrItems = Split(Line,",")
      i=0
      'Convert each hex value to character data.
      For Each HexVal in arrItems
        Redim Preserve arrValue(i)
        If HexVal <> "00" Then
          arrValue(i) = CStr(Chr(CInt("&h" & HexVal)))
          strData = strData & arrValue(i)
          i= i + 1
        End If
      Next
      Redim Preserve arrArgData(iArgs)
      arrArgData(iArgs) = strData
      strData = ""
      iArgs = iArgs + 1
    End If
  Next
  objRegistry.SetMultiStringValue objDictionary(strKey),strKeyPath,strValueName,arrArgData
  Redim arrArgData(0)
End Sub

'**********************************************************************
'* Routine: CheckForCScript
'**********************************************************************
Sub CheckForCScript
  'This script must run from cscript because
  'it uses the WScript.StdOut property.
  'Test the script host and if it's not cscript, 
  'instruct the operator on how to run the script.
  If Right(LCase(WScript.FullName),11) <> LCase("cscript.exe") Then
    WScript.Echo "This script must run from cscript." & _
      VbCrLf & "Example: cscript ApplyReg.vbs /f:ComptSearch.csv /r:RegFile.reg"
    WScript.Quit
  End If
End Sub

Добавлено: 26 май 2009 10:50, Вт
Bibigool

Продолжение:

Код: Выделить всё

'**********************************************************************
'* Function: PadZero
'**********************************************************************
Function PadZero(dtValue)
  If Len(dtValue) = 1 Then
    PadZero = 0 & dtValue
  Else
    PadZero = dtValue
  End If
End Function

'**********************************************************************
'* Function: GenFileName
'**********************************************************************
Function GenFileName(prefix)
  'Create a unique time stamped name for the text file
  Dim dtDate,strYear,strMonth,strDay,strDate
  Dim dtNow,strHour,strMinute,strSecond,strTime
  dtDate = Date()
  strYear = Mid(Year(dtDate),3)
  strMonth = PadZero(Month(dtDate))
  strDay = PadZero(Day(dtDate))
  strDate = strYear & strMonth & strDay & "-"
  dtNow = Now()
  strHour = PadZero(Hour(dtNow))
  strMinute = PadZero(Minute(dtNow))
  strSecond = PadZero(Second(dtNow))
  strTime = strHour & strMinute & strSecond
  GenFileName = prefix & "-" & strDate & strTime & ".csv"
End Function

'**********************************************************************
'* Function: SampleCommandLine
'**********************************************************************
Function SampleCommandLine()
  SampleCommandLine = _
    "For example, to apply registry changes specified in" & VbCrLf & _
	  "a file named SysAdmin.reg, to all computers listed in" & VbCrLf & _
	  "ComptSearch.csv, type:" & VbCrLf & _
	  "CScript ApplyReg.vbs /r:SysAdmin.reg /f:ComptSearch.csv" 
End Function

Добавлено: 26 май 2009 10:54, Вт
UncleFather

Окончание:

Код: Выделить всё

'**********************************************************************
'* Function: BindDN
'**********************************************************************
Function BindDN(Line)
  Const E_ADS_PROPERTY_NOT_FOUND  = &h8000500D
  Const LDAP_NO_SUCH_OBJECT = &h80072030
  Dim strDN,objComputer,strComptName
  'Use Instr to get the distinguishedName column for writing to the
  'first column of the report.
  strDN = Mid(Line,2,Instr(1,Line,Chr(34) & Chr(44))-2)
  'Bind to the computer in AD
  On Error Resume Next
  Set objComputer = GetObject("LDAP://" & strDN)
  If Err.Number = LDAP_NO_SUCH_OBJECT Then
    'The GetObject method was unable to bind to the specified
    'dn. This probably means the computer is not listed in AD.
    BindDN = strDN & "||None||Invalid"
  Else
    'Get the  dNSHostName of the computer
    strComptName = objComputer.Get("dNSHostName")
    'If the dNSHostName attribute is set, use it for the registry update.
    If Err.number <> E_ADS_PROPERTY_NOT_FOUND Then
      BindDN = strDN & "||" & strComptName & "||Host"
    Err.Clear
    'If the dNSHostName attribute is not set then use 
    'the cn for the registry update.
    Else
      strComptName = objComputer.Get("cn")
      BindDN = strDN & "||" & strComptName & "||NetBIOS"
    End If
  End If
  Err.Clear
  On Error GoTo 0
End Function

Добавлено спустя 3 минуты 20 секунд:

Примечание:
Если установлена русская версия Windows, то строку

Код: Выделить всё

    If InStr(strPingStdOut, "Reply from ") Then

нужно заменить на

Код: Выделить всё

    If InStr(strPingStdOut, "ћвўґв ®в ") Then

.
Листинг скрипта ComputerSearch.vbs:

Код: Выделить всё

'**************************************************************************
'*  File:           ComputerSearch.vbs                                    *
'*  Created:        March 2003                                            *
'*  Version:        1.0                                                   *
'*                                                                        *
'*  Description:    Diagnostic utility that returns a report containing   *
'*                  the distinguished names of computers in the domain    *
'*                  (domain controllers, member computers or both). This  *
'*                  report can be viewed in a spreadsheet or database     *
'*                  program and it can be read by ApplyReg.vbs to apply   *
'*                  registry changes to all the computers listing in      *
'*                  the report.                                           *
'*                                                                        *
'*  Compatibility:  This script requires WSH 5.6, CScript, ADSI,          *
'*                  and access to Active Directory                        *
'**************************************************************************
Option Explicit
'Define any constants used in this script
'Denotes a workstation:
Const ADS_UF_WORKSTATION_TRUST_ACCOUNT = &h1000
'Denotes a DC:
Const ADS_UF_SERVER_TRUST_ACCOUNT = &h2000
Const ForAppending = 2
Dim objArgs,strRole
Dim objRootDSE,strDomain
Dim objConnection,objCommand,objRecordSet
Dim strFileName,objFSO,objFile
Call CheckForCScript
'Use Named Arguments collection for the command line argument.
'The WSHArguments Object is included in WSH version 5.6 and later
Set objArgs = WScript.Arguments.Named
strRole = UCase(objArgs.Item("r"))

Добавлено: 26 май 2009 10:56, Вт
Bibigool

Продолжение:

Код: Выделить всё

If WScript.Arguments.Named.Count < 1 Then
   WScript.Echo "No role was specified on the command-line." & VbCrLf & _
     "Therefore, the report will list both domain controller and" & VbCrLf & _
     "member computers in the domain." & VbCrLf & _
     "Possible roles are: dc (domain controller) or mc (member computer)."
End If
If WScript.Arguments.Named.Exists("r") Then
  If strRole <> "DC" AND strRole <> "MC" Then
    WScript.Echo SampleCommandLine()
    WScript.Quit
  End If
End If
'Use the RootDSE object for upcoming search operation
Set objRootDSE = GetObject("LDAP://rootDSE")
'Bind to the current domain
'Use to specify the search base for the LDAP search
strDomain = "<LDAP://" & _
  objRootDSE.Get("defaultNamingContext") & ">"
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider=ADsDSOObject;"
Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection
objCommand.CommandText = strDomain & _
  ";(objectCategory=computer);" & _
  "distinguishedName,userAccountControl;subtree"
  '"distinguishedName,userAccountControl,samAccountName,dNSHostName;subtree"
'Specify page size for this command object.
'This is necessary to avoid overutilization of server
'and network resources. Also, by default,
'only 1000 records will be returned if paging isn't
'specified. The domain might contain more
'than 1000 computer objects.
objCommand.Properties("Page Size") = 256
objCommand.Properties("Asynchronous") = True
objCommand.Properties("Cache results") = False
'Run the computer object query
Set objRecordSet = objCommand.Execute
'Create a unique file name (timestamp) using the GenFileName function
strFileName = GenFileName("ComputerSearch")
'Create a text file (.csv format) to hold the
'results of the class test.
Set objFSO = CreateObject("Scripting.FileSystemObject")
'This will overwrite the file if it already exists.
Set objFile = objFSO.CreateTextFile(strFileName,True)
objFile.Close
Set objFile = objFSO.OpenTextFile(strFileName,ForAppending)
Call PopulateReport
objConnection.Close
WScript.Echo VbCrLf & "The report data has been saved to: " & strfileName & "."
'**********************************************************************
'* Routine: PopulateReport
'**********************************************************************
Sub PopulateReport
  On Error Resume Next
  Dim strRecord,iCnt,i
  i=0
  ObjFile.WriteLine "distinguishedName,Role"
  While Not objRecordset.EOF
    If strRole = "" Then
      If ADS_UF_SERVER_TRUST_ACCOUNT AND objRecordset.Fields("userAccountControl") Then
        strRecord = GenRecord & "Domain Controller"
        objFile.WriteLine strRecord
        i=i+1
      ElseIf ADS_UF_WORKSTATION_TRUST_ACCOUNT AND objRecordset.Fields("userAccountControl") Then
        strRecord = GenRecord & "Workstation or Server"
        objFile.WriteLine strRecord
        i=i+1
      End If
    ElseIf strRole = "DC" Then

Добавлено: 26 май 2009 10:56, Вт
UncleFather

Окончание:

Код: Выделить всё

      If ADS_UF_SERVER_TRUST_ACCOUNT AND objRecordset.Fields("userAccountControl") Then 
        strRecord = GenRecord & "Domain Controller" 
        objFile.WriteLine strRecord 
        i=i+1 
      End If 
    ElseIf strRole = "MC" Then 
      If ADS_UF_WORKSTATION_TRUST_ACCOUNT AND objRecordset.Fields("userAccountControl") Then 
        strRecord = GenRecord & "Workstation or Server" 
        objFile.WriteLine strRecord 
        i=i+1 
      End If 
    End If 
    'Progress indicator 
    For iCnt = 1 to Len(i) + 35 
      WScript.StdOut.Write Chr(8) 
    Next 
      WScript.StdOut.Write "Current number of computers found: " & i 
    objRecordset.MoveNext 
  Wend 
End Sub 
'********************************************************************** 
'* Routine: CheckForCScript 
'********************************************************************** 
Sub CheckForCScript 
  'This script must run from cscript because 
  'it uses the WScript.StdOut property. 
  'Test the script host and if it's not cscript, 
  'instruct the operator on how to run the script. 
  If Right(LCase(WScript.FullName),11) <> LCase("cscript.exe") Then 
    WScript.Echo "This script must run from cscript." & _ 
      VbCrLf & "Example: cscript ComputerSearch.vbs" 
    WScript.Quit 
  End If 
End Sub 
'********************************************************************** 
'* Function: PadZero 
'********************************************************************** 
Function PadZero(dtValue) 
  If Len(dtValue) = 1 Then 
    PadZero = 0 & dtValue 
  Else 
    PadZero = dtValue 
  End If 
End Function 
'********************************************************************** 
'* Function: GenFileName 
'********************************************************************** 
Function GenFileName(prefix) 
  'Create a unique time stamped name for the text file 
  Dim dtDate,strYear,strMonth,strDay,strDate 
  Dim dtNow,strHour,strMinute,strSecond,strTime 
  dtDate = Date() 
  strYear = Mid(Year(dtDate),3) 
  strMonth = PadZero(Month(dtDate)) 
  strDay = PadZero(Day(dtDate)) 
  strDate = strYear & strMonth & strDay & "-" 
  dtNow = Now() 
  strHour = PadZero(Hour(dtNow)) 
  strMinute = PadZero(Minute(dtNow)) 
  strSecond = PadZero(Second(dtNow)) 
  strTime = strHour & strMinute & strSecond 
  GenFileName = prefix & "-" & strDate & strTime & ".csv" 
End Function 
'********************************************************************** 
'* Function: SampleCommandLine 
'********************************************************************** 
Function SampleCommandLine() 
  SampleCommandLine = _ 
    "Specify the /r parameter to limit the computer list to" & VbCrLf & _ 
     "only domain controllers or only member computers in the domain." & VbCrLf & _ 
     "ComputerSearch.vbs /r:dc" & VbCrlf & _ 
     "or"  & VbCrlf & _ 
     "ComputerSearch.vbs /r:mc" 
End Function 
'********************************************************************** 
'* Function: GenRecord 
'********************************************************************** 
Function GenRecord() 
  Dim strRecord 
  strRecord = chr(34) & objRecordset.Fields("distinguishedName") & chr(34) & "," 
  GenRecord = strRecord 
End Function