【VB用XML实现在线翻译范例】
界面效果
Option ExplicitPrivate 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 LongPrivate 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 LongPrivate Const CP_ACP = 0 ' default to ANSI code pagePrivate Const CP_UTF8 = 65001 ' default to UTF-8 code pagePublic 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 = ReturnStrEnd FunctionFunction 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 IfEnd FunctionPrivate 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 = ReturnTextEnd SubPrivate Sub Form_Load() Combo1.AddItem "英 → 汉[en_zh]" Combo1.AddItem "汉 → 英[zh_en]" Combo1.AddItem "日 → 汉[ja_zh]" Combo1.AddItem "汉 → 日[zh_ja]" Combo1.ListIndex = 0End Sub