'#==============================================================================
'#==============================================================================
'#  SCRIPT.........:	CheckPasswords.vbs
'#  AUTHOR.........:	Stuart Barrett
'#  VERSION........:	1.0
'#  CREATED........:	18/05/11
'#  LICENSE........:	Freeware
'#  REQUIREMENTS...:
'#
'#  DESCRIPTION....:	Check all AD accounts on a set password.
'#
'#  NOTES..........:	This utility will test the password of each user within
'#						your organisation, to do this it will use a live login
'#						attempt, therefore there is a possibility that it could
'#						lock out some accounts by mistake.
'#
'#  CUSTOMIZE......:
'#==============================================================================
'#  REVISED BY.....:
'#  EMAIL..........:
'#  REVISION DATE..:
'#  REVISION NOTES.:
'#
'#==============================================================================
'#==============================================================================

On Error Resume Next

Const ADS_SECURE_AUTHENTICATION = &h0001
Const ADS_CHASE_REFERRALS_ALWAYS = &h60

Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")

'strTemp = objShell.ExpandEnvironmentStrings("%TEMP%")
strTemp = "c:\temp"

strPass = "12345678"
advanced=1

If strPass = "" Then WScript.Quit

Set objNetwork = CreateObject("WScript.Network")
strDomain = objNetwork.UserDomain

Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")

Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider=ADsDSOObject;"

Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection

Set objCommand.ActiveConnection = objConnection
strBase = "<LDAP://" & strDNSDomain & ">"

strFilter = "(&(objectclass=user)(objectcategory=person))"
strAttributes = "distinguishedName,sAMAccountName,displayName"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"

objCommand.CommandText = strQuery
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 30
objCommand.Properties("Cache Results") = False

Set objRecordset = objCommand.Execute

If (objRecordset.EOF = True) Then
	MsgBox "Error", vbExclamation, "Password Checker"
	WSxript.Quit
End If

strPath = "LDAP://" & strDomain & "/" & strDNSDomain
Set objDSO = GetObject("LDAP:")

Set objFile = objFSO.CreateTextFile(strTemp & "\PasswordCheck.csv", True)

If Err.Number <> 0 Then
	MsgBox "There was an error accessing the " & strTemp & "\PasswordCheck.csv file." & _
		vbCrLf & vbCrLf & "Please make sure you do not already have it open and then try again.", _
		vbExclamation, "Password Check"
	WScript.Quit
End If

objFile.WriteLine strType & "Password Check"
objFile.WriteLine ""

WScript.Echo strPass
WScript.Echo "Username,Display Name,Password,ACCOUNTDISABLE"

Do Until objRecordSet.EOF
	strUser = objRecordSet.Fields("sAMAccountName").Value
	strName = objRecordSet.Fields("displayName").Value

	strName = Replace(strName, ",", "")

	Set objUser = objDSO.OpenDSObject (strPath, strUser, strPass, ADS_SECURE_AUTHENTICATION OR ADS_CHASE_REFERRALS_ALWAYS)

	If Err.Number <> 0 Then
		strUser = Replace(strUser, ",", "")
		strCSV = strCSV & strUser & "," & strName & ",N/A" & vbCrLf
		Else
			if advanced=1 then
				WScript.Echo "======================"
				Set objUser = GetObject("LDAP://"& objRecordSet.Fields("distinguishedname").value)
				WScript.Echo "There are " & objRecordSet.PropertyCount & " properties"

				strStatus =	objUser.objectClass		'do not remove for properties
				intUAC = objUser.Get("userAccountControl")
				If intUAC AND 2 then
					strStatus = "Disabled"
				else
					strStatus = "Enabled"
				End If
				'WScript.Echo "There are " & objUser.PropertyCount & " properties"
				'--------------------
				sAttribList=""
				'Iterate through available user attributes
				For count = 0 to (objUser.PropertyCount-1)
					sAttribName = objUser.Item(CInt(count)).Name
					sAttribVal = objUser.Get(sAttribName)

					If IsArray(sAttribVal) Then
						For Each sMultiVal in objUser.GetEx(sAttribName)
							sAttribList = sAttribList & sAttribName & Space(16-Len(sAttribName)) & ":: " & sMultiVal & vbCRLF
						Next
					Else
						sAttribList = sAttribList & sAttribName & Space(16-Len(sAttribName)) & ":  " & sAttribVal & vbCRLF
					End If
				Next

				'WScript.Echo sAttribList
			end if	'advanced
			'---------------
			i = i + 1
			strUser = Replace(strUser, ",", "")
			strCSV = strCSV & strUser & "," & strName & "," & strPass & vbCrLf
			if strStatus = "Enabled" or 1 then
				WScript.Echo strUser & "," & strName & "," & strPass & "," & strStatus
			End if
	End If
	Err.Clear

	objRecordSet.MoveNext
Loop

objFile.WriteLine "Total Users Using '" & strPass & "': " & i
objFile.WriteLine ""
objFile.WriteLine "Username,Display Name,Password"
objFile.WriteLine strCSV

objFile.Close
Set objFile = Nothing

'MsgBox "Password checking complete, the resulting file has been saved to " & strTemp & _
'	"\PasswordCheck.csv", vbInformation, "Password Check"

'objShell.Run strTemp & "\PasswordCheck.csv"