【VB用XML实现在线翻译范例】

现在还是人类 2008-10-14 01:58:19

界面效果



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

虽然功能是个小工能，但里面有讲述用XMLHTTP如何取得网页信息及UTF-8编码的转换。
希望能给想了解这方面的朋友一些帮助。

另外大家看看这个帖子的楼主，真是让人郁闷，我没想到还有这么懒得人，哎
http://topic.csdn.net/u/20081010/09/68f81bee-d09b-498e-9604-8aa96218aa59.html
[Quote=引用 10 楼 wuruijing 的回复:]
万分感谢lyserver朋友和SupermanKing 朋友，再提一个冒昧的要求，不知能否将程序发送到我的邮箱：wuruijing@sohu.com。谢谢！
[/Quote]

...全文