e, 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, 双击“我的
计算机”,右击“安装的软件包”,选“新” -> “软件包”,接下来