快递鸟API调用碰到编码问题

samuel1573

各位大神请指教：
我想尝试一下用Excel VBA来调用快递鸟的电子面单服务。请看附件代码，进本过程就是用WinHTTP POST 提交JSON数据。关键里面有一个数据校验Datasign。先要MD5然后转Base64。如果提交的JSON全英文的话，测试成功能正确返回电子面单。但是一旦JSON有中文字符，就会报错。我尝试了很多方法先转UTF-8再做MD5+Base64，但是折腾了两天还是不行，请不吝赐教。
还有一个小问题是Base64老是多了“77u/"，这是一个BOM吗？

samuel1573

沉得好快，我把代码贴出来吧。 myname="张三" 就会导致失败
Sub KDNiao()

Dim myurl As String
Dim myid As String
Dim myappkey As String
myurl = "http://sandboxapi.kdniao.cc:8080/kdniaosandbox/gateway/exterfaceInvoke.json"   'sandbox test address
myid = "test1343572"  'test ID
myappkey = "924ad868-bc05-43a5-961c-1efd89fcaaaf"   'test encryption key

Dim myjson As String
Dim mypostdata As String
Dim myresponse As String
Dim mydatasign As String

Dim myreceiver As String
Dim mysender As String
Dim mycommodity As String
Dim myorder As String
Dim myname As String
myname = "English"
myorder = "1234563"

mysender = ""
mysender = mysender & Chr(34) & "Company" & Chr(34) & Chr(58) & Chr(34) & "MyCompany" & Chr(34) & Chr(44) 'Company
mysender = mysender & Chr(34) & "Name" & Chr(34) & Chr(58) & Chr(34) & myname & Chr(34) & Chr(44)   'Name
mysender = mysender & Chr(34) & "Tel" & Chr(34) & Chr(58) & Chr(34) & "021-22117613" & Chr(34) & Chr(44)   'Tel
mysender = mysender & Chr(34) & "Mobile" & Chr(34) & Chr(58) & Chr(34) & "18621664569" & Chr(34) & Chr(44)  'Mobile
mysender = mysender & Chr(34) & "PostCode" & Chr(34) & Chr(58) & Chr(34) & "201203" & Chr(34) & Chr(44)   'PostCode
mysender = mysender & Chr(34) & "ProvinceName" & Chr(34) & Chr(58) & Chr(34) & "Shanghai" & Chr(34) & Chr(44)   'ProvinceName
mysender = mysender & Chr(34) & "CityName" & Chr(34) & Chr(58) & Chr(34) & "Shanghai" & Chr(34) & Chr(44)   'CityName
mysender = mysender & Chr(34) & "ExpAreaName" & Chr(34) & Chr(58) & Chr(34) & "Minhang" & Chr(34) & Chr(44)   'ExpAreaName
mysender = mysender & Chr(34) & "Address" & Chr(34) & Chr(58) & Chr(34) & "Hongmei road" & Chr(34)  'Address

myreceiver = ""
myreceiver = myreceiver & Chr(34) & "Company" & Chr(34) & Chr(58) & Chr(34) & "KDNiao" & Chr(34) & Chr(44) 'Company
myreceiver = myreceiver & Chr(34) & "Name" & Chr(34) & Chr(58) & Chr(34) & "Zhang San" & Chr(34) & Chr(44)   'Name
myreceiver = myreceiver & Chr(34) & "Tel" & Chr(34) & Chr(58) & Chr(34) & "0755-0907283" & Chr(34) & Chr(44)   'Tel
myreceiver = myreceiver & Chr(34) & "Mobile" & Chr(34) & Chr(58) & Chr(34) & "13709076789" & Chr(34) & Chr(44)  'Mobile
myreceiver = myreceiver & Chr(34) & "PostCode" & Chr(34) & Chr(58) & Chr(34) & "435100" & Chr(34) & Chr(44)   'PostCode
myreceiver = myreceiver & Chr(34) & "ProvinceName" & Chr(34) & Chr(58) & Chr(34) & "Guangdong" & Chr(34) & Chr(44)   'ProvinceName
myreceiver = myreceiver & Chr(34) & "CityName" & Chr(34) & Chr(58) & Chr(34) & "Shenzhen" & Chr(34) & Chr(44)   'CityName
myreceiver = myreceiver & Chr(34) & "ExpAreaName" & Chr(34) & Chr(58) & Chr(34) & "Futian" & Chr(34) & Chr(44)   'ExpAreaName
myreceiver = myreceiver & Chr(34) & "Address" & Chr(34) & Chr(58) & Chr(34) & "no2000 Shennan Road" & Chr(34) 'Address

mycommodity = Chr(123)
mycommodity = mycommodity & Chr(34) & "GoodsName" & Chr(34) & Chr(58) & Chr(34) & "Files" & Chr(34) & Chr(44) 'GoodsName
mycommodity = mycommodity & Chr(34) & "GoodsCode" & Chr(34) & Chr(58) & Chr(34) & "20398" & Chr(34) & Chr(44) 'GoodsCode
mycommodity = mycommodity & Chr(34) & "Goodsquantity" & Chr(34) & Chr(58) & Chr(34) & "1" & Chr(34) & Chr(44) 'Goodsquantity
mycommodity = mycommodity & Chr(34) & "GoodsWeight" & Chr(34) & Chr(58) & Chr(34) & "1" & Chr(34) & Chr(44) 'GoodsWeight
mycommodity = mycommodity & Chr(34) & "GoodsDesc" & Chr(34) & Chr(58) & Chr(34) & "Fapiao" & Chr(34) & Chr(125) 'GoodsDesc

mypostdata = "EBusinessID=" & myid & Chr(38)   'User ID
mypostdata = mypostdata & "DataType=2" & Chr(38) 'Data Type 2 = JSON
mypostdata = mypostdata & "RequestType=1007" & Chr(38) 'RequestType 1007 =?????浥
mypostdata = mypostdata & "RequestData="  'requestdata = JSON data set

myjson = Chr(123)
myjson = myjson & Chr(34) & "MemberID" & Chr(34) & Chr(58) & Chr(34) & "1343572" & Chr(34) & Chr(44) 'MemberID = ??????
myjson = myjson & Chr(34) & "CustomerName" & Chr(34) & Chr(58) & Chr(34) & "teststo" & Chr(34) & Chr(44) 'CustomerName = ???????????
myjson = myjson & Chr(34) & "CustomerPwd" & Chr(34) & Chr(58) & Chr(34) & "teststopwd" & Chr(34) & Chr(44) 'CustomerPwd = ???????????????
myjson = myjson & Chr(34) & "SendSite" & Chr(34) & Chr(58) & Chr(34) & "testSTOsite" & Chr(34) & Chr(44) 'SendSite = ???????
myjson = myjson & Chr(34) & "ShipperCode" & Chr(34) & Chr(58) & Chr(34) & "STO" & Chr(34) & Chr(44) 'ShipperCode = ?????????
myjson = myjson & Chr(34) & "LogisticCode" & Chr(34) & Chr(58) & Chr(34) & myorder & Chr(34) & Chr(44) 'LogisticCode = ??????
myjson = myjson & Chr(34) & "ThrOrderCode" & Chr(34) & Chr(58) & Chr(34) & "1234567890" & Chr(34) & Chr(44) 'ThrOrderCode
myjson = myjson & Chr(34) & "OrderCode" & Chr(34) & Chr(58) & Chr(34) & "1234561" & Chr(34) & Chr(44) 'OrderCode = ????????????岻?????
myjson = myjson & Chr(34) & "PayType" & Chr(34) & Chr(58) & Chr(34) & "3" & Chr(34) & Chr(44) 'PayType = ???????? 1 ??? 2 ???? 3 ???
myjson = myjson & Chr(34) & "MonthCode" & Chr(34) & Chr(58) & Chr(34) & "12345678" & Chr(34) & Chr(44) 'MonthCode = ?????
myjson = myjson & Chr(34) & "ExpType" & Chr(34) & Chr(58) & Chr(34) & "1" & Chr(34) & Chr(44) 'ExpType 1 = ??????
myjson = myjson & Chr(34) & "IsReturnSignBill" & Chr(34) & Chr(58) & "0" & Chr(44) 'IsReturnSignBill
myjson = myjson & Chr(34) & "OperateRequire" & Chr(34) & Chr(58) & Chr(34) & "" & Chr(34) & Chr(44) 'OperateRequire
myjson = myjson & Chr(34) & "Cost" & Chr(34) & Chr(58) & "12" & Chr(44) 'Cost
myjson = myjson & Chr(34) & "OtherCost" & Chr(34) & Chr(58) & "0" & Chr(44)  'OtherCost
myjson = myjson & Chr(34) & "Receiver" & Chr(34) & Chr(58) & Chr(123) & myreceiver & Chr(125) & Chr(44) 'Receiver ????????
myjson = myjson & Chr(34) & "Sender" & Chr(34) & Chr(58) & Chr(123) & mysender & Chr(125) & Chr(44) 'Sender ?????????
myjson = myjson & Chr(34) & "IsNotice" & Chr(34) & Chr(58) & "1" & Chr(44)  'IsNotice
myjson = myjson & Chr(34) & "StartDate" & Chr(34) & Chr(58) & Chr(34) & "" & Chr(34) & Chr(44) 'StartDate
myjson = myjson & Chr(34) & "EndDate" & Chr(34) & Chr(58) & Chr(34) & "" & Chr(34) & Chr(44) 'EndDate
myjson = myjson & Chr(34) & "Weight" & Chr(34) & Chr(58) & "3" & Chr(44) 'Weight
myjson = myjson & Chr(34) & "Quantity" & Chr(34) & Chr(58) & "1" & Chr(44) 'Quantity
myjson = myjson & Chr(34) & "Volume" & Chr(34) & Chr(58) & "1" & Chr(44) 'Volume
myjson = myjson & Chr(34) & "Remark" & Chr(34) & Chr(58) & Chr(34) & "test" & Chr(34) & Chr(44) 'Remark
myjson = myjson & Chr(34) & "Commodity" & Chr(34) & Chr(58) & Chr(91) & mycommodity & Chr(93) & Chr(44) 'Commodity ???????
myjson = myjson & Chr(34) & "IsSendMessage" & Chr(34) & Chr(58) & "0" & Chr(44) 'IsSendMessage
myjson = myjson & Chr(34) & "TemplateSize" & Chr(34) & Chr(58) & "180" & Chr(44) 'TemplateSize
myjson = myjson & Chr(34) & "IsReturnPrintTemplate" & Chr(34) & Chr(58) & "1" & Chr(125) 'IsReturnPrintTemplate 1 = ????????浥???

'MD5 on JSON and APPKEY, and then convert to Base64 as DataSign
mydatasign = Base64Encode(MD5(myjson & myappkey, "32"), "utf-8")
Debug.Print mydatasign

mypostdata = mypostdata & myjson & Chr(38) & "DataSign=" & Mid(mydatasign, 5)
Debug.Print mypostdata

Dim mywinH As New WinHttpRequest
mywinH.Open "post", myurl
mywinH.setRequestHeader "Content-Type", "application/x-www-form-urlencoded;charset=utf-8"
mywinH.setRequestHeader "Accept-Language", "zh-CN"
mywinH.send mypostdata
myresponse = ByteToUTF16(mywinH.responseBody, "utf-8")
Debug.Print myresponse

End Sub

Public Function Base64Encode(varIn As Variant, CodeBase As String) As String

    Dim adoStream As Object
    Dim xmlDoc As Object
    Dim xmlNode As Object

    Set adoStream = CreateObject("ADODB.Stream")
    adoStream.Charset = CodeBase
    If VarType(varIn) = vbString Then
        adoStream.Type = 2    'adTypeText
        adoStream.Open
        adoStream.WriteText varIn
    ElseIf VarType(varIn) = vbByte Or vbArray Then
        adoStream.Type = 1    'adTypeBinary
        adoStream.Open
        adoStream.Write varIn
    Else
        Exit Function
    End If
    adoStream.Position = 0
    adoStream.Type = 1        'adTypeBinary

    Set xmlDoc = CreateObject("MSXML2.DOMDocument")
    Set xmlNode = xmlDoc.createElement("MyNode")
    xmlNode.DataType = "bin.base64"
    xmlNode.nodeTypedValue = adoStream.Read
    Base64Encode = xmlNode.Text
    adoStream.Close
End Function

Function ByteToUTF16(bArr, chrSet) As String   
    With CreateObject("adodb.stream")
        .Type = 1
        .Open
        .Write bArr         
        .Position = 0     
        .Type = 2         
        .Charset = chrSet
        ByteToUTF16 = .ReadText()
        .Close
    End With
End Function

liucqa

用浏览器提交一个中文的，再用你的程序重复提交一遍，用fiddler抓包对比提交的数据，就知道问题了

samuel1573

liucqa 发表于 2018-5-24 14:23
用浏览器提交一个中文的，再用你的程序重复提交一遍，用fiddler抓包对比提交的数据，就知道问题了

我也试图比较数据包的不同，可是Fiddler抓的包EXcel过来的是没有经过URI编码的，网页测试的是经过转码的。
如图所示：

samuel1573

我的环境是英文64位Win10 + 32位Office2013
照理说Winhttp会在提交时自动转URI，可是抓不到转成URI的包

zpy2

samuel1573 发表于 2018-5-24 13:34
沉得好快，我把代码贴出来吧。 myname="张三" 就会导致失败
Sub KDNiao()

我测试下，是你的EBusinessID不正确，另外，官方有c#的demo,用起来比较方便的，后续解析JSON,打印面单，vba比较麻烦，c#都有现成的demo.

zpy2

@ZKing 申通测试环境快递公司不维护，暂不能使用，正式环境正常使用，可测试其他快递公司
群里看到的。。。

samuel1573

zpy2 发表于 2018-5-25 10:08
@ZKing 申通测试环境快递公司不维护，暂不能使用，正式环境正常使用，可测试其他快递公司
群里看到的。。 ...

我用的是沙箱测试环境：
http://sandboxapi.kdniao.cc:8080 ... xterfaceInvoke.json
所以ID是对的test1343572
myname=“English" 测试可以通过
myname="中文" 测试就失败
我换成其他测试环境或者其他快递公司，碰到的问题还是一样Datasign不一致
我怀疑是不是做MD5/Base64之前要从UTF16转码到UTF8

zpy2

samuel1573 发表于 2018-5-25 10:54
我用的是沙箱测试环境：
http://sandboxapi.kdniao.cc:8080/kdniaosandbox/gateway/exterfaceInvoke.jso ...

官方的demo的url测试地址和你这个不一样，怪不得不对。改了一下，也没测出来。你说的应该是对的，官方demo是utf-8后加密的(第76行).

samuel1573

zpy2 发表于 2018-5-25 12:57
官方的demo的url测试地址和你这个不一样，怪不得不对。改了一下，也没测出来。你说的应该是对的，官方dem ...

我试过用Adodb.stream转码，折腾了很久也不行，就是卡在这里