摘  要：本文介绍了在WEB方式更改Windows NT用户密码的一种方法，并给出了该方法所用的asp组件的源代码。

关键词：net user，ASP组件，Windows API，域控制服务器，独立服务器，重定向

一、引言

因为安全的原因，一个公司在网络使用中，往往建有较多的普通用户来管理公司的子站点，或使用FTP服务、WEB服务、邮件服务、代理服务等。用户数量多了，这些用户的密码维护就比较困难。

一般地说，Windows NT用户密码的更改有两种途径：1，由系统管理员在服务器上更改；2，用户自己通过终端服务客户端或telnet客户端登陆到服务器上更改密码。第一种方法受时间地点的限制，管理员忙时或不在岗时，更改密码的操作就不能完成。第二种方法要求服务器上要运行终端服务或telnet服务，且要对用户开放登陆权限，这往往会给服务器带来不安全、不稳定的因素。如果能让用户通过浏览器自己更改密码，这样即方便用户又减少系统管理员的工作量，对服务器又安全。

二、实现方案

Windows NT下 的net user 命令有添加用户，删除用户，更改用户密码的功能，可以在ASP网页中调用net user 命令实现更改用户密码的目的。在ASP中运行net user 命令需要能运行dos命令行程序的ASP组件, 下面将介绍该组件的设计原理和实现过程，另外，net user没有验证用户身份是否合法的功能，该组件也将实现这一功能。

三、zhaspdll.dll的设计

zhaspdll(综合ASP动态库)是作者使用VB设计的ASP组件，它提供LogonUser和RunDosCmd两个对象。LogonUser用于验证用户名/密码对的合法性，RunDosCmd用于运行Dos命令行程序。

LogonUser通过执行Windows API函数LogonUser来验证要求更改密码的用户所提供的用户名和旧密码是否合法。

RunDosCmd通过执行Windows API函数CreateProcess来运行所要求Dos命令行程序，并通过重定向该Dos命令行程序的输出到一匿名管道中，来获取该Dos命令行程序的运行结果。

该组件的创建过程如下：

1．运行Visaul Basic 6.0，创建一新的ActiveX DLL项目，项目名取为zhaspdll。

2．在项目中添加一新moduel（模块），取名为winapi，模块的内容为：

'windows API 声明

Declare Function LogonUser Lib "advapi32.dll" Alias "LogonUserA" _

        (ByVal lpszUsername As String, _

        ByVal lpszDomain As String, ByVal lpszPassword As String, _

        ByVal dwLogonType As Long, ByVal dwLogonProvider As Long, _

        phToken As Long) As Long

Declare Function RevertToSelf Lib "advapi32.dll" () As Long

Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" _

        (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As _

        Long, ByVal dwLanguageId As Long, ByRef lpBuffer As Long, _

        ByVal nSize As Long, Arguments As Long) As Long

Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long

Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, _

        phWritePipe As Long, lpPipeAttributes As SECURITY_ATTRIBUTES, _

        ByVal nSize As Long) As Long

Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Declare Function GetCurrentProcess Lib "kernel32" () As Long

Declare Function wsprintf Lib "user32" Alias "wsprintfA" _

        (sr As Byte, ByVal strformat As String, ByVal szapi As String, _

        ByVal errid As Long, ByVal lp As Long) As Long

Declare Function PeekNamedPipe Lib "kernel32" (ByVal hNamedPipe As Long, _

        ByVal lpBuffer As String, ByVal nBufferSize As Long, lpBytesRead As _

        Long, lpTotalBytesAvail As Long, lpBytesLeftThisMessage As Long) As Long

Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, _

        ByVal dwMilliseconds As Long) As Long

Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, _

        ByVal uExitCode As Long) As Long

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, _

        lpExitCode As Long) As Long

Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" _

        (ByVal lpApplicationName As String, ByVal lpCommandLine As String, _

        lpProcessAttributes As Any, lpThreadAttributes As Any, ByVal _

        bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal _

        lpEnvironment As Any, ByVal lpCurrentDriectory As String, _

        lpStartupInfo As STARTUPINFO, lpProcessInformation As _

        PROCESS_INFORMATION) As Long

Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As _

        Byte, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As _

        Long, ByVal lpOverlapped As Any) As Long

Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (LPMSG As MSG, _

        ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax _

        As Long, ByVal wRemoveMsg As Long) As Long

3．删除项目中已有的Class Moduel（类模块），添加一新Class Moduel取名为LogonUser，内容为：

Option Explicit

‘windows API 常量

Const LOGON32_LOGON_INTERACTIVE = 2

Const LOGON32_PROVIDER_DEFAULT = 0

Public Function Logon(ByVal strAdminUser As String, ByVal _

strAdminPassword As String, ByVal strAdminDomain As String) As Boolean

     Dim lngTokenHandle, lngLogonType, lngLogonProvider As Long

     Dim blnResult As Boolean

     lngLogonType = LOGON32_LOGON_INTERACTIVE

     lngLogonProvider = LOGON32_PROVIDER_DEFAULT

     blnResult = RevertToSelf()  ‘恢复原用户身份

     If Not blnResult Then

         Logon = False

         Exit Function

     End If

     ‘以新的用户身份登陆

     Logon = LogonUser(strAdminUser, strAdminDomain, strAdminPassword, _

                 lngLogonType,lngLogonProvider, lngTokenHandle)

 End Function

4．在添加一Class Moduel，取名为RunDosCmd，内容为：

' 在asp中运行命令行程序或dos命令

' 该命令行程序或dos命令只向控制台输出结果字符串。

Option Explicit

‘windows API 常量

Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100

Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000

Const NORMAL_PRIORITY_CLASS = &H20&

Const SUBLANG_DEFAULT = &H1

‘windows API 所用的数据结构

Type SECURITY_ATTRIBUTES

    nLength As Long

    lpSecurityDescriptor As Long

    bInheritHandle As Long

End Type

Type PROCESS_INFORMATION

    hProcess As Long

    hThread As Long

    dwProcessId As Long

    dwThreadId As Long

End Type

Type STARTUPINFO

  cb As Long

  lpReserved As String

  lpDesktop As String

  lpTitle As String

  dwX As Long

  dwY As Long

  dwXSize As Long

  dwYSize As Long

  dwXCountChars As Long

  dwYCountChars As Long

  dwFillAttribute As Long

  dwFlags As Long

  wShowWindow As Integer

  cbReserved2 As Integer

  lpReserved2 As Long

    hStdInput As Long

    hStdOutput As Long

  hStdError As Long

End Type

Type OVERLAPPED

    Internal As Long

    InternalHigh As Long

    offset As Long

    OffsetHigh As Long

    hEvent As Long

End Type

Type POINTAPI

    x As Long

    y As Long

End Type

Type MSG

    hwnd As Long

    message As Long

    wParam As Long

    lParam As Long

    time As Long

    pt As POINTAPI

End Type

Function RunCmd(ByVal cmdline As String) As String

    Dim proc As PROCESS_INFORMATION, si As STARTUPINFO

    Dim sa As SECURITY_ATTRIBUTES, LPMSG As MSG

Dim ret As Long, bSuccess As Long, blProcExited As Boolean

    Dim hReadPipe1 As Long, hReadPipe As Long, hWritePipe As Long

    Dim BytesRead As Long, lpExitCode  As Long

Dim mybuff() As Byte, mybufflen As Long, tmp As String

    Dim lpTotalBytesAvail As Long, lpBytesLeftThisMessage As Long

    RunCmd = ""

    blProcExited = False

    ReDim mybuff(8256)

    mybufflen = 0

    sa.nLength = Len(sa)

    sa.bInheritHandle = 1&

    sa.lpSecurityDescriptor = 0&

    ‘创建匿名管道

    If 0 = CreatePipe(hReadPipe, hWritePipe, sa, 0) Then

        RunCmd = DllErrorMsg("CreatePipe")

        Exit Function

    End If

    ‘设置命令行程序的启动设置，命令行程序的标准输出和错误输出都转向

    ‘匿名管道

    si.cb = Len(si)

    si.dwFlags = &H101

    si.hStdOutput = hWritePipe

    si.hStdError = hWritePipe

    ‘执行命令行程序

If 0 = CreateProcess(vbNullString, cmdline, sa, sa, 1&, _

       NORMAL_PRIORITY_CLASS, vbNullString, vbNullString, si, proc) Then

        RunCmd = DllErrorMsg("CreateProcess")

        Exit Function

    End If

    ‘等待命令程序运行结束

    ret = WaitForSingleObject(proc.hProcess, 400)

    Do

        ret = PeekNamedPipe(hReadPipe, mybuff, 1&, BytesRead, _

             lpTotalBytesAvail, lpBytesLeftThisMessage)

        If ret = 0 Then

            RunCmd = DllErrorMsg("PeekNamedPipe ")

            Exit Function

        End If

        If BytesRead = 0 Then

            ret = WaitForSingleObject(proc.hProcess, 400&)

            If ret <> 0 Then

                ret = PeekMessage(LPMSG, 0&, 0&, 0&, 0&)

                If ret = 0 Then

                    ret = TerminateProcess(proc.hProcess, 0&)

                    If ret = 0 Then

                        RunCmd = DllErrorMsg("TerminateProcess")

                        Exit Function

                    End If

                    Exit Do

                Else

                    ret = GetExitCodeProcess(proc.hProcess, lpExitCode)

                    If lpExitCode <> &H103 Then

                        If blProcExited = False Then

                            blProcExited = True

                        Else

                            Exit Do

                        End If

                    Else

                        Sleep (10)

                    End If

                End If

            Else

                Exit Do

            End If

        Else

            ReDim Preserve mybuff(mybufflen + 8256)

‘从匿名管道中读取命令行程序执行结果

            bSuccess = ReadFile(hReadPipe, mybuff(mybufflen), 8250, _

                      BytesRead, vbNullString) 

            If bSuccess = 0 Or BytesRead < 0 Then

                RunCmd = DllErrorMsg("ReadFile")

                Exit Function

            End If

            mybufflen = mybufflen + BytesRead

        End If

    Loop

    tmp = StrConv(mybuff(), vbUnicode)

    tmp = Left(tmp, InStr(tmp, Chr(0)) - 1)

    RunCmd = tmp

    ret = CloseHandle(proc.hProcess)

    ret = CloseHandle(proc.hThread)

    ret = CloseHandle(hReadPipe)

    ret = CloseHandle(hWritePipe)

End Function

Private Function DllErrorMsg(ByVal sApi As String) As String

‘把Windows API函数运行时错误号，翻译成明文字符串

Dim langid As Long

Dim lpBuffer As Long

Dim bResult As Long

Dim szPrintBuffer(512) As Byte

Dim str1 As String

Dim lasterr As Long

lasterr = Err.LastDllError

langid = SUBLANG_DEFAULT * 2 * 2 * 2 * 2 * 2 * 2 * 2 * 2 * 2 * 2

bResult = FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER _

          Or FORMAT_MESSAGE_FROM_SYSTEM, 0&, lasterr, _

          langid, lpBuffer, 0&, 0&)

bResult = wsprintf(szPrintBuffer(0), _

         "ERROR: API    = %s." & vbCr & "   error code = %d." & vbCr _

          & "   message    = %s." & vbCr, _

          sApi, lasterr, lpBuffer)

str1 = StrConv(szPrintBuffer(), vbUnicode)

str1 = Left(str1, InStr(str1, Chr(0)) - 1)

bResult = LocalFree(lpBuffer)

DllErrorMsg = str1

End Function

5，在硬盘上建一新目录zhaspdll,保存项目，将module(模块)、Class Module（类模块）、project（项目）文件保存于该目录下，从File（文件）下拉菜单中选择Make zhaspdll，创建zhaspdll.dll文件，VB将自动在注册表中注册该组件。

要手工注册该组件，可以将该组件复制到c:\winnt\system32目录中，然后运行regsvr32 c:\winnt\system32\zhaspdll.dll。运行regsvr32 /u c:\winnt\system32\zhaspdll.dll将撤销该组件的注册。

四、在WEB下更改win2000用户密码

在WEB下更改密码需要建立两个网页，mima_wh.htm，mima_gg.asp。

mima_wh.htm让用户填写用户的用户名、旧密码、新密码。

mima_gg.asp根据用户填写的信息，尝试更改密码，并返回结果。

mima._wh.htm的代码如下：

<html>

<head>

<meta name="GENERATOR" content="Microsoft FrontPage 5.0">

<meta http-equiv="Content-Type" content="text/html; charset=gb2312">

<title>网站用户密码维护</title>

</head>

<body>

<p align="center">&nbsp;<font size="4">网站用户密码维护 </font></p>

<form method="POST" action="mima_gg.asp">

  <p align="center">用户名：<input type="text" name="yonghu" size="20"></p>

  <p align="center">旧密码：<input type="password" name="jiu_mima" size="20"></p>

  <p align="center">新密码：<input type="password" name="xin_mima1" size="20"></p>

  <p align="center">确认新密码：<input type="password" name="xin_mima" size="20"></p>

  <p align="center"><input type="submit" value="提交" name="B1">&nbsp; <input type="reset" value="重置" name="B2"></p>

</form>

</body>

</html>

mima_gg.asp的代码如下:

<html><head>

<meta name="GENERATOR" content="Microsoft FrontPage 5.0">

<meta name="ProgId" content="FrontPage.Editor.Document">

<meta http-equiv="Content-Type" content="text/html; charset=gb2312">

<title>网站用户密码维护_gg</title>

</head><body>

<%

       '从mima_wh.htm接收参数，并做简单的有效性检查

       yonghu=trim(Request.Form("yonghu"))

       jiumima=trim(Request.Form("jiu_mima"))

       xinmima1=trim(Request.Form("xin_mima1"))

       xinmima2=trim(Request.Form("xin_mima2"))

       if yonghu="" then

          response.write "用户名不能空"

          response.end

       end if

       if jiumima="" then

          response.write "旧密码不能空"

          response.end

       end if

       if xinmima1="" then

          response.write "新密码不能空"

          response.end

       end if

       Dim objLogon，objrun

       Set objrun = Server.CreateObject("zhaspdll.RunDosCmd")

       Set objlogon = Server.CreateObject("zhaspdll.LogonUser")

       '验证用户名和旧密码是否有效

       if not objlogon.logon(yonghu,jiumima,".") then

              response.write "用户名或密码错误！"

       else

              '设置新密码

              objrun.runcmd("net user " & yonghu & " " & xinmima1)

              '验证新密码是否设置成功

              if not objlogon.logon(yonghu,xinmima1,".") then

                     response.write "改密码出现意外错误，请和管理员联系！"

              else

                     response.write "改密码成功！"

              end if

       end if

       response.end

       set objlogon=nothing

       set objrun=nothing

%>

</body>

</html>

五、注意事项

上述程序在Windows 2000 Server 、Windows 2000 Professional +IIS5.0+VB6.0下调试通过。

zhaspdll的LogonUser类的LogonUser方法不能用于域控制服务器上的普通用户，可用于域控制服务器上的系统管理员用户及独立服务器的所有用户。

mima_gg.asp所在的虚拟目录的属性中 “应用程序保护”一项需要设为“低（IIS进程）”，否则，zhaspdll的调用不能成功，建议单独为密码的维护建立一虚拟目录，以免和其他应用的配置冲突。

在调试zhaspdll.dll的过程中，一旦调用了zhaspdll，在VB中将不能重新生成zhaspdll.dll,可以在控制面板->计算机管理->服务中，停止IIS Admin 服务，然后再重新启动IIS Admin  服务及其下的FTP、WWW服务等，这样就可以重新生成zhaspdll.dll。

六、结束语

本文仅给出了在WEB方式下更改密码的例子，关于添加用户、删除用户的操作等，读者可以参考net user 的帮助说明，自行设计。