英译中进阶版

手机边亲爱的你还好吗？大家好久不见
上次给大家带来了一个英文翻译中文的示例，这次给大家做了puls版本。
这个示例分成从两个不同的网站去取得结果，分别是有道与必应，因为百度翻译需要调用API，而且需要注册账号，所以百度这个我们可以单独拿出来做为一个示例。另外，谷歌翻译就暂时不要考虑了。
好啦，话不多说，让我们开始吧。
1、 建窗体
这次我们还是在之前的示例上做添加，添加一个选项组控件，然后再里面添加两个单选按钮，具体的如下图：

2、 添加代码
先在按钮的单击事件中添加代码

Private Sub btnTranslate_Click()
    Dim strEN As String
    strEN = ""
    Select Case Me.fraSel
        Case 1
           strEN = searchWordFromYoudao(Me.txtCN)
        Case 2
            strEN = searchWordFromBing(Me.txtCN)
    End Select
    Me.txtEN = strEN
End Sub

然后新增一个通用模块，在模块中添加代码

Option Compare Database
Option Explicit
Public Function searchWordFromYoudao(tmpWord As String) As String
    'http://dict.youdao.com/search?q=单词&keyfrom=dict.index
    Dim XH As Object
    Dim s() As String
    Dim str_tmp As String
    Dim str_base As String
    Dim ttt As String
    Dim yb As Variant
    Dim i As Long
    Dim tmpTrans As String, tmpPhoneticUSA As String, tmpPhoneticEN As String
    
    tmpTrans = ""
    tmpPhoneticUSA = ""
    tmpPhoneticEN = ""
    '开启网页
    Set XH = CreateObject("Microsoft.XMLHTTP")
    On Error Resume Next
    XH.Open "get", "http://dict.youdao.com/search?q=" & tmpWord & "&keyfrom=dict.index", False
    XH.send
    On Error Resume Next
    str_base = XH.responseText
    XH.Close
    Set XH = Nothing
    ttt = str_base
    
    yb = Split(Split(str_base, "<div id=""webTrans"" class=""trans-wrapper trans-tab"">")(0), "<span class=""keyword"">")(1)
        tmpPhoneticUSA = Split((Split(Split(yb, "<span class=""pronounce"">美")(1), "<span class=""phonetic"">")(1)), "</span>")(0)
    tmpPhoneticEN = Split((Split(yb, "<span class=""phonetic"">")(1)), "</span>")(0)
    
    '取中文翻译
    str_tmp = Split((Split(yb, "<div class=""trans-container"">")(1)), "</div>")(0)
    str_tmp = Split((Split(str_tmp, "<ul>")(1)), "</ul>")(0)
    s = Split(str_tmp, "<li>")
    tmpTrans = Split(s(LBound(s) + 1), "</li")(0)
    For i = LBound(s) + 2 To UBound(s)
        tmpTrans = tmpTrans & Chr(10) & Split(s(i), "</li")(0)
    Next
    searchWordFromYoudao = tmpTrans & vbCrLf & "[美]" & tmpPhoneticUSA & vbCrLf & "[英]" & tmpPhoneticEN
End Function

  Public Function searchWordFromBing(tmpWord As String) As String
        'http://cn.bing.com/dict/search?q=about+to&go=%E6%8F%90%E4%BA%A4&qs=bs&form=CM
        'http://cn.bing.com/dict/search?q=about+to&go=提交&qs=bs&form=CM
        Dim XH As Object
        Dim s() As String
        Dim str_tmp As String
        Dim str_base As String
        Dim tmpTrans As String, tmpPhonetic As String
        Dim yb As Variant
        Dim hy As Variant
        Dim ybEN As String, ybUS As String
        Dim hytmp As String
        Dim i As Long
        
        tmpTrans = ""
        tmpPhonetic = ""
        Dim url As String
        tmpWord = Replace(tmpWord, " ", "+")
        url = "http://cn.bing.com/dict/search?q=" & tmpWord & "&go=%E6%8F%90%E4%BA%A4&qs=bs&form=CM"
        
        '开启网页
        Set XH = CreateObject("Microsoft.XMLHTTP")
        On Error Resume Next
        XH.Open "get", url, True
        XH.send (Null)
        On Error Resume Next
        While XH.ReadyState <> 4
            DoEvents
        Wend
            str_base = XH.responseText
            XH.Close
            Set XH = Nothing
            
            '取得音标部分
            yb = Split(Split(str_base, "<div class=""hd_prUS"">")(1), "<span class=""pos"">")(0)
            '取得中文含义部分
            hy = Split(str_base, "<div class=""hd_div1"">")(0)
            
            hy = Split(hy, "<span class=""pos"">")
            '对音标部分进行分解，分别取得英国和美国音标
            yb = Split(yb, "<div class=""hd_pr"">")
            ybEN = DelHtml(Split(yb(0), "</div>")(0))
            ybUS = DelHtml(Split(yb(1), "</div>")(0))
            tmpPhonetic = ybEN & ybUS
            
            '对中文含义分解
            hytmp = ""
            For i = LBound(hy) + 1 To UBound(hy)
                hytmp = hytmp & DelHtml(Split(hy(i), "</span></span>")(0)) & vbCrLf
            Next i
            If UBound(hy) = 0 Then hytmp = ""
            tmpTrans = hytmp
            searchWordFromBing = tmpTrans & vbCrLf & tmpPhonetic
End Function

Public Function DelHtml(strh)
                Dim a As String
                Dim RegEx As Object
                'Dim mMatch As Match
                'Dim Matches As matchcollection
                
                a = strh
                a = Replace(a, Chr(13) & Chr(10), "")
                '    A = Replace(A, Chr(32), "")
                a = Replace(a, Chr(9), "")
                a = Replace(a, "</p>", vbCrLf)   '给段落后加上回车
                Set RegEx = CreateObject("vbscript.regexp")    '引入正则表达式
                With RegEx
                    .Global = True
                    .Pattern = "\<[^<>]*?\>"   '用<>括起来的html符号
                    .MultiLine = True  '多行有效
                    .ignorecase = True  '忽略大小写(网页处理时这个参数比较重要)
                    a = .Replace(a, "")   '将html符号全部替换为空
                End With
                a = Trim(a)
                '特殊符号处理
                
                a = Replace(a, "<", "<")
                a = Replace(a, ">", ">")
                a = Replace(a, "&", "&")
                a = Replace(a, """, "\")
                a = Replace(a, "&-->", vbCrLf)
                a = Replace(a, "æ", ChrW(230)) 'æ
                a = Replace(a, " ", ChrW(160)) ' 
                a = Replace(a, " ", " ")  ' ?
                DelHtml = a
End Function