Real-World ASP (8): Using ASP, VB and XML to build applications running on the Internet (II.)

xml| Program | Internet |xml| Internet use ASP, VB and XML to build applications running on the Internet (2)
In the actual programming process, you should use a number of methods to make your application more efficient. You can move the code in the ASP to a COM application and then create an XSLT transformation to display the returned data. Well, I don't say much, now all you have to do is try it!

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 ()
' Returns the command name and corresponding value from the database

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 as 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 no 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
' Show Text field
Txtresult.text = ""
Me.txtResult.Visible = True
Dgresult.visible = False
' Show product name
Txtresult.text = "The most recent product is:" & 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)
' Find the ID number associated with the list
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)
' Hide text because it's a recordset
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
' An error occurred
　
Set N = Xml.selectsinglenode ("Response/data")
If not N are 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


Code two, getdata.asp

<%@ Language=vbscript%>
<% Option Explicit%>
<%
Sub Responseerror (sdescription)
Response.Write "<res