本例采用雅虎的在线翻译功能为基础,提供中英,中日的在线翻译效果,希望对想了解XMLHTTP对象和UTF-8编码
的VB爱好者有所帮助。界面效果如下:
以下是窗口的程序代码:
Visual Basic Code |
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 |