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