使用ASP、VB和XML建立運行於互連網上的應用程式

來源:互聯網
上載者:User
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


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

相關文章

Beyond APAC's No.1 Cloud

19.6% IaaS Market Share in Asia Pacific - Gartner IT Service report, 2018

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 >

聯繫我們

該頁面正文內容均來源於網絡整理,並不代表阿里雲官方的觀點,該頁面所提到的產品和服務也與阿里云無關,如果該頁面內容對您造成了困擾,歡迎寫郵件給我們,收到郵件我們將在5個工作日內處理。

如果您發現本社區中有涉嫌抄襲的內容,歡迎發送郵件至: info-contact@alibabacloud.com 進行舉報並提供相關證據,工作人員會在 5 個工作天內聯絡您,一經查實,本站將立刻刪除涉嫌侵權內容。