六子技术网首页

六子技术网

  • 网站首页
  • HTML/CSS
  • javascript
  • seo优化
  • PS美工
  • 系统安全
  • 漏洞预警
  • 编程学习
  • 原创专区
  • 【六子技术网】是一家综合技术门户,为您提供网站建设,编程开发,安全维护,漏洞预警等技术文章

    技术文章MAP

    文章

    VB判断网页编码并且自动转码代码亲测好使

    日期:2019/10/13 14:11:00来源分类:编程开发

    VB判断网页编码并且自动转码代码亲测好使,最近用VB读取网页源码写程序由于编码的问题搞得我头痛,处理好了软件要么速度变慢 要么不稳定容易崩溃 甚至有很多站读出的数据还是乱码,终于整理出一套可以用的稳定代码 分享一下

    代码如下==============================================

    Private Const CP_UTF8 = 65001
    Private 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)
        Else
            Utf8ToUnicode = ""
    End If
    End Function

     '判断网页编码函数
    Private Function IsUTF8(Bytes) As Boolean
        Dim i As Long, AscN As Long, Length As Long
        Length = UBound(Bytes) + 1
        If Length < 3 Then
            IsUTF8 = False
            Exit Function
        ElseIf Bytes(0) = &HEF And Bytes(1) = &HBB And Bytes(2) = &HBF Then
            IsUTF8 = True
            Exit Function
        End If
        Do While i <= Length - 1
            If Bytes(i) < 128 Then
                i = i + 1
                AscN = AscN + 1
            ElseIf (Bytes(i) And &HE0) = &HC0 And (Bytes(i + 1) And &HC0) = &H80 Then
                i = i + 2
            ElseIf i + 2 < Length Then
                If (Bytes(i) And &HF0) = &HE0 And (Bytes(i + 1) And &HC0) = &H80 And (Bytes(i + 2) And &HC0) = &H80 Then
                     i = i + 3
                Else
                    IsUTF8 = False
                    Exit Function
                End If
            Else
                IsUTF8 = False
                Exit Function
            End If
        Loop
        If AscN = Length Then
            IsUTF8 = False
        Else
            IsUTF8 = True
        End If
    End Function


    Private Sub Command1_Click()
        Dim aa() As Byte
        Dim t As String, t1 As String, t2 As String, hhh As Integer
        Inet1.Cancel
         'URL在Text1里输入
    If Len(Inet1.OpenURL(Text3.Text, icByteArray)) <> 0 Then
        aa = Inet1.OpenURL(Text3.Text, icByteArray)
       Label1.Caption = "111111"
        If IsUTF8(aa) Then
            t = Utf8ToUnicode(aa)
        Else
            t = StrConv(aa, vbUnicode)
        End If
        t1 = InStr(t, "<body") + Len("<body")
        t2 = InStr(t, "</body>")
        Text2.Text = Mid(t, t1, t2 - t1)
    Else
      Timer1.Interval = 111
    End If
       
       
    End Sub

    本文由六子技术网小编:小熊编辑整理 - 转载请注明来源 - http://www.liuzi.net/bc/html/3889.html

    随机推荐

    • 该分类还没有添加任何内容!
    • 该分类还没有添加任何内容!

    Copyright 2005-2019 【六子技术网】 版权所有 黑ICP备16886888号

    声明:本站所有文章来自互联网 如有异议 请联系本站管理员