使用ASP、VB和XML建立运行于互联网上的应用程序

让我们先分析一下客户端/服务器应用程序。在一个标准的客户端/服务器应用程序中，在应用程序开始时，你能够初始化数据库连接字符串，这就意味着，客户有使用数据库连接字符串的权利，这包括用户名和口令。

但是客观情况如果不允许你在网络上发送这些信息的话，你就必需在不联接数据库的情况下直接从客户端取得数据发送给客户。那么解决方案之一就是在服务器上创建一个ASP页（在本例中称为getData.asp）接收特定格式的POST数据，它要求一个包含XML字符串，用来创建ADO对象并运行存储过程或动态SQL语句命令。

如果信息有效的话，getData.asp执行存储过程，并返回一个XML格式的数据集、返回值列表或错误页面信息的XML字符串。对于返回数据的命令，客户端要么重新实例化要么返回值或使用XML DOM(Document Object Model文档对象模型）格式的错误页面。

下面就让我们来讨论一下如何实现这个页面吧！

getData.asp页面首先使用一个DOMDocument对象来保存客户端发送的数据：

'创建DOMDocument对象

Set xml = Server.CreateObject ("msxml2.DOMDocument")

xml.async = False

然后，它装载POST数据

'装载POST数据

xml.Load Request

If xml.parseError.errorCode ＜＞ 0 Then

　Call responseError ("不能装载XML信息。" & "Description: " & xml.parseError.reason & "＜br＞Line: " & xml.parseError.Line)

End If

　 它能够返回commandtext元素值和returndata或returnvalue元素值。下面我只给出返回commandtext元素值的代码，其余代码请参看我下面所附的源程序。

Set N = xml.selectSingleNode("command/commandtext")

If N Is Nothing Then

　Call responseError ("缺少 ＜sp_name＞ 参数。")

Else sp_name = N.Text

End If

接着，应该让页面创建一个Command对象，读入所有＜param＞元素，并且为request中的每一个元素创建一个参数。最后，让页面打开一个连接使用存储过程adExecuteNoRecords选项来执行request。

set conn = Server.CreateObject("ADODB.Connection")

conn.Mode=adModeReadWrite

conn.open Application("ConnectionString")

set cm.ActiveConnection=conn

' 返回数据

if not returnsData then

cm.Execute

else

　set R = server.CreateObject("ADODB.Recordset")

　R.CursorLocation = adUseClient

　R.Open cm, ,adOpenStatic, adLockReadOnly

end if

如果能够返回数据的话，那么returnData变量就为真值，并且把结果数据集返回到客户端，仍然是一个XML文档。

if returnsData then

　R.Save Response, adPersistXML

if err.number ＜＞ 0 then

　call responseError ("数据集发生存储错误" & "在命令'" & CommandText & "': " & 　Err.Description)

　Response.end

end if

如果输出参数返回值，那么这个页面将返回一个包含这些值的XML字符串。文档的根元素是一个＜values＞标记，每一个返回值都有其相应的子元素，如果发生任何错误，页面都会格式化并返回一个包含错误信息的XML字符串：

Sub responseError(sDescription)

　Response.Write "＜response＞＜data＞错误: " & sDescription & "＜/data＞＜/response＞"

　Response.end

End Sub

假设在我们前面所说的例子中，我们想在应用程序中显示区域的左半边显示客户的姓名列表，再在每个客户姓名后面加上两个链接：Purchase History和Recent Purchase。当用户点击其中的一个链接，客户程序就会运行一个存储过程并在右边区域显示出结果。为了显示这个想法的灵活性，我想让用于返回数据的三个操作单元执行不同的工作过程，它们都调用getData.asp。

首先，通过调用CustOrderHist来运行一个存储过程，返回客户的Purchase History，它搜索Northwind数据库（为了方便起见我使用MS SQL中自带的数据库）并返回一个数据集。用于返回Recent Purchase 的查询语句运行一个叫RecentPurchaseByCustomerID的存储过程，来接收输入的CustomerID参数并通过ProductName参数返回最近顾客购买的商品名。定义其处理过程相应SQL语句如下：

CREATE PROCEDURE RecentPurchaseByCustomerID @CustomerID nchar(5), @ProductName nchar(40) output AS SELECT @ProductName = (SELECT top 1 ProductName FROM Products INNER JOIN ([Order Details] INNER JOIN Orders ON Orders.OrderID=[Order Details].OrderID) ON Products.ProductID = [Order Details].ProductID WHERE Orders.OrderDate = (SELECT MAX(orders.orderdate) FROM Orders

where CustomerID=@CustomerID) AND Orders.CustomerID=@CustomerID) GO

不管你的查询语句中含有动态SQL语句还是含有返回记录集的存储过程或是输出一个返回值，其处理POST消息的方法是一样的：

set xhttp = createObject ("msxml2.XMLHTTP")

xhttp.open "POST", "http://localhost/myWeb/ getData.asp", False

xhttp.send s

现在让我们看一看如何发送和接收数据

客户端的XML信息是由一个＜command＞元素和一些子元素组成：＜commandtext＞元素包含了存储过程的名称，＜returnsdata＞元素告诉服务器，客户端是否要求接收返回数据，＜param＞元素包含参数信息。如果不使用参数的话，那么最简单的发送字符串查询就象下面这样：

＜command＞

　＜commandtext＞

存储过程或动态SQL语句

＜/commandtext＞

　＜returnsvalues＞True＜/returnsvalues＞

＜/command＞

你可以为每一个参数使用一个＜param＞元素，来添加参数。每个＜param＞元素有五个子元素：name，type，direction，size和value。子元素的顺序可以随意调换，但是所有的元素都应当有不能缺少，我通常按照定义一个ADO对象的值的顺序来定义它们。举例来说，CustOrderHist存储过程需要一个CustomID参数，所以用来创建发送到getData.asp的XML字符串的代码为：

dim s

　s = "＜?xml version=""1.0""?＞" & vbcrlf

　s = s & "＜command＞＜commandtext＞"

　s = s & "CustOrderHist"

　s = s & "＜/commandtext＞"

　s = s & "＜returnsdata＞" &True＜/returnsdata＞"

　s = s & "＜param＞"

　s = s & "＜name＞CustomerID＜/name＞"

　s = s & "＜type＞＜%=adVarChar%＞＜/type＞"

　s = s & "＜direction＞" & ＜%=adParamInput%＞＜/direction＞"

　s = s & "＜size＞" & len(CustomerID)& "＜/size＞"

　s = s & "＜value＞" & CustomerID &"＜/value＞"

　s = s & "＜/param＞"

　s = s & "＜/command＞"

注意，前面的代码都是客户端代码，ADO常量是不在客户端定义的-这就是它们为什么使用＜% %＞标记围起来的原因。服务器在发送响应之前使用正确的值取代它们。getData.asp页有一个Response.ContentType，它的属性为"text/xml",这样，你就可以使用ResponseXML属性来返回结果了。当请求返回纪录，你就可以创建一个Recordset对象并且使用XMLHTTP来打开它：

Dim R

　set R = createObject("ADODB.Recordset")

　R.open xhttp.responseXML

当查询语句返回数据时，通过设置XMLHTTPRequest对象的responseXML属性来创建一个DOMDocument：

Dim xml

　set xml = xhttp.responseXML

输出参数的XML字符串的每个返回值都包含一个元素，它们都是根元素＜values＞的直接子元素，例如：

＜?xml version=""1.0"" encoding=""gb2312""?＞

＜values＞

＜paramname＞value＜/paramname＞

　＜paramname＞value＜/paramname＞

＜/values＞

如果你的数据使用别的国家的文字，你可能需要把编码属性用相应的编码替换，例如对于大部分欧洲语言，可以使用ISO-8859-1

客户端页面使用返回的数据来格式化一个HTML字符串用于显示，如：

document.all("details").innerHTML = ＜一些格式化的HTML字符串＞

前面我们已经介绍了使用ASP和XML混合编程，那是因为ASP页面能够很容易让我们看清应用程序正在做什么，但是你如果你不想使用ASP的话，你也可以使用任何你熟悉的技术去创建一个客户端程序。下面，我提供了一段VB代码，它的功能和ASP页面一样，也可以显示相同的数据，但是这个VB程序不会创建发送到服务器的XML字符串。它通过运行一个名叫Initialize的存储过程，从服务器取回XML字符串，来查询ClientCommands表的内容。

ClientCommands表包括两个域：command_name域和command_xml域。客户端程序需要三个特定的command_name域:getCustomerList,CustOrderHist和RecentPurchaseByCustomerID。每一个命令的command_xml域包括程序发送到getData.asp页面的XML字符串，这样，就可以集中控制XML字符串了，就象存储过程名字所表现的意思一样，在发送XML字符串到getData.asp之前，客户端程序使用XML DOM来设置存储过程的参数值。我提供的代码，包含了用于定义Initialize过程和用于创建ClientCommands表的SQL语句。

提供的例程中还说明了如何使用XHTTPRequest对象实现我在本文一开始时许下的承诺:任何远程的机器上的应用程序都可以访问getData.asp；当然，你也可以通过设置IIS和NTFS权限来限制访问ASP页面；你可以在服务器上而不是客户机上存储全局应用程序设置；你可以避免通过网络发送数据库用户名和密码所带来的隐患性。还有，在IE中，应用程序可以只显示需要的数据而不用刷新整个页面。

在实际的编程过程中，你们应当使用一些方法使应用程序更加有高效性。你可以把ASP中的关于取得数据的代码端搬到一个COM应用程序中去然后创建一个XSLT变换来显示返回的数据。好，我不多说了，现在你所要做的就是试一试吧！

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()

　' 从数据库返回命令名和相应的值

　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 = "最近的产品是: " & 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)

　' 找出列表中相关联的ID号

　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 , 因为它是一个记录集

　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

'发生错误

　

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

　 ' 创建DOMDocument对象

　Set xml = Server.CreateObject("msxml2.DOMDocument")

　xml.async = False

　' 装载POST数据

　xml.Load Request

　If xml.parseError.errorCode ＜＞ 0 Then

Call responseError("不能装载 XML信息。 描述: " & xml.parseError.reason & "＜br＞行数: " & xml.parseError.Line)

　End If

　' 客户端必须发送一个commandText元素

　Set N = xml.selectSingleNode("command/commandtext")

　If N Is Nothing Then

Call responseError("Missing ＜commandText＞ parameter.")

　Else

commandText = N.Text

　End If

　' 客户端必须发送一个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

　' 创建参数

　set nodes = xml.selectNodes("command/param")

　if nodes is nothing then

' 如果没有参数

　elseif nodes.length = 0 then

　' 如果没有参数

　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("创建参数: 不能发现名称标签。")

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("参数名为 '" & paramName & "'的参数缺少必要的域")

end if

cm.Parameters.Append 　cm.CreateParameter(paramName,paramType,paramDirection,paramSize,paramValue)

if err.number ＜＞ 0 then

　call responseError("不能创建或添加名为 '" & paramName & "的参数.' " &　err.description)

　 Response.end

end if

　next

　on error goto 0

end if

　'打开连结

　set conn = Server.CreateObject("ADODB.Connection")

　conn.Mode=adModeReadWrite

　conn.open Application("ConnectionString")

　if err.number ＜＞ 0 then

call responseError("连结出错: " & Err.Description)

Response.end

　end if

' 连结Command对象

set cm.ActiveConnection = conn

' 执行命令

if returnsData then

　' 用命令打开一个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("执行命令错误 '" & Commandtext & "': " & Err.Description)

Response.end

　end if

　if returnsData then

R.Save Response, adPersistXML

if err.number ＜＞ 0 then

　call responseError("数据集发生存储错误，在命令'" & 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

%＞