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
%＞