1. <wbr id="m8vu6"></wbr>

      <del id="m8vu6"><center id="m8vu6"><source id="m8vu6"></source></center></del>
        <p id="m8vu6"><sub id="m8vu6"></sub></p>

        VB.net 2010 視頻教程 VB.net 2010 視頻教程 python基礎視頻教程
        SQL Server 2008 視頻教程 c#入門經典教程 Visual Basic從門到精通視頻教程
        當前位置:
        首頁 > 編程開發 > vb >
        • vb教程之利用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服務器報告一個事件。可以打開事件查看器檢查。


        山東萊蕪鋼鐵集團公司自動化部信息中心
        相關教程
                
        免费看成年人视频大全_免费看成年人视频在线观看