Very slow finding a user in a Group AD VBS [duplicate] - vbscript

This question already has answers here:
Querying Active Directory using VBScript
(3 answers)
Closed 2 years ago.
when I try to find a user if is a member of a group it takes too long. Will it be possible to filter base DN for the LDAP search?
Here is the function.
' *****************************************************
'This function checks if the given AD user is a member of the given group.
Function IsMember(domainName,userName,groupName)
Set groupListD = CreateObject("Scripting.Dictionary")
groupListD.CompareMode = 1
ADSPath = domainName & "/" & userName
Set objUser = GetObject("WinNT://" & ADSPath & ",user")
For Each objGroup in objUser.Groups
groupListD.Add objGroup.Name, "-"
Next
IsMember = CBool(groupListD.Exists(groupName))
End Function
' *****************************************************
Thank you

You don't need to go through all groups once you have found the matching group, this should help:
Function IsMember(domainName, userName, groupName)
Dim sADSPath
Dim objUser
Dim objGroup
sADSPath = domainName & "/" & userName
Set objUser = GetObject("WinNT://" & sADSPath & ",user")
If objUser Is Nothing Then
IsMember = False
Exit Function
End If
For Each objGroup In objUser.Groups
If StrComp(objGroup.Name, groupName, vbTextCompare) = 0 Then
IsMember = True
Exit Function
End If
Next
IsMember = False
End Function
Also, there's no need to create and add group names to a Dictionary.

Related

Through LDAP unable to read members of the domain admin group from Windows Server 2012

Trying to read domain admin group members through VBScript, but unable to read. Throwing error on user server.
object not a collection
But it's working in my local test Windows Server 2012.
User Running it from member server. User is having domain admin rights.
How to check LDAP issue in server or is their anything else?
Option Explicit
'Get all member of a group INCLUDING members from ALL NESTED groups.
'Simply call the script with the samAccountName of the group.
'If the group name contains spaces it should be ENCLOSED IN QUOTES,
'IE scriptName.vbs "DOMAIN ADMINS"
Dim objGroup
'verify a group name was passed
If WScript.Arguments.Count <> 1 Then
WScript.Echo "NO GROUP PASSED"
WScript.Echo "Usage: scriptName <groupSamAccountName>"
WScript.Quit
End If
'bind to the gorup
Set objGroup = getGroup(WScript.Arguments(0))
'enumerate the groups members
enumMembers objGroup, ""
Function getGroup(strGroupName)
Dim objConn, objRecSet, strQueryString, objRootDSE, strQueryFrom
Const adsOpenStatic = 3
Set objRootDSE = GetObject("LDAP://RootDSE")
strQueryFrom = "LDAP://" & objRootDSE.Get("defaultNamingContext")
Set objConn = WScript.CreateObject("ADODB.Connection")
objConn.Provider = "ADsDSOObject"
objConn.Open
strQueryString = "SELECT AdsPath FROM '" & strQueryFrom & "' " & _
"WHERE samAccountName = '" & strGroupName & "'"
Set objRecSet = WScript.CreateObject("ADODB.Recordset")
objRecSet.Open strQueryString, objConn, adsOpenStatic
If objRecSet.RecordCount = 1 Then
Set getGroup = GetObject(objRecSet("AdsPath"))
Else
WScript.Echo UCase(strGroupName) & " was not found in the domain.(" & objRootDSE.Get("defaultNamingContext") & ")"
WScript.Quit
End If
End Function
Sub enumMembers(ByRef objGroup, strInheritedFrom)
Dim objMember
For Each objMember In objGroup.Members '<---throwing error by saying "object not a collection"
If LCase(objMember.class) = "group" Then
WScript.Echo objMember.SamAccountName
End If
Next
End Sub

How to retrieve All attributes of given user from given group in ActiveDirectory using VBScript?

Can anyone help me to get All Attributes of given user in given group from active-directory using Vb Script .
On Error Resume Next
Set objGroup = GetObject _
("LDAP://CN=Domain Admins,CN=Users,DC=IMTS,DC=TEST")
objGroup.GetInfo
arrMemberOf = objGroup.GetEx("member")
WScript.Echo "Members:"
For Each strMember in arrMemberOf
WScript.echo strMember.distinguishedName
Next
This is giving me only users in group but i want all attributes on given user
eg:
Account_Expires:
Account_Name_History:
CS_PolicyName:
Admin_Count:
Admin_Description:
Admin_DisplayName:
AllowedAttributes:
AllowedAttributesEffective:
Allowed_Child_Classes:
AllowedChildClassesEffective:
AltSecurityIdentities:
AttributeCertificateAttribute:
Audio:
Bad_Password_Time:
Bad_Pwd_Count:
Bridge_head_ServerListBL:
BusinessCategory:
C:
canonicalName:
carLicense:
co:
So on
Thanks
note: Sorry, I'm not in an environment where I could test it and all this answer is just a memory exercise. I hope it can help
You could try to query the LDAP schema for the User class
Set oSchema = GetObject("LDAP://schema/user")
Then, you can iterate over the MandatoryProperties and OptionalProperties collections storing the retrieved values to later check your users for these attributes
Set oAttributesList = WScript.CreateObject("Scripting.Dictionary")
For Each strAttribute In oSchema.MandatoryProperties
oAttributesList.Add strAttribute, ""
Next
For Each strAttribute In oSchema.OptionalProperties
oAttributesList.Add strAttribute, ""
Next
And once you have the full list, you could use GetEx to retrieve (as an array) the value of each of the attributes for each of the users
Set objGroup = GetObject _
("LDAP://CN=Domain Admins,CN=Users,DC=IMTS,DC=TEST")
objGroup.GetInfo
arrMemberOf = objGroup.GetEx("member")
WScript.Echo "Members:"
For Each strMember in arrMemberOf
Set oMember = GetObject("LDAP://" & strMember)
For Each strAttribute in oAttributesList.Keys
WScript.Echo strAttribute
aData = oMember.GetEx(strAttribute)
For i = 0 to UBound(aData)
WScript.Echo "....: " & aData(i)
Next
WScript.Echo ""
Next
Next

VBScript - Retrieving a user's nested groups and getting rid of repetitions

For my work, I have to write a script in VBScript that retrieves a list of ALL groups a user belongs to, including nested groups, and take out nested groups that would be repeated throughout the list (as well as indent nested groups, further indent nested groups of nested groups, etc.)
I found a script that fetches the entire list of groups a user belongs to by Monimoy Sanyal on gallery.technet.microsoft.com, and tried to adapt it to my needs. Here is the script as edited by me:
Option Explicit
Const ForReading = 1, ForWriting = 2, ForAppend = 8
Dim ObjUser, ObjRootDSE, ObjConn, ObjRS
Dim GroupCollection, ObjGroup
Dim StrUserName, StrDomName, StrSQL
Dim GroupsList
Dim WriteFile
GroupsList = ""
Set ObjRootDSE = GetObject("LDAP://RootDSE")
StrDomName = Trim(ObjRootDSE.Get("DefaultNamingContext"))
Set ObjRootDSE = Nothing
StrUserName = InputBox("Enter user login", "Info needed", "")
StrSQL = "Select ADsPath From 'LDAP://" & StrDomName & "' Where ObjectCategory = 'User' AND SAMAccountName = '" & StrUserName & "'"
Set ObjConn = CreateObject("ADODB.Connection")
ObjConn.Provider = "ADsDSOObject": ObjConn.Open "Active Directory Provider"
Set ObjRS = CreateObject("ADODB.Recordset")
ObjRS.Open StrSQL, ObjConn
If Not ObjRS.EOF Then
ObjRS.MoveLast: ObjRS.MoveFirst
Set ObjUser = GetObject (Trim(ObjRS.Fields("ADsPath").Value))
Set GroupCollection = ObjUser.Groups
WScript.Echo "Looking for groups " & StrUserName & " is member of. This may take some time..."
'Groups with direct membership, and calling recursive function for nested groups
For Each ObjGroup In GroupCollection
GroupsList = GroupsList + ObjGroup.CN + VbCrLf
CheckForNestedGroup ObjGroup
Next
Set ObjGroup = Nothing: Set GroupCollection = Nothing: Set ObjUser = Nothing
'Writing list in a file named Groups <username>.txt
Set WriteFile = WScript.CreateObject("WScript.Shell")
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile("Groups " & StrUserName & ".txt", ForWriting,true)
f.write(GroupsList)
f.Close
WScript.Echo "You can find the list in the Groups " &StrUserName & ".txt file that has just been created."
Else
WScript.Echo "Couldn't find user " & StrUserName & " in AD."
End If
ObjRS.Close: Set ObjRS = Nothing
ObjConn.Close: Set ObjConn = Nothing
'Recursive fucntion
Private Sub CheckForNestedGroup(ObjThisGroupNestingCheck)
On Error Resume Next
Dim AllMembersCollection, StrMember, StrADsPath, ObjThisIsNestedGroup
AllMembersCollection = ObjThisGroupNestingCheck.GetEx("MemberOf")
For Each StrMember in AllMembersCollection
StrADsPath = "LDAP://" & StrMember
Set ObjThisIsNestedGroup = GetObject(StrADsPath)
'Not include a group in the list if it is already in the list (does not work for some reason?)
If InStr(GroupsList, ObjThisIsNestedGroup.CN) = 0 Then
GroupsList = GroupsList + vbTab + ObjThisIsNestedGroup.CN + VbCrLf
End If
'Recursion to look for nested groups and nested groups of nested groups and nested groups of nested groups of nested groups and...
CheckForNestedGroup ObjThisIsNestedGroup
Next
Set ObjThisIsNestedGroup = Nothing: Set StrMember = Nothing: Set AllMembersCollection = Nothing
End Sub
Rather than display a popup for EACH group found like the original script did, I store the entire list in a String (GroupsList = GroupsList + ObjGroup.CN + VbCrLf for direct groups, GroupsList = GroupsList + vbTab + ObjThisIsNestedGroup.CN + VbCrLf for nested groups in the recursive function,) and once the script is done looking for groups, it saves the String in a file. (f.write(GroupsList))
My problem is, despite the If "InStr(GroupsList, ObjThisIsNestedGroup.CN) = 0 in the recursive function, I still find myself with tons of repetitions throughout the results (our AD is kind of bloated with groups, it is a huge structure with many nested groups and nested groups in other nested groups, etc.) and the check doesn't seem to notice that ObjThisIsNestedGroup.CN is already found in GroupsList.
And I have no idea how to implement the indentation properly.
Any ideas? I'm rather new at scripting, so forgive me if the answer is obvious.
Add the groups as keys to a Dictionary, so the list contains only unique names, and Join() the Keys array for output:
Set GroupsList = CreateObject("Scripting.Dictionary")
GroupsList.CompareMode = vbTextCompare 'make keys case-insensitive
...
GroupsList(ObjGroup.CN) = True
...
f.Write Join(GroupsList.Keys, vbNewLine)
I found the solution for both problems. Well, the first problem I'm not sure how I fixed since I only reverted the code after making a modification and then it was magically working.
For the increasing indentation, I declared a global variable named RecurCount that I increment every time I call the recursive procedure, and decrease after the procedure. Then, within the procedure, I added a For i = 0 to RecurCount that adds a varying number of vbTabs depending on RecurCount.
Here's the working procedure:
Private Sub CheckForNestedGroup(ObjThisGroupNestingCheck)
On Error Resume Next
Dim AllMembersCollection, StrMember, StrADsPath, ObjThisIsNestedGroup, TabAdd, i
AllMembersCollection = ObjThisGroupNestingCheck.GetEx("MemberOf")
For Each StrMember in AllMembersCollection
If StrMember <> "" Then
StrADsPath = "LDAP://" & StrMember
Set ObjThisIsNestedGroup = GetObject(StrADsPath)
'If InStr(GroupsList, ObjThisIsNestedGroup.CN) = 0 Then (Uncomment this If and indent lines below to remove groups already in the list)
TabAdd = ""
For i = 0 to Recurcount
TabAdd = TabAdd & vbTab
Next
GroupsList = GroupsList & TabAdd & " " & ObjThisIsNestedGroup.CN & VbCrLf
'End If
'Recursion to include nested groups of nested groups
Recurcount = Recurcount + 1
CheckForNestedGroup ObjThisIsNestedGroup
Recurcount = Recurcount - 1
End If
Next
Set ObjThisIsNestedGroup = Nothing: Set StrMember = Nothing: Set AllMembersCollection = Nothing
End Sub
Don't forget to Dim Recurcount in the main script, and to make it 0 right before calling CheckForNestedGroup for the first time.

Active Directory PSO fine grained passwords msDS-MaximumPasswordAge

Looking how to create a vbscript to pull the maximum number of days a PSO policy has set. It comes back as a value of ... and I do not know how to get the real value that was set.
This is what I have so far:
Option Explicit
Const ADS_UF_PASSWD_CANT_CHANGE = &H40
Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000
Dim strFilePath, objFSO, objFile, adoConnection, adoCommand, objCDOConf
Dim objRootDSE, strDNSDomain, strFilter, strQuery, adoRecordset, objMaxPwdAge
Dim strDN, objShell, lngBiasKey, lngBias, blnPwdExpire, strDept, strAdd
Dim objDate, dtmPwdLastSet, lngFlag, k, address, objAdd, objMessage
' Check for required arguments.
If (Wscript.Arguments.Count < 1) Then
Wscript.Echo "Arguments <FileName> required. For example:" & vbCrLf _
& "cscript PwdLastChanged.vbs c:\MyFolder\UserList.txt"
Wscript.Quit(0)
End If
strFilePath = Wscript.Arguments(0)
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Open the file for write access.
On Error Resume Next
Set objFile = objFSO.OpenTextFile(strFilePath, 2, True, 0)
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "File " & strFilePath & " cannot be opened"
Wscript.Quit(1)
End If
On Error GoTo 0
Set objShell = CreateObject("Wscript.Shell")
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
' Use ADO to search the domain for all users.
Set adoConnection = CreateObject("ADODB.Connection")
Set adoCommand = CreateObject("ADODB.Command")
adoConnection.Provider = "ADsDSOOBject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
' Determine the DNS domain from the RootDSE object.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("DefaultNamingContext")
' Filter to retrieve all user objects.
strFilter = "(&(objectClass=msDS-PasswordSettings))"
' Filter to retrieve all computer objects.
strQuery = "<LDAP://CN=PSO-Information Systems,CN=Password Settings Container,CN=System,DC=yrmc,DC=org>;" _
& ";cn,msDS-LockoutDuration,msDS-MaximumPasswordAge,msDS-
PasswordSettingsPrecedence;subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
Set adoRecordset = adoCommand.Execute
Do Until adoRecordset.EOF
objFile.WriteLine adoRecordset.Fields("cn").Value
adoRecordset.MoveNext
Loop
adoRecordset.Close
I can get a value for cn and even msDS-PasswordSettingsPrecedence but not for msDS-MaximumPasswordAge. Any help would be appreciated.
This is at best a partial answer but I did some searching and I believe you will need one or more of the following:
DSGet/DSQuery
LDIFDE to manage PSO's.
Quest's "Free PowerShell Commands for Active Directory"
Using Quest's free tools, you might find this link handy
Put square brackets around our Active Directory attribute name:
See the blog post "How can I retrieve the value of an active directory attribute that has a hyphen in its name" for more.
you have to find UsersPSO location in your AD like that
domainLookupString = ""CN=UsersPSO,CN=Password Settings Container,CN=System,DC=COMPAY,DC=ORG";
then run the ldap query
ldapFilterString = "(&(objectClass=msDS-PasswordSettings))";
at the end, get the ldap attribute with the Maximum Password Age of the current PSO policy
"msDS-MaximumPasswordAge"

Get SAMAccountNames for all users in AD group

I'm looking for a vbscript that will retrieve the SAMAccountNames for all members in a Active Directory Group.
Thanks.
Here is the script you are looking for :
' Begining from a given group
Dim strGrp
strGrp = "cn=g1,ou=ou,dc=societe,dc=fr"
Set objGroup = GetObject ("LDAP://"& strGrp)
objGroup.getInfo
arrMemberOf = objGroup.GetEx("member")
' Loop = For Each .... Next
' WScript.Echo "Members of Group "
For Each strMember in arrMemberOf
WScript.echo strMember
Set objUser = GetObject ("LDAP://"& strMember)
sAMAccountName = objUser.GetEx("sAMAccountName")
WScript.echo sAMAccountName(0)
Next
Wscript.Quit
Here is a site where you can get help.

Resources