Avatar of SynsealIT
 asked on

VBScript created user does not appear when querying groups using VBScript

Hi all,

I have been working very hard to automate user and computer creation and configuration, and I am just about there.

As Part of the process I have written a HTA for creating new users, and at face value it seems to work perfectly.

Here is the code for the function that creates the user.


Function addUser()
            Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
            Const CHANGE_PASSWORD_GUID = "{ab721a53-1e2f-11d0-9819-00aa0040529b}"
            Const ADS_RIGHT_DS_CONTROL_ACCESS = &H100
            ExHome = "/o=Exchange/ou=First Administrative Group/cn=Configuration/cn=Servers/cn=SERVERNAME"
            MDB = "CN=Mailbox Store (SERVERNAME),CN=First Storage Group,CN=InformationStore,CN=SERVERNAME,CN=Servers,"& _
                  "CN=First Administrative Group,CN=Administrative Groups,CN=Exchange,CN=Microsoft Exchange,CN=Services,CN=Configuration,DC=Domain,DC=com"
            Dim phngroup()
            Dim secgroup()
            Dim disgroup()
            'collect the new users details from the form, and place them in variables to be worked with.
            FirstName = document.frmNewUser.FirstName.value
            LastName = document.frmNewUser.LastName.value
            Mail = document.frmNewUser.Mail.value
            Pass = document.frmNewUser.Pass.value
            PassCheck = document.frmNewUser.PassCheck.value
            Department = document.frmNewUser.Deparment.value
            Office = document.frmNewUser.Office.value
            Phone = document.frmNewUser.Phone.value
            Mobile = document.frmNewUser.Mobile.value
            Manager = document.frmNewUser.SelManager.value
            ldapPath = document.frmNewUser.SelOU.value
            'begin creating the new user.
            If Pass <> PassCheck then
                  msgbox "the passwords do not match"
                  exit function
                  'configure the username and email address
                  UserName = FirstName & "." & LastName
                  FullName = FirstName & " " & LastName
                  MailAddress = UserName & "@synseal.com"
            End If
            ldapPath = "OU=Users," & ldapPath
            Set objOU = GetObject("LDAP://" & ldapPath)
            Set objUser = objOU.Create("User", "cn=" & FullName)
            objUser.Put "sAMAccountName", UserName
            objUser.Put "displayName", FullName
            objUser.Put "givenName", FirstName
            objUser.Put "mailNickname", FullName
            objUser.Put "name", FullName
            objUser.Put "sn", LastName
            objUser.Put "userPrincipalName", UserName
            If Mobile > "" then
                  objUser.Put "mobile", Mobile
            End If
            If Phone > "" then
                  objUser.Put "telephoneNumber", Phone
            End If
            If Manager > "" then
                  objUser.Put "manager", Manager
            End If
            objUser.Put "scriptPath", "LogonScript.vbs"
            objUser.Put "homeDirectory", "\\server\Users\" & UserName
            objUser.Put "homeDrive", "L:"
            objUser.Put "company", "My company Ltd"
            objUser.Put "department", Department
            objUser.Put "description", Department
            objUser.Put "physicalDeliveryOfficeName", Office
            objUser.SetPassword Pass
            objUser.AccountDisabled = FALSE
            UserPath = "cn=" & FullName & "," & ldapPath
            if Mail = "on" then
                  objUser.Put "msExchHomeServerName", ExHome
                  objUser.Put "mail", MailAddress
                  objUser.Put "mailnickname", UserName
                  objUser.put "mDBUseDefaults", TRUE
                  objUser.Put "homeMDB", MDB
            end if
            'create user folder and add security
            Set objFSO = CreateObject("Scripting.FileSystemObject")
            If objFSO.FolderExists("\\server\Users\" & UserName) = False Then
                  objFSO.CreateFolder("\\server\Users\" & UserName)
            End If
            aclupdate "\\server\Users\" & UserName,"DOMAIN\" & UserName
            If Manager <> "" then
                  Set objManager = GetObject("LDAP://" & Manager)
                  manname = objManager.Get("sAMAccountName")

                  aclupdate "\\server\Users\" & UserName,"SYNSEAL\" & manname
            End if
            'prevent password from expiering
            intUAC = objUser.Get("userAccountControl")
            objUser.Put "userAccountControl", intUAC XOR ADS_UF_DONT_EXPIRE_PASSWD
            'prevent user from changing password
            Set objSD = objUser.Get("ntSecurityDescriptor")
            Set objDACL = objSD.DiscretionaryAcl
            arrTrustees = array("nt authority\self", "EVERYONE")
            For Each strTrustee in arrTrustees
                   Set objACE = CreateObject("AccessControlEntry")
                objACE.Trustee = strTrustee
                  objACE.AceFlags = 0
                  objACE.AceType = ADS_ACETYPE_ACCESS_DENIED_OBJECT
                  objACE.Flags = ADS_ACEFLAG_OBJECT_TYPE_PRESENT
                  objACE.ObjectType = CHANGE_PASSWORD_GUID
                  objACE.AccessMask = ADS_RIGHT_DS_CONTROL_ACCESS
                  objDACL.AddAce objACE
            objSD.DiscretionaryAcl = objDACL
            objUser.Put "nTSecurityDescriptor", objSD
            objUser. SetInfo
            count = 0
            for each value in document.frmNewUser.PhoneGroups
                  document.frmNewUser.PhoneGroups.selectedIndex = count
                  ReDim Preserve phngroup(count)
                  phngroup(count) = document.frmNewUser.PhoneGroups.value
                  Set objGroup = GetObject("LDAP://cn=phn_" & phngroup(count) & ",ou=GroupsPhone,ou=AdministrativeOU,dc=domain,dc=com")
                  count = count +1
            count2 = 0
            for each value in document.frmNewUser.SecurityGroups
                  document.frmNewUser.SecurityGroups.selectedIndex = count2
                  ReDim Preserve secgroup(count2)
                  secgroup(count2) = document.frmNewUser.SecurityGroups.value
                  Set objGroup = GetObject("LDAP://cn=" & secgroup(count2) & ",ou=GroupsAccess,ou=AdministrativeOU,dc=domain,dc=com")
                  count2 = count2 +1
            count3 = 0
            for each value in document.frmNewUser.DistributionGroups
                  document.frmNewUser.DistributionGroups.selectedIndex = count3
                  ReDim Preserve disgroup(count3)
                  disgroup(count3) = document.frmNewUser.DistributionGroups.value
                  Set objGroup = GetObject("LDAP://cn=" & disgroup(count3) & ",ou=GroupsDistribution,ou=AdministrativeOU,dc=domain,dc=com")
                  count3 = count3 +1

      End Function
      Function aclupdate(folder,user)

             Set sec = CreateObject("ADsSecurity")
             Set sd = sec.GetSecurityDescriptor("FILE://" & folder)
             Set dacl = sd.DiscretionaryAcl
             Set ace = CreateObject("AccessControlEntry")
             ace.trustee = user
             ace.AccessMask = 2032127
             ace.AceType = 0
             ace.AceFlags = 3
             dacl.AddAce ace
             sd.DiscretionaryAcl = dacl
             sec.SetSecurityDescriptor sd
      End Function


This all seems to work very well, and if I compare a user created with this script to a user created with AD they are the same. They are also the same if I check them with ADSIEdit.

The problem is, that I have another HTA that the users view through outlook, which lists and searches for users their phone numbers and email addresses etc. Here is the query it uses.


Function members(group)
            'query the group that has been passed to the function, and place the
            'members in an array
            group = replace(group,"#"," ")
            Set objGroup = GetObject("LDAP://" & group)
            arrMemberOf = objGroup.GetEx("member")
            'create disconected recordset to hold the details of the array,
            'this is only done so we can properly sort the date in to alphanumeric order.
            Const adVarChar = 200
            Const MaxCharacters = 255
            Set DataList = CreateObject("ADOR.recordset")
            DataList.Fields.Append "UserName", adVarChar, MaxCharacters
            DataList.Fields.Append "Phone", adVarChar, MaxCharacters
            DataList.Fields.Append "Mobile", adVarChar, MaxCharacters
            DataList.Fields.Append "Mail", adVarChar, MaxCharacters
            DataList.Fields.Append "Office", adVarChar, MaxCharacters
            DataList.Fields.Append "SubDep", adVarChar, MaxCharacters
            'begin drawing the table to be placed on the lyrBody division
            strHTML = ""
            strHTML =  "<table border=2 bordercolor='#C0C0C0' cellspacing='0' bordercolorlight='#D8DAE2' bordercolordark='#C0C0C0' style='font-family: Century Gothic; font-size: 10pt; color: #000000'><tr><td><b>Name</b></td><td><b>Phone</b></td><td><b>Mobile</b>" & _
            'loop through the array containing the list of users, and return the users details to variables
            For Each strMember in arrMemberOf
                  Set objUser = GetObject("LDAP://" & strMember)
                  If intUAC = 66048 Then
                        UserName = objUser.cn
                        If len(UserName) = 0 then UserName = "&nbsp;"
                        Phone = objUser.telephoneNumber
                        If len(Phone) = 0 then Phone = "&nbsp;"
                        Mobile = objUser.mobile
                        If len(Mobile) = 0 then Mobile = "&nbsp;"
                        Mail = objuser.mail
                        If len(Mail) = 0 then Mail = "&nbsp;"
                        Office = objUser.physicalDeliveryOfficeName
                        If len(Office) = 0 then Office = "&nbsp;"
                        SubDep = objUser.department
                        If len(SubDep) = 0 then SubDep = "&nbsp;"
                        DataList("UserName") = UserName
                        DataList("Phone") = Phone
                        DataList("Mobile") = Mobile
                        DataList("Mail") = Mail
                        DataList("Office") = Office
                        DataList("SubDep") = SubDep
                        End If
            'loop back and do the next user            
            DataList.Sort = "UserName"
            bgcolour = "#C0C0C0"
            Do until DataList.EOF
                  'append the users details the table
                  strHTML = strHTML + "<tr bgcolor='" & bgcolour & "'><td>" & DataList("UserName") & "</td><td>" & DataList("Phone") & "</td><td>" & DataList("Mobile") & _
                              "</td><td><a href='mailto:" & DataList("Mail") & "'>" & DataList("Mail") & "</td><td>" & DataList("Office") & "</td><td>" & DataList("SubDep") & "</td></tr>"
                        If bgcolour = "#C0C0C0" then
                              bgcolour = "#EBECF0"
                              bgcolour = "#C0C0C0"
                        End If
                        'write out the table to the devision lyrBody
                        strHTML = strHTML + "</table>"
                        lyrBody.innerHTML = strHTML
                  End Function


Again this works perfectly, however it will not list any user created by the user creation script. If I look in AD User and Computers, the user is in the correct group, but the user is not listed by the script when I list the members of that group.

As you can probably tell, I am no stranger to scripting, but this has me stumped. Can anyone shed any light on this? Oh and I will not except any answers that involve javascript.
Web Languages and Standards

Avatar of undefined
Last Comment

8/22/2022 - Mon

When you set the useraccountcontrol, is it being set to 66048 ?

Off the top off my head I don't the bit flags for ADS_UF_DONT_EXPIRE_PASSWD.

Seems the most logical place to look since you are eliminating all accounts with a useraccountcontrol value something other than 66048


Well done, that one had me stupmed, the UserAccountControl was set to 66080, so now the question is how do I change the value of ADS_UF_DONT_EXPIRE_PASSWD from &h10000 to produce a value 66048?

Add the ADS_UF_NORMAL_ACCOUNT value to the to the useraccountcontrol flags.
Experts Exchange is like having an extremely knowledgeable team sitting and waiting for your call. Couldn't do my job half as well as I do without it!
James Murphy

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question

Ok I found a hexadecimal conversion site and converted 66048 to hex which gave me 10200, so I changed the value of the cons, ran the script checked ADSI edit and it still said 66080????

then I went back to the conversion site, put in 66080 and got back 10220 (not the 10000 that I started with), changed my const to that value ran the script, open ADSI edit and I got 66048!?!?!

So now I am more confused than before, but the script works perfectly. Thanks very much for your help. You can have extra points for that!!