User Accounts

'This code was lifted entirely from Hunter Coleman [hcoleman@state.mt.us]
'This was posted to the Activedir.org list on 12/18/03
'I have not modified it, except to fix the wrapped/broken lines.

'This code does not list users who have been granted Dialin/VPN access through RAS Policies or RADIUS Policies

Option Explicit

Const adStateOpen = 1

Dim agencyOU
Dim RootDSE
Dim SearchRoot
Dim ldapPath
Dim adoConnection
Dim adoRecordset
Dim thisDate
Dim userADsPath
Dim objUser
Dim dialInEnabled
Dim objRecordSet
Dim fileSys
Dim fileName
Dim fileTxt
Dim j

Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const adVarChar = 200 'specifies a string type data


'Create the disconnected recordset
Set objRecordset = CreateObject("ADODB.Recordset")
objRecordset.Fields.Append "UserName", adVarChar, 50
objRecordset.Fields.Append "ACF2ID", adVarChar, 10
objRecordset.Fields.Append "DialInState", adVarChar, 50
objRecordset.Open

Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADSDSOObject"
adoConnection.Open "", "", ""


agencyOU = InputBox ("Enter the Agency's root OU")

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

ldapPath = "ou=" & agencyOU & "," & searchRoot
'On Error Resume Next
Set adoRecordset = adoConnection.Execute _
        ("<LDAP://" & ldapPath & ">;(objectClass=User);" _
        & "Name,ADsPath,sAMAccountName;SubTree")


'Set up the text file for output
thisDate = FormatDateTime(Now(), 1)
thisDate = split(thisDate, ", ")
fileName = thisDate(0) & thisDate(1) & ".txt"
'Wscript.Echo fileName
set fileSys = CreateObject("Scripting.FileSystemObject")
Set fileTxt = fileSys.OpenTextFile(fileName, ForAppending, True)
fileTxt.WriteLine(vbCrLf & "***********************************************************")
fileTxt.WriteLine(formatdatetime(now(),2))
fileTxt.WriteLine(ldapPath)
fileTxt.WriteLine(vbCrLf)

'Loop through all of the user objects, and print out those who are able to dial in or VPN
While Not adoRecordset.EOF     
        userADsPath = adoRecordset.Fields.Item("ADsPath").Value
        set objUser = GetObject(userADsPath)
                dialInEnabled = objUser.msNPAllowDialin
                If (dialInEnabled = True) then
                        objRecordset.AddNew
                        objRecordSet("UserName") = adoRecordset.Fields.Item("Name").Value
                        objRecordSet("ACF2ID") = adoRecordset.Fields.Item("SAMAccountName").Value
                        objRecordSet("DialInState") = dialInEnabled
                        objRecordSet.Update
                       
                End If
        adoRecordset.MoveNext
Wend

adoConnection.Close
Set adoRecordset = Nothing

'-----------Output Attempt from the disconnected ADORecordset-------------------

objRecordSet.MoveFirst
'sort it by user name
objRecordSet.Sort="UserName ASC"
While Not objRecordSet.EOF
        fileTxt.WriteLine(objRecordSet.Fields.Item("UserName") & VBTab & "(" & objRecordSet.Fields.Item("ACF2ID") & ")" & VBTab & "Remote Access Permission = " & objRecordSet.Fields.Item("DialInState"))
        objRecordSet.MoveNext
Wend
fileTxt.WriteLine(vbCrLf)
j = objRecordSet.RecordCount
fileTxt.WriteLine("Total number of dial-in enabled users is " & j)
objRecordSet.Close
set objRecordSet = Nothing

Wscript.Echo "Script finished"