首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > 开发语言 > VB >

vb读取一个utf8的网页,存本地txt,中文乱码怎么处理

2012-03-06 
vb读取一个utf8的网页,存本地txt,中文乱码怎么办?vb读取一个utf8的网页,存本地txt,中文乱码怎么办?[解决办

vb读取一个utf8的网页,存本地txt,中文乱码怎么办?
vb读取一个utf8的网页,存本地txt,中文乱码怎么办?

[解决办法]
UTF-8转UniCode

VB code
Option ExplicitPrivate Function funUTF8ToUniCode(ByRef bytUTF8() As Byte) As String    Dim utfLen As Long    Dim i As Long    Dim j As Long    Dim k As Long    Dim N As Long    Dim B As Byte    Dim cnt As Byte    Dim Buf() As String    utfLen = -1On Error GoTo errFun    funUTF8ToUniCode = ""    utfLen = UBound(bytUTF8)    If utfLen = -1 Then Exit Function    ReDim Buf(utfLen)    i = 0    j = 0    Do While i <= utfLen        B = bytUTF8(i)        If (B And &HFC) = &HFC Then            cnt = 6        ElseIf (B And &HF8) = &HF8 Then            cnt = 5        ElseIf (B And &HF0) = &HF0 Then            cnt = 4        ElseIf (B And &HE0) = &HE0 Then            cnt = 3        ElseIf (B And &HC0) = &HC0 Then            cnt = 2        Else            cnt = 1        End If        If i + cnt - 1 > utfLen Then            Buf(j) = "?"            Exit Do        End If        Select Case cnt            Case 2                N = B And &H1F            Case 3                N = B And &HF            Case 4                N = B And &H7            Case 5                N = B And &H3            Case 6                N = B And &H1            Case Else                Buf(j) = Chr(B)                GoTo Continued:        End Select        For k = 1 To cnt - 1            B = bytUTF8(i + k)            N = N * &H40 + (B And &H3F)        Next        Buf(j) = ChrW(N)Continued:        i = i + cnt        j = j + 1    Loop    funUTF8ToUniCode = Join(Buf, "")errFun:    End FunctionPrivate Sub Form_Load()End Sub
[解决办法]
'此代码由“正则测试工具 v1.1.35”自动生成,请直接调用TestReg过程
VB code
Private Sub TestReg()    Dim strData As String    Dim reg As Object    Dim matchs As Object, match As Object    strData = getHtmlStr("http://www.google.com.hk")    debug.print strData End SubPublic Function getHtmlStr(strUrl As String) As String    Dim XmlHttp As Object    Set XmlHttp = CreateObject("Microsoft.XMLHTTP")        XmlHttp.Open "GET", strUrl, False    On Error GoTo Err_net    XmlHttp.send        getHtmlStr = BytesToBstr(XmlHttp.ResponseBody, "UTF-8")        Set XmlHttp = NothingErr_net:End FunctionPrivate Function BytesToBstr(strBody, codeBase) As String    Dim objStream As Object    Set objStream = CreateObject("Adodb.Stream")    objStream.Type = 1    objStream.Mode = 3    objStream.Open    objStream.Write strBody    objStream.position = 0    objStream.Type = 2    objStream.Charset = codeBase    BytesToBstr = objStream.ReadText    objStream.Close    Set objStream = NothingEnd Function 

热点排行