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

Source: Internet
Author: User
Tags exit end integer string
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



Related Article

Alibaba Cloud 10 Year Anniversary

With You, We are Shaping a Digital World, 2009-2019

Learn more >

Apsara Conference 2019

The Rise of Data Intelligence, September 25th - 27th, Hangzhou, China

Learn more >

Alibaba Cloud Free Trial

Learn and experience the power of Alibaba Cloud with a free trial worth $300-1200 USD

Learn more >

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.