ASP, VB and XML to build Internet applications

We've already covered using ASP and XML for mixed programming, because ASP pages make it easy for us to see what the application is doing, but if you don't want to use ASP, you can use any technology you know to create a client program. Below, I provide a section of VB code, its function and ASP page, can also display the same data, but this VB program will not create the XML string sent to the server. It queries the contents of the Clientcommands table by running a stored procedure called Initialize and retrieving the XML string from the server.

The Clientcommands table includes two domains: Command_name domain and Command_xml domain. The client program requires three specific command_name domains: Getcustomerlist,custorderhist and Recentpurchasebycustomerid. The command_ of every command An XML field includes an XML string that a program sends to a getdata.asp page, so that you can centralize control over an XML string, just as the stored procedure name means, before sending an XML string to GetData.asp, the client program uses the XML Dom to set the parameter values of the stored procedure. The code that I provide contains the SQL statements that define the initialize process and the Clientcommands table to create.

The routines I provide also explain how to use the Xhttprequest object to implement the commitments I made at the outset of this article: GetData.asp can be accessed by applications on any remote machine; Of course, you can also restrict access to ASP pages by setting IIS and NTFS permissions, and you can store global application settings on the server rather than on the client computer, and you can avoid the pitfalls of sending database username and password over the network. Also, in IE, an application can display only the data that is needed without refreshing the entire page.

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 = ' '
SXML = SXML & ' Initialize '
SXML = SXML & ' True '
SXML = SXML & ' '
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 = ' Nearest 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.O Pen XML
If err.number <> 0 Then
MsgBox err.description
Exit Function
Else
Set Getrec Ordset = 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 ' Error: ' & sdescription & ' '
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

' Create a DOMDocument object
Set XML = Server.CreateObject (' MSXML2. DOMDocument ')
Xml.async = False

' Load post data
Xml. Load Request
If xml.parseError.errorCode <> 0 Then
Call Responseerror (' cannot load XML information. Description: ' & Xml.parseError.reason & '
Line number: ' & Xml.parseError.Line '
End If

' The client must send a COMMANDTEXT element
Set N = Xml.selectsinglenode (' Command/commandtext ')
If N is nothing Then
Call Responseerror (' Missing parameter. ')
Else
CommandText = N.text
End If

' The client must send a returnsdata or returnsvalue element
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 or 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

' Create parameters
Set nodes = Xml.selectnodes (' Command/param ')
If nodes is Nothing Then
' If there are no parameters
ElseIf nodes.length = 0 Then
' If there are no parameters
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 (' Create parameter: Cannot find name tag. ')
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 (' parameter named ' & paramname & ' parameter is missing the necessary domain ')
End If
Cm. Parameters.Append cm. CreateParameter (Paramname,paramtype,paramdirection,paramsize,paramvalue)
If Err.Number <> 0 Then
Call Responseerror (' cannot create or add a parameter named ' & ParamName & '. ' ' & Err.Description)
Response.End
End If
Next
On Error Goto 0
End If

' Open the link
Set conn = Server.CreateObject (' ADODB. Connection ')
Conn. Mode=admodereadwrite
Conn.Open application (' ConnectionString ')
If Err.Number <> 0 Then
Call Responseerror (' Link error: ' & Err.Description ')
Response.End
End If

' Link Command object
Set cm. ActiveConnection = conn

' Execute command
If Returnsdata then
' open a recordset with a command
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 (' Execute command error Error ' & CommandText & ': ' & Err.Description '
Response.End
End If

If Returnsdata Then
R.save Response, adPersistXML
If Err.Number <> 0 Then
Call Responseerror (' DataSet has stored error, at command ' & CommandText & ': ' & Err.Description ')
Response.End
End If
ElseIf Returnsvalues Then
SXML = ' ' & vbCrLf & ' '
Set nodes = Xml.selectnodes (' command/param[direction= ' 2 '])
For all N in nodes
NodeName = N.selectsinglenode (' name '). Text
SXML = SXML & ' & nodename & ' ' & cm. Parameters (nodename). Value & ' & ' '
Next
SXML = SXML & ' '
Response.Write SXML
End If

Set cm = Nothing
Conn. Close
Set R = Nothing
Set conn = Nothing
Response.End
%>