VBA 实现刷网络，非暴力不合作，对抗ISP耍流氓之一

wjjhyf

已于 2024-09-09 09:28:56 修改

阅读量323

点赞数 10

文章标签：接口隔离原则

于 2024-09-09 09:24:20 首次发布

本人发表的原创，可以随意使用、传播，但本人不对副本承担任何责任；详见:https://wjjhyf.eu5.org

本文链接：https://blog.csdn.net/wjjhyf/article/details/142044171

版权

office 系列办公套件，均内含VBA功能，使用它可以完成很多工作，如果配合API使用，它将无所不能。

使用VBA完成工作，你可以完全不用担心木马、病毒，你完全掌控程序的运行，不需要部署开发环境，不需要编译代码。它是解释执行的，效率有点低。

使用本程序刷网络，占用CPU较高，刷满带宽比较难。但刷网络，缩短网络响应已经足够了！

打开任一office办公应用软件，以execl为例，其它类似

按下组合键ALT+F11(按下alt,不要放开，再按下F11)，打开VBA开发环境

插入一个模块

插入后的状态

复制源码到光标处

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 = 10 '/*每次发包数*/
Private Const MIN_TIME = 100 '/*时间间隔，毫秒数*/
Dim oHTML() As Object
Public Sub 刷网络()
    Dim iI As Long, iJ As Long
    Dim iWait As Long, iSleep 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
    iWait = timeGetTime()
    Do While Abs(timeGetTime() - iWait) < 1000
        iSleep = timeGetTime()
        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
        '延时
        Do While Abs(timeGetTime() - iSleep) < MIN_TIME
            DoEvents
        Loop
    Loop
    Application.OnTime DateAdd("s", 1, Now), "刷网络"
    Application.StatusBar = Time
End Sub