Wednesday, February 25, 2009

VBscript to Find Users in Active Directory with Dial-In VPN Access Permissions

As a systems administrator, it is not a good feeling when the boss comes to you and says "I need to know every user that has remote access." That is, if you can't get it for him. The script below will audit Active Directory to find users that have the dial-in access permissions enabled. The script will search the current Active Directory domain for users with Dial-In (VPN) RRAS permissions enabled.

To begin with the script opens a connection to the directory for the currently logged in user. Once connected, the script loops through the user accounts in the directory and queries each one to find out if the "msNPAllowDialin" has a value of True. If the script finds a user that meets the requirements, a function is called to find the container of the user object. This function will return the full path of the user object as such:
Because the output is for a CSV file, there are single quotes around the full path so, when the file is opened with Excel it doesn't see the commas in the container path as delimeters. The user's full name and the container path are written out to a CSV file in the same directory as the script in the format:
First Last, 'OU=sales,DC=fabrikam,DC=com'

Option Explicit
On Error Resume Next


Dim objConnection, objCommand, objRootDSE
Dim objRecordSet, ou
Dim namingContext, fso, outFile

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

objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"

Set objCommand.ActiveConnection = objConnection
Set objRootDSE = getobject("LDAP://RootDSE")

namingContext = objRootDSE.Get("defaultNamingContext")

Set objRootDSE = nothing
Set fso = CreateObject("Scripting.FileSystemObject")
Set outFile = fso.CreateTextFile("RRAS_VPN_Users.txt", True)

objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.CommandText = _ "SELECT Name FROM 'LDAP://" & namingContext & WHERE objectCategory='user' " & "AND msNPAllowDialin = TRUE"

Set objRecordSet = objCommand.Execute


Do Until objRecordSet.EOF
ou = getOUByUserName(objRecordSet.Fields("Name").Value)
outFile.WriteLine(objRecordSet.Fields("Name").Value & ",'" & ou & "'")


WScript.Echo "Complete"

function getOUByUserName(byval UserName)
DIM namingContext, ldapFilter, ou
DIM cn, cmd, rs
DIM objRootDSE

Set objRootDSE = getobject("LDAP://RootDSE")
namingContext = objRootDSE.Get("defaultNamingContext")

Set objRootDSE = nothing ldapFilter = ";(&(objectCategory=User)(name=" & userName & "))" & ";distinguishedName;subtree"
Set cn = createobject("ADODB.Connection")
Set cmd = createobject("ADODB.Command") "Provider=ADsDSOObject;"
cmd.activeconnection = cn
cmd.commandtext = ldapFilter

Set rs = cmd.execute

if rs.eof <> true and rs.bof <> true then
ou = rs(0)
ou = mid(ou,instr(ou,",")+1,len(ou)-instr(ou,","))
getOUByuserName = ou
end if


end function

No comments: