将ZIP文件从vb6发送到Web服务SOAP

时间:2015-12-01 22:31:46

标签: web-services soap vb6

我在Visual Basic 6.0(vb6)中开发了以下代码,其中已经设法连接到Web服务,但是当我将ZIP文件发送到字节数组时返回一个错误,告诉我ZIP文件已损坏,显然我没有正确发送ZIP文件,这就是错误的原因。

在我使用的代码下面。

Dim strFileName2 As String
Dim nFile As Integer
Dim strImage As String
Dim strBoundary As String
Dim AsmxUrl As String
Dim SoapActionUrl As String
Dim filebytes() As Byte
Dim Attachment() As Byte

SoapActionUrl = "https://www.sat.gob.mx/ol-ti-itcpgem-beta/billService"
AsmxUrl = "https://www.sat.gob.mx/ol-ti-itcpgem-beta/billService?wsdl"
strBoundary = "----=_Part_23_1578679283.1448552263862"
strFileName2 = "C:\20502264096-01-F001-9672.zip"
nFile = FreeFile()

Dim adostream As Object
adostream = CreateObject("ADODB.Stream")
adostream.Open()
adostream.Type = 1
adostream.LoadFromFile strFileName2
filebytes = adostream.Read
adostream.Close()

Open strFileName2 For Binary As #nFile
strImage = String(LOF(nFile), " ")
Get #nFile, , strImage
Close #nFile

'message head SOAP
Xml = "<soapenv:Envelope xmlns:soapenv='http://schemas.xmlsoap.org/soap/envelope/' " & _
            "xmlns:ser='http://service.sat.gob.mx' " & _
            "xmlns:wsse='http://docs.oasis-open.org/wss/2004/01/oasis-200401-wss-wssecurity-secext-1.0.xsd'> " & _
            "   <soapenv:Header>      " & _
            "       <wsse:Security>         " & _
            "           <wsse:UsernameToken>           " & _
            "               <wsse:Username>USUSARIO</wsse:Username>            " & _
            "               <wsse:Password>CONTRASENA</wsse:Password> " & _
            "           </wsse:UsernameToken>      " & _
            "       </wsse:Security>   " & _
            "   </soapenv:Header> " & _
            "   <soapenv:Body> " & _
            "       <ser:sendBill> " & _
            "               <!--Optional:--> " & _
            "               <fileName>20502264096-01-F001-9672.zip</fileName> " & _
            "               <!--Optional:--> " & _
            "               <contentFile><inc:Include href=""cid:20502264096-01-F001-9672.zip"" xmlns:inc=""http://www.w3.org/2004/08/xop/include""/></contentFile>" & _
            "       </ser:sendBill> " & _
            "   </soapenv:Body> " & _
            "</soapenv:Envelope> "

'"               <contentFile>cid:20502264096-01-F001-9672.zip</contentFile> " & _
'message attachment
Attachment = filebytes

'multipart message template
SendDataS = "--$boundary$" & Chr(10) & _
            "Content-Type: application/xop+xml; charset=UTF-8; type=""text/xml""" & Chr(10) & _
            "Content-Transfer-Encoding: 8bit" & Chr(10) & _
            "Content-ID: <rootpart@soapui.org>" & Chr(10) & _
            "" & Chr(10) & _
            "$xml$" & Chr(10) & _
            "--$boundary$" & Chr(10) & _
            "Content-Type: application/zip; name=20502264096-01-F001-9672.zip" & Chr(10) & _
            "Content-Transfer-Encoding: binary" & Chr(10) & _
            "Content-ID: <20502264096-01-F001-9672.zip>" & Chr(10) & _
            "Content-Disposition: attachment; name=""20502264096-01-F001-9672.zip""; filename=""20502264096-01-F001-9672.zip""" & Chr(10) & _
            " " & Chr(10) & _
            "$Attachment$" & Chr(10) & _
            "--$boundary$" & "--"

'Create objects to DOMDocument and XMLHTTP
objDom = CreateObject("MSXML2.DOMDocument")
objXmlHttp = CreateObject("MSXML2.XMLHTTP")

strXmlHead = ""
strXmlBody = ""


'Load XMLHead
objDom.async = False
objDom.LoadXml Xml 'aqui carga el XML armado antes
strXmlHead = objDom.xml 'aqui lee el XML

MsgBox(objDom.xml)

'Load XMLbody
'objDom.async = False
'objDom.LoadXml Attachment

MsgBox(Attachment)

'strXmlBody = objDom.LoadXml
strXmlBody = Attachment

strXml = Replace(SendDataS, "$xml$", strXmlHead)
strXml = Replace(strXml, "$Attachment$", strXmlBody)
strXml = Replace(strXml, "$boundary$", strBoundary)

MsgBox(strXml)
Me.Text1.Text = strXml
'Open the webservice
objXmlHttp.Open("POST", AsmxUrl, False)

'Create headings
objXmlHttp.setRequestHeader("MIME-Version", "1.0")
objXmlHttp.setRequestHeader("Content-Type", "multipart/related; boundary=""" & strBoundary & """")

objXmlHttp.setRequestHeader("Accept", "application/soap+xml, application/dime, multipart/related, text/*")
objXmlHttp.setRequestHeader("SOAPAction", """" & SoapActionUrl & """")
objXmlHttp.setRequestHeader("Content-Length", Len(strXml))
objXmlHttp.setRequestHeader("Connection", "Close")

'Send XML command
objXmlHttp.send CStr(strXml) 'objDom.xml

'Get all response text from webservice
strRet = objXmlHttp.responseText
MsgBox(strRet)

1 个答案:

答案 0 :(得分:0)

以下是我用于发布到网络服务器的代码。也许你能为你得到一些东西......

Private Function mbPostFile(sRequest As String, sFileName As String, sExpectedNode As String, ByRef oNode As IXMLDOMNode) As Boolean
  Const STR_BOUNDARY  As String = "3fbd04f5-b1ed-4060-99b9-fca7ff59c113"

  Dim sPostData       As String
  Dim oStream         As Object

  On Error GoTo ErrorHandler

  If Not mbCheckSession Then
    Exit Function
  End If

  Set oStream = CreateObject("ADODB.STREAM")
  oStream.Type = 1 'binary
  Call oStream.Open
  Call oStream.LoadFromFile(sFileName)

  sPostData = "--" & STR_BOUNDARY & vbCrLf & _
    "Content-Disposition: form-data; name=""uploadfile""; filename=""" & Mid$(sFileName, InStrRev(sFileName, "\") + 1) & """" & vbCrLf & _
    "Content-Type: application/octet-stream" & vbCrLf & vbCrLf & _
    StrConv(oStream.Read, vbUnicode) & vbCrLf & _
    "--" & STR_BOUNDARY & "--"

  With moGetHttp
    Call .Open("POST", msPortalUrl & sRequest & "&session=" & msSession, False)
    Call .setRequestHeader("Content-Type", "multipart/form-data; boundary=" & STR_BOUNDARY)
    Call .send(pvToByteArray(sPostData))

    mbPostFile = mbCheckResult(.responseXML, sExpectedNode, oNode, True)
  End With

  Exit Function
ErrorHandler:
  Call mShowError("mbPostFile")
End Function

Private Function pvToByteArray(sText As String) As Byte()
  pvToByteArray = StrConv(sText, vbFromUnicode)
End Function