【VB用XML实现在线翻译范例】
界面效果
Option Explicit
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
Private Const CP_ACP = 0 ' default to ANSI code page
Private Const CP_UTF8 = 65001 ' default to UTF-8 code page
Public Function EncodeToBytes(ByVal sData As String) As String
Dim aRetn() As Byte, nSize As Long, ReturnStr As String, X As Long
nSize = WideCharToMultiByte(CP_UTF8, 0, StrPtr(sData), -1, 0, 0, 0, 0) - 1
If nSize = 0 Then Exit Function
ReDim aRetn(0 To nSize - 1) As Byte
WideCharToMultiByte CP_UTF8, 0, StrPtr(sData), -1, VarPtr(aRetn(0)), nSize, 0, 0
For X = LBound(aRetn) To UBound(aRetn)
ReturnStr = ReturnStr & "%" & String(2 - Len(Hex(aRetn(X))), "0") & Hex(aRetn(X))
Next X
Erase aRetn
EncodeToBytes = ReturnStr
End Function
Function Utf8ToUnicode(ByRef Utf() As Byte) As String
Dim lRet As Long
Dim lLength As Long
Dim lBufferSize As Long
lLength = UBound(Utf) - LBound(Utf) + 1
If lLength <= 0 Then Exit Function
lBufferSize = lLength * 2
Utf8ToUnicode = String$(lBufferSize, Chr(0))
lRet = MultiByteToWideChar(CP_UTF8, 0, VarPtr(Utf(0)), lLength, StrPtr(Utf8ToUnicode), lBufferSize)
If lRet <> 0 Then
Utf8ToUnicode = Left(Utf8ToUnicode, lRet)
End If
End Function
Private Sub Command1_Click()
Dim XMLObject As XMLHTTP, SendStr As String, TranslateType As String
Dim ReturnText As String, ReturnByte() As Byte
Dim StartStation As Long, EndStation As Long
Set XMLObject = CreateObject("Microsoft.XMLHTTP")
TranslateType = Combo1.List(Combo1.ListIndex)
TranslateType = Right(TranslateType, 6)
TranslateType = Left(TranslateType, 5)
SendStr = "ei=UTF-8&fr=&lp=" & TranslateType & "&trtext=" & EncodeToBytes(Text1.Text)
XMLObject.Open "POST", "http://fanyi.cn.yahoo.com/translate_txt", False
XMLObject.setRequestHeader "Referer", "http://fanyi.cn.yahoo.com/translate_txt"
XMLObject.setRequestHeader "CONTENT-TYPE", "application/x-www-form-urlencoded"
XMLObject.setRequestHeader "CONTENT-LENGTH", Len(SendStr)
XMLObject.send SendStr
ReturnByte = XMLObject.responseBody
Set XMLObject = Nothing
Select Case TranslateType
Case "en_zh", "ja_zh", "zh_ja": ReturnText = Utf8ToUnicode(ReturnByte)
Case "zh_en": ReturnText = StrConv(ReturnByte, vbUnicode)
End Select
StartStation = InStr(1, ReturnText, "<div id=""pd"" class=""pd"">")
StartStation = StartStation + Len("<div id=""pd"" class=""pd"">")
EndStation = InStr(StartStation, ReturnText, "</div>")
ReturnText = Mid(ReturnText, StartStation, EndStation - StartStation)
ReturnText = Trim(ReturnText)
ReturnText = Replace(ReturnText, "<br/>", vbCrLf)
ReturnText = Replace(ReturnText, "<dnt> </dnt>", "")
ReturnText = Replace(ReturnText, " ", " ")
Text2.Text = ReturnText
End Sub
Private Sub Form_Load()
Combo1.AddItem "英 → 汉[en_zh]"
Combo1.AddItem "汉 → 英[zh_en]"
Combo1.AddItem "日 → 汉[ja_zh]"
Combo1.AddItem "汉 → 日[zh_ja]"
Combo1.ListIndex = 0
End Sub
