|
前段時間寫出一個程序，只是不完善，不能判斷是否存在該用戶，現在補充查找功能。
代碼不足之處，希不吝指教！
完整代碼如下：
<%@ Language=VBScriptcodepage="936"%>
<% Option Explicit %>
<HTML>
<HEAD>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<META NAME="GENERATOR" Content="Microsoft Visual Studio 7.0">
</HEAD>
<BODY>
<%
'程序目的：創建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
'查詢語句：語法：要找什么，即查找基(<LDAP://DC=program,DC=org>)；
'在目錄的什么地方找(&(objectCategory=person)(sAMAccountName=用戶
'名))（用戶為？的用戶；找到對象的屬性(sAMAccount,ADsPath)（用戶名，
'LDAP地址）；查找的范圍(subTree:查找搜索基以下的整個子樹中)。例句
'就是下面這句.
'具體細節請參看《ASP3高級編程》P644，機械工業出版社（好象精華區內
'有這本書的電子文檔，這本本書真的不錯，值得購買）
strQuery = "<LDAP://DC=program,DC=org>;(&(objectCategory=person)" & _
"(sAMAccountName=" & Request.Form ("txtUserName") & "));" & _
"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=" & emailname
'下面這語個IF語句沒多少價值。 ：）
if Request.Form ("txtTruename") <> "" then
LastName = "sky"
FirstName = "Word"
else
LastName = "Last"
FirstName = "Name"
end if
'打開對象
Set objContainer = GetObject("LDAP://" & ServerName & "/OU=China.org," & DomainName)
'創建帳號
Set objUser = objContainer.Create("User", recip)
objUser.Put "samAccountName", emailname'帳號
objUser.Put "sn", LastName
objUser.Put "givenName", FirstName
objUser.Put "DisplayName", emailname '& "@hina.org"'顯示的名字
objUser.Put "mail", emailname & "@China.org"
objUser.Put "userPrincipalName", emailname & "@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/" & _
"CN=Mailbox Store (SKYWORD),CN=First Storage Group," & _
"CN=InformationStore,CN=SKYWORD,CN=Servers," & _
"CN=First Administrative Group,CN=Administrative Groups," & _
"CN=ecitye,CN=Microsoft Exchange,CN=Services," & _
"CN=Configuration,DC=program,DC=org"
objUser.SetInfo
Set objContainer = Nothing
Set objUser = Nothing
Set objMailbox = Nothing
'下面是簡單的錯誤處理。
if err <> 0 then
Response.Write "創建用戶失敗！請重試一次<br>"
Response.Write "<input type='button' value='重試一次' onclick='vbscript:history.back()'>"
Response.Write "<input type='button' value='返回' onclick='vbscript:window.location.href=index.html'>"
else
'以下是簡單的測試
Set objMail = Server.CreateObject ("CDONTS.NewMail")
objMail.Send "Admins@china.org", emailname & "@china.org", "Welcome", "Welcome use China.org Mail"
set objMail = Nothing
Response.Write emailname & "用戶已經成功創建！!!!" & "<br>三秒后導向登錄頁！"
Response.AddHeader "refresh","3;url=http://mail.china.org"
end if
End If
%>
</BODY>
</HTML>
|
