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
if returnsData then
R.Save Response, adPersistXML
if err.number <> 0 then
call responseError ("数据集发生存储错误" & "在命令'" & CommandText
& "': " & Err.Description)
Response.end
end if
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
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>"
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 Stri