Change All Local Admin Passwords

[djwatts]

Hello,

For some reason many people leave the default local admin password as blank, or many machines have different local admin passwords.

Create a TXT file with computer names (EXPORT FROM AD?!)

E.G.
WS000
WS001
WS002

Then run the script below:-

********************************************************



On Error Resume Next

Const FOR_READING = 1
Const E_ADS_PROPERTY_NOT_FOUND = &h8000500D
Dim objFSO,objFile,strSongLine
Dim INPUT_FILE_NAME

set oUA = CreateObject("UserAccounts.CommonDialog")
if oUA.ShowOpen = false then WSCRIPT.Quit

INPUT_FILE_NAME = oUA.FileName

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(INPUT_FILE_NAME, FOR_READING,true,TristateUseDefault)

NEWPASS = inputbox("Enter a new password...","Password","")

CONF = inputbox("Confirm new password...","Password","")

if CONF <> NEWPASS then
msgbox "Confirmation password does not match.",vbcritical,"Error"
Wscript.Quit
end if


Const WINDOW_HANDLE = 0
Const NO_OPTIONS = 0
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder (WINDOW_HANDLE, "Select a folder, for log file to be created:-", NO_OPTIONS, "")
if objFolder = null then
msgbox "You need to specify a log directory",vbcritical,"Error"
wscript.quit
end if

Set objFolderItem = objFolder.Self
if right(objFolderItem.Path,1) = "\" then
FILEPTH = objFolderItem.Path & "Password Failure.txt"
else
FILEPTH = objFolderItem.Path & "\Password Failure.txt"
end if

msgbox "Log will be generated in " & vbcr & vbcr & FILEPTH,vbinformation,"Log File"

FAILCNT = ""

Do Until objFile.AtEndOfStream
strSongLine = objFile.ReadLine
if strsongline <> "" then
ComputerName = trim(strsongline)
Err.Clear
Set CPU = Nothing
Set CPU = GetObject("WinNT://" & ComputerName & ",Computer")
if Err.Number = 0 then
Set User = CPU.GetObject("User", "Administrator")
User.SetPassword(NEWPASS)
User.SetInfo
else
FAILCNT = FAILCNT & strSongLine & ";"
Err.Clear
end if
end if
loop

if FAILCNT <> "" then
FAILARR = split(FAILCNT,";")
Set f2 = objFSO.OpenTextFile(FILEPTH,8,true)
for i = lbound(FAILARR) to ubound(FAILARR)
f2.writeline(trim(FAILARR(i)))
next
f2.close
end if

X = msgbox ("Function completed, " & ubound(FAILARR) & " computers failed" & vbcr & vbcr & "Would you like to view the log now?",vbexclamation+vbyesno,"Finished")
if X = vbYes then
Set wshshell=createobject("wscript.shell")
wshshell.Run "notepad.exe " & FILEPTH
end if