网络要多刷刷,能提速不少。VBA刷网络之API篇

VBA 实现刷网络,非暴力不合作,对抗ISP耍流氓之一本次使用VBA+windows API 来发包刷网络,目的让网络平衡系统多分配点资源 

使用VBA刷网络,见拙作VBA 实现刷网络,非暴力不合作,对抗ISP耍流氓之一icon-default.png?t=O83Ahttps://blog.csdn.net/wjjhyf/article/details/142044171,有详细的操作

在这儿就不抢占带宽了,用VB实现太麻烦。还是VC方面,用winsock套接字,下载大文件。收到数据后,直接丢弃。

现在下载,使用了跳转。用封装的API下载,不好控制,还要解密,太浪费CPU了!所以直接winsock套接字,交换密钥后,取得下载文件真实地址,然后下载文件,内存接收,不解密,直接丢弃。下载完成后,直接移动指针到文件首,再次下载,多线程。榨干每一滴宽带!太流*氓了!估计ISP能封杀宽带!这个就不放代码了!

上VBA+API刷网络【不是占宽带】

Private Declare Function SetTimer Lib "user32" (ByVal HWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal HWnd As Long, ByVal nIDEvent As Long) As Long

Private Declare Function timeGetTime Lib "winmm.dll" () As Long
'/*检测oHTML是否初始化*/
Private Declare Function SafeArrayGetDim Lib "oleaut32.dll" (ByRef saArray() As Any) As Long
Private Const MAX_PACKS = 50 '/*每次发包数*/
Private Const MIN_TIME = 100& '/*时间间隔,毫秒数*/

Dim oHTML() As Object
Dim TimerID As Long

Public Sub 刷网络()
    TimerID = SetTimer(0&, 0&, MIN_TIME, AddressOf FlushWebProc)
End Sub

Sub 停止刷网络()
    If TimerID <> 0 Then
        KillTimer 0&, TimerID
    End If
    TimerID = 0
End Sub

Private Sub FlushWebProc(ByVal HWnd As Long, ByVal uMsg As Long, ByVal nIDEvent As Long, ByVal dwTimer As Long)
    Dim iI As Long, iJ As Long
    Dim iWait As Long
   '/*要刷的网址,可以任意定义*/
    Dim sUrl(8) As String
    sUrl(0) = "https://wjjhyf.eu5.org"
    sUrl(1) = "https://yandex.com/search/?text=wjjhyf.eu5.org"
    sUrl(2) = "https://www.sogou.com/tx?ie=utf8&pid=&query=wjjhyf.eu5.org"
    sUrl(3) = "https://yz.m.sm.cn/s?q=wjjhyf.eu5.org"
    sUrl(4) = "https://www.chinaso.com/newssearch/all/allResults?q=wjjhyf.eu5.org"
    sUrl(5) = "https://so.toutiao.com/search?keyword=wjjhyf.eu5.org"
    sUrl(6) = "https://cn.bing.com/search?q=wjjhyf.eu5.org"
    sUrl(7) = "https://www.so.com/s?q=wjjhyf.eu5.org"
    sUrl(8) = "https://www.baidu.com/#&ie={inputEncoding}&wd=wjjhyf.eu5.org"
 
    If SafeArrayGetDim(oHTML) = 0 Then
        '/*初始化oHTML*/
        ReDim oHTML(MAX_PACKS - 1)
        For iI = LBound(oHTML) To UBound(oHTML)
            Set oHTML(iI) = CreateObject("Msxml2.ServerXMLHTTP")
        Next
    End If
    For iI = LBound(oHTML) To UBound(oHTML)
        '随机发送网址
        iJ = Int((UBound(sUrl) + 1) * Rnd)
        iJ = IIf(iJ > UBound(sUrl), 0, iJ) '防止溢出
        On Error Resume Next
        oHTML(iI).Open "Get", sUrl(iJ), True
        oHTML(iI).send
        On Error GoTo 0
        DoEvents
    Next
    If Abs(timeGetTime() - iWait) > 1000 Then
        iWait = timeGetTime()
        On Error Resume Next'运行宏窗口时,Application.StatusBar 禁止赋值,只能简单粗暴跳过,判断太麻烦
        Application.StatusBar = Time
        DoEvents
    End If
End Sub

操作,使用方法同

VBA 实现刷网络,非暴力不合作,对抗ISP耍流氓之一icon-default.png?t=O83Ahttps://blog.csdn.net/wjjhyf/article/details/142044171其它可参见: https://wjjhyf.eu5.org【个人主页】

调整数字,改变刷网频度【100毫秒刷50包,把我的路由器给刷死了。断网了!】

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值