利用VB组件实现WEB方式下对NT域用户口令的修改

摘 要  利用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服务器报告一个事件。可以打开事件查看器检查。


山东莱芜钢铁集团公司自动化部信息中心

原文转自：http://www.ltesting.net