Archive - February 2013

"Aim not for what you are, but for what you could be." - Lucas Hellmer

Index

Toggle Desktop Icons Show/Hide
Enumerate All Users in a Domain
Enumerate All DCs in a Domain
Random Password Generator
Find Locked Out Users
Move Inactive Computer Accounts
Delete Files Older Than X Days

Return User Account Info
Windows Update Fix
Return Domain Logon History
Password is about to Expire
Reset The Local Password On All Machines

Δ Useful Script of the Month

How to rename a list of computers from a text file

Task:
Rename a fleet of workstations from a text file. The text file contains computer old and new names.

For example the text file (oldname, newname):

lab01,class01
lab02,class02
lab03,class03

Script:
@:: 1ST CREATE THE COMPUTERS.TXT FILE - CONTAINS OLDNAME,NEWNAME COMPUTER NAMES
@:: 2ND UPDATE THE NETDOM COMMAND WITH THE PROPER CREDENTIALS

@Echo off
Title Administrative Computer Rename
color 0a

:: --------------------------------------------------------------------------------------------------------------------------------
for /f "tokens=1,2 delims=," %%a in (computers.txt) do (

:: TEST FOR ONLINE STATUS
echo Loading workstation name...
echo.
ping -n 2 127.0.0.1>nul
ping %%a | find "Reply" > nul
if errorlevel 1 (echo oldname:%%a,newname:%%b,OFFLINE >> "log.txt"
) else (
echo oldname:%%a,newname:%%b,ONLINE >> "log.txt"
echo Found %%a...
echo.
ping -n 2 127.0.0.1>nul
:: RENAME COMPUTER
echo Renaming computer...
echo.
netdom renamecomputer %%a /newname:%%b /userD:DOMAIN\DOMAIN_ACCOUNT_NAME /passwordd:
DOMAIN_ACCOUNT_PASSWORD /usero:administrator /passwordo:LOCAL_ACCOUNT_PASSWORD /reboot:30 /force
ping -n 2 127.0.0.1>nul
)
)
:: --------------------------------------------------------------------------------------------------------------------------------

Δ Thursday, February 28th, 2013

Δ Toggle Desktop Icons Show/Hide

How to show and hide desktop icons

[download resource files]

Demo

This is an AutoIT script that uses a function to toggle the show and hide icons feature. I use
this regularly for even easier access via a one-click panel.

Δ [email me]

Δ Wednesday, February 27th, 2013

Δ Enumerate All Users in a Domain

How to return all usernames in a domain

[download resource files]

VBScript to create a text file listing the names of all users in the domain. The file contains
the NT name of each user, one name per line. The NT name is called the pre-Windows 2000
logon name. It is the value of the sAMAccountName attribute of the user. The sAMAccountName
of any object must be unique in the domain.

Option Explicit

Dim strFilePath, strNetBIOSDomain, objFSO, objFile, objDomain, objUser
Dim strName

' Check for required arguments.
If (Wscript.Arguments.Count < 2) Then
    Wscript.Echo "Arguments <Domain> and <FileName> required. " _
        & "For example:" & vbCrLf _
        & "cscript CreateUserList1.vbs MyDomain, c:\MyFolder\UserList1.txt"
    Wscript.Quit(0)
End If

strNetBIOSDomain = Wscript.Arguments(0)
strFilePath = Wscript.Arguments(1)

Set objFSO = CreateObject("Scripting.FileSystemObject")

' Open the file for write access.
On Error Resume Next
Set objFile = objFSO.OpenTextFile(strFilePath, 2, True, 0)
If (Err.Number <> 0) Then
    On Error GoTo 0
    Wscript.Echo "File " & strFilePath & " cannot be opened"
    Wscript.Quit(1)
End If

' Bind to the domain.
On Error Resume Next
Set objDomain = GetObject("WinNT://" & strNetBIOSDomain)
If (Err.Number <> 0) Then
    On Error GoTo 0
    Wscript.Echo "Domain " & strNetBIOSDomain & " not found"
    Wscript.Quit(1)
End If
On Error GoTo 0

' Enumerate all users in the domain.
' Write each user's NT name to the file, one name per line.
objDomain.Filter = Array("user")
For Each objUser In objDomain
    strName = objUser.name
    objFile.WriteLine strName
Next

' Clean up.
objFile.Close

Δ [email me]

Δ Monday, February 25th, 2013

Δ Enumerate All DCs in a Domain

How to return domain controllers in a domain

[download resource files]

VBScript to enumerate all Domain Controllers in the domain.

Option Explicit

Dim objRootDSE, strDNSDomain, adoConnection, adoCommand, strQuery
Dim strFilter, strAttributes, adoRecordset, strDN, strDNSHostName
Dim strName, strBase

' Determine DNS domain name.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")

' Use ADO to search Active Directory.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection

' Search entire domain.
strBase = "<LDAP://" & strDNSDomain & ">"

' Filter on DC's.
strFilter = "(&(objectCategory=computer)" _
    & "(userAccountControl:1.2.840.113556.1.4.803:=8192))"

' Comma delimited list of attribute values to retrieve.
strAttributes = "distinguishedName,sAMAccountName,dNSHostName"

' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"

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

Set adoRecordset = adoCommand.Execute

Do Until adoRecordset.EOF
    strDN = adoRecordset.Fields("distinguishedName").Value
    strName = adoRecordset.Fields("sAMAccountName").Value
    ' Remove trailing "$" character.
    strName = Left(strName, Len(strName) - 1)
    strDNSHostName = adoRecordset.Fields("dNSHostName").Value
    Wscript.Echo "Domain Controller: " & strName _
        & vbCrLf & "  Distinguished Name: " & strDN _
        & vbCrLf & "  DNS Host Name: " & strDNSHostName
    adoRecordset.MoveNext
Loop

' Clean up.
adoRecordset.Close
adoConnection.Close

Wscript.Echo "Done"

Δ [email me]

Δ Friday, February 22nd, 2013

Δ Random Password Generator

How to return random characters to a text file

[download resource files]

Demo

This VBScript uses a simple function and an arrary to generate random characters and then
sendkey them to notepad.

Option Explicit

Dim wshshell
Set WshShell = WScript.CreateObject("WScript.Shell")
NewPW

wshshell.Run ("notepad.exe")

while wshshell.appactivate("Untitled - Notepad") = FALSE
	Wscript.Sleep 10
Wend

wshshell.SendKeys "Random Password is: "& vbcrlf  & newpw 
WScript.Quit

'====== Subs and Functions
Function NewPW()
On Error goto 0
	Dim lranval
	dim fso,tfolder,tname, wd, temporaryfolder
	dim lRVal,spchar,strlc,lchar
	
	'get randomly generated directoryname in format rad*.tmp
	set fso = CreateObject("Scripting.FileSystemObject")
	Set tfolder = fso.GetSpecialFolder(TemporaryFolder)
	tname = fso.GetTempName
	
	'select a special character
	dim aSpecial
	aSpecial = array("!","@","!","#","*","?","$","~")
	lranval = randbetween(0,7)
	spchar = aSpecial(lranval)
	
	'select a lower case middle char
	lranval = randBetween(97,122)   ' Generate random value from lower case ASCII table.
	lchar = Chr(lranval)
	
	'get random initial digits and concatenate with above
	lranval = randbetween(1,99)
	NewPW = Replace(tname, ".tmp", spchar)
	newpw = Replace(newpw, "rad", lchar & lranval)
	newpw = Replace(newpw,"0","9")	'get rid of confusing characters
	newpw = Replace(newpw,"O","o")
	lranval = randBetween(97,122)   ' Generate random value from lower case ASCII table.
	lchar = Chr(lranval)
	NewPW = lchar & NewPW
	lranval = randBetween(0,9)   ' Generate random value to split password below
	newpw = Right(newpw,lranval) & Left(newpw,9-lranval) 
End Function

Function RandBetween(min,max)
	Randomize   ' Initialize random-number generator.
	RandBetween = min + Int(Rnd*(max - min + 1))
End Function

Δ [email me]

Δ Thursday, February 21st, 2013

Δ Find Locked Out Users

How to return all your locked out users

[download resource files]

VBScript demonstrating an efficient way to retrieve the names of all users that are currently locked
out. This program outputs the Distinguished Names of all locked out users.

Option Explicit

Dim objRootDSE, strDNSDomain, objShell, lngBiasKey, lngBias, k
Dim objDomain, objDuration, lngHigh, lngLow, lngDuration
Dim adoCommand, adoConnection, adoRecordset
Dim strBase, strFilter, strAttributes, strQuery
Dim strUserDN, dtmLockOut, lngSeconds, str64Bit

' Retrieve DNS domain name.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")

' Obtain local Time Zone bias from local 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
Set objShell = Nothing

' Retrieve domain lockout duration policy.
Set objDomain = GetObject("LDAP://" & strDNSDomain)
Set objDuration = objDomain.lockoutDuration
lngHigh = objDuration.HighPart
lngLow = objDuration.LowPart
If (lngHigh = 0 And lngLow = 0) Then
    ' There is no domain lockout duration policy.
    ' Locked out accounts remain locked out until reset.
    ' Any user with value of lockoutTime greater than 0
    ' is locked out.
    str64Bit = "1"
Else
    ' Account for error in IADsLargeInteger property methods.
    If (lngLow < 0) Then
        lngHigh = lngHigh + 1
    End If
    ' Convert to minutes.
    lngDuration = lngHigh * (2^32) + lngLow
    lngDuration = -lngDuration/(60 * 10000000)

' Determine critical time in the past. Any accounts
    ' locked out after this time will still be locked out,
    ' unless the account has been reset (in which case the
    ' value of the lockoutTime attribute will be 0).

Δ [email me]

Δ Tuesday, February 19th, 2013

Δ Move Inactive Computer Accounts

How to move computer accounts in active directory

[download resource files]

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:\MyFolder\OldComputers.log"

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

' Specify the Distinguished Name of the Organizational Unit into
' which inactive computer objects will be moved.
strTargetOU = "ou=Inactive,dc=MyDomain,dc=com"

' 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"
    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, not disabled.
strFilter = "(&(objectCategory=computer)" _
    & "(!userAccountControl:1.2.840.113556.1.4.803:=2))"

' 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]

Δ Monday, February 18th, 2013

Δ Delete Files Older Than X Days

How to delete files older than a specified date

[download resource files]

This PowerShell script allows you to delete old files based on the specified amount of days old.

#----- define parameters -----# #----- get current date ----# $Now = Get-Date #----- define amount of days ----# $Days = "7" #----- define folder where files are located ----# $TargetFolder = "C:\Applications\Logs" #----- define extension ----# $Extension = "*.log" #----- define LastWriteTime parameter based on $Days ---# $LastWrite = $Now.AddDays(-$Days) #----- get files based on lastwrite filter and specified folder ---# $Files = Get-Childitem $TargetFolder -Include $Extension -Recurse | Where {$_.LastWriteTime -le "$LastWrite"} foreach ($File in $Files) { if ($File -ne $NULL) { write-host "Deleting File $File" -ForegroundColor "DarkRed" Remove-Item $File.FullName | out-null } else { Write-Host "No more files to delete!" -foregroundcolor "Green" } }

Δ [email me]

Δ Friday, February 15th, 2013

Δ Return User Account Info

How to return user account information from active directory.

[download resource files]

VBScript to retrieve the password information for one user. The user Distinguished Name
is hard coded in the program. The program outputs the date the user last changed their
password, the domain maximum password age policy in days, whether the user is allowed
to change their password, and whether the password is expired. The user is allowed to change
their password if the flag "User cannot change password" is not set, and the flag "Password
never expires" is also not set.

Option Explicit

Dim objUser, strUserDN, objShell, lngBiasKey, lngBias, k
Dim objRootDSE, strDNSDomain, objDomain, objMaxPwdAge, intMaxPwdAge
Dim objDate, dtmPwdLastSet, lngFlag, blnPwdExpire, blnExpired
Dim lngHighAge, lngLowAge

Const ADS_UF_PASSWD_CANT_CHANGE = &H40
Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000

' Hard code user Distinguished Name.
strUserDN = "cn=TestUser,ou=Sales,dc=MyDomain,dc=com"
Set objUser = GetObject("LDAP://" & strUserDN)

' Determine domain maximum password age policy in days.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("DefaultNamingContext")
Set objDomain = GetObject("LDAP://" & strDNSDomain)
Set objMaxPwdAge = objDomain.MaxPwdAge

' Account for bug in IADslargeInteger property methods.
lngHighAge = objMaxPwdAge.HighPart
lngLowAge = objMaxPwdAge.LowPart
If (lngLowAge < 0) Then
    lngHighAge = lngHighAge + 1
End If
intMaxPwdAge = -((lngHighAge * 2^32) _
    + lngLowAge)/(600000000 * 1440)

' Retrieve user password information.
' The pwdLastSet attribute should always have a value assigned,
' but other Integer8 attributes representing dates could be "Null".
If (TypeName(objUser.pwdLastSet) = "Object") Then
    Set objDate = objUser.pwdLastSet
    dtmPwdLastSet = Integer8Date(objDate, lngBias)
Else
    dtmPwdLastSet = #1/1/1601#
End If
lngFlag = objUser.Get("userAccountControl")
blnPwdExpire = True
If ((lngFlag And ADS_UF_PASSWD_CANT_CHANGE) <> 0) Then
    blnPwdExpire = False
End If
If ((lngFlag And ADS_UF_DONT_EXPIRE_PASSWD) <> 0) Then
    blnPwdExpire = False
End If

' Determine if password expired.
blnExpired = False
If (blnPwdExpire = True) Then
    If (DateDiff("d", dtmPwdLastSet, Now()) > intMaxPwdAge) Then
        blnExpired = True
    End If
End If

' Display password information.
Wscript.Echo "User: " & strUserDN & vbCrLf & "Password last set: " _
    & dtmPwdLastSet & vbCrLf & "Maximum password age (days): " _
    & intMaxPwdAge & vbCrLf & "Can password expire? " & blnPwdExpire _
    & vbCrLf & "Password expired? " & blnExpired

Δ [email me]

Δ Thursday, February 7th, 2013

Δ Windows Update Fix

How to repair windows update

[download resource files]

Every once in awhile the windows update feature just completely stops working; this is how you fix it.

ipconfig /flushdns
Cd /d %windir% 
del /s *.chk;*.rip;*.tmp;~*.*
msiexec /regserver
sc config msiserver start= auto
net stop msiserver
msiexec /unreg
msiexec /regserver
regsvr32 msi.dll /s
regsvr32 msihnd.dll /s
net start msiserver
Regsvr32 wuaueng.dll /s
net stop wuauserv 
cd /d %windir%
rmdir /s /q  softwaredistribution
net start wuauserv
sc config eventlog start= auto obj= Localsystem
net start eventlog
regsvr32 qmgr.dll /s
regsvr32 qmgrprxy.dll /s
sc sdset bits D:(A;;CCLCSWRPWPDTLOCRRC;;;SY)(A;;CCDCLCSWRPWPDTLOCRSDRCWDWO;;;BA)(A;;CCLCSWLOCRRC;;;AU)(A;;CCLCSWRPWPDTLOCRRC;;;PU)
regsvr32 wuaueng.dll /s
sc sdset wuauserv D:(A;;CCLCSWRPWPDTLOCRRC;;;SY)(A;;CCDCLCSWRPWPDTLOCRSDRCWDWO;;;BA)(A;;CCLCSWLOCRRC;;;AU)(A;;CCLCSWRPWPDTLOCRRC;;;PU)
sc config wuauserv start= auto obj= Localsystem
net stop wuauserv
sc config bits start= DEMAND obj= Localsystem
net stop bits
regsvr32 msxml.dll /s
regsvr32 msxml2.dll /s
regsvr32 msxml3.dll /s
regsvr32 msxml4.dll /s
regsvr32 qmgr.dll /s
regsvr32 qmgrprxy.dll /s
regsvr32 muweb.dll /s
regsvr32 winhttp.dll /s
regsvr32 wuapi.dll /s
regsvr32 wuaueng.dll /s
regsvr32 wuaueng1.dll /s
regsvr32 wucltui.dll /s
regsvr32 wups.dll /s
regsvr32 wups2.dll /s
regsvr32 wuweb.dll /s
net start wuauserv
net start bits
sc config cryptsvc start= auto
net stop cryptsvc
cd %windir%\system32\catroot2
del *.* /f/q/s
regsvr32 cryptdlg.dll /s
regsvr32 cryptui.dll /s
regsvr32 dssenh.dll /s
regsvr32 gpkcsp.dll /s
regsvr32 initpki.dll /s
regsvr32 mssip32.dll /s
regsvr32 sccbase.dll /s
regsvr32 softpub.dll /s
regsvr32 slbcsp.dll /s
regsvr32 rsaenh.dll /s
regsvr32 winhttp.dll /s
regsvr32 wintrust.dll /s
net start cryptsvc
cd\
sc config ose start= demand
net start ose
regsvr32 qmgr.dll /s
regsvr32 qmgrprxy.dll /s
regsvr32 es.dll /s
cls
Rem **************End of the process*****************
pause
exit

Δ [email me]

Δ Wednesday, February 6th, 2013

Δ Return Domain Logon History

How to return a user's domain logon history

[download resource files]

This script queries a list of computers and get a list of domain users that have logged on from WMI.
Note, this takes awhile using WMI.

Option Explicit
Dim strFilePath: strFilePath = ""
Dim i, arrComputers
Dim retVal
dim strIP, strPingStatus
dim wshShell: Set wshShell = WScript.CreateObject("WScript.Shell")
dim oWShell: Set oWShell = WScript.CreateObject("WScript.Shell")
Dim strComputer, message

If (Not IsCScript()) Then 		'If not CScript, re-run with cscript...
	dim quote: quote=chr(34)
    Dim strCmdLine, Argument
    
    strCmdLine = WScript.Path & "\cscript.exe //NOLOGO " & quote & WScript.scriptFullName & Quote
    
    If Wscript.Arguments.Count > 0 Then
        For Each Argument in Wscript.Arguments
            strCmdLine = strCmdLine & space(1) & quote & Argument & quote
        Next 
    End If
    
    oWShell.Run strCmdLine,1,False
    WScript.Quit            	'...and stop running as WScript    
End If

if wscript.arguments.count = 0 Then 
	message = "This script gets a list of domain accounts which have logged onto a list of computers.  This is a slow process." & _
	vbCrLf & VbCrLf & "Excel is supported, but not required. This relies on WMI, and admin rights are required."
	retval = MsgBox(message,vbInformation + vbOKCancel,"Welcome")
	If retval = vbCancel Then WScript.Quit
	strFilePath = ExcelOpenDialog("Choose a text file containing computer names", "Text Files (*.txt),*.txt",strFilePath ) 
Else
	strFilePath = Wsccript.arguments(0)
End If

'setup log
Const ForAppend = 8
Dim fso,logfile, appendout, logName 
logName = Left(WScript.ScriptName,Len(Wscript.ScriptName)-3)& "XLS"
logfile = wshShell.ExpandEnvironmentStrings("%userprofile%") & "\desktop\" & logName
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(logfile) Then fso.DeleteFile logfile, True

set appendout = fso.OpenTextFile(logfile, ForAppend, True)
echoandlog "Computername	Logon Name	Full Name	Description	Disabled	Errors"

arrComputers = ArrayFromList(strFilePath)

For i = 0 To UBound(arrComputers)
	If Len(arrComputers(i)) > 0 Then 
		strcomputer =  arrComputers(i)
		if PingReply(strComputer) Then 
			WMIQuery strComputer
		Else
			EchoAndLog strComputer & String(5,vbTab) & "Failed. " & strPingStatus
		End If 
	End If 
Next

appendout.Close

SaveAsExcel logfile

MsgBox "Script Complete.  The logfile is " & logfile, vbInformation + vbOKOnly,"Done"

'========== Functions And Sub ==================
Function WMIQuery(strComputer)
    Dim oWMI, oWMIObjSet, oWMIUserAcct
    On Error Resume Next 
    Set oWMI = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
    oWMI.Security_.ImpersonationLevel = 3

If Err <> 0 Then 
    	EchoAndLog strComputer & String(5,vbTab) & "Failed. " & Err.Description
    	Exit Function 
    End If

Set oWMIObjSet = oWMI.ExecQuery("ASSOCIATORS OF {Win32_ComputerSystem.Name='"& strComputer & "'} WHERE AssocClass=Win32_SystemUsers ResultClass=Win32_UserAccount")
    If oWMIObjSet.Count Then
        For Each oWMIUserAcct In oWMIObjSet
        	If oWMIUserAcct.LocalAccount = False Then 
	            EchoAndLog strComputer & vbTab & oWMIUserAcct.Caption & vbTab & oWMIUserAcct.FullName & vbTab  & oWMIUserAcct.Description & _
	             vbTab  & oWMIUserAcct.Disabled
            End If 
        Next
    Else
       EchoAndLog strComputer & String(5,vbTab) & "No network users have logged on."
    End If
    
    Set oWMIObjSet = Nothing
    Set oWMI = Nothing
End Function

Function ExcelOpenDialog( sPrompt, sFilter, strDefaultFile ) 
	'Based on code by Michael Hardt 
   	'http://www.softimage.com/community/xsi/discuss/archives/xsi.archive.0111/msg00066.htm
	Dim oExcelApp 
	On Error Resume Next 
	Set oExcelApp = CreateObject("Excel.Application") 
	If Err =  0 Then 
	Dim sFile 
   	sFile = oExcelApp.GetOpenFilename ( sFilter, , sPrompt) 	   	
	'Cancel or no file name? 
	   	If sFile <> False Then 
	      	ExcelOpenDialog = sFile 
	   	Else 
	   		oExcelApp.Quit
	     	Wscript.quit
	   	End If 
	 Else
	 	Err.Clear
		ExcelOpenDialog = InputBox(sPrompt,"Open what file",strDefaultFile)
	 End If 
	On Error GoTo 0
End Function

Function ArrayFromList(strFilePath)
	Dim fso, f, strAll
	Set fso = CreateObject("Scripting.FileSystemObject")
	Const ForReading = 1 
	Set f = fso.OpenTextFile(strFilePath,ForReading) 
	strAll = f.ReadAll
	ArrayFromList = Split(strAll,VbCrLf)
End Function

Sub EchoAndLog (message)
'Echo output and write to log
	Wscript.Echo message
	AppendOut.WriteLine message
End Sub

Sub SaveAsExcel(strFileName)
	Const xlnormal = -4143 
	Const xlAscending = 1
	Const xlDescending = 2
	Const xlYes = 1
	Const xlSortValues = 1

Dim fso, oXL, objRange, objRange2
	Set fso = CreateObject("Scripting.FileSystemObject")
	If Not fso.FileExists(strFileName) Then WScript.Quit
	On Error Resume Next
	Set oXL = CreateObject("Excel.Application")
	
	If Err <> 0 Then 'Excel not installed
		Err.Clear
		On Error GoTo 0
		WScript.echo "Saving log as tab delimited text, please wait"
		fso.MoveFile strFileName, Replace(strFileName,".xls",".txt")
		Exit Sub
	Else
		WScript.echo "Saving log as Excel file, please wait"
	End If

'oXL.Visible = True
	oXL.DisplayAlerts=False ' don't display overwrite prompt.
	oXL.Workbooks.Open(strFileName)
	Set objRange = oXL.Worksheets(1).UsedRange
	Set objRange2 = oXL.Range("A2")
	objRange.Sort objRange2, xlAscending,,,,,, xlYes
	objRange.EntireColumn.Autofit()

Dim oWS	
	Set oWS = oXL.Worksheets(1)
	oWS.Activate
	oWS.Name = "User Names"
	
	oXL.ActiveWorkBook.SaveAs strFileName,xlnormal,,,,,,,True 'overwrite existing
	oXL.ActiveWorkBook.Close
	oXL.Quit
End Sub

Function IsCScript()
    If (InStr(UCase(WScript.FullName), "CSCRIPT") <> 0) Then
        IsCScript = True
    Else
        IsCScript = False
    End If
End Function

Function PingReply(strcomputer) 
	strIP = "Not Available"
	Dim objScriptExec, strPingResults
	Dim objRE, match, matches, strOut

'RegEx pattern from Bill Stewart
	Set objRE = New RegExp
    objRE.Pattern = " [0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}"
	
	'Three lines from Steve Cathersalc 
	Set objScriptExec=wshShell.Exec("ping -n 2 -w 1000 " & strComputer)
	strOut = lcase(objScriptExec.StdOut.Readall)

If InStr(strOut,"could not find host") Then
		PingReply = False
		strPingStatus = "No Host Record"
		Exit Function
	End If  
	
	If InStr(strOut,"unreachable") Then 
		PingReply = False
		strPingStatus = "Unreachable"
	End If  
	
	If  InStr(strOut,"bytes=") = 0 Then 
		PingReply = False
		strPingStatus= "Offline"
	Else
		PingReply = True
		strPingStatus = "Online"
	End If  
	
	Set matches = objRE.Execute(strOut)   ' Execute search.

If Matches.count = 1 Then 
	   For Each Match in Matches   ' Iterate Matches collection.
	     strIP = trim(Match.Value) 'Cleanup
	   Next
	Else
		strIP = ""
	End If 
End Function

Δ [email me]

Δ Monday, February 4th, 2013

Δ Password is about to Expire

How to return all users that have passwords about to expire

[download resource files]

VBScript to find all user accounts where the password is about to expire in a specified
number of days.

Option Explicit

Dim adoCommand, adoConnection, strBase, strFilter, strAttributes
Dim objRootDSE, strDNSDomain, strQuery, adoRecordset
Dim dtmDate1, dtmDate2, intDays, strName, strEmail
Dim lngSeconds1, str64Bit1, lngSeconds2, str64Bit2
Dim objShell, lngBiasKey, lngBias, k
Dim objDomain, objMaxPwdAge, lngHighAge, lngLowAge, sngMaxPwdAge
Dim objDate, dtmPwdLastSet, dtmExpires
Dim arrEmails, strItem, strPrefix

' Specify number of days. Any users whose password expires within
' this many days after today will be processed.
intDays = 14

' Account for bug in IADslargeInteger property methods.
lngHighAge = objMaxPwdAge.HighPart
lngLowAge = objMaxPwdAge.LowPart
If (lngLowAge < 0) Then
    lngHighAge = lngHighAge + 1
End If
' Convert from 100-nanosecond intervals into days.
sngMaxPwdAge = -((lngHighAge * 2^32) _
    + lngLowAge)/(600000000 * 1440)

' Determine the password last changed date such that the password
' would just now be expired. We will not process users whose
' password has already expired.
dtmDate1 = DateAdd("d", - sngMaxPwdAge, Now())

' Determine the password last changed date such that the password
' will expire intDays in the future.
dtmDate2 = DateAdd("d", intDays - sngMaxPwdAge, Now())

' 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

' Convert the datetime values to UTC.
dtmDate1 = DateAdd("n", lngBias, dtmDate1)
dtmDate2 = DateAdd("n", lngBias, dtmDate2)

' Find number of seconds since 1/1/1601 for these dates.
lngSeconds1 = DateDiff("s", #1/1/1601#, dtmDate1)
lngSeconds2 = DateDiff("s", #1/1/1601#, dtmDate2)

' Convert the number of seconds to a string
' and convert to 100-nanosecond intervals.
str64Bit1 = CStr(lngSeconds1) & "0000000"
str64Bit2 = CStr(lngSeconds2) & "0000000"

' Setup ADO objects.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection

' Search entire Active Directory domain.
strBase = "<LDAP://" & strDNSDomain & ">"

' Filter on user objects where the password expires between the
' dates specified, the account is not disabled, password never
' expires is not set, password not required is not set,
' and password cannot change is not set.
strFilter = "(&(objectCategory=person)(objectClass=user)" _
    & "(pwdLastSet>=" & str64Bit1 & ")" _
    & "(pwdLastSet<=" & str64Bit2 & ")" _
    & "(!userAccountControl:1.2.840.113556.1.4.803:=2)" _
    & "(!userAccountControl:1.2.840.113556.1.4.803:=65536)" _
    & "(!userAccountControl:1.2.840.113556.1.4.803:=32)" _
    & "(!userAccountControl:1.2.840.113556.1.4.803:=48))"

' Comma delimited list of attribute values to retrieve.
strAttributes = "sAMAccountName,mail,proxyAddresses,pwdLastSet"

' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False

' Run the query.
Set adoRecordset = adoCommand.Execute

' Enumerate the resulting recordset.
Do Until adoRecordset.EOF
    ' Retrieve values.
    strName = adoRecordset.Fields("sAMAccountName").Value
    strEmail = adoRecordset.Fields("mail").Value & ""
    arrEmails = adoRecordset.Fields("proxyAddresses").Value
    If (strEmail = "") And (IsNull(arrEmails) = False) Then
        ' Select primary email address.
        For Each strItem In arrEmails
            strPrefix = Left(strItem, 5)
            If (strPrefix = "SMTP:") Or (strPrefix = "X400:") Then
                strEmail = Mid(strItem, 6)
                Exit For
            End If
        Next
    End If
    ' Determine when password expires.
    ' 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
    dtmExpires = DateAdd("d", sngMaxPwdAge, dtmPwdLastSet)
    If (strEmail <> "") Then
        ' Send an email message to the user.
        Call SendEmailMessage(strEmail, strName, dtmExpires)
        Wscript.Echo "Message for " & strName & " sent to " & strEmail
    Else
        Wscript.Echo "No email address for " & strName
    End If
    ' Move to the next record in the recordset.
    adoRecordset.MoveNext
Loop

' Clean up.
adoRecordset.Close
adoConnection.Close

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

Sub SendEmailMessage(ByVal strDestEmail, ByVal strNTName, ByVal dtmDate)
    ' Send email message.
    Dim objMessage

If (strDestEmail = "") Then
        Exit Sub
    End If

Set objMessage = CreateObject("CDO.Message") 
    objMessage.Subject = "Password Will Expire"
    ' Hard code sender email address.
    objMessage.Sender = "jimsmith@mycompany.com" 
    objMessage.To = strDestEmail 
    objMessage.TextBody = "The password for account " & strNTName _
        & " will expire " & CStr(dtmDate)
    objMessage.Send
End Sub

Δ [email me]

Δ Friday, February 1st, 2013

Δ Reset The Local Password On All Machines

How to reset the local password on your fleet machines

EASY WAY - using SCCM/LANDesk/Logon Script

HARD WAY

[download resource files]

VBScript to reset the local Administrator password on all workstations in the domain to the
same value. The program documents all activity, including workstations that could not be
contacted or on which the password could not be reset, to a log file. The NetBIOS names
of all computers where the password was not reset are also written to a "missed" file. The
next time the program is run, only the computers listed in this file will be processed. The
program can be run repeatedly until this file is empty, meaning that the local Administrator
password has been reset on all workstations.

Option Explicit

Dim adoCommand, adoConnection, strBase, strFilter, strAttributes
Dim objRootDSE, strDNSDomain, strQuery, adoRecordset, strComputer
Dim objShell, strLogFile, objFSO, objLog, blnMissed, lngReset
Dim objLocalAdmin, strPassword, strLine, strTitle, lngMissed
Dim strMissedFile, objMissed, arrstrMissed(), k, strMessage
Dim objComputer, strHexSID

Const ForWriting = 2
Const ForAppending = 8
Const ForReading = 1
Const OpenAsASCII = 0
Const CreateIfNotExist = True

strTitle = "ResetLocalAdminPwds"

' Specify the new local Administrator password for all workstations.
strPassword = "zXy#213$q"

' Specify log file.
strLogFile = "c:\scripts\ResetPwds.log"
' Specify missed file (NetBIOS names of missed computers).
strMissedFile = "c:\scripts\Missed.txt"

' Open the log file for appending.
Set objFSO = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set objLog = objFSO.OpenTextFile(strLogFile, _
    ForAppending, CreateIfNotExist, OpenAsASCII)
If (Err.Number <> 0) Then
    On Error GoTo 0
    Wscript.Echo "File " & strLogFile & " cannot be opened"
    Wscript.Quit
End If
On Error GoTo 0

' Open missed file.
If (objFSO.FileExists(strMissedFile) = True) Then
    ' Missed text file exists. Open the file for reading.
    blnMissed = True
    Set objMissed = objFSO.OpenTextFile(strMissedFile, _
        ForReading)
    ' Read computer NetBIOS names into an array.
    k = 0
    Do Until objMissed.AtEndOfStream
        strLine = Trim(objMissed.ReadLine)
        If (strLine <> "") Then
            ReDim Preserve arrstrMissed(k)
            arrstrMissed(k) = strLine
            k = k + 1
        End if
    Loop
    ' Close the file.
    objMissed.Close
    ' Check if any names in file.
    If (k = 0) Then
        ' No NetBIOS names in missed text file. No computers need
        ' to have the local Administrator password reset.
        Call MsgBox("No computers need to have the local Administrator" _
            & vbCrLf & "password reset. To reset the password on all" _
            & vbCrLf & "workstations in the domain, delete the file of" _
            & vbCrLf & "missed computers: " & strMissedFile & "." _
            & vbCrLf & "You may also want to delete the log file: " _
                & strLogFile & "." _
            & vbCrLf & "Then make sure the new password is hard coded" _
            & vbCrLf & "correctly and rerun the program.", _
            vbOKOnly + vbInformation, strTitle)
        objLog.Close
        Wscript.Quit
    End If
    ' Reopen the file for writing.
    Set objMissed = objFSO.OpenTextFile(strMissedFile, _
        ForWriting, CreateIfNotExist, OpenAsASCII)
Else
    ' Missed text file does not exist. Open the file for writing.
    blnMissed = False
    Set objMissed = objFSO.OpenTextFile(strMissedFile, _
        ForWriting, CreateIfNotExist, OpenAsASCII)
End If

' Write to log file.
objLog.WriteLine "Program ResetLocalAdminPwds.vbs"
objLog.WriteLine "Started: " & CStr(Now())
If (blnMissed = True) Then
    objLog.WriteLine "Reading computer names from file of missed computers"
Else
    objLog.WriteLine "Retrieving all workstation names from AD"
End If

' WshShell object required by Function PingMachine.
Set objShell = CreateObject("Wscript.Shell")

lngReset = 0
lngMissed = 0
If (blnMissed = True) Then
    ' Read array of missed computer names.
    For k = 0 To UBound(arrstrMissed)
        strComputer = arrstrMissed(k)
        Wscript.Echo strComputer
        ' Ping the computer.
        If (PingMachine(strComputer, 1, 750) = True) Then
            ' Bind to the computer object.
            On Error Resume Next
            Set objComputer = GetObject("WinNT://" & strComputer)
            If (Err.Number = 0) Then
                On Error GoTo 0
                ' Filter on user objects.
                objComputer.Filter = Array("user")
                ' Enumerate all local users on the computer.
                For Each objLocalAdmin In objComputer
                    ' Retrieve SID and convert to hex string.
                    strHexSID = OctetToHexStr(objLocalAdmin.objectSID)
                    ' Check SID = "500" decimal, "F4010000" hex.
                    If (Right(strHexSID, 8) = "F4010000") Then
                        Exit For
                    End If
                Next
                On Error Resume Next
                objLocalAdmin.SetPassword strPassword
                If (Err.Number = 0) Then
                    ' Restore normal error handling.
                    On Error GoTo 0
                    objLog.WriteLine strComputer & " password reset"
                    lngReset = lngReset + 1
                Else
                    ' Restore normal error handling.
                    On Error GoTo 0
                    objLog.WriteLine strComputer _
                        & " ## unable to set password"
                    objMissed.WriteLine strComputer
                    lngMissed = lngMissed + 1
                End If
            Else
                ' Restore normal error handling.
                On Error GoTo 0
                objLog.WriteLine strComputer _
                    & " ## unable to bind to computer"
                objMissed.WriteLine strComputer
                lngMissed = lngMissed + 1
            End If
        Else
            ' Computer not available.
            objLog.WriteLine strComputer & " ## not available"
            objMissed.WriteLine strComputer
            lngMissed = lngMissed + 1
        End If
    Next
Else
    ' Setup ADO objects.
    Set adoCommand = CreateObject("ADODB.Command")
    Set adoConnection = CreateObject("ADODB.Connection")
    adoConnection.Provider = "ADsDSOObject"
    adoConnection.Open "Active Directory Provider"
    adoCommand.ActiveConnection = adoConnection

' Search entire Active Directory domain.
    Set objRootDSE = GetObject("LDAP://RootDSE")
    strDNSDomain = objRootDSE.Get("defaultNamingContext")
    strBase = "<LDAP://" & strDNSDomain & ">"

' Filter on computers without a server operating system.
    strFilter = "(&(objectCategory=computer)(!operatingSystem=*server*))"

' Comma delimited list of attribute values to retrieve.
    strAttributes = "sAMAccountName"

' Construct the LDAP syntax query.
    strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
    adoCommand.CommandText = strQuery
    adoCommand.Properties("Page Size") = 100
    adoCommand.Properties("Timeout") = 30
    adoCommand.Properties("Cache Results") = False

' Run the query.
    Set adoRecordset = adoCommand.Execute

' Enumerate the resulting recordset.
    Do Until adoRecordset.EOF
        ' Retrieve NetBIOS name of computer.
        strComputer = adoRecordset.Fields("sAMAccountName").Value
        ' Remove trailing "$".
        strComputer = Left(strComputer, Len(strComputer) - 1)
        Wscript.Echo strComputer
        ' Ping the computer.
        If (PingMachine(strComputer, 1, 750) = True) Then
            ' Bind to the computer object.
            On Error Resume Next
            Set objComputer = GetObject("WinNT://" & strComputer)
            If (Err.Number = 0) Then
                On Error GoTo 0
                ' Filter on user objects.
                objComputer.Filter = Array("user")
                ' Enumerate all local users on the computer.
                For Each objLocalAdmin In objComputer
                    ' Retrieve SID and convert to hex string.
                    strHexSID = OctetToHexStr(objLocalAdmin.objectSID)
                    ' Check SID = "500" decimal, "F4010000" hex.
                    If (Right(strHexSID, 8) = "F4010000") Then
                        Exit For
                    End If
                Next
                On Error Resume Next
                objLocalAdmin.SetPassword strPassword
                If (Err.Number = 0) Then
                    ' Restore normal error handling.
                    On Error GoTo 0
                    objLog.WriteLine strComputer & " password reset"
                    lngReset = lngReset + 1
                Else
                    ' Restore normal error handling.
                    On Error GoTo 0
                    objLog.WriteLine strComputer _
                        & " ## unable to set password"
                    objMissed.WriteLine strComputer
                    lngMissed = lngMissed + 1
                End If
            Else
                ' Restore normal error handling.
                On Error GoTo 0
                objLog.WriteLine strComputer _
                    & " ## unable to bind to computer"
                objMissed.WriteLine strComputer
                lngMissed = lngMissed + 1
            End If
        Else
            ' Computer not available.
            objLog.WriteLine strComputer & " ## not available"
            objMissed.WriteLine strComputer
            lngMissed = lngMissed + 1
        End If
        ' Move to the next record in the recordset.
        adoRecordset.MoveNext
    Loop
    adoRecordset.Close
    adoConnection.Close
End If

' Write to log file.
objLog.WriteLine "Finished: " & CStr(Now())

' Clean up.
objLog.Close
objMissed.Close

If (lngReset > 0) Then
    strMessage = "Passwords reset on " & FormatNumber(lngReset, 0) _
        & " computers."
Else
    strMessage = "Passwords reset on No computers."
End If
If (lngMissed > 0) Then
    strMessage = strMessage & vbCrLf _
        & "Passwords Not reset on " & FormatNumber(lngMissed, 0) _
        & " computers." _
        & vbCrLf & "Computers missed are documented in file:" _
        & vbCrLf & strMissedFile
End If
strMessage = strMessage & vbCrLf & "See log file:" _
    & vbCrLf & strLogFile
Call MsgBox(strMessage, vbOKOnly + vbInformation, strTitle)

Function PingMachine(ByVal strHost, ByVal intPings, ByVal intTO)
    ' Returns True if strHost can be pinged.
    ' strHost is the NetBIOS name or IP address of host computer.
    ' intPings is number of echo requests to send.
    ' intTO is timeout in milliseconds to wait for each reply.
    ' Variable objShell has global scope and must be declared and set
    ' in the main program. Requires WSH 5.6, which comes standard with
    ' Windows XP and above.
    ' Modified 09/14/2010 to search for "Reply from" instead of "TTL=".

Dim strResults
    Dim objExecObject

' Defaults.
    If (intPings = "") Then
        intPings = 2
    End If
    If (intTO = "") Then
        intTO = 750
    End If

' Ping the machine.
    Set objExecObject = objShell.Exec("%comspec% /c ping -n " _
        & CStr(intPings) & " -w " & CStr(intTO) & " " & strHost)

' Read the output.
    Do Until objExecObject.StdOut.AtEndOfStream
        strResults = objExecObject.StdOut.ReadAll
    Loop

Select Case InStr(strResults, "Reply from")
        Case 0
            ' No response.
            PingMachine = False
        Case Else
            ' Computer responded to ping.
            PingMachine = True
    End Select

End Function

Function OctetToHexStr(ByVal arrbytOctet)
    ' Function to convert OctetString (Byte Array) to a hex string.

Dim k

OctetToHexStr = ""
    For k = 1 To Lenb(arrbytOctet)
        OctetToHexStr = OctetToHexStr _
            & Right("0" & Hex(Ascb(Midb(arrbytOctet, k, 1))), 2)
    Next

End Function

Δ [email me]

About

   I'm a Computer
   Systems Engineer

   Living and Loving Life

Author