unit_frmmain.pas

在内存中动态运行可执行程序的演示

{=======================================================}
{                                                       }
{         DelphiUpx－ 内存运行EXE文件演示程序           }
{                                                       }
{    版权所有 (c) 2004 陈经韬[e-mail]      }
{                                                       }
{                            http://www.138soft.com     }
{=======================================================}

unit Unit_FrmMain;

{=======================================================
  项目:  DelphiUpx
  模块:  主窗口
  描述:
  版本:  0.5
  日期:  2004-04-23
  作者:  陈经韬
  更新:
=======================================================}
interface

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

type
  TFrmMain = class(TForm)
    Label1: TLabel;
    Edit_FileName: TEdit;
    Button1: TButton;
    Button2: TButton;
    GroupBox1: TGroupBox;
    rbVcl: TRadioButton;
    rbSdk: TRadioButton;
    SpeedButton1: TSpeedButton;
    OpenDialog1: TOpenDialog;
    Label2: TLabel;
    Label3: TLabel;
    Bevel1: TBevel;
    Label4: TLabel;
    Label5: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Label5Click(Sender: TObject);
  private
    { Private declarations }
    function CheckExeFile:Boolean;{判断是否为exe文件}
    function IsPackedFile(const FileName:string):Boolean;{判断是否已经压缩}
  public
    { Public declarations }
  end;

var
  FrmMain: TFrmMain;

implementation
uses
   ShellApi,Unit_ModifIconByStream,Lh5Unit;{引用压缩单元}
{$R *.dfm}

function TFrmMain.CheckExeFile: Boolean;{判断是否为合法exe文件}
const
strBorlandDosSub:string='This program must be run under Win32';
//strMicroSoftDosSub:string='This is program cannot be run in DOS mode.';
var
FileStreamRead:TFileStream;
DosHeader:TImageDosHeader;
NtHeaders:TImageNtHeaders;
strDosSub:string;
label ExeForMatError;
begin
Result:=False;
if Trim(Edit_FileName.Text)='' then
begin
Application.MessageBox('请选择欲操作的exe文件!',Pchar(Application.Title),MB_ICONINFORMATION);
Edit_FileName.SetFocus;
Exit;
end;
if not FileExists(Edit_FileName.Text) then
begin
Application.MessageBox('exe文件不存在,请重新选择!',Pchar(Application.Title),MB_ICONINFORMATION);
Edit_FileName.SetFocus;
Exit;
end;
FileStreamRead:=TFileStream.Create(Edit_FileName.Text,fmOpenRead or fmShareDenyNone);
FileStreamRead.Read(DosHeader,sizeof(DosHeader));
if DosHeader.e_magic<>IMAGE_DOS_SIGNATURE  then goto ExeForMatError;
FileStreamRead.Seek(DosHeader._lfanew,soBeginning);
FileStreamRead.Read(NtHeaders,sizeof(NtHeaders));
if NtHeaders.Signature<>IMAGE_NT_SIGNATURE then goto ExeForMatError;

FileStreamRead.Seek($50,soFromBeginning);
SetLength(strDosSub,36);
FileStreamRead.Read(strDosSub[1],36);
if strDosSub<>strBorlandDosSub then goto ExeForMatError;
Result:=True;
FileStreamRead.Free;
Exit;
ExeForMatError:
Application.MessageBox('该文件不是一个exe文件!或者不是用Delphi或C++Builder编写的exe文件!',Pchar(Application.Title),MB_ICONINFORMATION);
FileStreamRead.Free;
end;


function TFrmMain.IsPackedFile(const FileName: string): Boolean;{判断是否已经压缩}
var
FileStreamRead:TFileStream;
PackMark:string;
begin
FileStreamRead:=TFileStream.Create(FileName,fmOpenRead or fmShareDenyNone);
FileStreamRead.Seek(-3,soFromEnd);
SetLength(PackMark,3);
FileStreamRead.Read(PackMark[1],3);
FileStreamRead.Free;
Result:=PackMark='cjt';
end;


procedure TFrmMain.FormCreate(Sender: TObject);
begin
Application.Title:='DelphiUpx';
Caption:=Application.Title;
Edit_FileName.Clear;
end;

procedure TFrmMain.SpeedButton1Click(Sender: TObject);
begin
if OpenDialog1.Execute then Edit_FileName.Text:=OpenDialog1.FileName;
end;

procedure TFrmMain.Button1Click(Sender: TObject);
var
Res:TResourceStream;
MyIcon:TIcon;
MyStreamRead,MyStreamPack,MyStreamWrite:TMemoryStream;
PackMark:string;
iOrgSize,iPackedSize:integer;
begin
if not CheckExeFile then Exit;
if IsPackedFile(Edit_FileName.Text) then
begin
Application.MessageBox('该文件已经压缩过了!',Pchar(Application.Title),MB_ICONINFORMATION);
Exit;
end;
{$R head.RES}
if rbVcl.Checked then Res:=TResourceStream.Create(HInstance,'VclHead','binfile')
                 else Res:=TResourceStream.Create(HInstance,'SdkHead','binfile');
MyStreamWrite:=TMemoryStream.Create;
Res.SaveToStream(MyStreamWrite);
Res.Free;

MyStreamRead:=TMemoryStream.Create;
MyStreamPack:=TMemoryStream.Create;
MyStreamRead.LoadFromFile(Edit_FileName.Text);
LHACompress(MyStreamRead,MyStreamPack);{压缩}
MyStreamPack.Position:=0;
MyStreamWrite.CopyFrom(MyStreamPack,0);
iOrgSize:=MyStreamRead.Size;
iPackedSize:=MyStreamPack.Size;
MyStreamWrite.Write(iPackedSize,sizeof(iPackedSize));{写入压缩后的大小}
PackMark:='cjt';
MyStreamWrite.Write(PackMark[1],3);{写入加密标志}
MyIcon:=TIcon.Create;
try
MyIcon.Handle:=ExtractIcon(Handle,Pchar(Edit_FileName.Text),0);
if MyIcon.Handle<>0 then Cjt_ModifIconByStream(MyIcon,MyStreamWrite);
finally
MyIcon.Free;
end;
SetFileAttributes(Pchar(Edit_FileName.Text),FILE_ATTRIBUTE_NORMAL);
//CopyFile(Pchar(Edit_FileName.Text),Pchar(ChangeFileExt(Edit_FileName.Text,'.bak')),False);
if not DeleteFile(Edit_FileName.Text) then
begin
  //DeleteFile(ChangeFileExt(Edit_FileName.Text,'.bak'));
  Application.MessageBox('文件覆盖失败!请检查文件是否正在使用!',Pchar(Application.Title),MB_ICONINFORMATION);
  MyStreamRead.Free;
  MyStreamPack.Free;
  MyStreamWrite.Free;
  Exit;
end;

MyStreamWrite.SaveToFile(Edit_FileName.Text);

MyStreamRead.Free;
MyStreamPack.Free;
MyStreamWrite.Free;
Application.MessageBox(Pchar(Format('文件压缩完毕!'#13+'原文件大小:%d字节!'#13+'压缩后大小:%d字节!',[iOrgSize,iPackedSize])),Pchar(Application.Title),MB_ICONINFORMATION);

if Application.MessageBox('您要现在测试压缩后的文件吗?(注意:如果运行失败,请解压还原该EXE文件!)',Pchar(Application.Title),MB_ICONQUESTION+MB_YESNO)=IDNO then Exit
   else
   ShellExecute(Handle, 'OPEN',PChar(Edit_FileName.Text), Pchar(ExtractFileDir(Edit_FileName.Text)), '', SW_SHOWNORMAL);
end;

procedure TFrmMain.Button2Click(Sender: TObject);
var
FileStreamRead:TFileStream;
MyStreamRead,MyStreamUnPack:TMemoryStream;
iPackSize:integer;
begin
if not CheckExeFile then Exit;
if not IsPackedFile(Edit_FileName.Text) then
begin
Application.MessageBox('该文件不是一个压缩文件!',Pchar(Application.Title),MB_ICONINFORMATION);
Exit;
end;
FileStreamRead:=TFileStream.Create(Edit_FileName.Text,fmOpenRead or fmShareDenyNone);
FileStreamRead.Seek(-(3+sizeof(iPackSize)),soFromEnd);
FileStreamRead.Read(iPackSize,sizeof(iPackSize));
FileStreamRead.Seek(-(3+sizeof(iPackSize)+iPackSize),soFromEnd);
MyStreamRead:=TMemoryStream.Create;
MyStreamUnPack:=TMemoryStream.Create;
MyStreamRead.CopyFrom(FileStreamRead,iPackSize);
FileStreamRead.Free;

MyStreamRead.Position:=0;
LHAExpand(MyStreamRead,MyStreamUnPack);
if not DeleteFile(Edit_FileName.Text) then
begin
  Application.MessageBox('文件覆盖失败!请检查文件是否正在使用!',Pchar(Application.Title),MB_ICONINFORMATION);
  MyStreamRead.Free;
  MyStreamUnPack.Free;
  Exit;
end;
MyStreamUnPack.SaveToFile(Edit_FileName.Text);
MyStreamRead.Free;
MyStreamUnPack.Free;
Application.MessageBox('文件解压完毕!',Pchar(Application.Title),MB_ICONINFORMATION);
end;



procedure TFrmMain.Label5Click(Sender: TObject);
begin
 ShellExecute(Handle, 'OPEN',PChar((Sender as TLabel).Caption), '', '', SW_SHOWNORMAL);
end;

end.