百度翻译新版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 Byte
End 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 Long
Public 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 = Result
End Function

调用方法

Debug.Print Translate("你好")

补一下，在Windows XP系统下用

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