'UnlockReset Script begins
'Alan Kaplan, for VA Medical Center, Salisbury
'www.akaplan.com/tools.html
'This script unlocks an account and resets the password 
'with a mostly random password.
'3/28/2000, 5/15/2001

'Requires ADSI on workstation running script
'To unlock user account and change password, you must be logged on with Admin rights
'or Account Manager rights 

'For more info, see MS Press Title WSH 2.0 Developer's Guide by Gunter Born
'and Microsoft ADSI docs.

Option Explicit
Dim WshShell, key, key2
Dim Major, Minor, Ver, message,message1,title1
dim DName, title, text1, Exname,result,rdname
dim Username, newpw, dspath
dim objDomain, objUser, objEnv

Set WshShell = WScript.CreateObject("WScript.Shell")
set objEnv = WshShell.Environment("process")

dname = objEnv("USERDOMAIN")		'Get current domain name

'get resource domain name as default search string within logon domain
key = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\Currentversion\Winlogon\CachePrimaryDomain"
RDname = WshShell.RegRead (key)

'******Optional Edits ************
Exname = rdname & "Last5First1" 	'Example display username for domain

'Remark out next line AFTER you know workstation
'is properly configured to speed execution ...
SysTest
'****************************

'set the username to 1st argument passed to script
On Error resume next
UserName = WScript.Arguments(0)						
if err <> 0	then		' No username
err.clear
on error goto 0
	' Define dialog box variables.
	Message = "You must have appropriate rights to run this script!" &vbCRLF _
	&vbCRLF & "Please enter a username within " & Ucase(dname) & " domain."

	Title = "Unlock, Reset User Account with Random Password"
	Text1 = "Canceled"
	UserName = InputBox(Message, Title, Exname)
		If UserName = "" Then			'Canceled by the user
			WScript.Quit
		End If
End if

err.clear
on error resume next

DSPath = "WinNT://" & DName & "/" & Username & ",user"
Set objUser = GetObject(DSPath)
if err <> 0	then						' No username
err.clear
on error goto 0
	' Define dialog box variables.
	Message = Ucase(dname & "\" & Username) & " not found, or insufficient authority for change."
	Title = "Cannot Access User Account"
	WshShell.Popup message,0,title,vbcritical
			WScript.Quit
		End If

GetPW

'First line of results message
Message = "Results for " & UCase(username) &":" & vbcrlf & vbcrlf

'UNlock
'on error resume next
err.clear
If Objuser.IsAccountLocked = FALSE Then
'Ask if not locked out
	Title1 = "Not unlocked"
	Message1 = "Account not locked, are you sure you want to change password?"
	result = MSGBox(message1,36,Title)
			if result = 6 Then
				Objuser.IsAccountLocked = FALSE
				objUser.SetInfo
				message = "Account unlocked" &vbCrLf
					Else
			WshShell.Popup vbcrlf & vbcrlf &_
			 "No changes have been made to " & username,0,"Script Aborted",vbInformation
			Wscript.Quit
		End if
Else
'Go ahead and unlock
				Objuser.IsAccountLocked = FALSE
				objUser.SetInfo
				message = "Account unlocked" &vbCrLf
End if
on error goto 0
'password set
        on error resume next
        err.clear
		objUser.SetPassword newpw
if err = 0 then 
        message = message & "Password reset to: " & newpw &vbcrlf
     Else
      	message = message & "Password not reset." &vbcrlf
      end if

'Password Expired
        on error resume next
        err.clear
        ObjUser.Put "PasswordExpired", CLng(1)
        objUser.SetInfo
if err = 0 then 
        message = message & "User must change password at next logon." &vbcrlf
     Else
      	message = message & "User will not be required to change password at next logon." &vbcrlf
      end if
      
If(msgbox (message & vbcrlf & "Send to Notepad?",_
	vbYesNo + vbQuestion, "User Account Reset") = vbYes) then
	wshshell.Run ("notepad.exe")
	
	while wshshell.appactivate("Untitled - Notepad") = FALSE
		Wscript.Sleep 10
	Wend
	
	wshshell.SendKeys "Your new Password is: " & newpw & vbcrlf & "You must " &_
	"type it exactly as it appears.  You will be prompted to " &_
	"change your password when you log in." &_

'*** Edit Min Password length here ****
	vbcrlf & "Your new password must at least 999 characters "&_
	"must be mixed upper and lower case, include at least one "&_
	"number or special character such as '*' or '!'."
End If


WScript.Quit					'End


'subroutine to test for ADSI and WSH 5.5 
Sub SysTest()
' WSH version tested
Major = (ScriptEngineMinorVersion())
Minor = (ScriptEngineMinorVersion())/10
Ver = major + minor
'Need version 5.5
	If ver < 5.5 then
	message = "You have WScript Version " & ver & ". Please load Version 5.5 or later."
End If

'Test for ADSI
err.clear
key = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Active Setup\Installed Components\{E92B03AB-B707-11d2-9CBD-0000F87A369E}\version"
key2 = WshShell.RegRead (key)
if err <> 0 then
  	message = message & "ADSI must be installed on local workstation to continue" & vbCrLf
WshShell.Popup message,0,"Workstation Setup Error",vbInformation
	WScript.Quit
	End if
End Sub 

sub GetPW()
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 special character based on day of week.  Must be printable using sendkeys method
'Note this is different characterset then used before publishing.

wd = Weekday(date)
Select Case wd
   Case 0
	spchar="@" 'prints
   Case 1
	spchar="*"	'*	prints
   Case 2
	spchar="%"	'? prints
   Case 3
	spchar="$"	'$ prints
   Case 4
	spchar="!"	'prints
   Case 5
	spchar=	"^"	'prints
   Case 6
	spchar="!" 'prints

End Select

'select middle char based on month
strlc = month(now)
Select Case strlc
   Case 1
	lchar="g"
   Case 2
	lchar="n"
   Case 3
	lchar="b"
   Case 4
	lchar="o"
   Case 5
	lchar="p"
   Case 6
	lchar="m"
   Case 7
	lchar="e"
   Case 8
	lchar="f"
   Case 9
	lchar="k"
   Case 10
	lchar="v" 
   Case 11
	lchar="h"
   Case 12
	lchar="t"
 
End Select

'get random initial digits and concatenate with above
Randomize   ' Initialize random-number generator.
lranval = Int((1 * Rnd) + 999)   ' Generate random value between 1 and 999.
NewPW = Replace(tname, ".tmp", spchar)
NewPW = Replace(Newpw, "rad", lchar & lranval)
End Sub

'*** Script Ends