debug.print sname
stype = adgroup.get(cpropcustomtype)
if err.number = 0 and stype = ctyperc then
nresult.add sname, sname
end if
err.clear
next
set enumgroups = nresult
end function
AD & ADSI入门[3]
[入库：2005年8月18日] [更新：2007年3月24日]
本文简介：选择自 mittermeyer 的 blog
- 添加一个用户以及用户相关的邮箱，这是一个相对复杂的利用adsi的示例，其他类似的操作就不赘述了。这里用到的就是adsi和exchange针对adsi中iadsuser对象的扩展。斜体的那一段代码颇值得回味，在vb中非常简单的一句话，背后有一套复杂的逻辑。
添加用户组和组邮箱的操作类似，不同的是组邮箱不是一个物理邮箱，而是一个邮箱列表，通过imailrecipient.mailboxenabled使之有效即可。
' add new user to domain and create mailbox for it
public function addaccountex(byval saccount as string, byval sfullname as string, byval sdesc as string, _
byval spassword as string) as long
dim addomain as iadscontainer
dim adnewuser as iadsuser
dim omailstore as cdoexm.imailboxstore
dim oexchserver as cexchagemanager
if m_sadmin <> vbnullstring then
set addomain = m_adroot.opendsobject("ldap://cn=users," & m_sdomain, _
m_sadmin, m_sadminpwd, ads_secure_authentication)
else
set addomain = getobject("ldap://cn=users," & m_sdomain)
end if
public function addaccountex(byval saccount as string, byval sfullname as string, byval sdesc as string, _
byval spassword as string) as long
dim addomain as iadscontainer
dim adnewuser as iadsuser
dim omailstore as cdoexm.imailboxstore
dim oexchserver as cexchagemanager
if m_sadmin <> vbnullstring then
set addomain = m_adroot.opendsobject("ldap://cn=users," & m_sdomain, _
m_sadmin, m_sadminpwd, ads_secure_authentication)
else
set addomain = getobject("ldap://cn=users," & m_sdomain)
end if
' create a account
set adnewuser = addomain.create("user", "cn=" & saccount)
adnewuser.put "samaccountname", saccount
adnewuser.put "userprincipalname", saccount & "@" & domain
adnewuser.fullname = sfullname
adnewuser.description = sdesc
adnewuser.setinfo
set adnewuser = addomain.create("user", "cn=" & saccount)
adnewuser.put "samaccountname", saccount
adnewuser.put "userprincipalname", saccount & "@" & domain
adnewuser.fullname = sfullname
adnewuser.description = sdesc
adnewuser.setinfo
adnewuser.setpassword spassword
adnewuser.accountdisabled = false
' create mailbox for this account
set oexchserver = new cexchagemanager
oexchserver.connect m_sexchserver ' get exchange server's information
set omailstore = adnewuser
call omailstore.createmailbox("ldap://" & m_sexchserver & "/" & oexchserver.defaultmailboxstore)
adnewuser.setinfo
adnewuser.accountdisabled = false
' create mailbox for this account
set oexchserver = new cexchagemanager
oexchserver.connect m_sexchserver ' get exchange server's information
set omailstore = adnewuser
call omailstore.createmailbox("ldap://" & m_sexchserver & "/" & oexchserver.defaultmailboxstore)
adnewuser.setinfo
' enable immediate-logon for the user
adnewuser.put "msexchuseraccountcontrol", 2
adnewuser.setinfo
end function
adnewuser.put "msexchuseraccountcontrol", 2
adnewuser.setinfo
end function
- 查找。通过ado查询比较简单，只是属性的类型，特别是一些多值属性需要额外注意。
这个例子是查询所有指定域中所有的组，其中description就是一个多值属性。
public function searchgroup() as adodb.recordset
dim oresult as adodb.recordset
dim ocommand as adodb.command
dim sconnectionstr as string
if m_sadmin = vbnullstring then
sconnectionstr = "provider=adsdsoobject"
else
sconnectionstr = "provider=adsdsoobject;uid=" & m_sadmin & ";pwd=" & m_sadminpwd
end if
dim oresult as adodb.recordset
dim ocommand as adodb.command
dim sconnectionstr as string
if m_sadmin = vbnullstring then
sconnectionstr = "provider=adsdsoobject"
else
sconnectionstr = "provider=adsdsoobject;uid=" & m_sadmin & ";pwd=" & m_sadminpwd
end if
本文关键：AD,ADSI,VB
本站最佳浏览方式为 分辨率 1024x768 IE 6.0（或更高版本的 IE浏览器）
