zoukankan      html  css  js  c++  java

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

    A系统 ：

    Imports System.Xml


    Partial     Class _Default
            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 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


    %>
  • 相关阅读:
    Linux-exec族函数
    Linux-竟态初步引入
    Linux-waitpid介绍
    Java基础：Java运算符:算术运算符
    Java中的算术运算符
    JAVA冒泡排序
    引用 java的一些基本概念
    Tomcat服务器的下载安装跟基本配置
    Tomcat配置Web站点
    Tomcat+JSP经典配置实例
  • 原文地址：https://www.cnblogs.com/amadeuslee/p/3744585.html
Copyright © 2011-2022 走看看