ASP、VB和XML建互联网应用程序
日期：2011-03-20 浏览次数：21176 次
前面我们已经介绍了使用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变换来显示返回的数据。好，我不多说了，现在你所要做的就是试一试吧！
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 = getCommandXM
