DIV CSS 佈局教程網

sp; 　在個人電腦上使用單機版應用軟件的時代很快就要過去了，現在大部分的應用程序都開發出網絡版或大都需要共享網絡上豐富的數據資源。我們雖然寫了很長時間基於客戶端/服務器的應用程序，但是這些程序大部分只是運行在小型的局域網內部。然而，有很多客觀的原因要求我們要修改這些程序以使它們能夠運行在一個企業的內部網甚至是國際互聯網。

　　是什麼原因迫使我們做呢？首先，隨著一個企業的規模逐漸擴大，公司可能會跨地區甚至跨國經營，每個分公司的員工的數量也會逐年增多，這些在外地的員工肯定需要頻繁地訪問總公司的數據庫資源；其次，集中應用程序的數據資源，能夠使你更好的監控數據庫的訪問和使用情況。第三，你可以通過從一個集中的位置獲取全局應用程序設置，從而維護和更新它們，最終達到緩減應用程序更新的目的。第四，盡量從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


　　代碼二、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
　　%＞