' Abridged original remarks from Ralph Mongtomery
' Get User Information NTUser.wsf
' Version 1.0 Created 11-26-2001 by Ralph Montgomery (rmonty@myself.com)

' Alan Kaplan remarks
' 3/23/2009  I have been using this script for a very long time, and have probably hacked
' it beyond recognition.  I take neither the credit nor the blame for the clumsy bits...
' I stripped out Win9x stuff, and system info detection, as everyone I know 
' using this is at XP or later.

'10/23/2009 added support for and enumeration of UPN 

Option Explicit
Dim strUserName, objUserDomain, objGroup, objUser, strGroupList
Dim WshShell, strMessage, strTitle
Dim oDomain, strNTDomain, strVer
Dim  strSortedGroups, arrGroupList, strUserList
Dim objChangePwdTrue, objChangePwd, objUserProfile
Dim objPwdExpiresTrue, objFlags, oPwdExpire, strPwdExpires
Dim objAcctDisabled, intPwdExpired, objPwdExpiredTrue, objPwdExpires,bAccountDisabled
Dim StrQuote, iBadLogins, iMaxPadPw, iAccountLockout, iPwdAge
Set WshShell = WScript.CreateObject("WScript.Shell")
strVer = "Ver 3.1 "
strQuote = Chr(34)
Dim strNTName, strUPN
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1
Const ADS_NAME_TYPE_USER_PRINCIPAL_NAME = 9
Dim strNTUserName
Const ADS_NAME_INITTYPE_DOMAIN = 1
Const ADS_NAME_TYPE_UNKNOWN = 8
Const ADS_NAME_TYPE_CANONICAL = 2

Dim oTrans
Set oTrans = CreateObject("NameTranslate")

' Pull Environment variables for domain/user
strNTDomain = WshShell.ExpandEnvironmentStrings("%USERDOMAIN%")
strNTUserName = ucase(WshShell.ExpandEnvironmentStrings("%USERNAME%"))

GetInfo
Main 

' ======== Functions and Subs ==========
Sub GetInfo() 
	If WScript.arguments.Count = 1 Then 
	strUserName = WScript.Arguments(0)
	Else
		strUserName = InputBox("Get information on what user account?  (Enter NT Name or UPN)","Account Name",strNTDomain & "\" & strNTUserName)
	End If 
	If strUserName = "" Then WScript.Quit
	
	If InStr(strUserName,"@") Then 
		strUPN = strUserName
		strUserName = GetNTPath(strUserName)
	End If 
	
	strUserName = Replace(strUserName,"/","\")
	If InStr(strUserName,"\") Then  
		Dim tArray
		tArray = Split(strUserName,"\")
		strNTDomain = tArray(0)
		strNTUserName = tArray(1)
	Else
		strNTUserName = strUserName
	End If
		
	If Len(strUPN) = 0 Then strUPN = GetUPN(strNTDomain & "\" & strNTUserName)

	'Attempt to bind to the user
	Set objUser = GetObject("WinNT://"& strNTDomain & "/" & strNTUserName & ", user")
	
	If Err <> 0 Then
	' Lets see if anyone matches strNTUserName first 4 characters...
	Set objFindUser = GetObject("WinNT://"& strNTDomain)
	strNTUserName = UCase(strNTUserName)	' has to be uppercase
		For Each User In objFindUser	'search thru the domain users list
			If Left(User.Name, 4) = Left(strNTUserName, 4) Then
				strUserList = strUserList & User.Name & vbTab & User.Fullname & vbCrLf
			End If
		Next
			' show list of matching users if any at all
			strMsgNoUser =  "Error: Could not find: " & vbCrLf _
				& VbCrLf & "WinNT://" & strNTDomain &"/"& strNTUserName & vbCrLf & vbCrLf
			strMsgNoUser = strMsgNoUser & "Perhaps you meant one of these: " & vbCrLf & vbCrLf & strUserList
			WshShell.Popup strMsgNoUser,0,"Error retrieving information",vbCritical
		
			' Evaluate the user input in case they want to quit
			If strNTUserName = "" Then    ' Cancelled by the user
			    WScript.quit
			End If
	strUserList = ""
	GetInfo
	End If 
End Sub

Sub Main()
	'Mostly RM.  AK added AdminBitCount, copy to IE
	Dim iAdminCount, dPwdLastChanged, iAutoUnlock
	On Error resume Next
	' Creates the list of goups the user belongs To
	For Each objGroup In objUser.Groups
		If strGroupList = "" Then
			strGroupList = objGroup.Name
		Else
			strGroupList = strGroupList & ", " & objGroup.Name
		End If
	Next
	' Convert strgrouplist to Array
	arrGroupList = Split(strGroupList,",")
	'Sort the durn thing
	Quicksort arrGroupList, LBound(arrGroupList), UBound(arrGroupList)
	' Now concatenate arrGroupList into a variable for display
	strSortedGroups = trim(Join(arrGroupList, ", "))
	
	'check for expired password
	intPwdExpired = objUser.Get("PasswordExpired")
	
		If intPwdExpired = 1 Then
			objPwdExpiredTrue = "Yes"
			Else objPwdExpiredTrue = "No"
		End If
		
	'Check for Must Change Password Flag
	objFlags = objUser.Get("UserFlags")
		If (objFlags And &H00040) <> 0 Then
			objChangePwdTrue = "No"
			Else objChangePwdTrue = "Yes"
		End If
	
	' Is password set to NEVER expire?
	objPwdExpires = objUser.Get("UserFlags")
	
		If (objPwdExpires And &H10000) <> 0 Then
			objPwdExpiresTrue = "Yes"
				strPwdExpires = "Date Set: "
			Else objPwdExpiresTrue = "No"
				strPwdExpires = "Password Expires: "
		End If
		
	' Is the account disabled?
		If objUser.AccountDisabled = True Then
			bAccountDisabled = "Yes"
			Else bAccountDisabled = "No"
		End If
		
	'How many wrong logins?
	'Dim iBadLogins
	iBadLogins = objUser.BadPasswordAttempts
	
	'Maximum bad password attempts?
	iMaxPadPw = objUser.MaxBadPasswordsAllowed	
	
	'Account Lockout Observation Interval
	iAccountLockout = FormatNumber((objUser.LockoutObservationInterval/60), 0)
	
	' How old is the current password?
	iPwdAge = FormatNumber(((objUser.Get("PasswordAge")/60)/60)/24, 0)
	
	' Calculate the date the password was last changed
	dPwdLastChanged = CStr(objUser.PasswordExpirationDate - objUser.Get("MaxPasswordAge") / (60 * 60 * 24))
	
	iAdminCount = objUser.Get("AdminCount")
	
	' Set Profile path to tabs if blank
	objUserProfile = objUser.Profile
		If objUserProfile = "" Then
			objUserProfile= "<None>" & vbTab 
			Else objUserProfile = objUserProfile
		End If
	
	' Determine how many passwords are saved
	Set oDomain = GetObject("WinNT://" & strNTDomain)
	
	Dim  intPwdHistory 
	intPwdHistory = oDomain.PasswordHistoryLength
	iAutoUnlock = oDomain.AutoUnlockInterval/60

	' Set strMessage box variables to null	
	strMessage =""
	
	'popup user information: each line broken up for better reading
	strMessage = "Full Name: " & objUser.FullName & vbCrLf &_
	"NT4Name: " & strNTDomain & "\"  & strNTUserName &  "  UPN: " & strUPN & vbcrlf 
	strMessage = strMessage &  "Description: " & objUser.Description & vbCrLf & vbCrLf
	
	strMessage = strMessage & "Account Locked Out: " & objUser.IsAccountLocked & _
	vbTab & "Account Disabled: " & bAccountDisabled & vbCrLf
	strMessage = strMessage &  "Bad Logins: " & iBadLogins & vbTab & vbTab & "~ Last logon: " & _
	objUser.LastLogin & vbCrLf
	strMessage = strMessage & "Max password attempts: " & iMaxPadPw & vbTab & "Attempts left: " & _
	iMaxPadPw - iBadLogins & vbCrLf & vbCrLf
	
	strMessage = strMessage & "Password Expired: " & objPwdExpiredTrue & vbTab & "Password Age: " & _
	iPwdAge & " days" & vbCrLf 
	strMessage = strMessage & "Password Last Changed: " & vbTab & dPwdLastChanged & vbCrLf
	strMessage = strMessage & "Password Never Expires: " & objPwdExpiresTrue & vbTab & strPwdExpires & _
	objUser.PasswordExpirationDate & vbCrLf  & vbCrLf
	
	strMessage = strMessage & "User can change Pwd: " & objChangePwdTrue & _
	vbTab & "Password Minimum Length: " & objUser.PasswordMinimumLength & vbCrLf
	strMessage = strMessage & "Passwords Kept In History: " & vbTab & intPwdHistory & " password(s)" & vbCrLf
	strMessage = strMessage & "Lockout Time: " & iAccountLockout & " minutes" & vbTab & "AutoUnlock: " & _
	iAutoUnlock & " minutes" & vbCrLf & vbCrLf
	
	strMessage = strMessage & "Login Script: " & objUser.LoginScript & vbcrlf & "Home Directory: " & _
	objUser.HomeDirectory & vbCrLf
	
	strMessage = strMessage & "AdminCount: " & vbTab & iAdminCount & vbcrlf
	strMessage = strMessage & "User Profile Path: " & objUserProfile 
	
	' Display User Information!
	Dim retval
	retval = msgbox(strMessage & VbCrLf & VbCrLf &"View Group information?", _
		vbYesNo + vbquestion, "User Information for: " & strNTUserName & " in " & strNTDomain)
	
	If retval = vbYes Then 
		MsgBox "User Groups: " & VbCrLf & VbCrLf & strSortedGroups,vbinformation + vbokonly,"Groups for " & strNTUserName
	End If 
	
	retval = msgbox("Copy User Information for: " & strNTUserName & " to clipboard via IE?",vbYesNo+ vbquestion, "Copy?" )
	
	If retval = vbYes Then 
		Dim objIE
		Set objIE = CreateObject("InternetExplorer.Application")
		objIE.Navigate("about:blank")		
		objIE.document.parentwindow.clipboardData.SetData "text", strMessage & VbCrLf & VbCrLf & "User Groups: " & VbCrLf & strSortedGroups
		objIE.Quit
	End If 	
End Sub 

' Sorts the items in the array (between the two values you pass in).
Sub Quicksort(strValues(), ByVal min, ByVal max)

	Dim strMediumValue, high, low, i

	'If the list has only 1 item, it's sorted.
	If min >= max Then Exit Sub

	' Pick a dividing item randomly.
	i = min + Int(Rnd(max - min + 1))
	strMediumValue = strValues(i)

	' Swap the dividing item to the front of the list.
	strValues(i) = strValues(min)

	' Separate the list into sublists.
	low = min
	high = max
	Do
		' Look down from high for a value < strMediumValue.
		Do While strValues(high) >= strMediumValue
			high = high - 1
			If high <= low Then Exit Do
		Loop

		If high <= low Then
			'The list is separated.
			strValues(low) = strMediumValue
			Exit Do
		End If

		'Swap the low and high strValues.
		strValues(low) = strValues(high)

		'Look up from low for a value >= strMediumValue.
		low = low + 1
		Do While strValues(low) < strMediumValue
			low = low + 1
			If low >= high Then Exit Do
		Loop

		If low >= high Then
			'The list is separated.
			low = high
			strValues(high) = strMediumValue
			Exit Do
		End If

		'Swap the low and high strValues.
		strValues(high) = strValues(low)
	Loop 'Loop until the list is separated.

	'Recursively sort the sublists.
	Quicksort strValues, min, low - 1
	Quicksort strValues, low + 1, max

End Sub

Function GetUPN (strNTName)
	On Error Resume Next 
	oTrans.Init ADS_NAME_INITTYPE_GC, ""
	oTrans.Set ADS_NAME_TYPE_UNKNOWN,strNTName
		If Err <> 0 Then 
		MsgBox "Unable to lookup " & strNTName,vbCritical + vbOKOnly,"Error"
		WScript.Quit
	End If 
	GetUPN = oTrans.Get(5)
End Function 

Function GetNTPath (strUPN)
	On Error Resume next
	oTrans.Init ADS_NAME_INITTYPE_GC, ""
	oTrans.Set ADS_NAME_TYPE_USER_PRINCIPAL_NAME,strUPN
	If Err <> 0 Then 
		MsgBox "Unable to lookup " & strUPN,vbCritical + vbOKOnly,"Error"
		WScript.Quit
	End If 
	
	GetNTPath  =  oTrans.Get(ADS_NAME_TYPE_NT4)
	GetNTPath = Replace(GetNTPath,"\","/")
End Function