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 ADS_ACETYPE_ACCESS_DENIED_ OBJECT = &H6
Const ADS_ACEFLAG_OBJECT_TYPE_PR ESENT = &H1
Const CHANGE_PASSWORD_GUID = "{ab721a53-1e2f-11d0-9819- 00aa004052 9b}"
Const ADS_RIGHT_DS_CONTROL_ACCES S = &H100
ExHome = "/o=Exchange/ou=First Administrative Group/cn=Configuration/cn= Servers/cn =SERVERNAM E"
MDB = "CN=Mailbox Store (SERVERNAME),CN=First Storage Group,CN=InformationStore, CN=SERVERN AME,CN=Ser vers,"& _
"CN=First Administrative Group,CN=Administrative Groups,CN=Exchange,CN=Micr osoft Exchange,CN=Services,CN=Co nfiguratio n,DC=Domai n,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.FirstN ame.value
LastName = document.frmNewUser.LastNa me.value
Mail = document.frmNewUser.Mail.v alue
Pass = document.frmNewUser.Pass.v alue
PassCheck = document.frmNewUser.PassCh eck.value
Department = document.frmNewUser.Deparm ent.value
Office = document.frmNewUser.Office .value
Phone = document.frmNewUser.Phone. value
Mobile = document.frmNewUser.Mobile .value
Manager = document.frmNewUser.SelMan ager.value
ldapPath = document.frmNewUser.SelOU. value
'begin creating the new user.
If Pass <> PassCheck then
msgbox "the passwords do not match"
exit function
Else
'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 "physicalDeliveryOfficeNam e", Office
objUser.SetInfo
objUser.SetPassword Pass
objUser.AccountDisabled = FALSE
objUser.SetInfo
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
objUser.SetInfo
end if
'create user folder and add security
Set objFSO = CreateObject("Scripting.Fi leSystemOb ject")
If objFSO.FolderExists("\\ser ver\Users\ " & UserName) = False Then
objFSO.CreateFolder("\\ser ver\Users\ " & UserName)
End If
aclupdate "\\server\Users\" & UserName,"DOMAIN\" & UserName
If Manager <> "" then
Set objManager = GetObject("LDAP://" & Manager)
manname = objManager.Get("sAMAccount Name")
aclupdate "\\server\Users\" & UserName,"SYNSEAL\" & manname
End if
'prevent password from expiering
intUAC = objUser.Get("userAccountCo ntrol")
objUser.Put "userAccountControl", intUAC XOR ADS_UF_DONT_EXPIRE_PASSWD
objUser.SetInfo
'prevent user from changing password
Set objSD = objUser.Get("ntSecurityDes criptor")
Set objDACL = objSD.DiscretionaryAcl
arrTrustees = array("nt authority\self", "EVERYONE")
For Each strTrustee in arrTrustees
Set objACE = CreateObject("AccessContro lEntry")
objACE.Trustee = strTrustee
objACE.AceFlags = 0
objACE.AceType = ADS_ACETYPE_ACCESS_DENIED_ OBJECT
objACE.Flags = ADS_ACEFLAG_OBJECT_TYPE_PR ESENT
objACE.ObjectType = CHANGE_PASSWORD_GUID
objACE.AccessMask = ADS_RIGHT_DS_CONTROL_ACCES S
objDACL.AddAce objACE
Next
objSD.DiscretionaryAcl = objDACL
objUser.Put "nTSecurityDescriptor", objSD
objUser. SetInfo
count = 0
for each value in document.frmNewUser.PhoneG roups
document.frmNewUser.PhoneG roups.sele ctedIndex = count
ReDim Preserve phngroup(count)
phngroup(count) = document.frmNewUser.PhoneG roups.valu e
Set objGroup = GetObject("LDAP://cn=phn_" & phngroup(count) & ",ou=GroupsPhone,ou=Admini strativeOU ,dc=domain ,dc=com")
objGroup.Add(objUser.ADsPa th)
count = count +1
next
count2 = 0
for each value in document.frmNewUser.Securi tyGroups
document.frmNewUser.Securi tyGroups.s electedInd ex = count2
ReDim Preserve secgroup(count2)
secgroup(count2) = document.frmNewUser.Securi tyGroups.v alue
Set objGroup = GetObject("LDAP://cn=" & secgroup(count2) & ",ou=GroupsAccess,ou=Admin istrativeO U,dc=domai n,dc=com")
objGroup.Add(objUser.ADsPa th)
count2 = count2 +1
next
count3 = 0
for each value in document.frmNewUser.Distri butionGrou ps
document.frmNewUser.Distri butionGrou ps.selecte dIndex = count3
ReDim Preserve disgroup(count3)
disgroup(count3) = document.frmNewUser.Distri butionGrou ps.value
Set objGroup = GetObject("LDAP://cn=" & disgroup(count3) & ",ou=GroupsDistribution,ou =Administr ativeOU,dc =domain,dc =com")
objGroup.Add(objUser.ADsPa th)
count3 = count3 +1
next
document.frmNewUser.reset( )
End Function
Function aclupdate(folder,user)
Set sec = CreateObject("ADsSecurity" )
Set sd = sec.GetSecurityDescriptor( "FILE://" & folder)
Set dacl = sd.DiscretionaryAcl
Set ace = CreateObject("AccessContro lEntry")
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)
objGroup.GetInfo
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.records et")
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
DataList.open
'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><t d><b>Mobil e</b>" & _
"</td><td><b>Email</b></td ><td><b>Of fice</b></ td><td><b> Department </b></td>< /tr>"
'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)
intUAC=objUser.userAccount Control
If intUAC = 66048 Then
UserName = objUser.cn
If len(UserName) = 0 then UserName = " "
Phone = objUser.telephoneNumber
If len(Phone) = 0 then Phone = " "
Mobile = objUser.mobile
If len(Mobile) = 0 then Mobile = " "
Mail = objuser.mail
If len(Mail) = 0 then Mail = " "
Office = objUser.physicalDeliveryOf ficeName
If len(Office) = 0 then Office = " "
SubDep = objUser.department
If len(SubDep) = 0 then SubDep = " "
DataList.AddNew
DataList("UserName") = UserName
DataList("Phone") = Phone
DataList("Mobile") = Mobile
DataList("Mail") = Mail
DataList("Office") = Office
DataList("SubDep") = SubDep
DataList.Update
End If
'loop back and do the next user
Next
DataList.Sort = "UserName"
DataList.MoveFirst
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>"
DataList.MoveNext
If bgcolour = "#C0C0C0" then
bgcolour = "#EBECF0"
Else
bgcolour = "#C0C0C0"
End If
Loop
'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.
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 ADS_ACETYPE_ACCESS_DENIED_
Const ADS_ACEFLAG_OBJECT_TYPE_PR
Const CHANGE_PASSWORD_GUID = "{ab721a53-1e2f-11d0-9819-
Const ADS_RIGHT_DS_CONTROL_ACCES
ExHome = "/o=Exchange/ou=First Administrative Group/cn=Configuration/cn=
MDB = "CN=Mailbox Store (SERVERNAME),CN=First Storage Group,CN=InformationStore,
"CN=First Administrative Group,CN=Administrative Groups,CN=Exchange,CN=Micr
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.FirstN
LastName = document.frmNewUser.LastNa
Mail = document.frmNewUser.Mail.v
Pass = document.frmNewUser.Pass.v
PassCheck = document.frmNewUser.PassCh
Department = document.frmNewUser.Deparm
Office = document.frmNewUser.Office
Phone = document.frmNewUser.Phone.
Mobile = document.frmNewUser.Mobile
Manager = document.frmNewUser.SelMan
ldapPath = document.frmNewUser.SelOU.
'begin creating the new user.
If Pass <> PassCheck then
msgbox "the passwords do not match"
exit function
Else
'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 "physicalDeliveryOfficeNam
objUser.SetInfo
objUser.SetPassword Pass
objUser.AccountDisabled = FALSE
objUser.SetInfo
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
objUser.SetInfo
end if
'create user folder and add security
Set objFSO = CreateObject("Scripting.Fi
If objFSO.FolderExists("\\ser
objFSO.CreateFolder("\\ser
End If
aclupdate "\\server\Users\" & UserName,"DOMAIN\" & UserName
If Manager <> "" then
Set objManager = GetObject("LDAP://" & Manager)
manname = objManager.Get("sAMAccount
aclupdate "\\server\Users\" & UserName,"SYNSEAL\" & manname
End if
'prevent password from expiering
intUAC = objUser.Get("userAccountCo
objUser.Put "userAccountControl", intUAC XOR ADS_UF_DONT_EXPIRE_PASSWD
objUser.SetInfo
'prevent user from changing password
Set objSD = objUser.Get("ntSecurityDes
Set objDACL = objSD.DiscretionaryAcl
arrTrustees = array("nt authority\self", "EVERYONE")
For Each strTrustee in arrTrustees
Set objACE = CreateObject("AccessContro
objACE.Trustee = strTrustee
objACE.AceFlags = 0
objACE.AceType = ADS_ACETYPE_ACCESS_DENIED_
objACE.Flags = ADS_ACEFLAG_OBJECT_TYPE_PR
objACE.ObjectType = CHANGE_PASSWORD_GUID
objACE.AccessMask = ADS_RIGHT_DS_CONTROL_ACCES
objDACL.AddAce objACE
Next
objSD.DiscretionaryAcl = objDACL
objUser.Put "nTSecurityDescriptor", objSD
objUser. SetInfo
count = 0
for each value in document.frmNewUser.PhoneG
document.frmNewUser.PhoneG
ReDim Preserve phngroup(count)
phngroup(count) = document.frmNewUser.PhoneG
Set objGroup = GetObject("LDAP://cn=phn_"
objGroup.Add(objUser.ADsPa
count = count +1
next
count2 = 0
for each value in document.frmNewUser.Securi
document.frmNewUser.Securi
ReDim Preserve secgroup(count2)
secgroup(count2) = document.frmNewUser.Securi
Set objGroup = GetObject("LDAP://cn=" & secgroup(count2) & ",ou=GroupsAccess,ou=Admin
objGroup.Add(objUser.ADsPa
count2 = count2 +1
next
count3 = 0
for each value in document.frmNewUser.Distri
document.frmNewUser.Distri
ReDim Preserve disgroup(count3)
disgroup(count3) = document.frmNewUser.Distri
Set objGroup = GetObject("LDAP://cn=" & disgroup(count3) & ",ou=GroupsDistribution,ou
objGroup.Add(objUser.ADsPa
count3 = count3 +1
next
document.frmNewUser.reset(
End Function
Function aclupdate(folder,user)
Set sec = CreateObject("ADsSecurity"
Set sd = sec.GetSecurityDescriptor(
Set dacl = sd.DiscretionaryAcl
Set ace = CreateObject("AccessContro
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)
objGroup.GetInfo
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.records
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
DataList.open
'begin drawing the table to be placed on the lyrBody division
strHTML = ""
strHTML = "<table border=2 bordercolor='#C0C0C0' cellspacing='0' bordercolorlight='#D8DAE2'
"</td><td><b>Email</b></td
'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)
intUAC=objUser.userAccount
If intUAC = 66048 Then
UserName = objUser.cn
If len(UserName) = 0 then UserName = " "
Phone = objUser.telephoneNumber
If len(Phone) = 0 then Phone = " "
Mobile = objUser.mobile
If len(Mobile) = 0 then Mobile = " "
Mail = objuser.mail
If len(Mail) = 0 then Mail = " "
Office = objUser.physicalDeliveryOf
If len(Office) = 0 then Office = " "
SubDep = objUser.department
If len(SubDep) = 0 then SubDep = " "
DataList.AddNew
DataList("UserName") = UserName
DataList("Phone") = Phone
DataList("Mobile") = Mobile
DataList("Mail") = Mail
DataList("Office") = Office
DataList("SubDep") = SubDep
DataList.Update
End If
'loop back and do the next user
Next
DataList.Sort = "UserName"
DataList.MoveFirst
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>"
DataList.MoveNext
If bgcolour = "#C0C0C0" then
bgcolour = "#EBECF0"
Else
bgcolour = "#C0C0C0"
End If
Loop
'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.
ASKER
Bingo!!
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?
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.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
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!!
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!!
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