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

近幾年來，計算機網絡技術得到迅猛發展。Windows NT網絡操作系統以其可管理性、可用性和豐富的應用軟件贏得了越來越多的用戶。雖然NT的用戶管理非常容易，也有其局限性。例如UNIX下利用Telnet遠程修改用戶口令非常簡單，但是NT就沒有這么容易。我們利用NT建立了代理服務器、郵件服務器，管理用戶口令自然也遇到了這個問題。
本文中我們要創建的是一個在瀏覽器里管理NT域用戶的程序，解決了這個難題。

1、 應用實現的環境：
服務器：
Windows NT Server  4.0
IIS 4.0       （Internet Information Server，包含在NT Option Pack  4.0內）
MTS 2.0     (Microsoft Transaction Server，包含在NT Option Pack  4.0內)
ADSI 2.5   （Active Directory Services Interfaces ，到微軟站點下載）
ASP   （IIS4.0本身就支持，不需單獨安裝）

應用創建工具：

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

客戶：
Windows 98
IE4.0

2、 利用創建ActiveX DLL 組件。
  （1）起動VB ，創建一個新的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)選中。如果沒有這兩個文件，可以到其它計算機上去拷貝一個。
   （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事務日志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）新增一個過程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
            ' 設置ADSI路徑，將INTRANET改成你自己的域名。
            Set adsUser = GetObject("WinNT://INTRANET/" & pstrUser & ",user")
            ' 修改口令
            adsUser.ChangePassword pstrOldPassword, pstrNewPassword
            ' 產生日志
            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
    ' 提交事務
    objCtx.SetComplete
    ' 釋放事務對象
    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個以上的" &  "字符長度。\n"

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

strDialogText = strDialogText & "      - 英文大寫字母 (A-Z)\n"
strDialogText = strDialogText & "      - 英文小寫字母 (a-z)\n"
strDialogText = strDialogText & "      - 阿拉伯數字 (0-9)\n"
strDialogText = strDialogText & "      - 特殊字符" &  "比如標點符號\n"""

Call CreateAlertMarkup(strDialogText)
‘ 終止事務
objCtx.SetAbort    
' 釋放事務
Call ReleaseObjectReferences
End Sub
   （10）添加一個函數取得系統的真實域控制器名：
' 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）添加一個過程向PDC的應用程序日志加一個記錄：
' 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 = """意外錯誤： """ & GetLastError()
    Call CreateAlertMarkup(strDialogText)
End If
Call GlobalFree(hMsgs)
DeregisterEventSource (hEventLog)
End Sub
   （12）新增一個過程，構造了一個警告框，注意他是在瀏覽器端被顯示的，我們用了jscript,因為他是瀏覽器無關的：
' 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 產生一個對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、 在服務器上安裝組件。
    首先拷貝aciChangPassword.dll到NT服務器的 \winnt\system32 目錄中。打開MTS Explorer， 雙擊“我的計算機”，右擊“安裝的軟件包”，選“新” -> “軟件包”，接下來的對話框，選“創建一個空的軟件包”， 給包名命為 aciChangePassword ，單擊下一步，指定運行包的帳號，使用管理員帳號即可。
雙擊剛才創建的包，展開，右擊“組件”，選.“新”-->“組件”，安裝新的組件。添加文件，瀏覽，選中剛才拷貝的文件 aciChangePassword.dll (\winnt\system32) ，確認。選中復選框“詳細資料”，查看下面的列表框，應當看到組件名。確認后，修改屬性，事務里選擇“需要一個事務處理”。
直此，組件安裝完成。
4、 創建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、 創建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">確認一遍</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文件。表單包括四個文本框：用戶名，舊口令，新口令，確認口令。當按下更改按鈕后， ASP文件取得這四個參數，創建對象，引用setpass過程，修改口令。成功后系統會立即修改NT域用戶的口令，并且提示。若用戶名和舊口令不能登錄，則拒絕修改。
無論修改是否成功，都向NT服務器報告一個事件�？梢源蜷_事件查看器檢查。


山東萊蕪鋼鐵集團公司自動化部信息中心