|
马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有帐号?立即注册
x
ASP是依赖组件的,能访问数据库的组件好多就有好多种,再有就是你微软的东西可是什么都要收钱的啊!xml|法式|互联网 在团体电脑上利用单机版使用软件的时期很快就要曩昔了,如今大局部的使用法式都开辟出收集版或大都需求同享收集上丰厚的数据资本。咱们固然写了很长工夫基于客户端/办事器的使用法式,然而这些法式大局部只是运转在小型的局域网外部。但是,有良多客不雅的缘由请求咱们要修正这些法式以使它们可以运转在一个企业的外部网乃至是国际互联网。
是甚么缘由迫使咱们做呢?起首,跟着一个企业的范围逐步扩展,公司能够会跨区域乃至跨国运营,每一个分公司的员工的数目也会逐年增多,这些在外埠的员工一定需求频仍地会见总公司的数据库资本;其次,集中使用法式的数据资本,可以使你更好的监控数据库的会见和利用情形。第三,你可以经由过程从一个集中的地位获得全局使用法式设置,从而保护和更新它们,终究到达缓减使用法式更新的目标。第四,尽可能从Web办事器上会见数据库而不是从客户端上会见数据库,如许可以免经由过程收集传送登录信息和客户暗码,从而防止平安隐患;并且,利用阅读器从后台获得数据,如许可以防止刷新全部页面。
这就请求咱们创立一个运转于互联网上的使用法式,而假设想创立一个运转在HTTP协定上的VB法式,那末关头就是利用XML和XMLHTTPRequest对象。这个对象是Microsoft XML剖析器(msxml.dll)的一局部,XMLHTTPRequest对象可让你经由过程HTTP向近程办事器发送GET和POST恳求,运转在近程办事器上的法式吸收这个恳求,翻译出它的内容,前往数据或一个毛病页面到挪用它的使用法式。对收集编程有一些研讨的伴侣会看出我这个假想很象SOAP,然而在这里我不想利用SOAP,由于假如那样的话会使法式变得很庞杂。
想要改动一个完整自力的客户端单机版法式是不太实际的,但即便如斯,从一个集中的办事器高低载使用法式设置也比利用当地的INI文件或Windows注册标有更大的自力性和天真性。举例来讲,假定你有一支手机发卖步队,他们需求会见集中化的信息来更无效的发卖手机,天天,总公司集中搜集数据,然后用电子邮件的模式发送给发卖人员。但是,市场的压力和敏捷变更的发卖模式必将使发卖人员要会见最新的数据信息。然而,收集办理员却保持回绝让在近程客户真个发卖人员会见总公司数据库办事器,由于他们不想经由过程公用的收集发送用户名和登录暗码。因而必将要利用一种新的手艺取代基于客户端/办事器的手艺,不要焦急,我想看完本文你就会处理这个成绩的。
让咱们先剖析一下客户端/办事器使用法式。在一个尺度的客户端/办事器使用法式中,在使用法式入手下手时,你可以初始化数据库毗连字符串,这就意味着,客户有利用数据库毗连字符串的权力,这包含用户名和口令。然而客不雅情形假如不答应你在收集上发送这些信息的话,你就必须在不联接数据库的情形下直接从客户端获得数据发送给客户。那末处理计划之一就是在办事器上创立一个ASP页(在本例中称为getData.asp)吸收特定格局的POST数据,它请求一个包括XML字符串,用来创立ADO对象并运转存储进程或静态SQL语句号令。假如信息无效的话,getData.asp履行存储进程,并前往一个XML格局的数据集、前往值列表或毛病页面信息的XML字符串。关于前往数据的号令,客户端要末从头实例化要末前往值或利用XML DOM(Document Object Model文档对象模子)格局的毛病页面。
好,上面就让咱们来会商一下若何完成这个页面吧!
getData.asp页面起首利用一个DOMDocument对象来保留客户端发送的数据:
'创立DOMDocument对象
Set xml = Server.CreateObject ("msxml2.DOMDocument")
xml.async = False
然后,它装载POST数据
'装载POST数据
xml.Load Request
If xml.parseError.errorCode <> 0 Then
Call responseError ("不克不及装载XML信息。" & "Description: " & xml.parseError.reason & "<br>Line: " & xml.parseError.Line)
End If
它可以前往commandtext元素值和returndata或returnvalue元素值。上面我只给出前往commandtext元素值的代码,其他代码请参看我上面所附的源法式。
Set N = xml.selectSingleNode("command/commandtext")
If N Is Nothing Then
Call responseError ("短少 <sp_name> 参数。")
Else sp_name = N.Text
End If
接着,应当让页面创立一个Command对象,读入一切<param>元素,而且为request中的每个元素创立一个参数。最初,让页面翻开一个毗连利用存储进程adExecuteNoRecords选项来履行request。
set conn = Server.CreateObject("ADODB.Connection")
conn.Mode=adModeReadWrite
conn.open Application("ConnectionString")
set cm.ActiveConnection=conn
' 前往数据
if not returnsData then
cm.Execute
else
set R = server.CreateObject("ADODB.Recordset")
R.CursorLocation = adUseClient
R.Open cm, ,adOpenStatic, adLockReadOnly
end if
假如可以前往数据的话,那末returnData变量就为真值,而且把了局数据集前往到客户端,依然是一个XML文档。
if returnsData then
R.Save Response, adPersistXML
if err.number <> 0 then
call responseError ("数据集产生存储毛病" & "在号令'" & CommandText & "': " & Err.Description)
Response.end
end if
假如输入参数前往值,那末这个页面将前往一个包括这些值的XML字符串。文档的根元素是一个<values>标志,每个前往值都有其响应的子元素,假如产生任何毛病,页面城市格局化并前往一个包括毛病信息的XML字符串:
Sub responseError(sDescription)
Response.Write "<response><data>毛病: " & sDescription & "</data></response>"
Response.end
End Sub
假定在咱们后面所说的例子中,咱们想在使用法式中显示区域的左半边显示客户的姓名列表,再在每一个客户姓名前面加上两个链接:Purchase History和Recent Purchase。当用户点击个中的一个链接,客户法式就会运转一个存储进程并在右侧区域显示出了局。 为了显示这个设法的天真性,我想让用于前往数据的三个操作单位履行分歧的任务进程,它们都挪用getData.asp。起首,经由过程挪用CustOrderHist来运转一个存储进程,前往客户的Purchase History,它搜刮Northwind数据库(为了便利起见我利用MS SQL中自带的数据库)并前往一个数据集。用于前往Recent Purchase 的查询语句运转一个叫RecentPurchaseByCustomerID的存储进程,来吸收输出的CustomerID参数并经由过程ProductName参数前往比来顾客购置的商品名。界说其处置进程响应SQL语句以下:
CREATE PROCEDURE RecentPurchaseByCustomerID @CustomerID nchar(5), @ProductName nchar(40) output AS SELECT @ProductName = (SELECT top 1 ProductName FROM Products INNER JOIN ([Order Details] INNER JOIN Orders ON Orders.OrderID=[Order Details].OrderID) ON Products.ProductID = [Order Details].ProductID WHERE Orders.OrderDate = (SELECT MAX(orders.orderdate) FROM Orders
where CustomerID=@CustomerID) AND Orders.CustomerID=@CustomerID) GO
不论你的查询语句中含有静态SQL语句仍是含有前往纪录集的存储进程或是输入一个前往值,其处置POST动静的办法是一样的:
set xhttp = createObject ("msxml2.XMLHTTP")
xhttp.open "POST", "http://localhost/myWeb/ getData.asp", False
xhttp.send s
好了,如今让咱们看一看若何发送和吸收数据
客户真个XML信息是由一个<command>元素和一些子元素构成:<commandtext>元素包括了存储进程的称号,<returnsdata>元素告知办事器,客户端是不是请求吸收前往数据,<param>元素包括参数信息。假如不利用参数的话,那末最复杂的发送字符串查询就象上面如许:
<command>
<commandtext>
存储进程或静态SQL语句
</commandtext>
<returnsvalues>True</returnsvalues>
</command>
你可觉得每个参数利用一个<param>元素,来添加参数。每一个<param>元素有五个子元素:name,type,direction,size和value。子元素的按次可以随便互换,然而一切的元素都应该有不克不及短少,我凡是依照界说一个ADO对象的值的按次来界说它们。举例来讲,CustOrderHist存储进程需求一个CustomID参数,所以用来创立发送到getData.asp的XML字符串的代码为:
dim s
s = "<?xml version=""1.0""?>" & vbcrlf
s = s & "<command><commandtext>"
s = s & "CustOrderHist"
s = s & "</commandtext>"
s = s & "<returnsdata>" &True</returnsdata>"
s = s & "<param>"
s = s & "<name>CustomerID</name>"
s = s & "<type><%=adVarChar%></type>"
s = s & "<direction>" & <%=adParamInput%></direction>"
s = s & "<size>" & len(CustomerID)& "</size>"
s = s & "<value>" & CustomerID &"</value>"
s = s & "</param>"
s = s & "</command>"
注重,后面的代码都是客户端代码,ADO常量是不在客户端界说的-这就是它们为何利用<% %>标志围起来的缘由。办事器在发送呼应之前利用准确的值代替它们。getData.asp页有一个Response.ContentType,它的属性为"text/xml",如许,你就能够利用ResponseXML属性来前往了局了。当恳求前往记载,你就能够创立一个Recordset对象而且利用XMLHTTP来翻开它:
Dim R
set R = createObject("ADODB.Recordset")
R.open xhttp.responseXML
当查询语句前往数据时,经由过程设置XMLHTTPRequest对象的responseXML属性来创立一个DOMDocument:
Dim xml
set xml = xhttp.responseXML
输入参数的XML字符串的每一个前往值都包括一个元素,它们都是根元素<values>的直接子元素,例如:
<?xml version=""1.0"" encoding=""gb2312""?>
<values>
<paramname>value</paramname>
<paramname>value</paramname>
</values>
假如你的数据利用其余国度的文字,你能够需求把编码属性用响应的编码交换,例如关于大局部欧洲言语,可使用ISO-8859-1
客户端页面利用前往的数据来格局化一个HTML字符串用于显示,如:
document.all("details").innerHTML = <一些格局化的HTML字符串>
后面咱们已引见了利用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
代码2、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
%>专业性的服务。有的ASP商提供垂直型的应用服务,针对某一特定行业提供应用服务。 |
|