VB用XML实现在线翻译范例

最新推荐文章于 2024-10-28 22:51:59 发布

原创最新推荐文章于 2024-10-28 22:51:59 发布 · 1.8w 阅读

8 ·

本内容遵循CC 4.0 BY-SA版权协议

标签

#vb #xml #string #function #byte

本文介绍了一个使用VB编写的在线翻译程序，支持中英、中日互译。利用XMLHTTP对象实现与雅虎翻译服务的交互，并详细展示了如何处理UTF-8编码。

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