VB Script to Unlock User

[BriceJones]

Hi Everyone,

I have a script that i'd like to use to unlock users, the problem is i need normal domain users to do this. I've created a security group and added the correct permissions but they still cannot do it, so i'd like to authicate through this script (automatically) so the domain users can just double click the VB script and away it goes. I cannot figure out how to do this to save my life. I did not write this script i found it on the internet, i've tested and know it DOES work when i am logged on as a domain admin. So all i need to do is embed the correct security credentails into this script. Here is the script:

Option Explicit

Dim objUser, objDomain, lngBias, objLockout, dtmLockout
Dim objDuration, lngDuration, lngHigh, lngLow, dtmUnLock
Dim strUserDN, strDNSDomain, strNetBIOSDomain, strUserNTName
Dim objTrans, objShell, lngBiasKey, k, objRootDSE
Dim strText, strTitle, intConstants, intAns

' Constants for the NameTranslate object.
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1

strTitle = "IsUserLocked"

Set objShell = CreateObject("Wscript.Shell")

' Request user sAMAccountName.
strUserNTName = Trim(InputBox("Enter User Name", "IsUserLocked"))
If (strUserNTName = "") Then
strText = "Program Aborted"
intConstants = vbOKOnly + vbExclamation
intAns = objShell.Popup(strText, , strTitle, intConstants)
Wscript.Quit
End If

' Retrieve DNS domain name.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")

' Convert DNS domain name to NetBIOS domain name.
Set objTrans = CreateObject("NameTranslate")
objTrans.Init ADS_NAME_INITTYPE_GC, ""
objTrans.Set ADS_NAME_TYPE_1779, strDNSDomain
strNetBIOSDomain = objTrans.Get(ADS_NAME_TYPE_NT4)
' Remove trailing backslash.
strNetBIOSDomain = Left(strNetBIOSDomain, Len(strNetBIOSDomain) - 1)

' Convert user NT name to Distinguished Name.
On Error Resume Next
objTrans.Set ADS_NAME_TYPE_NT4, strNetBIOSDomain & "\" & strUserNTName
If (Err.Number <> 0) Then
On Error GoTo 0
strText = "User " & strUserNTName & " not found"
strText = strText & vbCrLf & "Program aborted"
intConstants = vbOKOnly + vbCritical
intAns = objShell.Popup(strText, , strTitle, intConstants)
Wscript.Quit
End If
On Error GoTo 0
strUserDN = objTrans.Get(ADS_NAME_TYPE_1779)

' Escape any forward slash characters, "/", with the backslash
' escape character. All other characters that should be escaped are.
strUserDN = Replace(strUserDN, "/", "\/")

' Bind to user object.
On Error Resume Next
Set objUser = GetObject("LDAP://" & strUserDN)
If (Err.Number <> 0) Then
On Error GoTo 0
strText = "User " & strUserNTName & " not found"
strText = strText & vbCrLf & "DN: " & strUserDN
strText = strText & vbCrLf & "Program aborted"
intConstants = vbOKOnly + vbCritical
intAns = objShell.Popup(strText, , strTitle, intConstants)
Wscript.Quit
End If
On Error GoTo 0

' Bind to domain.
Set objDomain = GetObject("LDAP://" & strDNSDomain)

' Obtain local Time Zone bias from machine registry.
' This bias changes with Daylight Savings Time.
lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\" _
& "TimeZoneInformation\ActiveTimeBias")
If (UCase(TypeName(lngBiasKey)) = "LONG") Then
lngBias = lngBiasKey
ElseIf (UCase(TypeName(lngBiasKey)) = "VARIANT()") Then
lngBias = 0
For k = 0 To UBound(lngBiasKey)
lngBias = lngBias + (lngBiasKey(k) * 256^k)
Next
End If

' Retrieve user lockoutTime and convert to date.
On Error Resume Next
Set objLockout = objUser.lockoutTime
If (Err.Number <> 0) Then
On Error GoTo 0
strText = "User " & strUserNTName & " is not locked out"
intConstants = vbOKOnly + vbInformation
intAns = objShell.Popup(strText, , strTitle, intConstants)
Wscript.Quit
End If
On Error GoTo 0

dtmLockout = Integer8Date(objLockout, lngBias)
If (dtmLockout = #1/1/1601#) Then
strText = "User " & strUserNTName & " is not locked out"
intConstants = vbOKOnly + vbInformation
intAns = objShell.Popup(strText, , strTitle, intConstants)
Wscript.Quit
End If
strText = "User " & strUserNTName & " locked out at: " & dtmLockout

' Retrieve domain lockoutDuration policy.
Set objDuration = objDomain.lockoutDuration
lngHigh = objDuration.HighPart
lngLow = objDuration.LowPart
If (lngLow < 0) Then
lngHigh = lngHigh + 1
End If
lngDuration = lngHigh * (2^32) + lngLow
lngDuration = -lngDuration/(60 * 10000000)
strText = strText & vbCrLf & "Domain lockout duration (minutes): " _
& lngDuration

' Determine if account still locked out.
dtmUnLock = DateAdd("n", lngDuration, dtmLockout)
If (Now() > dtmUnLock) Then
strText = strText & vbCrLf & "The account was unlocked at: " _
& dtmUnLock
intConstants = vbOKOnly + vbInformation
intAns = objShell.Popup(strText, , strTitle, intConstants)
Wscript.Quit
Else
strText = strText & vbCrLf & "Account will unlock at: " & dtmUnLock
strText = strText & vbCrLf & "Click ""Yes"" to unlock account now"
strText = strText & vbCrLf & "Click ""No"" to leave account locked"
intConstants = vbYesNo + vbExclamation
intAns = objShell.Popup(strText, , strTitle, intConstants)
If (intAns = vbYes) Then
On Error Resume Next
objUser.IsAccountLocked = False
objUser.SetInfo
If (Err.Number <> 0) Then
On Error GoTo 0
strText = "Unable to unlock user " & strUserNTName
strText = "You may not have sufficient rights"
strText = "Program aborted"
intConstants = vbOKOnly + vbCritical
intAns = objShell.Popup(strText, , strTitle, intConstants)
Else
On Error GoTo 0
strText = "User " & strUserNTName & " unlocked"
intConstants = vbOKOnly + vbExclamation
intAns = objShell.Popup(strText, , strTitle, intConstants)
End If
ElseIf (intAns = vbNo) Then
strText = "User " & strUserNTName & " account left locked out"
intConstants = vbOKOnly + vbInformation
intAns = objShell.Popup(strText, , strTitle, intConstants)
Else
strText = "Program aborted"
strText = strText & vbCrLf & "User " & strUserNTName _
& " still locked out"
intConstants = vbOKOnly + vbExclamation
intAns = objShell.Popup(strText, , strTitle, intConstants)
End If
End If

Function Integer8Date(ByVal objDate, ByVal lngBias)
' Function to convert Integer8 (64-bit) value to a date, adjusted for
' local time zone bias.
Dim lngAdjust, lngDate, lngHigh, lngLow
lngAdjust = lngBias
lngHigh = objDate.HighPart
lngLow = objdate.LowPart
' Account for error in IADsLargeInteger property methods.
If (lngLow < 0) Then
lngHigh = lngHigh + 1
End If
If (lngHigh = 0) And (lngLow = 0) Then
lngAdjust = 0
End If
lngDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) _
+ lngLow) / 600000000 - lngAdjust) / 1440
' Trap error if lngDate is ridiculously huge.
On Error Resume Next
Integer8Date = CDate(lngDate)
If (Err.Number <> 0) Then
On Error GoTo 0
Integer8Date = #1/1/1601#
End If
On Error GoTo 0
End Function

[BriceJones]

Has anyone had a chance to look at this? i'm completely stumped on how to authincate to the a domain through that script. This is another script that does the same thing as the first but shorter, maybe easier to work with.

username=inputbox("Enter username:")
if username = "" then wscript.quit

ldapPath = FindUser(username)

if ldapPath = "Not Found" then
	wscript.echo "User not found!"
else
	set objUser = getobject(ldapPath)
	if isAccountLocked(objUser) then
		objuser.put "lockoutTime", 0
		objUser.setinfo
		wscript.echo "Account Unlocked"
	else
		wscript.echo "This account is not locked out"
	end if
end if


Function FindUser(Byval UserName) 
	on error resume next

	set objRoot = getobject("LDAP://RootDSE")
	domainName = objRoot.get("defaultNamingContext")
	set cn = createobject("ADODB.Connection")
	set cmd = createobject("ADODB.Command")
	set rs = createobject("ADODB.Recordset")

	cn.open "Provider=ADsDSOObject;"
	
	cmd.activeconnection=cn
	cmd.commandtext="SELECT ADsPath FROM 'LDAP://" & domainName & _
			"' WHERE sAMAccountName = '" & UserName & "'"
	
	set rs = cmd.execute

	if err<>0 then
		wscript.echo "Error connecting to Active Directory Database:" & err.description
		wscript.quit
	else
		if not rs.BOF and not rs.EOF then
     			rs.MoveFirst
     			FindUser = rs(0)
		else
			FindUser = "Not Found"
		end if
	end if
	cn.close
end function

Function IsAccountLocked(byval objUser)
    	on error resume next
	set objLockout = objUser.get("lockouttime")

	if err.number = -2147463155 then
		isAccountLocked = False
		exit Function
	end if
	on error goto 0
	
	if objLockout.lowpart = 0 And objLockout.highpart = 0 Then
		isAccountLocked = False
	Else
		isAccountLocked = True
	End If

End Function