<%@ Language=VBScript codepage="936"%>
<% Option Explicit %>






<%
程序目的：创建EXCHANGE 2000 邮箱用户
程序实现方式：首先在AD（ACTIVE DIRECTORY：活动目录）中查找是否有该用
户，如果有则提示用户该名字已经存在，没有则创建该用户，
并为该用户创建邮箱。
程序设计：skyword, skyword@21cn.com
程序日期：2001-06-27
需要注意的问题：程序使用中，应当关注LDAP的不同。并且程序的运行需要比
较主高的运行权限（我使用是管理员权限，呵呵比较不安全，
大家在实际使用中要注意，不然被人窃取了帐号不要怪我。
我也不太会设置），需要在IIS中设置（以前就是因为不了解
，走了不少弯路：） ）
另外还有一种方案，查找用户可结合数据库查找，我想大家
会更熟悉一些，只是要记得在初始数据时，要把计算机内所
有的帐号都要记录进数据库，不然就不能准备判断是否该用
户，因为AD只判断是否有该用户，而不管该在什么位置，这
点大家要注意。
程序是中用到一些知识点均加以注释，希望对大家对所帮助
另外需要注意的是帐号名字不能小于2位，而且不能使用中文
名字.

Dim objUser
Dim objContainer
Dim objMailbox
Dim objMail

Dim recipname, recip
Dim ServerName, DomainName, emailname, FirstName, LastName, password

判断用户是否存在
Dim strQuery, objConn, objRs, strResult
查询语句：语法：要找什么，即查找基()；
在目录的什么地方找(%26amp;(objectCategory=person)(sAMAccountName=用户
名))（用户为？的用户；找到对象的属性(sAMAccount,ADsPath)（用户名，
LDAP地址）；查找的范围(subTree:查找搜索基以下的整个子树中)。例句
就是下面这句.
具体细节请参看《ASP3高级编程》P644，机械工业出版社（好象精华区内
有这本书的电子文档，这本本书真的不错，值得购买）

strQuery = ";(%26amp;(objectCategory=person)" %26amp; _
"(sAMAccountName=" %26amp; Request.Form ("txtUserName") %26amp; "));" %26amp; _
"sAMAccountName,ADsPath;subTree"
打开ADSI
Set objConn = Server.CreateObject ("ADODB.Connection")
objConn.Provider = "ADsDSOObject"
下面这句是用合法用户打开，不然查找的结果有误，本例中使用管理员帐号
objConn.Open "Active Directory Provider","CN=Administrator, CN=users, DC=program, DC=org","skyword"
查找用户是否存在，不存在则创建用户
Set objRs = Server.CreateObject ("ADODB.Recordset")
objRs.Open strQuery, objConn

if not objRs.EOF then
strResult = False
Response.Write "用户已经存在"
else
创建用户
strResult = True
End if

objRs.Close
Set objRs = Nothing

objConn.Close
Set objConn = Nothing

If strResult = True Then
创建用户的代码

ServerName,DomainName是ADSI需要的LDAP信息，是必需的。
ServerName = "skyword.program.org"
DomainName = "DC=program,DC=org"

emailname = Request.Form ("txtUserName")
password = Request.Form ("txtPassword")
recip = "CN=" %26amp; emailname
下面这语个IF语句没多少价值。 ：）
if Request.Form ("txtTruename") <> "" then
LastName = "sky"
FirstName = "Word"
else
LastName = "Last"
FirstName = "Name"
end if

打开对象
Set objContainer = GetObject("LDAP://" %26amp; ServerName %26amp; "/OU=China.org," %26amp; DomainName)

创建帐号
Set objUser = objContainer.Create("User", recip)
objUser.Put "samAccountName", emailname 帐号
objUser.Put "sn", LastName
objUser.Put "givenName", FirstName
objUser.Put "DisplayName", emailname %26amp; "@hina.org" 显示的名字
objUser.Put "mail", emailname %26amp; "@China.org"
objUser.Put "userPrincipalName", emailname %26amp; "@China.org" 用户登录帐号
objUser.SetInfo 写进AD中

objUser.SetPassword password 用户密码
objUser.AccountDisabled = False 帐号生效
objUser.SetInfo 写进AD,一定要,为什么我也不清楚

创建邮箱
Set objMailbox = objUser
下面的LDAP是查出来的，安装不同，LDAP会有所不同。
objMailbox.CreateMailbox "LDAP://skyword.program.org/" %26amp; _
"CN=Mailbox Store (SKYWORD),CN=First Storage Group," %26amp; _
"CN=InformationStore,CN=SKYWORD,CN=Servers," %26amp; _
"CN=First Administrative Group,CN=Administrative Groups," %26amp; _
"CN=ecitye,CN=Microsoft Exchange,CN=Services," %26amp; _
"CN=Configuration,DC=program,DC=org"
objUser.SetInfo

Set objContainer = Nothing
Set objUser = Nothing
Set objMailbox = Nothing
下面是简单的错误处理。
if err <> 0 then
Response.Write "创建用户失败！请重试一次
"
Response.Write " "
Response.Write ""
else
以下是简单的测试
Set objMail = Server.CreateObject ("CDONTS.NewMail")
objMail.Send "Admins@china.org", emailname %26amp; "@china.org", "Welcome", "Welcome use China.org Mail"
set objMail = Nothing

Response.Write emailname %26amp; "用户已经成功创建！!!!" %26amp; "
三秒后导向登录页！"
Response.AddHeader "refresh","3;url=http://mail.china.org"
end if
End If
%>