摘 要  利用VB完成一個(gè)組件，注冊到NT SERVER的MTS中。在ASP中使用了DLL中所包含的組件，完成瀏覽器對NT 域用戶口令的修改。
關(guān) 鍵 詞 ASP，ADSI，MTS，WEB 服 務(wù) 器，瀏 覽 器

近幾年來，計(jì)算機(jī)網(wǎng)絡(luò)技術(shù)得到迅猛發(fā)展。Windows NT網(wǎng)絡(luò)操作系統(tǒng)以其可管理性、可用性和豐富的應(yīng)用軟件贏得了越來越多的用戶。雖然NT的用戶管理非常容易，也有其局限性。例如UNIX下利用Telnet遠(yuǎn)程修改用戶口令非常簡單，但是NT就沒有這么容易。我們利用NT建立了代理服務(wù)器、郵件服務(wù)器，管理用戶口令自然也遇到了這個(gè)問題。
本文中我們要?jiǎng)?chuàng)建的是一個(gè)在瀏覽器里管理NT域用戶的程序，解決了這個(gè)難題。

1、 應(yīng)用實(shí)現(xiàn)的環(huán)境：
服務(wù)器：
Windows NT Server  4.0
IIS 4.0       （Internet Information Server，包含在NT Option Pack  4.0內(nèi)）
MTS 2.0     (Microsoft Transaction Server，包含在NT Option Pack  4.0內(nèi))
ADSI 2.5   （Active Directory Services Interfaces ，到微軟站點(diǎn)下載）
ASP   （IIS4.0本身就支持，不需單獨(dú)安裝）

應(yīng)用創(chuàng)建工具：

VB 6.0    (用來創(chuàng)建ActiveX DLL 服務(wù)器組件)
HTML 編輯器  （用來創(chuàng)建ASP 表單）

客戶：
Windows 98
IE4.0

2、 利用創(chuàng)建ActiveX DLL 組件。
  （1）起動(dòng)VB ，創(chuàng)建一個(gè)新的ActiveX DLL project。
  （2）將缺省名Project1 改名為 aciChangePassword。
  （3）將class 模塊 Class1 改名為 Main。
  （4）將Main的instancing 屬性值改為 5 – MultiUse。
  （5）將Threading 模式改為Apartment Threaded。
  （6）Project->reference菜單，將Microsoft Active DS Type Library (activeds.tlb)與Microsoft Transaction Server Type Library (mtxas.dll)選中。如果沒有這兩個(gè)文件，可以到其它計(jì)算機(jī)上去拷貝一個(gè)。
   （7）將Project保存。Class命名為“main.cls”，Project命名為“aciChangePassword.vbp”。
   （8）下面的代碼放到General declarations 里面。
Option Explicit
' 定義 MTS對象上下文變量
Dim objCtx As ObjectContext

' 定義 IIS對象
Dim objApplication As Object
Dim objRequest As Object
Dim objResponse As Object
Dim objServer As Object
Dim objSession As Object

' PDC事務(wù)日志API
Private Declare Function RegisterEventSource _
Lib "advapi32.dll" Alias "RegisterEventSourceA" _
(ByVal lpUNCServerName As String, ByVal lpSourceName As String) As Long

Private Declare Function DeregisterEventSource  Lib "advapi32.dll" (ByVal hEventLog As Long) As Long

Private Declare Function ReportEvent  Lib "advapi32.dll" Alias "ReportEventA" _
(ByVal hEventLog As Long, ByVal wType As Integer, _
ByVal wCategory As Integer, ByVal dwEventID As Long, _
ByVal lpUserSid As Any, ByVal wNumStrings As Integer, _
ByVal dwDataSize As Long, plpStrings As Long, lpRawData  As Any) As Boolean

Private Declare Function GetLastError Lib "kernel32" () As Long

Private Declare Sub CopyMemory  Lib "kernel32" Alias "RtlMoveMemory" _
(hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)

Private Declare Function GlobalAlloc _
Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long

Private Declare Function GlobalFree  Lib "kernel32" (ByVal hMem As Long) As Long

Private Declare Function NetGetDCName _
Lib "netapi32.dll" (ServerName As Long, domainname  As Byte, bufptr As Long) As Long

Private Declare Sub lstrcpyW Lib "kernel32"  (dest As Any, ByVal src As Any)

Private Declare Function NetApiBufferFree& Lib "netapi32" (ByVal Buffer As Long)

' 常量
Private Const EVENTLOG_ERROR_TYPE = 1
Private Const EVENTLOG_INFORMATION_TYPE = 4
   （9）新增一個(gè)過程SetPassword:
' change the user's password
Public Sub SetPassword(ByVal pstrUser As String, _
ByVal pstrOldPassword As String, ByVal pstrNewPassword _
As String, ByVal pstrConfirmPassword As String)

Dim adsUser As IADsUser
Dim strDialogText As String

On Error GoTo ChangePasswordErrorHandler

' 引用MTS對象
Call GetObjectReferences
If pstrUser <> vbNullString Then
    If (Not (pstrOldPassword = vbNullString)) And _
                   (Not (pstrNewPassword = vbNullString)) Then
        If (Not (pstrNewPassword <> pstrConfirmPassword)) Then
            ' 設(shè)置ADSI路徑，將INTRANET改成你自己的域名。
            Set adsUser = GetObject("WinNT://INTRANET/" & pstrUser & ",user")
            ' 修改口令
            adsUser.ChangePassword pstrOldPassword, pstrNewPassword
            ' 產(chǎn)生日志
            Call LogNTEvent("用戶 " & pstrUser & _
                   " 修改口令成功。", EVENTLOG_INFORMATION_TYPE, 1001)
            ' generate the alert dialog HTML                
            strDialogText = """用戶 " & pstrUser & " 口令修改成功！"""
            Call CreateAlertMarkup(strDialogText)
         Else
            ' generate the alert dialog HTML
            strDialogText = """兩次敲的口令不相同，禁止修改。"""
            Call CreateAlertMarkup(strDialogText)
          End If
       Else
          ' generate the alert dialog HTML
          strDialogText = """口令不能為空。"""
          Call CreateAlertMarkup(strDialogText)
       End If
    End If
    Set adsUser = Nothing
    ' 提交事務(wù)
    objCtx.SetComplete
    ' 釋放事務(wù)對象
    Call ReleaseObjectReferences
    Exit Sub
    
    '**********
ChangePasswordErrorHandler:
' log the failed attempt
Call LogNTEvent("企圖修改用戶 " & pstrUser & _
" 的口令失�。�", EVENTLOG_ERROR_TYPE, 1003)

' generate the alert dialog HTML with PASSFILT.DLL simulated error message
strDialogText = """用戶 " & pstrUser & "的口令不能被修改，原因如下：\n\n"
strDialogText = strDialogText & "1. 你原有的口令" &  "輸入不對。\n"

strDialogText = strDialogText & "2. 口令必須為6個(gè)以上的" &  "字符長度。\n"

strDialogText = strDialogText & "3.口令只能包含" &  "一下特殊字符:\n"

strDialogText = strDialogText & "      - 英文大寫字母 (A-Z)\n"
strDialogText = strDialogText & "      - 英文小寫字母 (a-z)\n"
strDialogText = strDialogText & "      - 阿拉伯?dāng)?shù)字 (0-9)\n"
strDialogText = strDialogText & "      - 特殊字符" &  "比如標(biāo)點(diǎn)符號\n"""

Call CreateAlertMarkup(strDialogText)
‘ 終止事務(wù)
objCtx.SetAbort    
' 釋放事務(wù)
Call ReleaseObjectReferences
End Sub
   （10）添加一個(gè)函數(shù)取得系統(tǒng)的真實(shí)域控制器名：
' returns the PDC machine name
Private Function GetPrimaryDCName(pstrMachineName As String) As String
Dim DCName As String
Dim DCNPtr As Long
Dim DNArray() As Byte
Dim DCNArray(100) As Byte
Dim result As Long
Dim strDialogText As String
' find the PDC
DNArray = pstrMachineName & vbNullChar
result = NetGetDCName(0&, DNArray(0), DCNPtr)
If result <> 0 Then
   ' generate the alert dialog HTML
   strDialogText = """域 " & pstrMachineName & " 的控制器沒有找到。"""
   Call CreateAlertMarkup(strDialogText)
   Exit Function
End If
lstrcpyW DCNArray(0), DCNPtr
result = NetApiBufferFree(DCNPtr)
DCName = DCNArray()
GetPrimaryDCName = Left(DCName, InStr(DCName, Chr(0)) - 1)
End Function
   （11）添加一個(gè)過程向PDC的應(yīng)用程序日志加一個(gè)記錄：
' log to the PDC Application event log
Private Sub LogNTEvent(sString As String, iLogType As Integer, iEventID As Long)
Dim bRC As Boolean
Dim iNumStrings As Integer
Dim hEventLog As Long
Dim hMsgs As Long
Dim cbStringSize As Long
Dim strPDC As String
Dim strDialogText As String
    
'** 以你的域名替換掉INTRANET **
strPDC = GetPrimaryDCName("INTRANET")
hEventLog = RegisterEventSource(strPDC, "aciChangePassword.dll")
hMsgs = GlobalAlloc(&H40, cbStringSize)
CopyMemory ByVal hMsgs, ByVal sString, cbStringSize
iNumStrings = 1
If ReportEvent(hEventLog, iLogType, 0, iEventID, 0&, iNumStrings, cbStringSize, hMsgs, hMsgs) = 0 Then    
    ' generate the alert dialog HTML
    strDialogText = """意外錯(cuò)誤： """ & GetLastError()
    Call CreateAlertMarkup(strDialogText)
End If
Call GlobalFree(hMsgs)
DeregisterEventSource (hEventLog)
End Sub
   （12）新增一個(gè)過程，構(gòu)造了一個(gè)警告框，注意他是在瀏覽器端被顯示的，我們用了jscript,因?yàn)樗�是瀏覽器無關(guān)的：
' generate JavaScript alert dialog HTML
Private Sub CreateAlertMarkup(pstrDialogText As String)
Dim strScriptingLanguage As String    
strScriptingLanguage = """JavaScript"""    
objResponse.Write vbCrLf
objResponse.Write ("<SCRIPT LANGUAGE=" & strScriptingLanguage & ">") & vbCrLf
objResponse.Write ("<!--") & vbCrLf
objResponse.Write ("{") & vbCrLf
objResponse.Write vbTab & ("window.alert(" & pstrDialogText & ");") & vbCrLf
objResponse.Write ("}") & vbCrLf
objResponse.Write ("-->") & vbCrLf
objResponse.Write ("</SCRIPT>") & vbCrLf
End Sub
   （13）過程 GetObjectReferences 產(chǎn)生一個(gè)對MTS的引用，要使用MTS功能，就必須引用他：
Private Sub GetObjectReferences()

' get MTS object context
Set objCtx = GetObjectContext
' get IIS intrinsic object references
Set objApplication = objCtx.Item("Application")
Set objRequest = objCtx.Item("Request")
Set objResponse = objCtx.Item("Response")
Set objServer = objCtx.Item("Server")
Set objSession = objCtx.Item("Session")
End Sub
   （14）釋放對象：
' release all MTS object references
Private Sub ReleaseObjectReferences()

Set objCtx = Nothing
Set objApplication = Nothing
Set objRequest = Nothing
Set objResponse = Nothing
Set objServer = Nothing
Set objSession = Nothing

End Sub
   （15）在上面的代碼全部完成后，生成aciChangPassword.dll文件。

3、 在服務(wù)器上安裝組件。
    首先拷貝aciChangPassword.dll到NT服務(wù)器的 \winnt\system32 目錄中。打開MTS Explorer， 雙擊“我的計(jì)算機(jī)”，右擊“安裝的軟件包”，選“新” -> “軟件包”，接下來的對話框，選“創(chuàng)建一個(gè)空的軟件包”， 給包名命為 aciChangePassword ，單擊下一步，指定運(yùn)行包的帳號，使用管理員帳號即可。
雙擊剛才創(chuàng)建的包，展開，右擊“組件”，選.“新”-->“組件”，安裝新的組件。添加文件，瀏覽，選中剛才拷貝的文件 aciChangePassword.dll (\winnt\system32) ，確認(rèn)。選中復(fù)選框“詳細(xì)資料”，查看下面的列表框，應(yīng)當(dāng)看到組件名。確認(rèn)后，修改屬性，事務(wù)里選擇“需要一個(gè)事務(wù)處理”。
直此，組件安裝完成。
4、 創(chuàng)建ASP頁面（setpass.asp）
<head>
<%
'declare variables
Dim objReference  
Dim strUser  
Dim strOldPassword
Dim strNewPassword  
Dim strConfirmNewPassword    

' obtain form values
strUser = Request.Form("txtUser")
strOldPassword = Request.Form("txtOldPassword")
strNewPassword = Request.Form("txtNewPassword")
strConfirmNewPassword = Request.Form("txtConfirmNewPassword")
  ' create object
Set objReference = Server.CreateObject("aciChangePassword.Main")

' change the password
Call bjReference.SetPassword(strUser,strOldPassword,strNewPassword,strConfirmNewPassword)
' release object reference
Set objReference = Nothing
%>
5、 創(chuàng)建HTML文件（change.htm）
<html>
<head>
<title>用戶口令修改</title>
</head>
<body bgcolor="#FFFFFF" background="../images/backgrnd.gif">
<h2><font color="#0000FF"><big>用戶口令修改</big></font></h2>
<form method="post" name="frmChangePassword" action="setpass.asp">
<table width="325" border="0">
<tr><td>
<font color="#0000FF"><b><font size="+1">用戶</font><font size="+1" face="Arial">:</font>
</b></font></td>
<td><font color="#0000FF"><input type="text" size="20" name="txtUser"></font></td>    </tr>
<tr>
      <td><font color="#0000FF"><b><font size="+1">口令</font><font size="+1" face="Arial">: </font></b></font></td>
      <td><font color="#0000FF"><input type="password" name="txtOldPassword" size="20"> </font></td>    </tr>
    <tr>
      <td><font color="#0000FF"><b><font size="+1">新口令</font><font size="+1" face="Arial">:
      </font></b></font></td>
      <td><font color="#0000FF"><input type="password" name="txtNewPassword" size="20"> </font></td>    </tr>
    <tr>
      <td><font color="#0000FF"><b><font size="+1">確認(rèn)一遍</font><font size="+1"
      face="Arial">: </font></b></font></td>
      <td><font color="#0000FF"><input type="password" name="txtConfirmNewPassword" size="20"> </font></td> </tr>
    <tr>
      <td colSpan="2"></td> </tr>
    <tr>
<td colSpan="2"><font face="Arial"><dl>
<dd align="center"><font color="#0000FF"><input id="txtChangePassword"
          name="txtChangePassword" style="font-FAMILY: ; HEIGHT: 24px; WIDTH: 149px" type="submit"  value="更改"> </font></font></dd>
      </dl> </td>
    </tr>
  </table>
</form>
</body>
</html>
6、 最后的測試。
在瀏覽器中打開change.htm文件。表單包括四個(gè)文本框：用戶名，舊口令，新口令，確認(rèn)口令。當(dāng)按下更改按鈕后， ASP文件取得這四個(gè)參數(shù)，創(chuàng)建對象，引用setpass過程，修改口令。成功后系統(tǒng)會(huì)立即修改NT域用戶的口令，并且提示。若用戶名和舊口令不能登錄，則拒絕修改。
無論修改是否成功，都向NT服務(wù)器報(bào)告一個(gè)事件。可以打開事件查看器檢查。


山東萊蕪鋼鐵集團(tuán)公司自動(dòng)化部信息中心