VBA 实现刷网络,非暴力不合作,对抗ISP耍流氓之一本次使用VBA+windows API 来发包刷网络,目的让网络平衡系统多分配点资源
使用VBA刷网络,见拙作VBA 实现刷网络,非暴力不合作,对抗ISP耍流氓之一
https://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耍流氓之一
https://blog.csdn.net/wjjhyf/article/details/142044171其它可参见: https://wjjhyf.eu5.org【个人主页】

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


被折叠的 条评论
为什么被折叠?



