VB用XML实现在线翻译范例

本例采用雅虎的在线翻译功能为基础，提供中英，中日的在线翻译效果，希望对想了解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