【Vegas原创】A系统(aspx)向B系统(asp)交互（XmLHttp）

A系统 ：

Imports System.Xml


Partial Class _DefaultClass _Default
    Inherits System.Web.UI.Page

    Protected Sub Page_Load()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 Class

B系统：

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


%>