37玩注册器5.0版POST注册实例教程第三课(重点）

就是没有钱

就是没有钱

menglovelili

学习学习

znyyjk

0000000000000000

天翔

来学习一下!!

liyunhua258

ddsfd

sandorn

[General]
SyntaxVersion=2
MacroID=54ecf654-599b-4041-81e8-cc628d5369e4
[Comment]

[Script]
//WinHttp对象_中文版
//QQ97012791
//-----------------------
//初始化WinHttp对象
Sub 基本_初始化()
    If IsObject(WinHttp) = False Then
        Set WinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
    End If
End Sub
//-----------------------
//销毁WinHttp对象
Sub 基本_销毁()
    Set WinHttp = Nothing
End Sub
//-----------------------
//中止正在进行的异步操作
Sub 方法_中止()
    WinHttp.Abort
End Sub
//-----------------------
//取得所有HTTP返回协议头
Function 方法_取所有返回协议头()
    方法_取所有返回协议头 = WinHttp.GetAllResp**eHeaders
End Function
//-----------------------
//取得HTTP返回协议头
//协议头[文本型]: 如 "Set-Cookie"
Function 方法_取返回协议头(协议头)
    方法_取返回协议头 = WinHttp.GetResp**eHeader(协议头)
End Function
//-----------------------
//打开一个HTTP连接
//方法[文本型]: POST、GET、HEAD
//地址[文本型]: 如 http://www.baidu.com
//异步[逻辑型]: 是否异步, 一般为异步
Sub 方法_打开(方法, 地址, 异步)
    WinHttp.Open 方法, 地址, 异步
End Sub
//-----------------------
//发送HTTP请求
//数据: 提交数据，可以被省略，一般为POST使用
Sub 方法_发送(数据)
    If 数据 = "" Then
        WinHttp.Send
    Else
        WinHttp.Send 数据
    End If
End Sub
//-----------------------
//指定是否应自动发送凭据
//自动登录策略[整数型]: 0=始终,1=仅在绕过代理时,2=永不
Sub 方法_设置自动登录策略(自动登录策略)
    WinHttp.SetAutoLogonPolicy 自动登录策略
End Sub
//-----------------------
//指定一个客户端**
//客户端**[文本型]: **存储的位置
Sub 方法_设置客户端**(客户端**)
    WinHttp.SetClientCertificate 客户端**
End Sub
//-----------------------
//指定身份验证凭据
//选项[整数型]: 0=凭证传递到服务器,1=凭证传递到代理,一般为0
Sub 方法_设置凭证(用户名, 密码, 选项)
    WinHttp.SetCredentials 用户名, 密码, 选项
End Sub
//-----------------------
//指定代理服务器配置
//代理配置[整数型]:
//代理配置=0: 从注册表中读取代理服务器设置。
//代理配置=1: 所有 HTTP 和 HTTPS 服务器应该直接访问，如果没有代理服务器，则使用此命令。
//代理配置=2: 指定代理配置，这个代理配置只适用于WinHttpRequest对象的当前实例。
//代理地址[文本型]: 如 "192.168.1.1:8080"
//绕过域名[文本型]: 设置当代理配置等于2时绕过的域名列表。如 "*.baidu.com"
Sub 方法_设置代理(代理配置, 代理地址, 绕过域名)
    WinHttp.SetProxy 代理配置, 代理地址, 绕过域名
End Sub
//-----------------------
//添加 HTTP 协议头
//协议头[文本型]: 如 "Connection"
//值[文本型]: 如 "Keep-Alive"
Sub 方法_设置协议头(协议头, 值)
    WinHttp.SetRequestHeader 协议头, 值
End Sub
//-----------------------
//指定超时设置(以毫秒为单位)
Sub 方法_设置超时(解析超时, 连接超时, 发送超时, 接收超时)
    WinHttp.SetTimeouts 解析超时, 连接超时, 发送超时, 接收超时
End Sub
//-----------------------
//等待异步发送完成(以秒为单位)
Sub 方法_等待响应(超时)
    WinHttp.WaitForResp**e 超时
End Sub
//-----------------------
//读取或者设置属性
//属性类型[整数型]:
//UserAgentString = 0;
//URL = 1;
//URLCodePage = 2;
//EscapePercentInURL = 3;
//SslErrorIgnoreFlags = 4;
//SelectCertificate = 5; '为13056时,忽略错误标志
//EnableRedirects = 6; '为True时,当请求的页面中有跳转时,抓取跳转页面信息.False相反不抓取
//UrlEscapeDisable = 7;
//UrlEscapeDisableQuery = 8;
//SecureProtocols = 9;
//EnableTracing = 10;
//RevertImpersonationOverSsl = 11;
//EnableHttpsToHttpRedirects = 12;
//EnablePassportAuthentication = 13;
//MaxAutomaticRedirects = 14;
//MaxResp**eHeaderSize = 15;
//MaxResp**eDrainSize = 16;
//EnableHttp1_1 = 17;
//EnableCertificateRevocationCheck = 18;
//属性值: 为空则读取属性,否则设置属性
Function 属性_读写属性(属性类型, 属性值)
    If 属性值 = "" Then
        Execute "Global_value=WinHttp.Option(" & 属性类型 & ")"
        属性_读写属性 = Global_value
    Else
        Execute "WinHttp.Option(" & 属性类型 & ")=" & 属性值
    End If
End Function
//-----------------------
//取字节集型返回数据
Function 属性_取返回字节集()
    属性_取返回字节集 = WinHttp.Resp**eBody
End Function
//-----------------------
//取返回数据流
Function 属性_取返回数据流()
    属性_取返回数据流 = WinHttp.Resp**eStream
End Function
//-----------------------
//取文本型返回数据
Function 属性_取返回文本()
    属性_取返回文本 = WinHttp.Resp**eText
End Function
//-----------------------
//取得HTTP状态(Status)号
Function 属性_取状态()
    属性_取状态 = WinHttp.Status
End Function
//-----------------------
//取得HTTP状态(Status)文本
Function 属性_取状态文本()
    属性_取状态文本 = WinHttp.StatusText
End Function
//-----------------------------
//从协议头文本取Cookie
//协议头[文本型]: 返回的协议头文本
Function 高级_取Cookie(协议头)
    Dim i, Headers_Txt, Cookie_All, TmpA
    Headers_Txt = Replace(协议头, Vbcrlf, Vblf)
    Headers_Txt = Replace(Headers_Txt, vbCr, Vblf)
    Headers_Arr = Split(Headers_Txt, Vblf)
    For i = 0 To UBound(Headers_Arr)
        TmpA = Instr(1, Headers_Arr(i), "Set-Cookie:", 1)
        If TmpA > 0 Then
            Cookie_All = Mid(Headers_Arr(i), TmpA + 11)
            Exit For
        End If
    Next
    Cookie_All = Trim(Cookie_All)
    高级_取Cookie = Cookie_All
End Function
//-----------------------------
//从WinHttp取返回Cookie,发送请求并得到响应后才能获取
Function 高级_取返回Cookie()
    高级_取返回Cookie = WinHttp.getResp**eHeader("Set-Cookie")
End Function
//-----------------------------
//取单条Cookie
//Cookies[文本型]: Cookies文本
//名称[文本型]: Cookies名称
//附带名称[逻辑型]: 为真则附带名称返回,如"aa=123",为假则只返回Cookie值,如"123"
Function 高级_取单条Cookie(Cookies, 名称, 附带名称)
    Dim i, Cookie_All, Cookie, TmpA, TmpB, TmpC
    Cookie_All = Trim(Cookies)
    If Right(Cookie_All, 1) <> ";" Then
        Cookie_All = Cookie_All & ";"
    End If
    TmpA = Instr(1, Cookie_All, 名称 & "=", 1)
    If TmpA > 0 Then
        TmpB = Instr(TmpA, Cookie_All, ";", 1)
        If TmpB > 0 Then
            TmpC = TmpA + Len(名称 & "=")
            Cookie = Mid(Cookie_All, TmpC, TmpB - TmpC)
        End If
    End If
    If 附带名称 = False or Len(Trim(Cookie)) = 0 Then
        高级_取单条Cookie = Trim(Cookie)
    Else
        高级_取单条Cookie = 名称 & "=" & Trim(Cookie)
    End If
End Function
//-----------------------------
//合并更新Cookie,返回更新后的Cookie
//旧Cookie[文本型]: 旧的Cookie文本 如 "aaa=111;bbb=222"
//新Cookie[文本型]: 新的Cookie文本 如 "aaa=123"
Function 高级_合并更新Cookie(旧Cookie, 新Cookie)
    Dim i, n, TmpA, TmpB, TmpX, NameA, NameB, NameC
    Dim CookieA_All, CookieB_All, NewCookie, NewCookie_All
    //初步格式化
    NewCookie_All = ""
    CookieA_All = Replace(旧Cookie, Chr(32), "")
    If Len(CookieA_All) > 0 and Right(CookieA_All, 1) <> ";" Then
        CookieA_All = CookieA_All & ";"
    End If
    CookieB_All = Replace(新Cookie, Chr(32), "")
    If Len(CookieB_All) > 0 and Right(CookieB_All, 1) <> ";" Then
        CookieB_All = CookieB_All & ";"
    End If
    CookieA_All  = CookieA_All  & CookieB_All
    CookieA_Arr = Split(CookieA_All, ";")
    CookieB_Arr = Split(CookieB_All, ";")
    //开始更新Cookie
    For i = 0 To UBound(CookieA_Arr)
        TmpA = instr(CookieA_Arr(i), "=")
        If TmpA > 0 Then
            NewCookie = CookieA_Arr(i)
            NameA = Left(CookieA_Arr(i), TmpA - 1)
            For n = 0 To UBound(CookieB_Arr)
                TmpB = instr(CookieB_Arr(n), "=")
                If TmpB > 0 Then
                    NameB = Left(CookieB_Arr(n), TmpB - 1)
                    If NameB = NameA Then
                        NewCookie = CookieB_Arr(n)
                        Exit For
                    End If
                End If
            Next
        Else
            NewCookie = ""
        End If
        //去除无效的Cookie
        If NewCookie <> "" and LCase(Right(NewCookie, 8)) <> "=deleted" Then
            NewCookie_All = NewCookie_All & NewCookie & ";"
        End If
    Next
    //对重复的Cookie进行合并
    If NewCookie_All <> "" Then
        Redim Tmp_Arr(- 1 )
        NewCookie_All = Left(NewCookie_All, Len(NewCookie_All) - 1)
        NewCookie_Arr = Split(NewCookie_All, ";")
        For i = 0 To UBound(NewCookie_Arr)
            TmpX = False
            For n = 0 To UBound(Tmp_Arr)
                If Tmp_Arr(n) = NewCookie_Arr(i) Then
                    TmpX = True
                    Exit For
                End If
            Next
            If TmpX = False Then
                Redim Preserve Tmp_Arr(UBound(Tmp_Arr) + 1)
                Tmp_Arr(UBound(Tmp_Arr)) = NewCookie_Arr(i)
            End If
        Next
        NewCookie_All = Join(Tmp_Arr, "; ") & ";"
    End If
    高级_合并更新Cookie = NewCookie_All
End Function
//--------------------------------------
//使用WinHttp对象的方式访问网页
//网址[文本型]: 完整的网页地址(必须包含http://或者https://)
//访问方式[整数型]: 0=GET 1=POST 2=HEAD
//提交信息: "POST"专用
//提交Cookies[文本型]: 使用Cookie访问网页
//附加协议头[文本型]: 一行一个请用换行符隔开
//禁止重定向[逻辑型]: 为True时,禁止页面跳转,为False抓取跳转后的数据
//代理地址[文本型]: 格式为 192.168.1.1:8080
//用户名[文本型]: 代理地址不为空时可用
//密码[文本型]: 代理地址不为空时可用
//代理标识[文本型]: 默认为1，0为路由器,代理地址不为空时可用
//超时[整数型]: 单位秒,设置0为默认15秒,设置-1为无限等待
//返回编码: 0=GBK,1=UTF-8,2=UNICODE,3=GB2312,4=GB18030,5=BIG5,6=ASCII, 可以自定义编码 如"UTF-16"
//返回值[数组型]: 返回数据为数组,数组0=状态码,数组1=网页数据(文本),数组2=Cookie,数组3=协议头,数组4=网页数据(字节集),一般用于下载文件
Function 高级_网页访问Ex(网址, 访问方式, 提交信息, 提交Cookies, 附加协议头, 禁止重定向, 代理地址, 用户名, 密码, 代理标识, 超时, 返回编码)
    Dim i, Name, Value, TmpA, TmpB, Headers_Txt, ObjStream, BytesToBstr, Out_Arr
    Dim 局_访问方式, 局_网页数据, 局_返回协议头, 局_返回状态码, 局_返回Cookie, 局_返回编码
    //初始化
    If IsObject(TmpWinHttp) = False Then
        Set TmpWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
    End If
    //设置访问方式
    If 访问方式 = 1 Then
        局_访问方式 = "POST"
    ElseIf 访问方式 = 2 Then
        局_访问方式 = "HEAD"
    Else
        局_访问方式 = "GET"
    End If
    //设置返回编码
    If IsNumeric(返回编码) Then
        If 返回编码 = 1 Then
            局_返回编码 = "UTF-8"
        ElseIf 返回编码 = 2 Then
            局_返回编码 = "UNICODE"
        ElseIf 返回编码 = 3 Then
            局_返回编码 = "GB2312"
        ElseIf 返回编码 = 4 Then
            局_返回编码 = "GB18030"
        ElseIf 返回编码 = 5 Then
            局_返回编码 = "BIG5"
        ElseIf 返回编码 = 6 Then
            局_返回编码 = "ASCII"
        Else
            局_返回编码 = "GBK"
        End If
    Else
        局_返回编码 = 返回编码
    End If
    //设置超时
    If 超时 > 0 Then
        超时 = 超时 * 1000
    ElseIf 超时 < 0
        超时 = 0
    Else
        超时 = 15000
    End If
    TmpWinHttp.SetTimeouts 超时, 超时, 超时, 超时
    //设置代理
    If 代理地址 <> "" Then
        TmpWinHttp.SetProxy 2, 代理地址
        If 用户名 <> "" Then
            If 代理标识 = "" Then
                代理标识 = 1
            End If
            TmpWinHttp.SetProxyCredentials 用户名, 密码, 代理标识
        End If
    Else
        TmpWinHttp.SetProxy 1
    End If
    //设置Open参数(False为同步方式访问)
    TmpWinHttp.Open 局_访问方式, 网址, False
    //设置重定向
    If 禁止重定向 Then
        Execute "TmpWinHttp.Option(6)=False"
    Else
        Execute "TmpWinHttp.Option(6)=True"
    End If
    //设置忽略错误提示
    Execute "TmpWinHttp.Option(4)=13056"
    //处理附加协议头
    If 附加协议头 = "" Then
        附加协议头 = "Accept: */*"
    Else
        If Instr(1, 附加协议头, "Accept:", 1) = 0 Then
            附加协议头 = 附加协议头 & vbcrlf & "Accept: */*"
        End If
    End If
    If Instr(1, 附加协议头, "Referer:", 1) = 0 Then
        附加协议头 = 附加协议头 & vbcrlf & "Referer: " & 网址
    End If
    If Instr(1, 附加协议头, "Accept-Language:", 1) = 0 Then
        附加协议头 = 附加协议头 & vbcrlf & "Accept-Language: zh-cn"
    End If
    If Instr(1, 附加协议头, "User-Agent:", 1) = 0 Then
        附加协议头 = 附加协议头 & vbcrlf & "User-Agent: Mozilla/4.0 (compatible; MSIE 9.0; Windows NT 6.1)"
    End If
    If Instr(1, 附加协议头, "Content-Type:", 1) = 0 Then
        附加协议头 = 附加协议头 & vbcrlf & "Content-Type: application/x-www-form-urlencoded"
    End If
    //设置Cookies
    If 提交Cookies <> "" Then
        TmpWinHttp.SetRequestHeader "Cookie", 提交Cookies
    End If
    //设置协议头
    附加协议头 = Replace(附加协议头, vbcrlf, vblf)
    附加协议头 = Replace(附加协议头, vbcr, vblf)
    Header_Arr = Split(附加协议头, vblf)
    For i = 0 To UBound(Header_Arr)
        TmpA = Instr(Header_Arr(i), ":")
        TmpB = Len(Header_Arr(i))
        If TmpA > 0 and TmpB > 0 Then
            Name = Trim(Left(Header_Arr(i), TmpA - 1))
            Value = Trim(Right(Header_Arr(i), TmpB - TmpA))
            If Len(Name) > 0 and Len(Value) Then
                TmpWinHttp.SetRequestHeader Name, Value
            End If
        End If
    Next
    //发送请求
    TmpWinHttp.Send 提交信息
    //获取网页数据(字节集)
    局_网页数据 = TmpWinHttp.Resp**eBody
    //获取返回协议头
    局_返回协议头 = TmpWinHttp.GetallResp**eHeaders
    //获取返回状态码
    局_返回状态码 = TmpWinHttp.Status
    //获取返回Cookies
    Headers_Txt = Replace(局_返回协议头, Vbcrlf, Vblf)
    Headers_Txt = Replace(Headers_Txt, vbCr, Vblf)
    Headers_Arr = Split(Headers_Txt, Vblf)
    For i = 0 To UBound(Headers_Arr)
        TmpA = Instr(1, Headers_Arr(i), "Set-Cookie:", 1)
        If TmpA > 0 Then
            局_返回Cookie = Mid(Headers_Arr(i), TmpA + 11)
            Exit For
        End If
    Next
    //局_返回Cookie = Trim(局_返回Cookie)
    局_返回Cookie = TmpWinHttp.getResp**eHeader("Set-Cookie")
    //处理网页数据
    If Len(局_网页数据) = 0 Then
        Out_Arr = Array(局_返回状态码, "", 局_返回Cookie, 局_返回协议头, 局_网页数据)
        高级_网页访问Ex = Out_Arr
        Exit Function
    End If
    Set ObjStream = CreateObject("Adodb.Stream")
    With ObjStream
        .Type = 1
        .Mode = 3
        .Open
        .Write 局_网页数据
        .Position = 0
        .Type = 2
        .Charset = 局_返回编码
        BytesToBstr = .ReadText
        .Close
    End With
    //输出数据
    Out_Arr = Array(局_返回状态码, BytesToBstr, 局_返回Cookie, 局_返回协议头, 局_网页数据)
    高级_网页访问Ex = Out_Arr
End Function
//---------------------------------------
//简易Get访问,参数及返回值解释参见: 高级_网页访问Ex
Function 简易_Get访问(网址, 超时, 返回编码)
    Dim Out_Arr
    Out_Arr = 高级_网页访问Ex(网址, 0, "", "", "", False, "", "", "", "", 超时, 返回编码)
    简易_Get访问 = Out_Arr
End Function
//---------------------------------------
//简易Get访问Ex,参数及返回值解释参见: 高级_网页访问Ex
Function 简易_Get访问Ex(网址, 提交Cookies, 附加协议头, 禁止重定向, 代理地址, 超时, 返回编码)
    Dim Out_Arr
    Out_Arr = 高级_网页访问Ex(网址, 0, "", 提交Cookies, 附加协议头, 禁止重定向, 代理地址, "", "", "", 超时, 返回编码)
    简易_Get访问Ex = Out_Arr
End Function
//---------------------------------------
//简易Post访问,参数及返回值解释参见: 高级_网页访问Ex
Function 简易_Post访问(网址, 提交信息, 提交Cookies, 附加协议头, 超时, 返回编码)
    Dim Out_Arr
    Out_Arr = 高级_网页访问Ex(网址, 1, 提交信息, 提交Cookies, 附加协议头, False, "", "", "", "", 超时, 返回编码)
    简易_Post访问 = Out_Arr
End Function
//---------------------------------------
//简易Post访问Ex,参数及返回值解释参见: 高级_网页访问Ex
Function 简易_Post访问Ex(网址, 提交信息, 提交Cookies, 附加协议头, 禁止重定向, 代理地址, 超时, 返回编码)
    Dim Out_Arr
    Out_Arr = 高级_网页访问Ex(网址, 1, 提交信息, 提交Cookies, 附加协议头, 禁止重定向, 代理地址, "", "", "", 超时, 返回编码)
    简易_Post访问Ex = Out_Arr
End Function[General]
SyntaxVersion=2
MacroID=54ecf654-599b-4041-81e8-cc628d5369e4
[Comment]

[Script]
//WinHttp对象_中文版
//QQ97012791
//-----------------------
//初始化WinHttp对象
Sub 基本_初始化()
    If IsObject(WinHttp) = False Then
        Set WinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
    End If
End Sub
//-----------------------
//销毁WinHttp对象
Sub 基本_销毁()
    Set WinHttp = Nothing
End Sub
//-----------------------
//中止正在进行的异步操作
Sub 方法_中止()
    WinHttp.Abort
End Sub
//-----------------------
//取得所有HTTP返回协议头
Function 方法_取所有返回协议头()
    方法_取所有返回协议头 = WinHttp.GetAllResp**eHeaders
End Function
//-----------------------
//取得HTTP返回协议头
//协议头[文本型]: 如 "Set-Cookie"
Function 方法_取返回协议头(协议头)
    方法_取返回协议头 = WinHttp.GetResp**eHeader(协议头)
End Function
//-----------------------
//打开一个HTTP连接
//方法[文本型]: POST、GET、HEAD
//地址[文本型]: 如 http://www.baidu.com
//异步[逻辑型]: 是否异步, 一般为异步
Sub 方法_打开(方法, 地址, 异步)
    WinHttp.Open 方法, 地址, 异步
End Sub
//-----------------------
//发送HTTP请求
//数据: 提交数据，可以被省略，一般为POST使用
Sub 方法_发送(数据)
    If 数据 = "" Then
        WinHttp.Send
    Else
        WinHttp.Send 数据
    End If
End Sub
//-----------------------
//指定是否应自动发送凭据
//自动登录策略[整数型]: 0=始终,1=仅在绕过代理时,2=永不
Sub 方法_设置自动登录策略(自动登录策略)
    WinHttp.SetAutoLogonPolicy 自动登录策略
End Sub
//-----------------------
//指定一个客户端**
//客户端**[文本型]: **存储的位置
Sub 方法_设置客户端**(客户端**)
    WinHttp.SetClientCertificate 客户端**
End Sub
//-----------------------
//指定身份验证凭据
//选项[整数型]: 0=凭证传递到服务器,1=凭证传递到代理,一般为0
Sub 方法_设置凭证(用户名, 密码, 选项)
    WinHttp.SetCredentials 用户名, 密码, 选项
End Sub
//-----------------------
//指定代理服务器配置
//代理配置[整数型]:
//代理配置=0: 从注册表中读取代理服务器设置。
//代理配置=1: 所有 HTTP 和 HTTPS 服务器应该直接访问，如果没有代理服务器，则使用此命令。
//代理配置=2: 指定代理配置，这个代理配置只适用于WinHttpRequest对象的当前实例。
//代理地址[文本型]: 如 "192.168.1.1:8080"
//绕过域名[文本型]: 设置当代理配置等于2时绕过的域名列表。如 "*.baidu.com"
Sub 方法_设置代理(代理配置, 代理地址, 绕过域名)
    WinHttp.SetProxy 代理配置, 代理地址, 绕过域名
End Sub
//-----------------------
//添加 HTTP 协议头
//协议头[文本型]: 如 "Connection"
//值[文本型]: 如 "Keep-Alive"
Sub 方法_设置协议头(协议头, 值)
    WinHttp.SetRequestHeader 协议头, 值
End Sub
//-----------------------
//指定超时设置(以毫秒为单位)
Sub 方法_设置超时(解析超时, 连接超时, 发送超时, 接收超时)
    WinHttp.SetTimeouts 解析超时, 连接超时, 发送超时, 接收超时
End Sub
//-----------------------
//等待异步发送完成(以秒为单位)
Sub 方法_等待响应(超时)
    WinHttp.WaitForResp**e 超时
End Sub
//-----------------------
//读取或者设置属性
//属性类型[整数型]:
//UserAgentString = 0;
//URL = 1;
//URLCodePage = 2;
//EscapePercentInURL = 3;
//SslErrorIgnoreFlags = 4;
//SelectCertificate = 5; '为13056时,忽略错误标志
//EnableRedirects = 6; '为True时,当请求的页面中有跳转时,抓取跳转页面信息.False相反不抓取
//UrlEscapeDisable = 7;
//UrlEscapeDisableQuery = 8;
//SecureProtocols = 9;
//EnableTracing = 10;
//RevertImpersonationOverSsl = 11;
//EnableHttpsToHttpRedirects = 12;
//EnablePassportAuthentication = 13;
//MaxAutomaticRedirects = 14;
//MaxResp**eHeaderSize = 15;
//MaxResp**eDrainSize = 16;
//EnableHttp1_1 = 17;
//EnableCertificateRevocationCheck = 18;
//属性值: 为空则读取属性,否则设置属性
Function 属性_读写属性(属性类型, 属性值)
    If 属性值 = "" Then
        Execute "Global_value=WinHttp.Option(" & 属性类型 & ")"
        属性_读写属性 = Global_value
    Else
        Execute "WinHttp.Option(" & 属性类型 & ")=" & 属性值
    End If
End Function
//-----------------------
//取字节集型返回数据
Function 属性_取返回字节集()
    属性_取返回字节集 = WinHttp.Resp**eBody
End Function
//-----------------------
//取返回数据流
Function 属性_取返回数据流()
    属性_取返回数据流 = WinHttp.Resp**eStream
End Function
//-----------------------
//取文本型返回数据
Function 属性_取返回文本()
    属性_取返回文本 = WinHttp.Resp**eText
End Function
//-----------------------
//取得HTTP状态(Status)号
Function 属性_取状态()
    属性_取状态 = WinHttp.Status
End Function
//-----------------------
//取得HTTP状态(Status)文本
Function 属性_取状态文本()
    属性_取状态文本 = WinHttp.StatusText
End Function
//-----------------------------
//从协议头文本取Cookie
//协议头[文本型]: 返回的协议头文本
Function 高级_取Cookie(协议头)
    Dim i, Headers_Txt, Cookie_All, TmpA
    Headers_Txt = Replace(协议头, Vbcrlf, Vblf)
    Headers_Txt = Replace(Headers_Txt, vbCr, Vblf)
    Headers_Arr = Split(Headers_Txt, Vblf)
    For i = 0 To UBound(Headers_Arr)
        TmpA = Instr(1, Headers_Arr(i), "Set-Cookie:", 1)
        If TmpA > 0 Then
            Cookie_All = Mid(Headers_Arr(i), TmpA + 11)
            Exit For
        End If
    Next
    Cookie_All = Trim(Cookie_All)
    高级_取Cookie = Cookie_All
End Function
//-----------------------------
//从WinHttp取返回Cookie,发送请求并得到响应后才能获取
Function 高级_取返回Cookie()
    高级_取返回Cookie = WinHttp.getResp**eHeader("Set-Cookie")
End Function
//-----------------------------
//取单条Cookie
//Cookies[文本型]: Cookies文本
//名称[文本型]: Cookies名称
//附带名称[逻辑型]: 为真则附带名称返回,如"aa=123",为假则只返回Cookie值,如"123"
Function 高级_取单条Cookie(Cookies, 名称, 附带名称)
    Dim i, Cookie_All, Cookie, TmpA, TmpB, TmpC
    Cookie_All = Trim(Cookies)
    If Right(Cookie_All, 1) <> ";" Then
        Cookie_All = Cookie_All & ";"
    End If
    TmpA = Instr(1, Cookie_All, 名称 & "=", 1)
    If TmpA > 0 Then
        TmpB = Instr(TmpA, Cookie_All, ";", 1)
        If TmpB > 0 Then
            TmpC = TmpA + Len(名称 & "=")
            Cookie = Mid(Cookie_All, TmpC, TmpB - TmpC)
        End If
    End If
    If 附带名称 = False or Len(Trim(Cookie)) = 0 Then
        高级_取单条Cookie = Trim(Cookie)
    Else
        高级_取单条Cookie = 名称 & "=" & Trim(Cookie)
    End If
End Function
//-----------------------------
//合并更新Cookie,返回更新后的Cookie
//旧Cookie[文本型]: 旧的Cookie文本 如 "aaa=111;bbb=222"
//新Cookie[文本型]: 新的Cookie文本 如 "aaa=123"
Function 高级_合并更新Cookie(旧Cookie, 新Cookie)
    Dim i, n, TmpA, TmpB, TmpX, NameA, NameB, NameC
    Dim CookieA_All, CookieB_All, NewCookie, NewCookie_All
    //初步格式化
    NewCookie_All = ""
    CookieA_All = Replace(旧Cookie, Chr(32), "")
    If Len(CookieA_All) > 0 and Right(CookieA_All, 1) <> ";" Then
        CookieA_All = CookieA_All & ";"
    End If
    CookieB_All = Replace(新Cookie, Chr(32), "")
    If Len(CookieB_All) > 0 and Right(CookieB_All, 1) <> ";" Then
        CookieB_All = CookieB_All & ";"
    End If
    CookieA_All  = CookieA_All  & CookieB_All
    CookieA_Arr = Split(CookieA_All, ";")
    CookieB_Arr = Split(CookieB_All, ";")
    //开始更新Cookie
    For i = 0 To UBound(CookieA_Arr)
        TmpA = instr(CookieA_Arr(i), "=")
        If TmpA > 0 Then
            NewCookie = CookieA_Arr(i)
            NameA = Left(CookieA_Arr(i), TmpA - 1)
            For n = 0 To UBound(CookieB_Arr)
                TmpB = instr(CookieB_Arr(n), "=")
                If TmpB > 0 Then
                    NameB = Left(CookieB_Arr(n), TmpB - 1)
                    If NameB = NameA Then
                        NewCookie = CookieB_Arr(n)
                        Exit For
                    End If
                End If
            Next
        Else
            NewCookie = ""
        End If
        //去除无效的Cookie
        If NewCookie <> "" and LCase(Right(NewCookie, 8)) <> "=deleted" Then
            NewCookie_All = NewCookie_All & NewCookie & ";"
        End If
    Next
    //对重复的Cookie进行合并
    If NewCookie_All <> "" Then
        Redim Tmp_Arr(- 1 )
        NewCookie_All = Left(NewCookie_All, Len(NewCookie_All) - 1)
        NewCookie_Arr = Split(NewCookie_All, ";")
        For i = 0 To UBound(NewCookie_Arr)
            TmpX = False
            For n = 0 To UBound(Tmp_Arr)
                If Tmp_Arr(n) = NewCookie_Arr(i) Then
                    TmpX = True
                    Exit For
                End If
            Next
            If TmpX = False Then
                Redim Preserve Tmp_Arr(UBound(Tmp_Arr) + 1)
                Tmp_Arr(UBound(Tmp_Arr)) = NewCookie_Arr(i)
            End If
        Next
        NewCookie_All = Join(Tmp_Arr, "; ") & ";"
    End If
    高级_合并更新Cookie = NewCookie_All
End Function
//--------------------------------------
//使用WinHttp对象的方式访问网页
//网址[文本型]: 完整的网页地址(必须包含http://或者https://)
//访问方式[整数型]: 0=GET 1=POST 2=HEAD
//提交信息: "POST"专用
//提交Cookies[文本型]: 使用Cookie访问网页
//附加协议头[文本型]: 一行一个请用换行符隔开
//禁止重定向[逻辑型]: 为True时,禁止页面跳转,为False抓取跳转后的数据
//代理地址[文本型]: 格式为 192.168.1.1:8080
//用户名[文本型]: 代理地址不为空时可用
//密码[文本型]: 代理地址不为空时可用
//代理标识[文本型]: 默认为1，0为路由器,代理地址不为空时可用
//超时[整数型]: 单位秒,设置0为默认15秒,设置-1为无限等待
//返回编码: 0=GBK,1=UTF-8,2=UNICODE,3=GB2312,4=GB18030,5=BIG5,6=ASCII, 可以自定义编码 如"UTF-16"
//返回值[数组型]: 返回数据为数组,数组0=状态码,数组1=网页数据(文本),数组2=Cookie,数组3=协议头,数组4=网页数据(字节集),一般用于下载文件
Function 高级_网页访问Ex(网址, 访问方式, 提交信息, 提交Cookies, 附加协议头, 禁止重定向, 代理地址, 用户名, 密码, 代理标识, 超时, 返回编码)
    Dim i, Name, Value, TmpA, TmpB, Headers_Txt, ObjStream, BytesToBstr, Out_Arr
    Dim 局_访问方式, 局_网页数据, 局_返回协议头, 局_返回状态码, 局_返回Cookie, 局_返回编码
    //初始化
    If IsObject(TmpWinHttp) = False Then
        Set TmpWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
    End If
    //设置访问方式
    If 访问方式 = 1 Then
        局_访问方式 = "POST"
    ElseIf 访问方式 = 2 Then
        局_访问方式 = "HEAD"
    Else
        局_访问方式 = "GET"
    End If
    //设置返回编码
    If IsNumeric(返回编码) Then
        If 返回编码 = 1 Then
            局_返回编码 = "UTF-8"
        ElseIf 返回编码 = 2 Then
            局_返回编码 = "UNICODE"
        ElseIf 返回编码 = 3 Then
            局_返回编码 = "GB2312"
        ElseIf 返回编码 = 4 Then
            局_返回编码 = "GB18030"
        ElseIf 返回编码 = 5 Then
            局_返回编码 = "BIG5"
        ElseIf 返回编码 = 6 Then
            局_返回编码 = "ASCII"
        Else
            局_返回编码 = "GBK"
        End If
    Else
        局_返回编码 = 返回编码
    End If
    //设置超时
    If 超时 > 0 Then
        超时 = 超时 * 1000
    ElseIf 超时 < 0
        超时 = 0
    Else
        超时 = 15000
    End If
    TmpWinHttp.SetTimeouts 超时, 超时, 超时, 超时
    //设置代理
    If 代理地址 <> "" Then
        TmpWinHttp.SetProxy 2, 代理地址
        If 用户名 <> "" Then
            If 代理标识 = "" Then
                代理标识 = 1
            End If
            TmpWinHttp.SetProxyCredentials 用户名, 密码, 代理标识
        End If
    Else
        TmpWinHttp.SetProxy 1
    End If
    //设置Open参数(False为同步方式访问)
    TmpWinHttp.Open 局_访问方式, 网址, False
    //设置重定向
    If 禁止重定向 Then
        Execute "TmpWinHttp.Option(6)=False"
    Else
        Execute "TmpWinHttp.Option(6)=True"
    End If
    //设置忽略错误提示
    Execute "TmpWinHttp.Option(4)=13056"
    //处理附加协议头
    If 附加协议头 = "" Then
        附加协议头 = "Accept: */*"
    Else
        If Instr(1, 附加协议头, "Accept:", 1) = 0 Then
            附加协议头 = 附加协议头 & vbcrlf & "Accept: */*"
        End If
    End If
    If Instr(1, 附加协议头, "Referer:", 1) = 0 Then
        附加协议头 = 附加协议头 & vbcrlf & "Referer: " & 网址
    End If
    If Instr(1, 附加协议头, "Accept-Language:", 1) = 0 Then
        附加协议头 = 附加协议头 & vbcrlf & "Accept-Language: zh-cn"
    End If
    If Instr(1, 附加协议头, "User-Agent:", 1) = 0 Then
        附加协议头 = 附加协议头 & vbcrlf & "User-Agent: Mozilla/4.0 (compatible; MSIE 9.0; Windows NT 6.1)"
    End If
    If Instr(1, 附加协议头, "Content-Type:", 1) = 0 Then
        附加协议头 = 附加协议头 & vbcrlf & "Content-Type: application/x-www-form-urlencoded"
    End If
    //设置Cookies
    If 提交Cookies <> "" Then
        TmpWinHttp.SetRequestHeader "Cookie", 提交Cookies
    End If
    //设置协议头
    附加协议头 = Replace(附加协议头, vbcrlf, vblf)
    附加协议头 = Replace(附加协议头, vbcr, vblf)
    Header_Arr = Split(附加协议头, vblf)
    For i = 0 To UBound(Header_Arr)
        TmpA = Instr(Header_Arr(i), ":")
        TmpB = Len(Header_Arr(i))
        If TmpA > 0 and TmpB > 0 Then
            Name = Trim(Left(Header_Arr(i), TmpA - 1))
            Value = Trim(Right(Header_Arr(i), TmpB - TmpA))
            If Len(Name) > 0 and Len(Value) Then
                TmpWinHttp.SetRequestHeader Name, Value
            End If
        End If
    Next
    //发送请求
    TmpWinHttp.Send 提交信息
    //获取网页数据(字节集)
    局_网页数据 = TmpWinHttp.Resp**eBody
    //获取返回协议头
    局_返回协议头 = TmpWinHttp.GetallResp**eHeaders
    //获取返回状态码
    局_返回状态码 = TmpWinHttp.Status
    //获取返回Cookies
    Headers_Txt = Replace(局_返回协议头, Vbcrlf, Vblf)
    Headers_Txt = Replace(Headers_Txt, vbCr, Vblf)
    Headers_Arr = Split(Headers_Txt, Vblf)
    For i = 0 To UBound(Headers_Arr)
        TmpA = Instr(1, Headers_Arr(i), "Set-Cookie:", 1)
        If TmpA > 0 Then
            局_返回Cookie = Mid(Headers_Arr(i), TmpA + 11)
            Exit For
        End If
    Next
    //局_返回Cookie = Trim(局_返回Cookie)
    局_返回Cookie = TmpWinHttp.getResp**eHeader("Set-Cookie")
    //处理网页数据
    If Len(局_网页数据) = 0 Then
        Out_Arr = Array(局_返回状态码, "", 局_返回Cookie, 局_返回协议头, 局_网页数据)
        高级_网页访问Ex = Out_Arr
        Exit Function
    End If
    Set ObjStream = CreateObject("Adodb.Stream")
    With ObjStream
        .Type = 1
        .Mode = 3
        .Open
        .Write 局_网页数据
        .Position = 0
        .Type = 2
        .Charset = 局_返回编码
        BytesToBstr = .ReadText
        .Close
    End With
    //输出数据
    Out_Arr = Array(局_返回状态码, BytesToBstr, 局_返回Cookie, 局_返回协议头, 局_网页数据)
    高级_网页访问Ex = Out_Arr
End Function
//---------------------------------------
//简易Get访问,参数及返回值解释参见: 高级_网页访问Ex
Function 简易_Get访问(网址, 超时, 返回编码)
    Dim Out_Arr
    Out_Arr = 高级_网页访问Ex(网址, 0, "", "", "", False, "", "", "", "", 超时, 返回编码)
    简易_Get访问 = Out_Arr
End Function
//---------------------------------------
//简易Get访问Ex,参数及返回值解释参见: 高级_网页访问Ex
Function 简易_Get访问Ex(网址, 提交Cookies, 附加协议头, 禁止重定向, 代理地址, 超时, 返回编码)
    Dim Out_Arr
    Out_Arr = 高级_网页访问Ex(网址, 0, "", 提交Cookies, 附加协议头, 禁止重定向, 代理地址, "", "", "", 超时, 返回编码)
    简易_Get访问Ex = Out_Arr
End Function
//---------------------------------------
//简易Post访问,参数及返回值解释参见: 高级_网页访问Ex
Function 简易_Post访问(网址, 提交信息, 提交Cookies, 附加协议头, 超时, 返回编码)
    Dim Out_Arr
    Out_Arr = 高级_网页访问Ex(网址, 1, 提交信息, 提交Cookies, 附加协议头, False, "", "", "", "", 超时, 返回编码)
    简易_Post访问 = Out_Arr
End Function
//---------------------------------------
//简易Post访问Ex,参数及返回值解释参见: 高级_网页访问Ex
Function 简易_Post访问Ex(网址, 提交信息, 提交Cookies, 附加协议头, 禁止重定向, 代理地址, 超时, 返回编码)
    Dim Out_Arr
    Out_Arr = 高级_网页访问Ex(网址, 1, 提交信息, 提交Cookies, 附加协议头, 禁止重定向, 代理地址, "", "", "", 超时, 返回编码)
    简易_Post访问Ex = Out_Arr
End Function

yun0712

看看

zxj8645

: 37玩注册器5.0版POST注册实例教程第三课(重点） [修改]

dzb123

收藏