A系统 ：
Imports System.Xml
Partial Class _Default
Partial 
Inherits System.Web.UI.Page
Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
Dim strXML As String Dim URL As String Dim strRtn As String strXML = "<?xml version='1.0' encoding='utf-8' ?><ROOT>" strXML = strXML & "<FORM_KIND>***</FORM_KIND>" strXML = strXML & "<IS_UPDATE>N</IS_UPDATE>" strXML = strXML & "<FORM_NO>0</FORM_NO>" 'IS_UPDATE等于Y时为表单号码 strXML = strXML & "<FORM_FILLER>0606806</FORM_FILLER>" '填表人工号 strXML = strXML & "<EMP_NO>0606806</EMP_NO>" '申请人工号 strXML = strXML & "<FIELD_COUNT>7</FIELD_COUNT>" '分隔的字段数 strXML = strXML & "<FIELDS>" strXML = strXML & "TRAIN_NAME*+*TRAIN_NO*+*TIME*+*HOURS*+*PROCESS_UNIT*+*NEED_RETURN*+*APP_NAME" strXML = strXML & "</FIELDS>" strXML = strXML & "<ROWS>" strXML = strXML & "<ROW>" strXML = strXML & "<VALUE>" strXML = strXML & "test*+*123*+*11:00*+*12*+*SC00*+*Y*+*Vegas" strXML = strXML & "</VALUE>" strXML = strXML & "</ROW>" strXML = strXML & "</ROWS>" strXML = strXML & "</ROOT>" Dim xmlhttp As New MSXML.XMLHTTPRequest() URL = "http://***/forms/VegasTest.asp?xmlText=" & strXML xmlhttp.open("POST", URL, False) xmlhttp.send() Dim xmlDom As New System.Xml.XmlDocument xmlDom.LoadXml(xmlhttp.responseText) Dim Form_Result As String Dim Form_Kind As String Dim Form_No As String Dim Err_Desc As String Form_Result = xmlDom.SelectSingleNode("/ROOT/FORM_RESULT").InnerXml Form_Kind = xmlDom.SelectSingleNode("/ROOT/FORM_KIND").InnerXml Form_No = xmlDom.SelectSingleNode("/ROOT/FORM_NO").InnerXml Err_Desc = xmlDom.SelectSingleNode("/ROOT/FORM_DESC").InnerXml strRtn = "" If Form_Result = "Y" Then '成功 '… strRtn = "" ElseIf Form_Result = "N" Then '失败 '… strRtn = "Failure" ElseIf Form_Result = "ERROR" Then '失败 '… strRtn = Err_Desc End If lblMsg.text = strRtn
End Sub
End ClassB系统：
<%@CODEPAGE=936 Language=VBScript%>
<%Response.Charset="gb2312"%><%Response.Buffer=true %><!--#include file="../Service/EngineWebservice.asp"--><!--#include file="FlowERFunction.asp"--><% On Error Resume Next'**接收客户端XML包的数据格式'**FIELDS和VALUE中的字段以 *+* 来分隔，且分隔数量必须相同 dim xmlDom set xmlDom=createobject("MSXML2.DOMDocument") xmlDom.async=False flag = xmlDom.loadxml(request.QueryString("xmlText")) if flag then dim cnn,RsFindEmp_ID Set cnn=Server.CreateObject("ADODB.Connection") cnn.Open Session("ConnectionString") 'myWriteLog Form_Kind,"1. Receive: " & xmlDom.xml dim Form_No, Form_kind, strFlag dim Form_Filler, Emp_No dim FieldCount dim arrC1, arrC2 dim strFields,strValue Form_No = trim(xmlDom.selectSingleNode("/ROOT/FORM_NO").Text) Form_kind = trim(xmlDom.selectSingleNode("/ROOT/FORM_KIND").Text) Form_Filler = trim(xmlDom.selectSingleNode("/ROOT/FORM_FILLER").Text) Emp_No = trim(xmlDom.selectSingleNode("/ROOT/EMP_NO").Text) FieldCount = trim(xmlDom.selectSingleNode("/ROOT/FIELD_COUNT").Text) strFlag = trim(xmlDom.selectSingleNode("/ROOT/IS_UPDATE").Text) myWriteLog Form_Kind,"1. Receive: " & xmlDom.xml FieldCount = FieldCount * 1 strFields = xmlDom.selectSingleNode("/ROOT/FIELDS").Text arrC1=Split(strFields,"* *") dim SqlFindEmp_ID,strEmpId SqlFindEmp_ID="select ***." set RsFindEmp_ID=cnn.Execute(SqlFindEmp_ID) if not RsFindEmp_ID.eof then strEmpId=RsFindEmp_ID("Emp_ID") RsFindEmp_ID.Close() else ReturnXML Form_Kind,Form_No,"ERROR","NOEMP_3__" & SqlFindEmp_ID end if select case strFlag case "N" 'New Form if Form_No<=0 then Form_No=CreateForm (Form_Kind,strEmpId) '调用flowER组件来生成表单编号(FORM_NO) end if case "Y" 'Update Form Form_No = trim(xmlDom.selectSingleNode("/ROOT/FORM_NO").Text) end select 'response.write strEmpId & "-" & Form_Kind & "-" & Form_No 'response.end if CLng(Form_No) <= 0 then Connection.Execute "exec sp_Facade_DeleteForm Form_Kind," & Form_No ReturnXML Form_Kind,"3","ERROR","FORM_NO" end if dim strsql, intPos dim nodeList dim xmlNod set nodeList = xmlDom.selectNodes("/ROOT/ROWS/ROW") For Each xmlNod In nodeList strValue = xmlNod.SelectSingleNode("VALUE").Text arrC2=Split(strValue,"* *") '*******************************************************************************************************************8 select case Form_Kind case "***" intPos=GetIndex(arrC1, FieldCount, "TRAIN_NAME") strTrainName=arrC2(intPos) intPos=GetIndex(arrC1, FieldCount, "TRAIN_NO") strTrainNo=arrC2(intPos) intPos=GetIndex(arrC1, FieldCount, "TIME") strTime=arrC2(intPos) intPos=GetIndex(arrC1, FieldCount, "HOURS") strHours=arrC2(intPos) intPos=GetIndex(arrC1, FieldCount, "PROCESS_UNIT") strProcessUnit=arrC2(intPos) intPos=GetIndex(arrC1, FieldCount, "NEED_RETURN") strNeedReturn=arrC2(intPos) intPos=GetIndex(arrC1, FieldCount, "APP_NAME") strAppName=arrC2(intPos) '----------更新或插入表单数据 strsql="***." 'end modify set myt=cnn.Execute(strsql) if not myt.eof then ''********************************************************回传参数 ReturnXML Form_Kind,Form_No,"Y","T024_ALREADY EXIST_" & myt("FORM_NO") strsql="sp_Facade_DeleteForm '***'," & Form_No cnn.Execute strsql else strsql="procedure *** '" & Form_Filler & "','" & Form_Kind & "'," & Form_No & ",'" & Emp_No & "'" strsql=strsql & ",'" & strTrainName & "','" & strTrainNo & "','" & strTime & "','" strsql=strsql & strHours & "','" & strProcessUnit & "','" & strNeedReturn & "','" & strAppName & "'" cnn.Execute strsql end if end select myWriteLog Form_Kind,"2. Execute: " & strsql next 'Each in nodeList'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Form_No=Form_No & "" SendFormResult=SendForm(Form_Kind, Form_No & "", strEmpId, "1") '调用flowER组件来生成或更新表单 ActiveFormResult=ActiveForm(Form_Kind, Form_No & "") if LCase(SendFormResult)="true" then strResult="Y" else strResult="N" end if '************************************************************* '**Return the result to client ReturnXML Form_Kind,Form_No,strResult,err.description else 'response.Write 11 'response.End ReturnXML "0","0","ERROR","RECEIVE: " & xmlDom.parseError.reason 'response.write xmlDom.parseError.reason end if %><% '********************************************************************** '**Get the index of array function GetIndex(arrExpression, arrCount, SearchString) dim intPos, i arrCount=arrCount*1 if UCase(isArray(arrExpression)) = "FALSE" or arrCount<=0 then intPos=0 else for i=0 to arrCount-1 if SearchString=arrExpression(i) then intPos=i end if next end if GetIndex=intPos end function '********************************************************************** '**Return the processed result to client sub ReturnXML(Form_Kind, Form_No, Result, Desc) on error resume next strxml="<?xml version='1.0' encoding='utf-8' ?><ROOT>" strxml=strxml & "<FORM_KIND>" & Form_Kind & "</FORM_KIND>" strxml=strxml & "<FORM_NO>" & Form_No & "</FORM_NO>" strxml=strxml & "<FORM_RESULT>" & Result & "</FORM_RESULT>" strxml=strxml & "<FORM_DESC>" & Desc & "</FORM_DESC>" strxml=strxml & "</ROOT>" myWriteLog Form_Kind,"3. Return: FORM_KIND=" & Form_Kind & " -- FORM_NO=" & Form_No & " -- FORM_RESULT=" & Result & " -- ERR_DESC=" & Desc response.write strxml if Result<>"Y" then '发生错误时删除该表单 Anson,04/12/2004 Connection.Execute "exec sp_Facade_DeleteForm '" & trim(Form_Kind) & "'," & Form_No myWriteLog Form_Kind,"3. Return--DELETE: FORM_KIND=" & Form_Kind & " -- FORM_NO=" & Form_No & " -- FORM_RESULT=" & Result & " -- ERR_DESC = DELETE" end if response.end end sub '********************************************************************** '** sub myWriteLog(FORM_KIND,strMsg) on error resume next dim strLogFileName 'strLogFileName = "Receive_FormData_" & FORM_KIND & ".Log" 'Log文件名 strLogFileName = "LOG\COMMON\" & FORM_KIND & "_" & Year(date) & "-" & Month(date) & "-" & Day(date) & ".Log" 'Log文件名 WriteLog strLogFileName,strMsg,true end sub%>
