197.htm

一些简单的编程例子 都是网页的形式

<p></p>
<p>　　Function getData(sXML As String) As DOMDocument</p>
<p>　　　Dim xhttp As New XMLHTTP30</p>
<p>　　　xhttp.Open "POST", dataURL, False</p>
<p>　　　xhttp.send sXML</p>
<p>　　　Debug.Print xhttp.responseText</p>
<p>　　　Set getData = xhttp.responseXML</p>
<p>　　End Function</p>
<p></p>
<p>　　Private Sub optAction_Click(Index As Integer)</p>
<p>　　　Call dgCustomers_Click</p>
<p>　　End Sub</p>
<p></p>
<p></p>
<p>　　代码二、getData.asp</p>
<p></p>
<p>　　　＜%@ Language=VBScript %＞</p>
<p>　　　＜% option explicit %＞</p>
<p>　　　＜%</p>
<p>　　　　Sub responseError(sDescription)</p>
<p>　　　　Response.Write "＜response＞＜data＞Error: " & sDescription & "＜/data＞＜/response＞"</p>
<p>　　　　Response.end</p>
<p>　　　End Sub</p>
<p></p>
<p>　　　Response.ContentType="text/xml"</p>
<p>　　　dim xml</p>
<p>　　　dim commandText</p>
<p>　　　dim returnsData</p>
<p>　　　dim returnsValues</p>
<p>　　　dim recordsAffected</p>
<p>　　　dim param</p>
<p>　　　dim paramName</p>
<p>　　　dim paramType</p>
<p>　　　dim paramDirection</p>
<p>　　　dim paramSize</p>
<p>　　　dim paramValue</p>
<p>　　　dim N</p>
<p>　　　dim nodeName</p>
<p>　　　dim nodes</p>
<p>　　　dim conn</p>
<p>　　　dim sXML</p>
<p>　　　dim R</p>
<p>　　　dim cm</p>
<p></p>
<p>　　　 注释： 创建DOMDocument对象</p>
<p>　　　Set xml = Server.CreateObject("msxml2.DOMDocument")</p>
<p>　　　xml.async = False</p>
<p></p>
<p>　　　注释： 装载POST数据</p>
<p>　　　xml.Load Request</p>
<p>　　　If xml.parseError.errorCode ＜＞ 0 Then</p>
<p>　　　　Call responseError("不能装载 XML信息。 描述: " & xml.parseError.reason & "＜br＞行数: " & </p>
<p>xml.parseError.Line)</p>
<p>　　　End If</p>
<p></p>
<p>　　　注释： 客户端必须发送一个commandText元素</p>
<p>　　　Set N = xml.selectSingleNode("command/commandtext")</p>
<p>　　　If N Is Nothing Then</p>
<p>　　　　Call responseError("Missing ＜commandText＞ parameter.")</p>
<p>　　　Else</p>
<p>　　　　commandText = N.Text</p>
<p>　　　End If</p>
<p></p>
<p>　　　注释： 客户端必须发送一个returnsdata或者returnsvalue元素</p>
<p>　　　set N = xml.selectSingleNode("command/returnsdata")</p>
<p>　　　if N is nothing then</p>
<p>　　　　set N = xml.selectSingleNode("command/returnsvalues")</p>
<p>　　　　if N is nothing then</p>
<p>　　　　　call responseError("Missing ＜returnsdata＞ or ＜returnsValues＞ parameter.")</p>
<p>　　　　else</p>
<p>　　　　　returnsValues = (lcase(N.Text)="true")</p>
<p>　　　　end if</p>
<p>　　　else</p>
<p>　　　　returnsData=(lcase(N.Text)="true")</p>
<p>　　　end if</p>
<p></p>
<p>　　　set cm = server.CreateObject("ADODB.Command")</p>
<p>　　　cm.CommandText = commandText</p>
<p>　　　if instr(1, commandText, " ", vbBinaryCompare) ＞ 0 then</p>
<p>　　　　cm.CommandType=adCmdText</p>
<p>　　　else</p>
<p>　　　　cm.CommandType = adCmdStoredProc</p>
<p>　　　end if</p>
<p></p>
<p>　　　注释： 创建参数</p>
<p>　　　set nodes = xml.selectNodes("command/param")</p>
<p>　　　if nodes is nothing then</p>
<p>　　　　注释： 如果没有参数 </p>
<p>　　　elseif nodes.length = 0 then</p>
<p>　　　　　注释： 如果没有参数 </p>
<p>　　　else</p>
<p>　　　　　for each param in nodes</p>
<p>　　　　　　注释： Response.Write server.HTMLEncode(param.xml) & "＜br＞"</p>
<p>　　　　　　on error resume next</p>
<p>　　　　　　paramName = param.selectSingleNode("name").text</p>
<p>　　　　　　if err.number ＜＞ 0 then</p>
<p>　　　　　　　call responseError("创建参数: 不能发现名称标签。")</p>
<p>　　　　　　end if</p>
<p>　　　　　　paramType = param.selectSingleNode("type").text</p>
<p>　　　　　　paramDirection = param.selectSingleNode("direction").text</p>
<p>　　　　　　paramSize = param.selectSingleNode("size").text</p>
<p>　　　　　　paramValue = param.selectSingleNode("value").text</p>
<p>　　　　　　if err.number ＜＞ 0 then</p>
<p>　　　　　　　　call responseError("参数名为 注释：" & paramName & "注释：的参数缺少必要的域")</p>
<p>　　　　　　end if</p>
<p>　　　　　　cm.Parameters.Append 　　　　　　　　　　　　　　　　　　　cm.CreateParameter</p>
<p>(paramName,paramType,paramDirection,paramSize,paramValue)</p>
<p>　　　　　　if err.number ＜＞ 0 then</p>
<p>　　　　　　　call responseError("不能创建或添加名为 注释：" & paramName & "的参数.注释： " &　err.description)</p>
<p>　　　　　　　 Response.end</p>
<p>　　　　　　end if</p>
<p>　　　　　next</p>
<p>　　　　　on error goto 0</p>
<p>　　　　end if</p>
<p></p>
<p>　　　注释：打开连结</p>
<p>　　　set conn = Server.CreateObject("ADODB.Connection")</p>
<p>　　　conn.Mode=adModeReadWrite</p>
<p>　　　conn.open Application("ConnectionString")</p>
<p>　　　if err.number ＜＞ 0 then</p>
<p>　　　　call responseError("连结出错: " & Err.Description) </p>
<p>　　　　Response.end</p>
<p>　　　end if</p>
<p></p>
<p>　　注释： 连结Command对象</p>
<p>　　set cm.ActiveConnection = conn</p>
<p></p>
<p>　　注释： 执行命令</p>
<p>　　if returnsData then</p>
<p>　　　注释： 用命令打开一个Recordset </p>
<p>　　　　set R = server.CreateObject("ADODB.Recordset")</p>
<p>　　　　R.CursorLocation = adUseClient</p>
<p>　　　　R.Open cm,,adOpenStatic,adLockReadOnly</p>
<p>　　else</p>
<p>　　　　cm.Execute recordsAffected, ,adExecuteNoRecords</p>
<p>　　end if</p>
<p>　　　if err.number ＜＞ 0 then</p>
<p>　　　　call responseError("执行命令错误 注释：" & Commandtext & "注释：: " & Err.Description) </p>
<p>　　　　Response.end</p>
<p>　　　end if</p>
<p></p>
<p>　　　if returnsData then</p>
<p>　　　　R.Save Response, adPersistXML</p>
<p>　　　　if err.number ＜＞ 0 then</p>
<p>　　　　　call responseError("数据集发生存储错误，在命令注释：" & CommandText & "注释：: " & Err.Description) </p>
<p>　　　　　Response.end</p>
<p>　　　　end if</p>
<p>　　　elseif returnsValues then</p>
<p>　　　　sXML = "＜?xml version=""1.0"" encoding=""gb2312""?＞" & vbcrlf & "＜values＞"</p>
<p>　　　　set nodes = xml.selectNodes("command/param[direction=注释：2注释：]")</p>
<p>　　　　for each N in nodes</p>
<p>　　　　　nodeName = N.selectSingleNode("name").text </p>
<p>　　　　　sXML = sXML & "＜" & nodename & "＞" & cm.Parameters(nodename).Value & "" & "＜/" & nodename </p>
<p>& "＞"</p>
<p>　　　　　next</p>
<p>　　　　　sXML = sXML & "＜/values＞"</p>
<p>　　　　　Response.Write sXML</p>
<p>　　　end if</p>
<p></p>
<p>　　　set cm = nothing</p>
<p>　　　conn.Close</p>
<p>　　　set R = nothing</p>
<p>　　　set conn = nothing</p>
<p>　　　Response.end</p>
<p>　　%＞</p>
<p> </p>