Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
On Error Resume Next
Dim PCQuery, objConnection, objCommand, objRecordSet
Dim oRootDSE, strDNC
[green]
'First get domain information[/green]
Set oRootDSE = GetObject("LDAP://rootDSE")
strDNC = oRootDSE.get("defaultNamingContext")[green]
' other categories = computer, user, printqueue, group[/green]
PCQuery = "<LDAP://" & strDNC & _
">;(objectCategory=computer)" & _
";distinguishedName,name;subtree"
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Open "Provider=ADsDSOObject;"
objCommand.ActiveConnection = objConnection
objCommand.CommandText = PCQuery
Set objRecordSet = objCommand.Execute
Do Until objRecordSet.EOF[green]
'assign the computer name and distinguished path to variables[/green]
strComputer = objRecordSet.Fields("name")
strComputerDN = objRecordSet.Fields("distinguishedName")[green]
'Put the worker process of your code in here[/green][red]
'*******************************************
'*******************************************[/red]
objrecordset.MoveNext
Loop
objConnection.Close
PCQuery = "<LDAP://" & strDNC & _
PCQuery = "<LDAP://[blue]CN=Computers,[/blue]" & strDNC & _
strPingStatus = PingStatus(strComputer)
If strPingStatus = "Success" Then[green]
'Ping was good, do some work![/green][red]
'*****************************************
'Worker section goes in here now.
'*****************************************[/red]
Else[green]
'Machine unreachable. Add code to log the name here[/green]
Wscript.Echo "Failure pinging " & strComputer & ": " & strPingStatus
End If
Function PingStatus(strComputer)
On Error Resume Next
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colPings = objWMIService.ExecQuery _
("SELECT * FROM Win32_PingStatus WHERE Address = '" & strComputer & "'")
For Each objPing in colPings
Select Case objPing.StatusCode
Case 0 PingStatus = "Success"
Case 11001 PingStatus = "Status code 11001 - Buffer Too Small"
Case 11002 PingStatus = "Status code 11002 - Destination Net Unreachable"
Case 11003 PingStatus = "Status code 11003 - Destination Host Unreachable"
Case 11004 PingStatus = _
"Status code 11004 - Destination Protocol Unreachable"
Case 11005 PingStatus = "Status code 11005 - Destination Port Unreachable"
Case 11006 PingStatus = "Status code 11006 - No Resources"
Case 11007 PingStatus = "Status code 11007 - Bad Option"
Case 11008 PingStatus = "Status code 11008 - Hardware Error"
Case 11009 PingStatus = "Status code 11009 - Packet Too Big"
Case 11010 PingStatus = "Status code 11010 - Request Timed Out"
Case 11011 PingStatus = "Status code 11011 - Bad Request"
Case 11012 PingStatus = "Status code 11012 - Bad Route"
Case 11013 PingStatus = "Status code 11013 - TimeToLive Expired Transit"
Case 11014 PingStatus = _
"Status code 11014 - TimeToLive Expired Reassembly"
Case 11015 PingStatus = "Status code 11015 - Parameter Problem"
Case 11016 PingStatus = "Status code 11016 - Source Quench"
Case 11017 PingStatus = "Status code 11017 - Option Too Big"
Case 11018 PingStatus = "Status code 11018 - Bad Destination"
Case 11032 PingStatus = "Status code 11032 - Negotiating IPSEC"
Case 11050 PingStatus = "Status code 11050 - General Failure"
Case Else PingStatus = "Status code " & objPing.StatusCode & _
" - Unable to determine cause of failure."
End Select
Next
End Function
[b]
'==========================================================================
'
' NAME: <EnumerateDomainComputers.vbs>
'
' AUTHOR: Mark D. MacLachlan , The Spider's Parlor
' URL: http://www.thespidersparlor.com
' DATE : 5/20/2004
'
' COMMENT: generates a list of domain computers
' MODIFICATIONS: Added support to automatically find the Domain NetBIOS Name
'==========================================================================
Dim objIADsContainer ' ActiveDs.IADsDomain - ' Container object
Dim objIADsComputer ' ActiveDs.IADsComputer
Dim Partition, Partitions
Set Partitions = GetObject("LDAP://CN=Partitions,CN=Configuration," & _
GetObject("LDAP://RootDSE").Get("DefaultNamingContext"))
On Error Resume Next
For Each Partition In Partitions
strDomain = Partition.Get("nETBIOSName")
If Err.Number = 0 then Exit For
Next
Set Partitions = Nothing
' connect to the computer.
Set objIADsContainer = GetObject("WinNT://" & strDomain)
' set the filter to retrieve only objects of class Computer
objIADsContainer.Filter = Array("Computer")
For Each objIADsComputer In objIADsContainer
report = report & objIADsComputer.Name & vbCrLf
Next
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.CreateTextFile ("wslist.txt", ForWriting)
ts.write report
Set fso = Nothing
Set objIADsComputer = Nothing
Set objIADsContainer = Nothing
MsgBox "Done"[/b]
[b] On Error Resume Next
[green]
'open the file system object[/green]
Set oFSO = CreateObject("Scripting.FileSystemObject")
set WSHShell = wscript.createObject("wscript.shell")
[green]'open the data file[/green]
Set oTextStream = oFSO.OpenTextFile("wslist.txt")
[green]'make an array from the data file[/green]
RemotePC = Split(oTextStream.ReadAll, vbNewLine)
[green]'close the data file[/green]
oTextStream.Close
[/b]
[b] For Each strComputer In RemotePC
[green]'Do something useful with strComputer here[/green]
[red]
'*******************************************
'*******************************************[/red]
Next[/b]
[b] strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colProcessList = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = 'Notepad.exe'")
For Each objProcess in colProcessList
objProcess.Terminate()
Next
[/b]
[b] On Error Resume Next
[green]
'open the file system object[/green]
Set oFSO = CreateObject("Scripting.FileSystemObject")
set WSHShell = wscript.createObject("wscript.shell")[green]
'open the data file[/green]
Set oTextStream = oFSO.OpenTextFile("wslist.txt")[green]
'make an array from the data file[/green]
RemotePC = Split(oTextStream.ReadAll, vbNewLine)[green]
'close the data file[/green]
oTextStream.Close
For Each strComputer In RemotePC
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colProcessList = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = 'Notepad.exe'")
For Each objProcess in colProcessList
objProcess.Terminate()
Next
Next[/b]
[b]
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colSettings = objWMIService.ExecQuery _
("Select * from Win32_OperatingSystem")
For Each OS In colSettings
Wscript.Echo OS.Caption
Wscript.Echo OS.Version
Next
Set colSettings = objWMIService.ExecQuery _
("Select * from Win32_ComputerSystem")
For Each objComputer in colSettings
Wscript.Echo objComputer.Name
Wscript.Echo objComputer.TotalPhysicalMemory /1024\1024+1 & "MB"
Next
Set colSettings = objWMIService.ExecQuery _
("Select * from Win32_Processor")
For Each objProcessor in colSettings
Wscript.Echo objProcessor.Description
Next
Set objLogicalDisk = objWMIService.Get("Win32_LogicalDisk.DeviceID='c:'")
Wscript.Echo objLogicalDisk.Size /1024\1024+1 & "MB"
Wscript.Echo objLogicalDisk.FreeSpace /1024\1024+1 & "MB"
[/b]
[b] on error resume next
set x = getobject(,"excel.application")
r = 2
do until len(x.cells(r, 1).value) = 0
strComputer = x.cells(r, 1).Value
[/b]
[b] '==========================================================================
'
' NAME: <MemProcDiskInventory.vbs>
'
' AUTHOR: Mark D. MacLachlan , The Spider's Parlor
' URL: http://www.thespidersparlor.com
' DATE : 2/5/2003
'
' COMMENT: <Inventories computer configurations from a list of computers>
'==========================================================================
on error resume next
set x = getobject(,"excel.application")
r = 2
do until len(x.cells(r, 1).value) = 0
strComputer = x.cells(r, 1).Value
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colSettings = objWMIService.ExecQuery _
("Select * from Win32_OperatingSystem")
For Each OS In colSettings
x.cells(r, 7).value = OS.Caption
x.cells(r, 8).value = OS.Version
Next
Set colSettings = objWMIService.ExecQuery _
("Select * from Win32_ComputerSystem")
For Each objComputer in colSettings
x.cells(r, 2).value = objComputer.Name
x.cells(r, 3).value = objComputer.TotalPhysicalMemory /1024\1024+1 & "MB"
Next
Set colSettings = objWMIService.ExecQuery _
("Select * from Win32_Processor")
For Each objProcessor in colSettings
x.cells(r, 4).value = objProcessor.Description
Next
Set objWMIService = GetObject("winmgmts:")
Set objLogicalDisk = objWMIService.Get("Win32_LogicalDisk.DeviceID='c:'")
x.cells(r, 5).value = objLogicalDisk.Size /1024\1024+1 & "MB"
x.cells(r, 6).value = objLogicalDisk.FreeSpace /1024\1024+1 & "MB"
r = r + 1
loop[/b]
[blue]
User Configuration
Administrative Templates
Microsoft Management Console
Restricted/Permitted snap-ins
WMI Control => Set to [b]Enabled[/b]
DCOM Configuration Extension => Set to [b]Enabled[/b]
Computer Configuration
Administrative Templates
Network\Network Connections
Windows Firewall
Domain Profile
Windows Firewall
Allow Remote administration exception => Set to [b]Enabled[/b]
[/blue]
[green]
'==========================================================================
'
' NAME: <MemProcDiskInventory.vbs>
'
' AUTHOR: Mark D. MacLachlan , The Spider's Parlor
' URL: http://www.thespidersparlor.com
' DATE : 2/5/2003
' MODIFIED 3/2/2006 Modifications to remote WMI calls.
' COMMENT: <Inventories computer configurations from a list of computers>
' NOTE: Firewall security may block ths script from running remotely.[/green][red]
' Execute the following command on each workstation to allow remote WMI calls.
' netsh firewall set service type=remoteadmin mode=enable scope=all profile=all [/red]
[green]'==========================================================================[/green]
on error resume Next
Set WSHNetwork = CreateObject("Wscript.Network")
set x = getobject(,"excel.application")
r = 2
Set Locator = CreateObject("WbemScripting.SWbemLocator")
do until len(x.cells(r, 1).value) = 0
strComputer = x.cells(r, 1).Value
[green]' Set the local admin credentials[/green]
strUser = strComputer & "\administrator"
strPassword = "passwordgoeshere"
[green]
' Check if the strComputer is THIS machine and set objWMIService as needed[/green]
If lcase(strComputer) = LCase(WSHNetwork.ComputerName) Then
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Else[green]
'Remote systems need added security context to be specified.[/green]
Set objWMIService = Locator.ConnectServer(strComputer, "root\cimv2", strUser, strPassword)
objWMIService.Security_.ImpersonationLevel = 3
End If[green]
' Let us know if there is a binding issue.[/green]
If Err Then
x.cells(r, 2).value = Err.Description
Err.Clear
End If
Set OScolSettings = objWMIService.ExecQuery _
("Select * from Win32_OperatingSystem")
For Each OS In OScolSettings
x.cells(r, 7).value = OS.Caption
x.cells(r, 8).value = OS.Version
Next
Set OScolSettings = Nothing
Set CScolSettings = objWMIService.ExecQuery _
("Select * from Win32_ComputerSystem")
For Each objComputer in CScolSettings
x.cells(r, 2).value = objComputer.Name
x.cells(r, 3).value = objComputer.TotalPhysicalMemory /1024\1024+1 & "MB"
Next
Set CScolSettings = Nothing
Set ProccolSettings = objWMIService.ExecQuery _
("Select * from Win32_Processor")
For Each objProcessor in ProccolSettings
x.cells(r, 4).value = objProcessor.Description
Next
Set ProccolSettings = Nothing
Set objLogicalDisk = objWMIService.Get("Win32_LogicalDisk.DeviceID='c:'")
x.cells(r, 5).value = objLogicalDisk.Size /1024\1024+1 & "MB"
x.cells(r, 6).value = objLogicalDisk.FreeSpace /1024\1024+1 & "MB"
Set objLogicalDisk = Nothing
r = r + 1
Set ObjWMIService = Nothing
Loop
MsgBox "Done"