將ZIP文件從vb6發送到Web服務SOAP

Question

我已經在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) 

Answer 1

以下是我用於發佈到Web服務器的代碼。也許你可以爲你...

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