• 新浪微博:
  • 微信 :
按键精灵电脑版
立即下载

软件版本:2014.05
软件大小:21.6M
更新时间:07-04

按键精灵安卓版
立即下载

软件版本:3.3.1
软件大小:62.5M
更新时间:5-24

按键精灵iOS版
立即下载

软件版本:1.3.5
软件大小:29.2M
更新时间:06-14

最新企业版UiBot
立即下载

软件版本:2.5
软件大小:181M
更新时间:05-20

快捷导航

登录 后使用快捷导航
没有帐号? 注册

登录 注册
返回列表 12345678» / 10
发新话题 回复该主题

[分享源码] 【分享】自动识别编码的获得网页源文件!!! [复制链接]

1#

好多人用这个获得网页源文件命令获取的都是乱码,
那是编码问题,我弄了个自动识别编码的,为新手朋友提供方便


可以把这个函数复制到命令库里覆盖原来的代码:
  1. '可以自动识别编码
  2. MsgBox 获得网页源文件("www.baidu.com")
  3. MsgBox 获得网页源文件("www.sina.com.cn")
  4. '可以自定义编码
  5. ' 其实参数就是附加到网页的参数里,同时也不会影响网页的正常访问
  6. ' 但是加参数也要有格式:
  7. MsgBox 获得网页源文件("www.baidu.com?BM=UTF-8")'格式不对,出错
  8. MsgBox 获得网页源文件("www.baidu.com/?BM=UTF-8")'格式正确
  9. MsgBox 获得网页源文件("www.anjian.com/test.txt?BM=UTF-8")'格式正确
  10. '除去HTML标签代码的内容
  11. MsgBox 获得网页源文件("www.anjian.com/test.txt?TQ=1")
  12. MsgBox 获得网页源文件("www.anjian.com/test.txt?BM=UTF-8&TQ=1") '有两个以上参数的写法
复制代码
  1. Function 获得网页源文件(网页地址)
  2.     //说明:支持远程获取文本内容,如:
  3.     '自动识别编码:
  4.     '     MsgBox Lib.网络.获得网页源文件("http://www.anjian.com")
  5.     '自定义编码:
  6.     '     参数格式:BM=编码类型
  7.     '     编码类型:GB2312、GBK、GB18030、UTF-8、ANSI、Unicode ……
  8.     '     MsgBox Lib.网络.获得网页源文件("http://www.anjian.com/test.txt?BM=UTF-8")
  9.     '除去HTML标签代码:
  10.     '     参数格式:TQ=1
  11.     '     MsgBox Lib.网络.获得网页源文件("http://www.anjian.com/?TQ=1")
  12.     '     MsgBox Lib.网络.获得网页源文件("http://www.anjian.com/test.txt?BM=UTF-8&TQ=1")
  13.     Dim xmlHttp, xmlBody, xmlUrl, URL头, 网页编码, 分割编码
  14.     Dim ThisCharCode, NextCharCode, BytesToBstr
  15.     Dim rep, MatchEs
  16.     Set rep = New RegExp
  17.     rep.IgnoreCase = True
  18.     rep.[Global] = True
  19.     URL头 = Left(网页地址, 7)
  20.     Select Case URL头
  21.     Case "https:/", "http://"
  22.         xmlUrl = 网页地址
  23.     Case Else
  24.         xmlUrl = "http://" & 网页地址
  25.     End Select
  26.     If InStr(1, xmlUrl, "BM=", 1) > 0 Then
  27.         rep.Pattern = "(?:\?|&)BM=([^\&]+)"
  28.         Set MatchEs = rep.Execute(xmlUrl)
  29.         网页编码 = MatchEs(0).SubMatches.Item(0)
  30.         rep.Pattern = "(\?|&)BM=[^\&]+&?"
  31.         xmlUrl = rep.Replace(xmlUrl, "$1")
  32.     End If
  33.     If InStr(1, xmlUrl, "TQ=", 1) > 0 Then
  34.         rep.Pattern = "(\?|&)TQ=[^\&]+&?"
  35.         xmlUrl = rep.Replace(xmlUrl, "$1")
  36.     End if
  37.     rep.Pattern = "\?$"
  38.     If rep.test(xmlUrl) Then xmlUrl = rep.Replace(xmlUrl, "")
  39.     Set xmlHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
  40.     xmlHttp.Open "Get", xmlUrl, False
  41.     xmlHttp.Send
  42.     获得网页源文件 = ""
  43.     If Len(XmlHttp.ResponseText) = 0 Then Set xmlHttp = Nothing : Exit Function
  44.     If InStr(1, XmlHttp.ResponseText, "charset", 1) > 0 Then
  45.         rep.Pattern = "content=""text/html;[\s]*charset=([^<>""]+)""|[\s]*charset=([^<>""]+)"""
  46.         Set MatchEs = rep.Execute(XmlHttp.ResponseText)
  47.         If rep.test(XmlHttp.ResponseText) Then
  48.             网页编码 = MatchEs(0).SubMatches.Item(0)
  49.         Else
  50.             If 网页编码 = "" Then 网页编码 = "GB2312"
  51.         End If
  52.     Else
  53.         If 网页编码 = "" Then 网页编码 = "GB2312"
  54.     End If
  55.     xmlBody = xmlHttp.ResponseBody
  56.     Set xmlHttp = Nothing
  57.     If Len(xmlBody) = 0 Then Exit Function
  58.     Set ObjStream = CreateObject("Adodb.Stream")
  59.     With ObjStream
  60.         .Type = 1
  61.         .Mode = 3
  62.         .Open
  63.         .Write xmlBody
  64.         .Position = 0
  65.         .Type = 2
  66.         .Charset = 网页编码
  67.         BytesToBstr = .ReadText
  68.         .Close
  69.     End With
  70.     Set ObjStream = Nothing
  71.     If InStr(1, 网页地址, "TQ=1", 1) > 0 Then
  72.         rep.Pattern = "(<script[\s\S]*?</script>)|(<[^<>]*?>)|(&nbsp;)"
  73.         BytesToBstr = rep.Replace(BytesToBstr, "")
  74.     End If
  75.     获得网页源文件 = BytesToBstr
  76. End Function
复制代码

    已有1评分我要评分查看所有评分

    最后编辑神梦科技 最后编辑于 2016-08-02 22:01:00
    2#

    真好呀

    3#

    谢谢楼主分享

    4#

    看看什么东西

    5#


    6#

    0000000000000000

    7#

    看一下喔,謝謝

    8#


    9#

    可以把这个函数复制到命令库里覆盖原来的代码:

    10#

    4333333333333333333

    11#

    回复一下看看

    12#

    需要这个

    13#


    14#

    学习一下看看了

    15#

    顶顶顶顶顶顶顶顶顶大大大

    <a href="http://www.111110.org" target="_blank">点击进入雨轩博客</a>
    16#

    2巴巴爸爸

    为了做脚本而游戏
    17#

    实参数就是附加到网页的参数里,同时也不会影响网页的正常访问

    18#

    2222222222222

    19#


    20#

    {:5_131:}

    发新话题 回复该主题