百度翻译新版API的VB实现代码

Public Const BAIDU_APP_ID = "XXXXXXXXXXXXXXXXXXXXX" '在百度申请后得到Public Const BAIDU_APP_KEY = "XXXXXXXXXXXXXXXXXXXXXX" '在百度申请后得到 Public Type MD5_CTX      dwNUMa      As Long      dwNUMb      As Long      Buffer(15)  As Byte      cIN(63)     As Byte      cDig(15)    As ByteEnd Type  Public Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As LongPublic Declare Sub MD5Final Lib "advapi32" (lpContext As MD5_CTX)Public Declare Sub MD5Init Lib "advapi32" (lpContext As MD5_CTX)Public Declare Sub MD5Update Lib "advapi32" (lpContext As MD5_CTX, ByRef lpBuffer As Any, ByVal BufSize As Long) Public Function Translate(ByVal Text As String, Optional ByVal Source As String = "auto", Optional ByVal Target As String = "auto", Optional ByVal AppID As String = BAIDU_APP_ID, Optional ByVal Key As String = BAIDU_APP_KEY) As String    Dim XML As Object, stcContext As MD5_CTX, URL As String, PostData As String, Salt As String    Dim Arr() As Byte, I As Long, Result As String    URL = "http://api.fanyi.baidu.com/api/trans/vip/translate"    Randomize    Salt = Replace(Rnd, ".", "")    MD5Init stcContext    PostData = "q=" & Text    PostData = PostData & "&appid=" & AppID    PostData = PostData & "&salt=" & Salt    PostData = PostData & "&from=" & Source    PostData = PostData & "&to=" & Target    PostData = PostData & "&sign="    I = Len(AppID & Text & Salt & Key)    ReDim Arr(I * 3)    I = WideCharToMultiByte(65001, 0, StrPtr(AppID & Text & Salt & Key), I, Arr(0), I * 3 + 1, vbNullString, 0)    If I < 1 Then Exit Function    MD5Update stcContext, Arr(0), I    MD5Final stcContext    For I = 0 To UBound(stcContext.cDig)        PostData = PostData & LCase(IIf(stcContext.cDig(I) < 16, "0" & Hex(stcContext.cDig(I)), Hex(stcContext.cDig(I))))    Next    Set XML = CreateObject("WinHttp.WinHttpRequest.5.1")    XML.Option(6) = False    XML.Option(4) = 13056    XML.Open "POST", URL    XML.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"    XML.SetRequestHeader "Content-Length", LenB(StrConv(PostData, vbFromUnicode))    XML.Send PostData    PostData = XML.ResponseText    Set XML = Nothing    I = InStr(PostData, "error_code")    If I > 0 Then        Result = "错误代码:" & Mid(PostData, I + 13, InStr(I + 13, PostData, """") - I - 13)        I = InStr(PostData, "error_msg")        Result = Result & ",说明:" & Mid(PostData, I + 12, InStr(I + 12, PostData, """") - I - 12)     Else        I = 1        PostData = Replace(PostData, "\""", "\'")        Do Until InStr(I, PostData, """dst"":""") = 0            I = InStr(I, PostData, """dst"":""") + 7            Result = IIf(Len(Result) = 0, "", Result & vbCrLf) & Mid(PostData, I, InStr(I, PostData, """") - I)        Loop        Result = Replace(Result, "\'", """")        ReDim Arr(1)        Do Until InStr(Result, "\u") = 0            I = InStr(Result, "\u")            Result = Replace(Result, Mid(Result, I, 6), ChrW("&H" & Mid(Result, I + 2, 4)))        Loop    End If    Translate = ResultEnd Function

调用方法

Debug.Print Translate("你好")

补一下，在Windows XP系统下用

CreateObject("WinHttp.WinHttpRequest.5.1")创建出来的对象，POST提交时langth项会变成0，需要改下代码变成工程引用后再定义。