域环境信息探测的vbs


teN.potgnayiaH.wwW vbs小铺
原来代码在 http://www.rlmueller.net/Programs/Inventory2.txt ，可惜它的要调用excel组件，而且还会弹出ie对话框。花了一点时间修改了一下，可以直接保存成html了，方便用于入侵。。由于我用的是数组pc(65535,10)，如果内网过大（>65535?，呵呵）请小心使用，只测试过域管理员权限，其它权限未测，应当也是可以的。
 Inventory2.vbs
code by http://www.rlmueller.net/Programs/Inventory2.txt ; modify by lcx
Option Explicit
Dim strComputer, strDN
Dim objShell, objFSO, strTemp, strTempFile, fileS
Dim objRootDSE, strRootDomain, adoConnection, adoCommand, strQuery
Dim adoRecordset, strAttributes
Dim objRemote, strRole
Dim strExcelPath, intRow, pc(65535,10)
Dim colSettings, objOS, objComputer
Dim objFix
Dim blnFlag, strPrevious, strStatus
Dim sHTML
Const ADS_CHASE_REFERRALS_SUBORDINATE = &H20
If (Wscript.Arguments.Count <> 1) Then
    Wscript.Echo "Argument <FileName> required. For example" & vbCrLf _
        & "cscript Inventory.vbs ""c:MyFolderInventory.html"""
    Wscript.Quit
End If
 Spreadsheet file name to be created.
strExcelPath = Wscript.Arguments(0)
blnFlag = True
Set objShell = CreateObject("Wscript.Shell")
On Error Resume Next
Set objRootDSE = GetObject("LDAP://RootDSE")
If (Err.Number <> 0) Then
    On Error GoTo 0
    Set objShell = Nothing
    Wscript.Echo "Domain not found, program aborted."
    Wscript.Echo "You may not be logged into a domain."
    Wscript.Quit
End If
On Error GoTo 0
strRootDomain = objRootDSE.Get("rootDomainNamingContext")
pc(0,0) = "sAMAccountName"
pc(0,1)="distinguishedName"
pc(0,2)="WMI"
pc(0,3)="# of OSs"
pc(0,4)= "OS Caption"
pc(0,5)="OS Version"
pc(0,6)= "OS Service Pack"
pc(0,7)= "# of Hot Fixes"
pc(0,8)= "Hot Fix ID"
pc(0,9)= "# of Computer Systems"
pc(0,10)="Computer Role"
sHTML = "<table width=100% border=1 cellspacing=0 cellpadding=0>"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set fileS=objFSO.opentextfile(strExcelPath,2,true)
fileS.writeline sHTML&vbcrlf& "<tr><td>"&pc(0,0)&"</td><td>"&pc(0,1)&"</td><td>"&pc(0,2)&"</td><td>"&pc(0,3)_
&"</td><td>"&pc(0,4)&"</td><td>"&pc(0,5)&"</td><td>"&pc(0,6)&"</td><td>"&pc(0,7)_
&"</td><td>"&pc(0,8)&"</td><td>"&pc(0,9)&"</td><td>"&pc(0,10)&"</td></tr>"

 Use ADO to search Active Directory for all computers.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open = "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
 Retrieve attributes.
strAttributes = "sAMAccountName,distinguishedName"
strQuery = "<LDAP://" & strRootDomain _
    & ">;(ObjectCategory=computer);" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
adoCommand.Properties("Chase Referrals") = _
    ADS_CHASE_REFERRALS_SUBORDINATE
Set adoRecordset = adoCommand.Execute
 Specify temporary file to save ping results.
strTemp = objShell.ExpandEnvironmentStrings("%TEMP%")
strTempFile = strTemp & "RunResult.tmp"
 Enumerate computer objects.
intRow = 2
Do Until adoRecordset.EOF
    strComputer = adoRecordset.Fields("sAMAccountName").Value
     Remove trailing "$".
    strComputer = Left(strComputer, Len(strComputer) - 1)
    pc(intRow, 0)=strComputer
    strDN = adoRecordset.Fields("distinguishedName").Value
    pc(intRow, 1)=strDN
strPrevious = strComputer

If (blnFlag = False) Then
         If (Err.Number <> 0) Then
            On Error GoTo 0
            Wscript.Echo "The path may be invalid."
            strExcelPath = ""
        End If
        On Error GoTo 0
        adoRecordset.Close
        adoConnection.Close
        If (objFSO.FileExists(strTempfile) = True) Then
            objFSO.DeleteFile(strTempFile)
        End If
        Set objRootDSE = Nothing
        Set adoCommand = Nothing
        Set adoConnection = Nothing
        Set adoRecordset = Nothing
        Set objRemote = Nothing
        Set objShell = Nothing
        Wscript.Echo "Program Aborted"
        Wscript.Echo "Computers documented: " & (intRow - 1)
        If (strExcelPath <> "") Then
            Wscript.Echo "See spreadsheet " & strExcelPath
        End If
        Wscript.Quit
    End If
     Ping computer to see if online.
    If (IsConnectible(strComputer, 1, 750) = True) Then
         Connect to computer with WMI.
        On Error Resume Next
        Set objRemote = GetObject("winmgmts:" _
            & "{impersonationLevel=impersonate}!\" _
            & strComputer & "ootcimv2")
        If (Err.Number <> 0) Then
            On Error GoTo 0
            
    pc(intRow, 2)="WMI Not Installed"
            strStatus = " no WMI"
        Else
            On Error GoTo 0
            pc(intRow, 2)="WMI Installed"
            On Error Resume Next
            Set colSettings = objRemote.ExecQuery _
    &

补充：软件开发 , Vb ,