'Alan Kaplan, for VA 
'alan dot kaplan at va dot gov
'This script unlocks an account and resets the password  with a mostly random password.
'3/28/2000, 5/15/2001, 1/6/2009

Option Explicit
Dim WshShell
Dim message
dim strNTDom, strExampleName,RetVal
dim strNTName, newpw, dspath
dim objDomain, objUser, objEnv
Set WshShell = WScript.CreateObject("WScript.Shell")
set objEnv = WshShell.Environment("process")

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

'******Optional Edits ************
'An example of convention
strExampleName = objEnv("USERNAME") 	'Example display strNTName for domain
'****************************

'set the strNTName to 1st argument passed to script
On Error Resume Next

If WScript.Arguments.Count = 1 Then 
	strNTName = WScript.Arguments(0)						
Else
	' Define dialog box variables.
	Message = "You must have appropriate rights to run this script!" &vbCRLF _
	&vbCRLF & "Please enter the NTName of a user within " & Ucase(strNTDom) & " domain."
	strNTName = InputBox(message, "Unlock, Reset User Account with Random Password", strExampleName)
End If

If strNTName = "" Then	WScript.Quit

On Error Resume Next

DSPath = "WinNT://" & strNTDom & "/" & strNTName & ",user"
Set objUser = GetObject(DSPath)
if Err <> 0	then						' No strNTName
		' Define dialog box variables.
		message = Ucase(strNTDom & "\" & strNTName) & " not found, or insufficient authority for change."
		WshShell.Popup message,0,"Cannot Access User Account",vbcritical
		WScript.Quit
End If

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

'Unlock
'On Error Resume Next

If Objuser.IsAccountLocked = FALSE Then
	'Ask if not locked out
	RetVal = MSGBox("Account not locked, are you sure you want to change password?",36,"Not locked")
	If RetVal = vbno Then
		WshShell.Popup vbcrlf & VbCrLf & "No changes have been made to " & strNTName,0,"Script Aborted",vbInformation
		Wscript.Quit
	End If
Else
	'Go ahead and unlock
	Objuser.IsAccountLocked = FALSE
	objUser.SetInfo
	message = message & "Account unlocked" & VbCrLf
End If

'password Set

GetPW

On Error Resume Next

objUser.SetPassword newpw
if Err = 0 then 
	message = message & "Password reset to: " & newpw &vbcrlf
Else
	message = message & "Password reset failed" &vbcrlf
End if

'Password Expired
On Error Resume Next
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." &_
	vbcrlf & "Your new password must at least 8 characters "&_
	"must be mixed upper and lower case, include at least one "&_
	"number or special character such as '*' or '!'."
End If


WScript.Quit					'End

' ================= Subs ============
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
	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="k"
	   Case 6
		lchar="v" 
	   Case 7
		lchar="h"
	   Case 8
		lchar="t"
	   Case 9
		lchar="p"
	   Case 10
		lchar="m"
	   Case 11
		lchar="e"
	   Case 12
		lchar="f" 
	End Select
	
	'get random initial digits and concatenate with above
	Randomize   ' Initialize random-number generator.
	lranval = Int((1 * Rnd) + 99)   ' Generate random value between 1 and 99.
	NewPW = Replace(tname, ".tmp", spchar)
	NewPW = Replace(Newpw, "rad", lchar & lranval)
End Sub