如何在 VB6 中下载 MTOM 附件

Question

拜托，有人可以给我看一个关于如何使用VB6下载MTOM附件并将其保存到磁盘的示例？

目前，我能够使用以下代码从我的ws获得响应：

Dim objDom As Object
Dim objXmlHttp As Object
Dim strRet As String
Dim intPos1 As Integer
Dim intPos2 As Integer
On Error GoTo Err_PW
' Create objects to DOMDocument and XMLHTTP
Set objDom = CreateObject("MSXML2.DOMDocument")
Set objXmlHttp = CreateObject("MSXML2.XMLHTTP")
'Set objXmlHttp = New MSXML2.XMLHTTP40
' Load XML
objDom.async = False
objDom.loadXML XmlBody
' Open the webservice
objXmlHttp.Open "POST", AsmxUrl, False
' Create headings
objXmlHttp.setRequestHeader "Content-Type", "text/xml; charset=utf-8"
objXmlHttp.setRequestHeader "SOAPAction", SoapActionUrl
' Send XML command
objXmlHttp.Send (objDom.xml)
' Get all response text from webservice
strRet = objXmlHttp.responseText

但是从这一点来看，我不知道如何继续抓取MTOM附件。

这是从 ws 返回的内容：

--uuid:0b9372cf-63bb-484f-87f3-7bedfaa776fb
Content-Id: <rootpart*[e-mail]>
Content-Type: application/xop+xml;charset=utf-8;type="text/xml"
Content-Transfer-Encoding: binary
<?xml version='1.0' encoding='UTF-8'?>
<S:Envelope xmlns:S="http://schemas.xmlsoap.org/soap/envelope/">
<S:Body><ns2:getContentStreamResponse xmlns:ns2="http://docs.oasis-open.org/ns/cmis/messaging/200908/" xmlns="http://docs.oasis-open.org/ns/cmis/core/200908/">
<ns2:contentStream>
<ns2:length>2572861</ns2:length>
<ns2:mimeType>application/vnd.openxmlformats-officedocument.wordprocessingml.document</ns2:mimeType>
<ns2:filename>SF-MASTER - SDTC.docx</ns2:filename>
<ns2:stream>
<xop:Include xmlns:xop="http://www.w3.org/2004/08/xop/include" href="cid:[e-mail]"/></ns2:stream>
</ns2:contentStream>
</ns2:getContentStreamResponse>
</S:Body>
</S:Envelope>
--uuid:0b9372cf-63bb-484f-87f3-7bedfaa776fb
Content-Id: <[e-mail]>
Content-Type: application/vnd.openxmlformats-officedocument.wordprocessingml.document
Content-Transfer-Encoding: binary
PK
31/05/2018 10:04:06: UUID documento: 0b9372cf-63bb-484f-87f3-7bedfaa776fb
31/05/2018 10:04:06: Tag finale: --uuid:0b9372cf-63bb-484f-87f3-7bedfaa776fb--
31/05/2018 10:04:06: lunghezza documento: 2572861

谢谢

Answer 1

以此为指导并修改代码以将返回的文件数据另存为二进制文件。

添加到功能顶部

Const adTypeBinary = 1
Const adSaveCreateOverWrite = 2
Dim varByteArray, ado
Dim strFile as String

发送请求后，插入此代码

If objXmlHttp.Status <> "200" Then
Exit Function
End If
' Pull this from returned header data
strFile = "SF-MASTER - SDTC.docx"
' get file contents
varByteArray = objXmlHttp.ResponseBody
Set objXmlHttp= Nothing
'Now save the binary file
On Error Resume Next
Set ado = Nothing
Set ado = CreateObject("ADODB.Stream")
ado.Type = adTypeBinary
ado.Open
ado.Write varByteArray
ado.SaveToFile strFile, adSaveCreateOverWrite
ado.Close