首页 >> 读书频道 >> 电脑 >> 用ASP、VB和XML建立互联网应用程序(4)
 
· 用ASP、VB和XML建
· 用ASP、VB和XML建
· 用ASP、VB和XML建
· 带日期标注的日历控件
· 在SQL2000查询中使
· 在ASP中判断SQL语句
· rs.open sql,
· 如何编程实现修改数据库
· Select INTO
· 如何 编程实现 备份数据
· 我需要多大马力?(自MS
· ADO如何新增修改删除数
 
· 全唐诗卷四十六
· 韩剧《布拉格恋人》剧情介
· 夜航船[作者:明·张岱]
· 局外人[作者:韩·可爱淘
· 现场流行病学
· 源氏物语[日本:紫式部]
· 红楼梦:120回全本[清
· 武林寓言故事
· 2006高考录取规则
· 首批中国世界名牌产品和2
· 济南美食大全
· 管理三十六计
 
· (出租)中动商场部分及写
· (出租)中动动漫基地&#
· 喜剧学院
· 《善德女王》剧情介绍
· 魔女18号 剧情
· 丑女无敌剧情介绍
· 魔女幼熙剧情介绍
· 龙游天下剧情介绍
· 震撼世界的七日剧情介绍
· 静静的白桦林剧情介绍
· 心情日记—老公今天我想对
· 旗舰剧情介绍
欢迎来到月影社区!如果您觉得这里不错,请推荐给您的朋友们。月影社区:http://wf66.com/

用ASP、VB和XML建立互联网应用程序(4)


查看有无更新版本

关键字:XML相关 2006-8-28

 

前面我们已经介绍了使用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
%>





原作者:Wayne
来 源:www.yesky.com

用ASP、VB和XML建立互联网应用程序(4)

[ 1 ]
用ASP、VB和XML建立互联网应用程序(4) num

打印本页 关闭

关于我们版权声明本站导航友情连结作品演示 TOP↑