直播中
工作時(shí)間
9:00 18:00
ClientCommands表包括兩個(gè)域：command_name域和command_xml域?？蛻舳顺绦蛐枰齻€(gè)特定的command_name域:getCustomerList,CustOrderHist和RecentPurchaseByCustomerID。每一個(gè)命令的command_xml域包括程序發(fā)送到getData.asp頁(yè)面的XML字符串，這樣，就可以集中控制XML字符串了，就象存儲(chǔ)過(guò)程名字所表現(xiàn)的意思一樣，在發(fā)送XML字符串到getData.asp之前，客戶端程序使用XML DOM來(lái)設(shè)置存儲(chǔ)過(guò)程的參數(shù)值。我提供的代碼，包含了用于定義Initialize過(guò)程和用于創(chuàng)建ClientCommands表的SQL語(yǔ)句。
我提供的例程中還說(shuō)明了如何使用XHTTPRequest對(duì)象實(shí)現(xiàn)我在本文一開(kāi)始時(shí)許下的承諾:任何遠(yuǎn)程的機(jī)器上的應(yīng)用程序都可以訪問(wèn)getData.asp；當(dāng)然，你也可以通過(guò)設(shè)置IIS和NTFS權(quán)限來(lái)限制訪問(wèn)ASP頁(yè)面；你可以在服務(wù)器上而不是客戶機(jī)上存儲(chǔ)全局應(yīng)用程序設(shè)置；你可以避免通過(guò)網(wǎng)絡(luò)發(fā)送數(shù)據(jù)庫(kù)用戶名和密碼所帶來(lái)的隱患性。還有，在IE中，應(yīng)用程序可以只顯示需要的數(shù)據(jù)而不用刷新整個(gè)頁(yè)面。
在實(shí)際的編程過(guò)程中，你們應(yīng)當(dāng)使用一些方法使應(yīng)用程序更加有高效性。你可以把ASP中的關(guān)于取得數(shù)據(jù)的代碼端搬到一個(gè)COM應(yīng)用程序中去然后創(chuàng)建一個(gè)XSLT變換來(lái)顯示返回的數(shù)據(jù)。好，我不多說(shuō)了，現(xiàn)在你所要做的就是試一試吧！
Option Explicit
Private RCommands As Recordset
Private RCustomers As Recordset
Private RCust As Recordset
Private sCustListCommand As String
Private Const dataURL = "http://localhost/XHTTPRequest/getData.asp"
Private arrCustomerIDs() As String
Private Enum ActionEnum
VIEW_HISTORY = 0
VIEW_RECENT_PRODUCT = 1
End Enum
Private Sub dgCustomers_Click()
Dim CustomerID As String
CustomerID = RCustomers("CustomerID").Value
If CustomerID ＜＞ "" Then
If optAction(VIEW_HISTORY).Value Then
Call getCustomerDetail(CustomerID)
Else
Call getRecentProduct(CustomerID)
End If
End If
End Sub
Private Sub Form_Load()
Call initialize
Call getCustomerList
End Sub
Sub initialize()
' 從數(shù)據(jù)庫(kù)返回命令名和相應(yīng)的值
Dim sXML As String
Dim vRet As Variant
Dim F As Field
sXML = "＜?xml version=""1.0""?＞"
sXML = sXML & "＜command＞＜commandtext＞Initialize＜/commandtext＞"
sXML = sXML & "＜returnsdata＞True＜/returnsdata＞"
sXML = sXML & "＜/command＞"
Set RCommands = getRecordset(sXML)
Do While Not RCommands.EOF
For Each F In RCommands.Fields
Debug.Print F.Name & "=" & F.Value
Next
RCommands.MoveNext
Loop
End Sub
Function getCommandXML(command_name As String) As String
RCommands.MoveFirst
RCommands.Find "command_name='" & command_name & "'", , adSearchForward, 1
If RCommands.EOF Then
MsgBox "Cannot find any command associated with the name '" & command_name & "'."
Exit Function
Else
getCommandXML = RCommands("command_xml")
End If
End Function
Sub getRecentProduct(CustomerID As String)
Dim sXML As String
Dim xml As DOMDocument
Dim N As IXMLDOMNode
Dim productName As String
sXML = getCommandXML("RecentPurchaseByCustomerID")
Set xml = New DOMDocument
xml.loadXML sXML
Set N = xml.selectSingleNode("command/param[name='CustomerID']/value")
N.Text = CustomerID
Set xml = executeSPWithReturn(xml.xml)
productName = xml.selectSingleNode("values/ProductName").Text
' 顯示text域
txtResult.Text = ""
Me.txtResult.Visible = True
dgResult.Visible = False
' 顯示product名
txtResult.Text = "最近的產(chǎn)品是: " & productName
End Sub
Sub getCustomerList()
Dim sXML As String
Dim i As Integer
Dim s As String
sXML = getCommandXML("getCustomerList")
Set RCustomers = getRecordset(sXML)
Set dgCustomers.DataSource = RCustomers
End Sub
Sub getCustomerDetail(CustomerID As String)
' 找出列表中相關(guān)聯(lián)的ID號(hào)
Dim sXML As String
Dim R As Recordset
Dim F As Field
Dim s As String
Dim N As IXMLDOMNode
Dim xml As DOMDocument
sXML = getCommandXML("CustOrderHist")
Set xml = New DOMDocument
xml.loadXML sXML
Set N = xml.selectSingleNode("command/param[name='CustomerID']/value")
N.Text = CustomerID
Set R = getRecordset(xml.xml)
' 隱藏 text , 因?yàn)樗且粋€(gè)記錄集
txtResult.Visible = False
dgResult.Visible = True
Set dgResult.DataSource = R
End Sub
Function getRecordset(sXML As String) As Recordset
Dim R As Recordset
Dim xml As DOMDocument
Set xml = getData(sXML)
Debug.Print TypeName(xml)
On Error Resume Next
Set R = New Recordset
R.Open xml
If Err.Number ＜＞ 0 Then
MsgBox Err.Description
Exit Function
Else
Set getRecordset = R
End If
End Function
Function executeSPWithReturn(sXML As String) As DOMDocument
Dim d As New Dictionary
Dim xml As DOMDocument
Dim nodes As IXMLDOMNodeList
Dim N As IXMLDOMNode
Set xml = getData(sXML)
If xml.documentElement.nodeName = "values" Then
Set executeSPWithReturn = xml
Else
'發(fā)生錯(cuò)誤
Set N = xml.selectSingleNode("response/data")
If Not N Is Nothing Then
MsgBox N.Text
Exit Function
Else
MsgBox xml.xml
Exit Function
End If
End If
End Function
Function getData(sXML As String) As DOMDocument
Dim xhttp As New XMLHTTP30
xhttp.Open "POST", dataURL, False
xhttp.send sXML
Debug.Print xhttp.responseText
Set getData = xhttp.responseXML
End Function
Private Sub optAction_Click(Index As Integer)
Call dgCustomers_Click
End Sub
代碼二、getData.asp
＜%@ Language=VBScript %＞
＜% option explicit %＞
?。?
Sub responseError(sDescription)
Response.Write "＜response＞＜data＞Error: " & sDescription & "＜/data＞＜/response＞"
Response.end
End Sub
Response.ContentType="text/xml"
dim xml
dim commandText
dim returnsData
dim returnsValues
dim recordsAffected
dim param
dim paramName
dim paramType
dim paramDirection
dim paramSize
dim paramValue
dim N
dim nodeName
dim nodes
dim conn
dim sXML
dim R
dim cm
' 創(chuàng)建DOMDocument對(duì)象
Set xml = Server.CreateObject("msxml2.DOMDocument")
xml.async = False
' 裝載POST數(shù)據(jù)
xml.Load Request
If xml.parseError.errorCode ＜＞ 0 Then
Call responseError("不能裝載 XML信息。 描述: " & xml.parseError.reason & "＜br＞行數(shù): " & xml.parseError.Line)
End If
' 客戶端必須發(fā)送一個(gè)commandText元素
Set N = xml.selectSingleNode("command/commandtext")
If N Is Nothing Then
Call responseError("Missing ＜commandText＞ parameter.")
Else
commandText = N.Text
End If
' 客戶端必須發(fā)送一個(gè)returnsdata或者returnsvalue元素
set N = xml.selectSingleNode("command/returnsdata")
if N is nothing then
set N = xml.selectSingleNode("command/returnsvalues")
if N is nothing then
call responseError("Missing ＜returnsdata＞ or ＜returnsValues＞ parameter.")
else
returnsValues = (lcase(N.Text)="true")
end if
else
returnsData=(lcase(N.Text)="true")
end if
set cm = server.CreateObject("ADODB.Command")
cm.CommandText = commandText
if instr(1, commandText, " ", vbBinaryCompare) ＞ 0 then
cm.CommandType=adCmdText
else
cm.CommandType = adCmdStoredProc
end if
' 創(chuàng)建參數(shù)
set nodes = xml.selectNodes("command/param")
if nodes is nothing then
' 如果沒(méi)有參數(shù)
elseif nodes.length = 0 then
' 如果沒(méi)有參數(shù)
else
for each param in nodes
' Response.Write server.HTMLEncode(param.xml) & "＜br＞"
on error resume next
paramName = param.selectSingleNode("name").text
if err.number ＜＞ 0 then
call responseError("創(chuàng)建參數(shù): 不能發(fā)現(xiàn)名稱標(biāo)簽。")
end if
paramType = param.selectSingleNode("type").text
paramDirection = param.selectSingleNode("direction").text
paramSize = param.selectSingleNode("size").text
paramValue = param.selectSingleNode("value").text
if err.number ＜＞ 0 then
call responseError("參數(shù)名為 '" & paramName & "'的參數(shù)缺少必要的域")
end if
cm.Parameters.Append cm.CreateParameter(paramName,paramType,paramDirection,paramSize,paramValue)
if err.number ＜＞ 0 then
call responseError("不能創(chuàng)建或添加名為 '" & paramName & "的參數(shù).' " & err.description)
Response.end
end if
next
on error goto 0
end if
'打開(kāi)連結(jié)
set conn = Server.CreateObject("ADODB.Connection")
conn.Mode=adModeReadWrite
conn.open Application("ConnectionString")
if err.number ＜＞ 0 then
call responseError("連結(jié)出錯(cuò): " & Err.Description)
Response.end
end if
' 連結(jié)Command對(duì)象
set cm.ActiveConnection = conn
' 執(zhí)行命令
if returnsData then
' 用命令打開(kāi)一個(gè)Recordset
set R = server.CreateObject("ADODB.Recordset")
R.CursorLocation = adUseClient
R.Open cm,,adOpenStatic,adLockReadOnly
else
cm.Execute recordsAffected, ,adExecuteNoRecords
end if
if err.number ＜＞ 0 then
call responseError("執(zhí)行命令錯(cuò)誤 '" & Commandtext & "': " & Err.Description)
Response.end
end if
if returnsData then
R.Save Response, adPersistXML
if err.number ＜＞ 0 then
call responseError("數(shù)據(jù)集發(fā)生存儲(chǔ)錯(cuò)誤，在命令'" & CommandText & "': " & Err.Description)
Response.end
end if
elseif returnsValues then
sXML = "＜?xml version=""1.0"" encoding=""gb2312""?＞" & vbcrlf & "＜values＞"
set nodes = xml.selectNodes("command/param[direction='2']")
for each N in nodes
nodeName = N.selectSingleNode("name").text
sXML = sXML & "＜" & nodename & "＞" & cm.Parameters(nodename).Value & "" & "＜/" & nodename & "＞"
next
sXML = sXML & "＜/values＞"
Response.Write sXML
end if
set cm = nothing
conn.Close
set R = nothing
set conn = nothing
Response.end
%＞
桂公網(wǎng)安備45010502000253號(hào)
電子營(yíng)業(yè)執(zhí)照
