Public Const BAIDU_APP_ID = "XXXX" '百度申请后得到
Public Const BAIDU_APP_KEY = "XXXX" '百度申请后得到
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 = "/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
调用：Text1 = Translate("Hello World!")
申请ID和KEY地址：