'This program forces name change of members of Domain Admins by password age
'It excludes accounts set to never expire, and logs results
'Written by Alan Kaplan 9-4-2001
'9-5 modified to include report option, and to do Administrators.
'You must have ADSI on PC running this script for it to work

Option Explicit
Dim Message1, dname, Title1, title, dnameobj, objenv, ofile
Dim grp, memberList, member, userobj, message, comma, quote, report, rmessage
Dim isnew, path, newpath, oFolders, fso, wsfile, iflag, command, status
Dim mp1,mp2,major,minor,ver,message2,wshshell,key,key2,days, pwdays
dim pwseconds, ageskipM, changeM, noexpM
dim logfile, appendout
public cgroup

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

'* Possible Edits
'default number of days
days = 35
logfile = "c:\PWChange.csv"	'Name of log file. 
'* End Edits

Const ForAppend = 8

'Get current domain name for default domain
dname = objEnv("USERDOMAIN")	
comma = ","
quote = chr(34)

SysTest


'on error resume next
'delete old log
	if (fso.FileExists(logfile))then
			set oFile = fso.GetFile(logfile)
			oFile.Delete
	End If
		if err <> 0 then
			message = "Logfile " & quote & logfile & quote & " is open" & vbcrlf 
			message = message & "Please close the file before running this script."
			WshShell.Popup message,20,"File Open Error",vbCritical
			wscript.quit
		End If
on error goto 0

' Define dialog box variables.
message1 = "You will overwrite the logfile " & logfile & " if it exists." &vbCrLf & vbCrLf
Message1 = "Please enter NT 4.0 Domain Name"           
Title1 = "Domain Name"
'get domain name, vhasby default
dname = InputBox(Message1, Title1, dname, 100, 100)
If dname = "" Then    ' Canceled by the user
    WScript.quit
End If

Message1 = "Expire Passwords for members with last change greater than how many days?"
Title1 = "Number of days"
days = InputBox(Message1, Title1, days, 100, 100)
If days = "" Then    ' Canceled by the user
    WScript.quit
End If


Message1 = "Do you want to create a report only, without changing accounts?"           
Title1 = "Report Only"
report = MsgBox(Message1,260, Title1)
select case report
  Case 6 	
	report = TRUE
	status =  "Expected Result"
  Case 7	
	report = FALSE
	status = "Result"
End Select

ageskipM = "PW age less than "& days & " days,Skipped"
changeM = "Password set to expire,Changed"
noexpM = "Account set to not expire,Skipped"


'create header for log
set AppendOut = fso.OpenTextFile(logfile, ForAppend, True)
appendout.writeline "Group,Username,Fullname,Message,"& Status


on error goto 0
'Case counts here!
dnameobj = "WinNT://" & dname
on error goto 0 
'The heart of the matter

checkusr "Domain Admins"
checkusr "Administrators"

'Done.  open file with associated app, Excel if installed.
command = "cmd.exe /c start " & logfile  
WshShell.Run command
wscript.quit			'The end

sub checkusr(GName)
Cgroup = gname
on error resume next
Wscript.echo vbcrlf& "Proccessing members of " & Gname
If Report = TRUE then
	wscript.echo "Report only.  Accounts not changed." &vbcrlf
End If

Set grp = GetObject(dnameobj &"/"& Gname)
Set memberList = grp.members
For Each member In memberList
	call DoIT()
Next
on error goto 0
end sub

Sub DoIt()
Set UserObj = GetObject(dnameobj&"/"& member.name &",user")
message = cgroup & ","
message = message & UserObj.Name 
message	= message &	","	
message	= message & quote & UserObj.FullName & quote
message	= message &	","	
PWSeconds =userobj.Get("PasswordAge")
PWDays = round(((pwseconds/86400)),2)
message = message & "Password age: " & PWdays & ". "

'skip if pasword set to never expire	
IFlag=userobj.Get("UserFlags") 
If (IFlag AND &H10000) <> 0	Then 
	message	= message & noexpM
	echoandlog message	'write to log
	Exit Sub
End If


If clng(PWDays) < clng(Days) then
	message	= message &  ageskipM
	echoandlog message	'write to log
	Exit Sub
End If
		
'only change account if report not selected
If Report = False then
	UserObj.Put "PasswordExpired",	1
	UserObj.SetInfo
End If
	
if err <> 0	then
	message	= message & "Error processing account. " & err.number & " "  & err.message
		Else
	message	= message & changeM
	echoandlog message	'write to log
End If

End Sub


Function IsCScript()
    ' Check whether CScript.exe is the host.
    If (InStr(UCase(WScript.FullName), "CSCRIPT") <> 0) Then
        IsCScript = True
    Else
        IsCScript = False
    End If
End Function



Sub SysTest()
' WSH version tested
Major = (ScriptEngineMinorVersion())
Minor = (ScriptEngineMinorVersion())/10
Ver = major + minor
'Need version 5.5
	If ver < 5.5 then
	message2 = "Please load Windows Script Host Version 5.5"
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
  	message2 = Message2 & "ADSI must be installed on local workstation to continue" & vbCrLf
WshShell.Popup message2,0,"Workstation Setup Error",vbInformation
	WScript.Quit
	End if
	
If (Not IsCScript()) Then
    message = "You must set default host for WSH to CScript." &vbcrlf &_
	"Use the command wscript //h:cscript"	'popup 
	WshShell.Popup message,20,"Workstation Setup Error",vbCritical
    WScript.Quit            ' Terminate script.
End If

	
End Sub 


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