Archive - September 2012

"The more effort you put into something, the more you get in return." - Dwight Rivera

Index

Return Uninstall Commands
Disable Account If User Change PW
Move Computer from OU to OU
Query if Laptop or Desktop
Return all Product IDs/Names
Return NIC Speeds
Pause Printing

Return Refresh Rate
Modify Service Properties
List Disk Drive & Capacity
Enable Wake-on-LAN
Move Old Computers

Δ Sunday, September 30th, 2012

Δ Return Uninstall Commands

How to list uninstall commands

[download resource files]

Demo

This uses WMI and queries reg path to return a list of uninstall commands for all your apps.

' usage: cscript FILE.VBS > Uninstall_list.txt

Option Explicit

Const HKEY_LOCAL_MACHINE = &H80000002

Dim arrSubKeys
Dim bln64bit, blnFilter, blnRegEx, blnTab
Dim i, int32bit, int64bit, intFound, intValid
Dim colItems, colPings, objItem, objRE, objReg, objStatus, objWMIService
Dim strComputer, strDateZZZ, strFilter, strHive, strKeyZZZ, strKeyPath
Dim strMsg, strNameZZZ, strPrgZZZ, strQuery, strQuietUnstZZZ, strUninstallZZZ, strVersionZZZ

bln64bit   = False
blnFilter  = False
blnRegEx   = False
int32bit   = 0
int64bit   = 0
strHive    = HKEY_LOCAL_MACHINE
strMsg     = ""

With WScript.Arguments
	If .Unnamed.Count > 0 Then Syntax
	intValid = 0
	If .Named.Exists( "F" ) Then
		strFilter = .Named.Item( "F" )
		If strFilter = "" Then Syntax
		intValid  = intValid + 1
		blnFilter = True
		If .Named.Exists( "R" ) Then
			intValid  = intValid + 1
			blnRegEx  = True
			Set objRE = New RegExp
		End If
	End If
	If .Named.Exists( "M" ) Then
		intValid    = intValid + 1
		strComputer = Trim( .Named.Item( "M" ) )
		If strComputer = "" Then Syntax
	Else
		strComputer = "."
	End If
	If .Named.Exists( "T" ) Then
		intValid = intValid + 1
		blnTab   = True
	Else
		blnTab   = False
	End If
	If .Named.Count <> intValid Then Syntax
End With

' Use custom error handling, just in case the remote computer
' won't respond or this script runs on a Windows 2000 computer
On Error Resume Next

Set objWMIService = GetObject( "winmgmts://./root/cimv2" )
Set colItems      = objWMIService.ExecQuery( "SELECT * FROM Win32_Processor", , 48 )
For Each objItem in colItems
	If objItem.AddressWidth = 64 Then
		bln64bit = True
	End If
Next

If strComputer <> "." Then
	strQuery = "SELECT * FROM Win32_PingStatus WHERE Address='" & strComputer & "'"
	Set colPings      = objWMIService.ExecQuery( strQuery )
	For Each objStatus in colPings
		If IsNull( objStatus.StatusCode ) Or objStatus.StatusCode <> 0 Then
			strMsg = "Computer " & strComputer & " did not respond." & vbCrLf
			Syntax
		End If
	Next
	Set colPings      = Nothing
	Set objWMIService = Nothing
End If

Set objReg = GetObject( "winmgmts:{impersonationLevel=impersonate}!//" & strComputer & "/root/default:StdRegProv" )
If Err Then
	If strComputer = "." Then
		strMsg = "Error connecting to the local WMI Standard Registry Provider." & vbCrLf
	Else
		strMsg = "Error connecting to " & strComputer & "'s WMI StdReg Provider." & vbCrLf
	End If
	Syntax
End If

On Error Goto 0

If blnTab Then
	strMsg = """Program Name""" & vbTab & """Program Version""" & vbTab & """Install Date""" & vbTab & """Unique Identifier""" & vbTab & """Uninstall String""" & vbCrLf
End If

' This is where uninstall info for 32-bit apps is stored in 32-bit
' Windows, or uninstall info for 64-bit apps in 64-bit Windows
strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
intFound   = 0
strMsg     = strMsg & ListApps( strHive, strKeyPath )

' 64-bit check, added after a tip by Christopher A. LaRue
If bln64bit Then
	' This is where uninstall info for 32-bit apps is stored in 64-bit Windows
	strKeyPath = "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall"
	int64bit = intFound
	intFound = 0
	strMsg   = strMsg & ListApps( strHive, strKeyPath )
	int32bit = intFound
	strMsg = strMsg & vbCrLf & "    " & int64bit & " 64-bit programs and " & int32bit & " 32-bit programs found"
Else
	strMsg = strMsg & vbCrLf & "    " & intFound & " programs found"
End If

WScript.Echo strMsg

Set objReg = Nothing
Set objRE  = Nothing

Function ListApps( myHive, myKeyPath )
	Dim arrSubKeys
	Dim strDate, strKey, strName, strPrg, strQuietUnst, strUninstall, strVersion

ListApps = ""

objReg.EnumKey myHive, myKeyPath, arrSubKeys

If UBound( arrSubKeys ) > -1 Then
		intFound = UBound( arrSubKeys ) + 1
		
		For i = 0 To UBound( arrSubKeys )
			strDate      = ""
			strName      = ""
			strQuietUnst = ""
			strUninstall = ""
			strVersion   = ""
			strKey = myKeyPath & "\" & arrSubKeys(i)
			objReg.GetStringValue         myHive, strKey, "DisplayName",          strName
			objReg.GetStringValue         myHive, strKey, "DisplayVersion",       strVersion
			objReg.GetStringValue         myHive, strKey, "InstallDate",          strDate
			objReg.GetExpandedStringValue myHive, strKey, "UninstallString",      strUninstall
			objReg.GetExpandedStringValue myHive, strKey, "QuietUninstallString", strQuietUnst
			If Trim( strQuietUnst ) <> "" Then strUninstall = strQuietUnst
			If blnTab Then
				strPrg = """" & strName       & """" & vbTab _
				       & """" & strVersion    & """" & vbTab _
				       & """" & strDate       & """" & vbTab _
				       & """" & arrSubKeys(i) & """" & vbTab _
				       & """" & strUninstall  & """" & vbCrLf
			Else
				strPrg = "Program Name      = " & strName       & vbCrLf _
				       & "Program Version   = " & strVersion    & vbCrLf _
				       & "Install Date      = " & strDate       & vbCrLf _
				       & "Unique Identifier = " & arrSubKeys(i) & vbCrLf _ 
				       & "Uninstall String  = " & strUninstall  & vbCrLf & vbCrLf
			End If
			If Trim( strName ) <> "" Then
				If blnFilter Then
					If blnRegEx Then
						objRE.Global     = False
						objRE.IgnoreCase = True
						objRE.Pattern    = strFilter
						If objRE.Test( strName ) Then
							ListApps = ListApps & strPrg
						End If
					Else
						If InStr( 1, strName, strFilter, vbTextCompare ) Then
							ListApps = ListApps & strPrg
						End If
					End If
				Else
					ListApps = ListApps & strPrg
				End If
			End If
		Next
	End If
End Function

Sub Syntax
	strMsg = strMsg & vbCrLf _
	       & UCase( WScript.ScriptName ) & ",  Version 3.01" _
	       & vbCrLf _
	       & "List or search uninstall command lines" _
	       & vbCrLf & vbCrLf _
	       & "Usage: CSCRIPT.EXE //NoLogo " & UCase( WScript.ScriptName ) _
	       & " [/M:""computer""] [/F:""filter"" [/R]] [/T]" _
	       & vbCrLf & vbCrLf _
	       & "Where: /M:""computer""  specifies a remote computer to be queried" _
	       & vbCrLf _
	       & "                      (default is the local computer)" _
	       & vbCrLf _
	       & "       /F:""filter""    narrows down the search result to programs whose" _
	       & vbCrLf _
	       & "                      descriptive name contains the string ""filter""" _
	       & vbCrLf _
	       & "       /R             interprets the filter string as a regular expression" _
	       & vbCrLf _
	       & "       /T             displays tab delimited results (default: list)"

WScript.Echo strMsg
	WScript.Quit 1
End Sub

Δ [email me]

Δ Friday, September 28th, 2012

Δ Disable Account If User Change PW

How to control user accounts

[download resource files]

This will disable a user account based upon whether or not the "if user change password next login"
is checked.

Δ [email me]

Δ Thursday, September 27th, 2012

Δ Move Computer from OU to OU

How to move an object in Active Directory

[download resource files]

Easy move a computer object to another OU.

' Verify arguments
If Wscript.Arguments.Count = 0 or Wscript.Arguments.Count > 1 Then
	Wscript.Echo "used like this: 'movepc.vbs COMPUTERNAME' "
Else
'Set variables, where to search and where to move the computer
strSoeg = "'LDAP://dc=DOMAIN,dc=COM' WHERE objectCategory='computer' AND name=" 'LDAP path to search
' if you want to move users then change the objectCategory to 'user' instead

strDestination = "LDAP://OU=Student_PC,OU=Software_Distribution,DC=DOMAIN,DC=COM" ' LDAP path of destination

'Set computername to argument 0 (first argument)
	strComputerName = Wscript.Arguments(0)
	lenComp = len(strComputername) + 11
	On Error Resume Next

Const ADS_SCOPE_SUBTREE = 2

Set objConnection = CreateObject("ADODB.Connection")
	Set objCommand =   CreateObject("ADODB.Command")
	objConnection.Provider = "ADsDSOObject"
	objConnection.Open "Active Directory Provider"
	Set objCommand.ActiveConnection = objConnection

objCommand.Properties("Page Size") = 1000
	objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE

' Search command
	objCommand.CommandText = _
		"SELECT ADsPath FROM  " & strSoeg & "'" & strComputerName & "'"
	' Search
	Set objRecordSet = objCommand.Execute

objRecordSet.MoveFirst
	Do Until objRecordSet.EOF	
		strADsPath = objRecordSet.Fields("ADsPath").Value
		Set objNewOU = GetObject(strDestination)

Set objMoveComputer = objNewOU.MoveHere (strADsPath, "CN=" & strComputerName)
		objRecordSet.MoveNext
	Loop

msgbox "Done!"

end if

' Clean up
set objNewOU = nothing
set objMoveComputer = nothing
set objRecordSet = nothing
set objCommand = nothing
set objConnection = nothing

Δ [email me]

Δ Tuesday, September 25th, 2012

Δ Query if Laptop or Desktop

How to use WMI and return device type

[download resource files]

Demo

This uses WMI to query for the battery class, if it exists then the device is a laptop.

Δ [email me]

Δ Monday, September 24th 2012

Δ Return all Product IDs/Names

How to get product names

[download resource files]

Demo

Queries reg keys to return all your program IDs on your computer.

Option Explicit

Const HKEY_CLASSES_ROOT = &H80000000

Dim arrProgID, lstProgID, objReg, strMsg, strProgID, strSubKey, subKey, subKeys()

If WScript.Arguments.Count > 0 Then
	strMsg = "ProgIDs.vbs,  Version 1.00"                       & vbCrLf _
	       & "List all ProgIDs available on the local computer" & vbCrLf & vbCrLf _
	       & "Based on a PowerShell script on www.readify.net"  & vbCrLf & vbCrLf _
	       & "Usage:  " & WScript.ScriptName                    
	       	WScript.Echo strMsg
End If

Set lstProgID = CreateObject( "System.Collections.ArrayList" )
Set objReg    = GetObject( "winmgmts://./root/default:StdRegProv" )

' List all subkeys of HKEY_CLASSES_ROOT\CLSID
objReg.EnumKey HKEY_CLASSES_ROOT, "CLSID", subKeys

' Loop through the list of subkeys
For Each subKey In subKeys
	' Check each subkey for the existence of a ProgID
	strSubKey = "CLSID\" & subKey & "\ProgID"
	objReg.GetStringValue HKEY_CLASSES_ROOT, strSubKey, "", strProgID
	' If a ProgID exists, add it to the list
	If Not IsNull( strProgID ) Then lstProgID.Add strProgID
Next

' Sort the list of ProgIDs
lstProgID.Sort

' Copy the list to an array (this makes displaying it much easier)
arrProgID = lstProgID.ToArray

' Display the entire array
WScript.Echo Join( arrProgID, vbCrLf )

Δ [email me]

Δ Friday, September 21st, 2012

Δ Return NIC Speeds

How to query NIC info

[download resource files]

Demo

Uses WMI to return NIC information.

On Error Resume Next

Select Case WScript.Arguments.UnNamed.Count
	Case 0
		Set objWMIService = GetObject( "winmgmts://./root/cimv2" )
		Set colItems = objWMIService.ExecQuery( "Select * from Win32_ComputerSystem", , wbemFlagReturnImmediately + wbemFlagForwardOnly )
		For Each objItem in colItems
			strComputer = objItem.Name
		Next
	Case 1
		strComputer = WScript.Arguments.UnNamed(0)
	Case Else
		Syntax( )
End Select

Const wbemFlagReturnImmediately = &h10
Const wbemFlagForwardOnly = &h20

Set objWMIService = GetObject( "winmgmts://" & strComputer & "/root/WMI" )
Set colItems      = objWMIService.ExecQuery( "SELECT * FROM MSNdis_EthernetCurrentAddress WHERE Active = True", "WQL", wbemFlagReturnImmediately + wbemFlagForwardOnly )
For Each objItem In colItems
	strMsg = strMsg & "Ethernet Adapter : " & objItem.InstanceName      & vbCrLf
	Set col2Items = objWMIService.ExecQuery("SELECT * FROM MSNdis_LinkSpeed WHERE InstanceName = '" & objItem.InstanceName & "'", "WQL", wbemFlagReturnImmediately + wbemFlagForwardOnly)
	For Each obj2Item In col2Items
		strMsg = strMsg & "NDIS Link Speed  : " & obj2Item.NdisLinkSpeed & " kBps" & vbCrLf
	Next
	strMsg = strMsg & vbCrLf
Next
WScript.Echo strMsg

Sub Syntax( )
	strMsg = strMsg & vbCrLf _
	       & "NICSpeed.vbs,  Version 1.00" & vbCrLf _
	       & "Display network adapter link speed for " _
	       & "any WMI enabled computer on the network" & vbCrLf & vbCrLf _
	       & "Usage:  CSCRIPT  //NOLOGO  NICSPEED.VBS  " _
	       & "[ computer_name ]" & vbCrLf & vbCrLf _
	       & "Where:  " & Chr(34) & "computer_name" & Chr(34) _
	       & " is the optional name of a remote computer" & vbCrLf _
	       & "                        (default is the local computer " _
	       & "name)" & vbCrLf & vbCrLf _
	       & "Created with Microsoft's Scriptomatic tool" & vbCrLf _
	       & "http://www.microsoft.com/technet/treeview/default.asp" _
	       & "?url=/technet/scriptcenter/WMImatic.asp"
	WScript.Echo strMsg
	WScript.Quit(1)
End Sub

Δ [email me]

Δ Tuesday, September 11th, 2012

Δ Pause Printing

How to pause print manager

[download resource files]

Uses the printer class and specified printer name to pause a printer.

Option Explicit Dim arrStatus Dim blnDefault, blnPaused Dim intJobs, intStatus Dim colPrinters, colPrintJobs, objItem, objWMIService Dim strPrinter arrStatus = Array( "Script Error", "Other", "Unknown", "Idle", "Printing", "Warmup", "Stopped Printing", "Offline", "Paused", "Error", "Busy", "Not Available", "Waiting", "Processing", "Initialization", "Power Save", "Pending Deletion", "I/O Active", "Manual Feed" ) With WScript.Arguments If .Count <> 1 Then Syntax If .Named.Exists( "Default" ) Or .Named.Exists( "D" ) Then blnDefault = True Else blnDefault = False If .Unnamed.Count <> 1 Then Syntax strPrinter = .Unnamed( 0 ) End If End With Set objWMIService = GetObject("winmgmts://./root/CIMV2") Set colPrintJobs = objWMIService.ExecQuery( "SELECT * FROM Win32_PrintJob WHERE Name LIKE '" & strPrinter & ", %'", "WQL", 48 ) intJobs = 0 For Each objItem In colPrintJobs intJobs = intJobs + 1 Next If blnDefault Then Set colPrinters = objWMIService.ExecQuery( "SELECT * FROM Win32_Printer WHERE Default=TRUE", "WQL", 48 ) Else Set colPrinters = objWMIService.ExecQuery( "SELECT * FROM Win32_Printer WHERE DeviceID='" & strPrinter & "'", "WQL", 48 ) End If For Each objItem In colPrinters intStatus = objItem.ExtendedPrinterStatus strPrinter = objItem.DeviceID WScript.Echo "Printer : " & strPrinter WScript.Echo "Print Jobs : " & intJobs WScript.Echo "Status : " & arrStatus( intStatus ) If objItem.ExtendedPrinterStatus <> 8 Then ' Not Paused WScript.Echo "Pause printing . . ." objItem.Pause() blnPaused = True End If Next If blnPaused Then Do Until intStatus = 8 WScript.Echo "Wait . . ." WScript.Sleep 1000 Set colPrinters = objWMIService.ExecQuery( "SELECT * FROM Win32_Printer WHERE DeviceID='" & strPrinter & "'", "WQL", 48 ) For Each objItem In colPrinters intStatus = objItem.ExtendedPrinterStatus WScript.Echo "Status : " & arrStatus( intStatus ) Next Loop End If Set colPrinters = Nothing Set objWMIService = Nothing Sub Syntax Dim strMsg strMsg = vbCrLf _ & "PausePrinting.vbs, Version 1.00" _ & vbCrLf _ & "Pause printing for the specified printer." _ & vbCrLf & vbCrLf _ & "Usage: CSCRIPT PausePrinting.vbs //NoLogo printer" _ & vbCrLf & vbCrLf _ & "Where: ""printer"" is either /D (default printer) or the printer name" _ & vbCrLf _ & " (use doublequotes if the printer name contains spaces)" WScript.Echo strMsg Wscript.Quit 1 End Sub

Δ [email me]

Δ Monday, September 10th, 2012

Δ Return Refresh Rate

How to return display info

[download resource files]

Demo

Yet another script to return display information like vertical and horizontal resolution.

On Error Resume Next
strMsg = vbCrLf

' Display help if any command line parameter is specified
If WScript.Arguments.Count Then
	strMsg = strMsg _
	       & "GetRes.vbs,  Version 1.00 for Windows 2000" & vbCrLf _
	       & "Display screen resolution and refresh rate" _
	       & vbCrLf & vbCrLf _
	       & "Usage:  CSCRIPT  GETRES.VBS" _
	       & vbCrLf & vbCrLf _
	       & vbCrLf & vbCrLf _
	       & "Created with Microsoft's Scriptomatic tool" & vbCrLf _
	       & "http://www.microsoft.com/technet/treeview/default.asp" _
	       & "?url=/technet/scriptcenter/WMImatic.asp" _
	       & vbCrLf & vbCrLf & vbCrLf
End If

' Retrieve information
Set objWMIService = GetObject( "winmgmts://./root/cimv2" )
Set colItems = objWMIService.ExecQuery( "Select * from Win32_DisplayConfiguration", , 48 )

' Format output
For Each objItem in colItems
	strMsg = strMsg _
	       & "VideoCard   : " & objItem.DeviceName & vbCrLf _
	       & "XResolution : " & objItem.PelsWidth & vbCrLf _
	       & "YResolution : " & objItem.PelsHeight & vbCrLf _
	       & "BitsPerPel  : " & objItem.BitsPerPel & vbCrLf _
	       & "VRefresh    : " & objItem.DisplayFrequency & vbCrLf
Next

' Display the result
WScript.Echo strMsg

Δ [email me]

Δ Friday, September 7th, 2012

Δ Modify Service Properties

How to edit server properties

Ever needed to modify the recovery properies of a service? This is how you do it.

Δ [email me]

Δ Wednesday, September 5th, 2012

Δ List Disk Drive & Capacity

How to return disk info

[download resource files]

Demo

Simple script to return disk information.

Option Explicit

Dim arrCDR( ), arrHDC( ), arrHDD( ), arrHost( )
Dim blnAlignOutput, blnDebug
Dim i, intDescLen, intSizeLen, intValidArgs, j, lngSize
Dim colItems, objItem, objWMIService
Dim strComputer, strInterface, strMsg, strSize

blnAlignOutput = True
blnDebug = False
strComputer = "."
intValidArgs = 0

' Parse command line
With WScript.Arguments
	If .Count         > 3 Then Syntax
	If .Unnamed.Count > 1 Then Syntax
	If .Unnamed.Count = 1 Then
		If strComputer <> "." Then
			Syntax
		Else
			strComputer = .Unnamed(0)
			intValidArgs = intValidArgs + 1
		End If
	End If
	If .Named.Exists( "HELP" ) Then Syntax
	If .Named.Exists( "?" ) Then Syntax
	If .Named.Exists( "D" ) Then
		blnDebug = True
		intValidArgs = intValidArgs + 1
	End If
	If .Named.Exists( "R" ) Then
		If strComputer <> "." Then
			Syntax
		Else
			strComputer = .Named.Item( "R" )
			intValidArgs = intValidArgs + 1
		End If
	End If
	If .Named.Exists( "T" ) Then
		blnAlignOutput = False
		intValidArgs = intValidArgs + 1
	End If
	' Check if more arguments were passed than the ones we recognized
	If intValidArgs <> .Count Then
		WScript.Echo vbCrLf & "ERROR: Invalid command line argument(s)"
		Syntax
	End If
End With

If Trim( strComputer ) = "" Then
	WScript.Echo vbCrLf & "ERROR: Specify a computer name when using the /R switch"
	Syntax
End If

On Error Resume Next
Set objWMIService = GetObject( "winmgmts://" & strComputer & "/root/cimv2" )
If Err Then
	WScript.Echo vbCrLf & "ERROR: " & Err.Description
	Syntax
End If
On Error Goto 0

' Query HDD properties and save results in HDD array
Set colItems = objWMIService.ExecQuery( "SELECT * FROM Win32_DiskDrive" )
ReDim arrHDD( 3, colItems.Count - 1 )
For Each objItem in colItems
	With objItem
		lngSize = 0
		strSize = "0   "
		If Not IsNull( objItem.Size ) Then
			lngSize = CInt( .Size / 1073741824 ) ' divide by 1 GB
			If lngSize > 0 Then
				strSize = CStr( lngSize ) & " GB"
			Else
				lngSize = CInt( .Size / 1048576 ) ' divide by 1 MB
				strSize = CStr( lngSize ) & " MB"
			End If
		End If
		If IsNull( .InterFaceType ) Or .InterfaceType = "" Then
			If Left( .PnpDeviceID, 3 ) = "USB" Then
				strInterface = "USB"
			Else
				strInterface = "-"
			End If
		Else
			strInterface = .InterfaceType
		End If
		arrHDD( 0, .Index ) = .Caption
		arrHDD( 1, .Index ) = .PnpDeviceID
		arrHDD( 2, .Index ) = strSize
		arrHDD( 3, .Index ) = strInterface
	End With
Next

' Query CDR properties and save results in CDR array
Set colItems = objWMIService.ExecQuery( "SELECT * FROM Win32_CDROMDrive" )
ReDim arrCDR( 3, colItems.Count - 1 )
i = 0
For Each objItem in colItems
	With objItem
		If Left( .PnpDeviceID, 3 ) = "USB" Then
			strInterface = "USB"
		Else
			strInterface = "-"
		End If
		arrCDR( 0, i ) = .Caption
		arrCDR( 1, i ) = .PnpDeviceID
		arrCDR( 2, i ) = .Drive
		arrCDR( 3, i ) = strInterface
	End With
	i = i + 1
Next

' Query harddisk and USB controller properties and save results in HDC array
Set colItems = objWMIService.ExecQuery( "SELECT * FROM Win32_IDEController" )
ReDim arrHDC( 2, colItems.Count - 1 )
i = 0
For Each objItem in colItems
	With objItem
		arrHDC( 0, i ) = UCase( .Caption & " (" & .Description & ")" )
		arrHDC( 1, i ) = .PNPDeviceID
		' This is one of two "weakest links" in this script: differentiating between IDE (PATA) and SATA
		' depends on the words SATA or S-ATA or Serial ATA in the harddisk controller's description field
		If InStr( arrHDC( 0, i ), "SATA" ) Then
			arrHDC( 2, i ) = "SATA"
		ElseIf InStr( arrHDC( 0, i ), "S-ATA" ) Then
			arrHDC( 2, i ) = "SATA"
		ElseIf InStr( arrHDC( 0, i ), "SERIAL ATA" ) Then
			arrHDC( 2, i ) = "SATA"
		Else
			arrHDC( 2, i ) = "IDE"
		End If
	End With
	i = i + 1
Next
Set colItems = objWMIService.ExecQuery( "SELECT * FROM Win32_SCSIController" )
ReDim Preserve arrHDC( 2, UBound( arrHDC, 2 ) + colItems.Count )
For Each objItem in colItems
	With objItem
		arrHDC( 0, i ) = UCase( .Caption & " (" & .Description & ")" )
		arrHDC( 1, i ) = .PNPDeviceID
		arrHDC( 2, i ) = "SCSI"
	End With
	i = i + 1
Next
Set colItems = objWMIService.ExecQuery( "SELECT * FROM Win32_USBController" )
ReDim Preserve arrHDC( 2, UBound( arrHDC, 2 ) + colItems.Count )
For Each objItem in colItems
	With objItem
		arrHDC( 0, i ) = UCase( .Caption & " (" & .Description & ")" )
		arrHDC( 1, i ) = .PNPDeviceID
		' This is the second "weakest links" in this script: differentiating between "classic" USB and USB 3.0 depends on the words
		' "USB 3" in the harddisk controller's description field, or its PnP Device ID starting with "NUSB3" (NEC/Renesas only)
		If InStr( arrHDC( 0, i ), "USB 3" ) Then
			arrHDC( 2, i ) = "USB3"
		ElseIf Left( arrHDC( 0, i ), 5 ) = "NUSB3" Then
			arrHDC( 1, i ) = "USB3"
		Else
			arrHDC( 2, i ) = "USB"
		End If
	End With
	i = i + 1
Next

' Query hosted drives and save results in Host array
Set colItems = objWMIService.ExecQuery( "SELECT * FROM Win32_IDEControllerDevice" )
ReDim arrHost( 2, colItems.Count - 1 )
i = 0
For Each objItem in colItems
	With objItem
		arrHost( 0, i ) = Replace( .Antecedent, "\\", "\", 3 )
		arrHost( 1, i ) = Replace( .Dependent,  "\\", "\", 3 )
	End With
	i = i + 1
Next
Set colItems = objWMIService.ExecQuery( "SELECT * FROM Win32_SCSIControllerDevice" )
ReDim Preserve arrHost( 2, UBound( arrHost, 2 ) + colItems.Count )
For Each objItem in colItems
	With objItem
		arrHost( 0, i ) = Replace( .Antecedent, "\\", "\", 3 )
		arrHost( 1, i ) = Replace( .Dependent,  "\\", "\", 3 )
	End With
	i = i + 1
Next
Set colItems = objWMIService.ExecQuery( "SELECT * FROM Win32_USBControllerDevice" )
ReDim Preserve arrHost( 2, UBound( arrHost, 2 ) + colItems.Count )
For Each objItem in colItems
	With objItem
		arrHost( 0, i ) = Replace( .Antecedent, "\\", "\", 3 )
		arrHost( 1, i ) = Replace( .Dependent,  "\\", "\", 3 )
	End With
	i = i + 1
Next

' Check interface per hosted disk
For i = 0 To UBound( arrHost, 2 )
	For j = 0 To UBound( arrHDC, 2 )
		If InStr( arrHost( 0, i ), arrHDC( 1, j ) ) Then
			arrHost( 2, i ) = arrHDC( 2, j )
		End If
	Next
Next

' Match hosted disks array with HDD array
For i = 0 To UBound( arrHDD, 2 )
	For j = 0 To UBound( arrHost, 2 )
		If InStr( arrHost( 1, j ), arrHDD( 1, i ) ) Then
			arrHDD( 3, i ) = arrHost( 2, j )
		End If
	Next
Next
For i = 0 To UBound( arrCDR, 2 )
	For j = 0 To UBound( arrHost, 2 )
		If InStr( arrHost( 1, j ), arrCDR( 1, i ) ) Then
			arrCDR( 3, i ) = arrHost( 2, j )
		End If
	Next
Next

' Display intermediate data
If blnDebug Then
	For i = 0 To UBound( arrHDD, 2 )
		WScript.Echo """HDD" & i & """,""" & arrHDD( 0, i ) & """,""" & arrHDD( 1, i ) & """,""" & arrHDD( 2, i ) & """,""" & arrHDD( 3, i ) & """"
	Next
	WScript.Echo
	For i = 0 To UBound( arrCDR, 2 )
		WScript.Echo """CDROM" & i & """,""" & arrCDR( 0, i ) & """,""" & arrCDR( 1, i ) & """,""" & arrCDR( 2, i ) & """,""" & arrCDR( 3, i ) & """"
	Next
	WScript.Echo
	For i = 0 To UBound( arrHDC, 2 )
		WScript.Echo """HDC" & i & """,""" & arrHDC( 0, i ) & """,""" & arrHDC( 1, i ) & """,""" & arrHDC( 2, i ) & """"
	Next
	WScript.Echo
	For i = 0 To UBound( arrHost, 2 )
		WScript.Echo """Host" & i & """,""" & arrHost( 0, i ) & """,""" & arrHost( 1, i ) & """,""" & arrHost( 2, i ) & """"
	Next
	WScript.Echo
End If

' Display results
intDescLen = 0
intSizeLen = 0
For i = 0 To UBound( arrHDD, 2 )
	If Len( arrHDD( 0, i ) ) > intDescLen Then
		intDescLen = Len( arrHDD( 0, i ) )
	End If
	If Len( arrHDD( 2, i ) ) > intSizeLen Then
		intSizeLen = Len( arrHDD( 2, i ) )
	End If
Next
For i = 0 To UBound( arrCDR, 2 )
	If Len( arrCDR( 0, i ) ) > intDescLen Then
		intDescLen = Len( arrCDR( 0, i ) )
	End If
Next
For i = 0 To UBound( arrHDD, 2 )
	If blnAlignOutput Then
		WScript.Echo "HDD" & i & vbTab & Left( arrHDD( 0, i ) & Space( intDescLen ), intDescLen ) & vbTab & arrHDD( 3, i ) & vbTab & Right( Space( intSizeLen ) & arrHDD( 2, i ), intSizeLen )
	Else
		WScript.Echo "HDD" & i & vbTab & arrHDD( 0, i ) & vbTab & arrHDD( 3, i ) & vbTab & arrHDD( 2, i )
	End If
Next
For i = 0 To UBound( arrCDR, 2 )
	If blnAlignOutput Then
		WScript.Echo "CDROM" & i & vbTab & Left( arrCDR( 0, i ) & Space( intDescLen ), intDescLen ) & vbTab & arrCDR( 3, i ) & vbTab & Right( Space( intSizeLen + 3 ) & arrCDR( 2, i ), intSizeLen )
	Else
		WScript.Echo "CDROM" & i & vbTab & arrCDR( 0, i ) & vbTab & arrCDR( 3, i ) & vbTab & arrCDR( 2, i )
	End If
Next

Set objItem       = Nothing
Set colItems      = Nothing
Set objWMIService = Nothing

Sub Syntax
	strMsg = vbCrLf _
	       & "DiskTypes.vbs,  Version 1.00 BETA" _
	       & vbCrLf _
	       & "List disk drives and their interface type (IDE/SATA/SCSI/USB/USB3) and capacity" _
	       & vbCrLf & vbCrLf _
	       & "Usage:  DISKTYPES.VBS  [ /R:computer ]  [ /T ]  [ /D ]" _
	       & vbCrLf & vbCrLf _
	       & "Where:  /R:computer    query remote computer" _
	       & vbCrLf _
	       & "        /T             generate tab delimited output" _
	       & vbCrLf _
	       & "        /D             show intermediate results (for debugging)" _
	       & vbCrLf & vbCrLf _
	       & "Notes:  Differentiation between IDE and SATA depends on the words ""SATA"" or" _
	       & vbCrLf _
	       & "        ""S-ATA"" or ""Serial ATA"" in the harddisk controller's description field;" _
	       & vbCrLf _
	       & "        this is far from fool-proof, but so far the least unreliable method" _
	       & vbCrLf _
	       & "        available for scripting." _
	       & vbCrLf _
	       & "        Likewise, detection of USB 3.0 depends on the words ""USB 3"" in the USB" _
	       & vbCrLf _
	       & "        controller's descrition, or ""NUSB3"" in its PnP Device ID; the latter is" _
	       & vbCrLf _
	       & "        true only for NEC/Renesas controllers." _
	       & vbCrLf _
	       & "        ""SCSI"" signifies either true SCSI or RAID enabled IDE/SATA controllers." _
	       & vbCrLf _
	       & "        ""USB3"" signifies the USB port; the device may still be USB 2.0 or 1.1." _
	       & vbCrLf & vbCrLf _
	       & "" _
	       & vbCrLf _
	       & ""
	WScript.Echo strMsg
	WScript.Quit 1
End Sub

Δ [email me]

Δ Monday, September 3rd, 2012

Δ Enable Wake-on-LAN

How to work with WOL

[download resource files]

Modifies reg keys to enable wake on lan. This doesn't actually wake a machine up, it just enables
the feature.

'************************************************************************
'* VBS Script to:
'* Enable/Disable showing the icon in your system tray for connected NICs
'* Enable/Disable Power Management for Connected NICs
'************************************************************************

'Let's setup our variables
Const HKLM = &H80000002		'HKEY_LOCAL_MACHINE info for registry writes
Dim objReg			'Registry Object
Dim objWMIService		'WMI Service Object
Dim arrayNetCards		'Array of all connected NICs
Dim objNetCard			'A specific NIC
Dim strNICguid			'
Dim strShowNicKeyName		'Key Specific to the Network Adapters in CurrentControlSet
Dim strShowNicKeyName001	'Key Specific to the Network Adapters in CurrentControlSet001
Dim strPnPCapabilitesKeyName	'Key Specific to the Network Adapters in CurrentControlSet
Dim strPnPCapabilitesKeyName001	'Key Specific to the Network Adapters in CurrentControlSet001
Dim strComputer			'Name of computer to modify

strComputer = "." 		'Period = local computer

strShowNicKeyName = "SYSTEM\CurrentControlSet\Control\Network\{4D36E972-E325-11CE-BFC1-08002BE10318}\"
strShowNicKeyName001 = "SYSTEM\CurrentControlSet001\Control\Network\{4D36E972-E325-11CE-BFC1-08002BE10318}\"
strPnPCapabilitiesKeyName = "SYSTEM\CurrentControlSet\Control\Class\{4D36E972-E325-11CE-BFC1-08002bE10318}\"
strPnPCapabilitiesKeyName001 = "SYSTEM\CurrentControlSet001\Control\Class\{4D36E972-E325-11CE-BFC1-08002bE10318}\"

ShowNicdwValue = 1 		'1 for ON, 0 for OFF

PnPdwValue = 56			'56 to disable "Allow the computer to turn off this device to save power."

'48 to enable "Allow the computer to turn off this device to save power."

'32 to enable "Allow the computer to turn off this device to save power."
				'  and enable "Allow this device to bring the computer out of standby."

'288 to enable "Allow the computer to turn off this device to save power."
				'  and enable "Allow this device to bring the computer out of standby."
				'  and enable "Only allow management stations to bring the computer out of standby."

On Error Resume Next
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

'Look for the NICs that have IP enabled
Set arrayNetCards = objWMIService.ExecQuery ("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled = True")

'Make changes on the NICs that have IP enabled
For Each objNetCard in arrayNetCards 
	strNICguid = objNetCard.SettingID		'Get the GUID of the NIC
	strDeviceID = Mid(objNetCard.Caption,6,4)	'Get the DeviceID of the NIC

'Change the "Show icon in notification area when connected value"
	objReg.SetDWORDValue HKLM, strShowNicKeyName & strNICguid & "\Connection", "ShowIcon", ShowNicdwValue
	objReg.SetDWORDValue HKLM, strShowNicKeyName001 & strNICguid & "\Connection", "ShowIcon", ShowNicdwValue

'Change the Power Management Values
	objReg.SetDWORDValue HKLM, strPnPCapabilitiesKeyName & strDeviceID & "\","PnPCapabilities",PnPdwValue
	objReg.SetDWORDValue HKLM, strPnPCapabilitiesKeyName001 & strDeviceID & "\","PnPCapabilities",PnPdwValue
Next

Set objReg = Nothing
Set objWMIService = Nothing

Δ [email me]

Δ Saturday, September 1st, 2012

Δ Move Old Computers

How to move objects in Active Directory

[download resource files]

Determines when each computer account in the domain last had their password
changed. If this date is more than a specified number of days in the past, the computer
object is considered inactive and it is moved to a target Organizational Unit. The computer
account is also disabled. A log file keeps track of which computer objects are moved.

' MoveOldComputers.vbs
' VBScript program to determine when each computer account in the domain
' last had their password changed. If this date is more than a specified
' number of days in the past, the computer object is considered inactive
' and it is moved to a target Organizational Unit. The computer account
' is also disabled. A log file keeps track of which computer objects are
' moved.
'
' ----------------------------------------------------------------------

Option Explicit

Dim strFilePath, objFSO, objFile, adoConnection, adoCommand
Dim objRootDSE, strDNSDomain, strFilter, strQuery, adoRecordset
Dim strComputerDN, objShell, lngBiasKey, lngBias
Dim objDate, dtmPwdLastSet, k
Dim intDays, strTargetOU, objTargetOU, objComputer
Dim intTotal, intInactive, intNotMoved, intNotDisabled

' Specify the log file. This file will be created if it does not
' exist. Otherwise, the program will append to the file.
strFilePath = "c:\OldComputers.log"

' Specify the minimum number of days since the password was last set for
' the computer account to be considered inactive.
intDays = 90

' Specify the Distinguished Name of the Organizational Unit into
' which inactive computer objects will be moved.
strTargetOU = "ou=your_workstation_ou,dc=your_domain_name,dc=local"

' Bind to target Organizational Unit.
On Error Resume Next
Set objTargetOU = GetObject("LDAP://" & strTargetOU)
If (Err.Number <> 0) Then
    On Error GoTo 0
    Wscript.Echo "Organization Unit not found: " & strTargetOU
    Wscript.Quit
End If
On Error GoTo 0

' Open the log file for write access. Append to this file.
Set objFSO = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set objFile = objFSO.OpenTextFile(strFilePath, 8, True, 0)
If (Err.Number <> 0) Then
    On Error GoTo 0
    Wscript.Echo "File " & strFilePath & " cannot be opened"
    Set objFSO = Nothing
    Wscript.Quit
End If
On Error GoTo 0

' Obtain local time zone bias from machine registry.
' This bias changes with Daylight Savings Time.
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

' Use ADO to search the domain for all computers.
Set adoConnection = CreateObject("ADODB.Connection")
Set adoCommand = CreateObject("ADODB.Command")
adoConnection.Provider = "ADsDSOOBject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection

' Determine the DNS domain from the RootDSE object.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("DefaultNamingContext")

' Filter to retrieve all computer objects.
strFilter = "(objectCategory=computer)"

' Retrieve Distinguished Name and date password last set.
strQuery = "<LDAP://" & strDNSDomain & ">;" & strFilter _
    & ";distinguishedName,pwdLastSet;subtree"

adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False

' Write information to log file.
objFile.WriteLine "Search for Inactive Computer Accounts"
objFile.WriteLine "Start: " & Now()
objFile.WriteLine "Base of search: " & strDNSDomain
objFile.WriteLine "Log File: " & strFilePath
objFile.WriteLine "Inactive if password not set in days: " & intDays
objFile.WriteLine "Inactive accounts moved to: " & strTargetOU
objFile.WriteLine "----------------------------------------------"

' Initialize totals.
intTotal = 0
intInactive = 0
intNotMoved = 0
intNotDisabled = 0

' Enumerate all computers and determine which are inactive.
Set adoRecordset = adoCommand.Execute
Do Until adoRecordset.EOF
    strComputerDN = adoRecordset.Fields("distinguishedName").Value
    ' Escape any forward slash characters, "/", with the backslash
    ' escape character. All other characters that should be escaped are.
    strComputerDN = Replace(strComputerDN, "/", "\/")
    intTotal = intTotal + 1
    ' Determine date when password last set.
    ' The pwdLastSet attribute should always have a value assigned,
    ' but other Integer8 attributes representing dates could be "Null".
    If (TypeName(adoRecordset.Fields("pwdLastSet").Value) = "Object") Then
        Set objDate = adoRecordset.Fields("pwdLastSet").Value
        dtmPwdLastSet = Integer8Date(objDate, lngBias)
    Else
        dtmPwdLastSet = #1/1/1601#
    End If
    ' Check if computer object inactive.
    If (DateDiff("d", dtmPwdLastSet, Now()) > intDays) Then
        ' Computer object inactive.
        intInactive = intInactive + 1
        objFile.WriteLine "Inactive: " & strComputerDN _
            & " - password last set: " & dtmPwdLastSet
        ' Move computer object to the target OU.
        On Error Resume Next
        Set objComputer = objTargetOU.MoveHere("LDAP://" _
            & strComputerDN, vbNullString)
        If (Err.Number <> 0) Then
            On Error GoTo 0
            intNotMoved = intNotMoved + 1
            objFile.WriteLine "Cannot move: " & strComputerDN
        End If
        ' Disable the computer account.
        On Error Resume Next
        objComputer.AccountDisabled = True
        ' Save changes to Active Directory.
        objComputer.SetInfo
        If (Err.Number <> 0) Then
            On Error GoTo 0
            intNotDisabled = intNotDisabled + 1
            objFile.WriteLine "Cannot disable: " & strComputerDN
        End If
        On Error GoTo 0
    End If
    adoRecordset.MoveNext
Loop
adoRecordset.Close

' Write totals to log file.
objFile.WriteLine "Finished: " & Now()
objFile.WriteLine "Total computer objects found:   " & intTotal
objFile.WriteLine "Inactive:                       " & intInactive
objFile.WriteLine "Inactive accounts not moved:    " & intNotMoved
objFile.WriteLine "Inactive accounts not disabled: " & intNotDisabled
objFile.WriteLine "----------------------------------------------"

' Display summary.
Wscript.Echo "Computer objects found:         " & intTotal
Wscript.Echo "Inactive:                       " & intInactive
Wscript.Echo "Inactive accounts not moved:    " & intNotMoved
Wscript.Echo "Inactive accounts not disabled: " & intNotDisabled
Wscript.Echo "See log file: " & strFilePath

' Clean up.
objFile.Close
adoConnection.Close

Wscript.Echo "Done"

Function Integer8Date(ByVal objDate, ByVal lngBias)
    ' Function to convert Integer8 (64-bit) value to a date, adjusted for
    ' local time zone bias.
    Dim lngAdjust, lngDate, lngHigh, lngLow
    lngAdjust = lngBias
    lngHigh = objDate.HighPart
    lngLow = objdate.LowPart
    ' Account for error in IADsLargeInteger property methods.
    If (lngLow < 0) Then
        lngHigh = lngHigh + 1
    End If
    If (lngHigh = 0) And (lngLow = 0) Then
        lngAdjust = 0
    End If
    lngDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) _
        + lngLow) / 600000000 - lngAdjust) / 1440
    ' Trap error if lngDate is ridiculously huge.
    On Error Resume Next
    Integer8Date = CDate(lngDate)
    If (Err.Number <> 0) Then
        On Error GoTo 0
        Integer8Date = #1/1/1601#
    End If
    On Error GoTo 0
End Function

Δ [email me]

About

   I'm a Computer
   Systems Engineer

   Living and Loving Life

Author