main.pas

PEZIP捆绑壳delphi源代码 一份不错的源码

unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs, StdCtrls;

type
  TfrmMain = class(TForm)
    btnOpen: TButton;
    edtFilePath: TEdit;
    btnCompress: TButton;
    btnClose: TButton;
    dlgOpen: TOpenDialog;
    btnAbout: TButton;
    procedure FormCreate(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure btnCompressClick(Sender: TObject);
    procedure btnOpenClick(Sender: TObject);
    procedure btnAboutClick(Sender: TObject);
  private
    procedure ShowError(const Msg: string);
    procedure ShowMessage(const Msg: string);
    procedure ShowExcept(Sender: TObject; E: Exception);
  end;

var
  frmMain: TfrmMain;

implementation

uses
  XpTheme, Pack, CRC32;

{$R *.DFM}
{$I STUB.DMP}

procedure TfrmMain.ShowError(const Msg: string);
begin
  MessageBox(Handle, PChar(Msg), PChar(Application.Title), MB_ICONWARNING);
end;

procedure TfrmMain.ShowMessage(const Msg: string);
begin
  MessageBox(Handle, PChar(Msg), PChar(Application.Title), MB_ICONINFORMATION);
end;

procedure TfrmMain.ShowExcept(Sender: TObject; E: Exception);
begin
  ShowError(E.Message);
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  Application.OnException:= ShowExcept;
  if ParamCount > 0 then
    edtFilePath.Text:= ParamStr(1);
  Caption:= Application.Title;
end;

procedure TfrmMain.btnOpenClick(Sender: TObject);
begin
  if dlgOpen.Execute then
    edtFilePath.Text:= dlgOpen.FileName;
end;

function CheckPE(const FileName: string): Boolean;
var
  FHandle: THandle;
  OFS: OFSTRUCT;
  PEHeaderOffset, PESig: DWORD;
  BytesRead: DWORD;
begin
  FHandle:= OpenFile(PChar(FileName), OFS, OF_READ or OF_SHARE_DENY_READ);
  if (FHandle = INVALID_HANDLE_VALUE) then
  begin
    Result:= False;
    Exit;
  end;
  SetFilePointer(FHandle, $3C, nil, 0);
  ReadFile(FHandle, PEHeaderOffset, SizeOf(PEHeaderOffset), BytesRead, nil);
  if (PEHeaderOffset = 0) then
  begin
    Result:= False;
    Exit;
  end;
  SetFilePointer(FHandle, PEHeaderOffset, nil, 0);
  ReadFile(FHandle, PESig, SizeOf(PESig), BytesRead, nil);
  Result:= (PESig = $00004550);
  CloseHandle(FHandle);
end;

function CheckDLL(const FileName: string): Boolean;
var
  FHandle: THandle;
  OFS: OFSTRUCT;
  PEHeaderOffset, PESig: DWORD;
  PEHeader: TImageFileHeader;
  BytesRead: DWORD;
begin
  FHandle:= OpenFile(PChar(FileName), OFS, OF_READ or OF_SHARE_DENY_READ);
  if (FHandle = INVALID_HANDLE_VALUE) then
  begin
    Result:= False;
    Exit;
  end;
  SetFilePointer(FHandle, $3C, nil, 0);
  ReadFile(FHandle, PEHeaderOffset, SizeOf(PEHeaderOffset), BytesRead, nil);
  if (PEHeaderOffset = 0) then
  begin
    Result:= False;
    Exit;
  end;
  SetFilePointer(FHandle, PEHeaderOffset, nil, 0);
  ReadFile(FHandle, PESig, SizeOf(PESig), BytesRead, nil);
  if (PESig <> $00004550) then
  begin
    Result:= False;
    Exit;
  end;
  ReadFile(FHandle, PEHeader, SizeOf(PEHeader), BytesRead, nil);
  Result:= (PEHeader.Characteristics and IMAGE_FILE_DLL <> 0);
  CloseHandle(FHandle);
end;

procedure TfrmMain.btnCompressClick(Sender: TObject);
const
  Flag: DWORD = $2E444E45;
type
  TSection = record
    Name: array[0..7] of Char;
    VirtualSize: DWORD;
    VirtualAddress: DWORD;
    PhysicalSize: DWORD;
    PhysicalOffset: DWORD;
    PointerToRelocations: DWORD;
    PointerToLinenumbers: DWORD;
    NumberOfRelocations: Word;
    NumberOfLinenumbers: Word;
    Characteristics: DWORD;
  end;
var
  fSrc, fDest: THandle;
  OFS: TOFStruct;
  bWrite: Cardinal;
  InBuff, OutBuff: Pointer;
  InBytes, OutBytes: Cardinal;
  PEHeaderOffset, PESig: DWORD;
  ImageBase: DWORD;
  NumOfSections: WORD;
  ResRVA, ResSize: DWORD;
  ResPhysOffset, ResPhysSize: DWORD;
  I: WORD;
  Section: TSection;
  CRC32: Cardinal;
label
  down;
begin
  if not FileExists(edtFilePath.Text) then
  begin
    ShowError('File does not exist');
    Exit;
  end;
  if not CheckPE(edtFilePath.Text) then
  begin
    ShowError('Is a not valid PE file');
    Exit;
  end;
  if CheckDLL(edtFilePath.Text) then
  begin
    ShowError('Compress DLL is not supported. Sorry...');
    Exit;
  end;
  if not RenameFile(edtFilePath.Text, edtFilePath.Text + '.bak') then
  begin
    ShowError('Error at opening file');
    Exit;
  end;
  fSrc:= OpenFile(PChar(edtFilePath.Text + '.bak'), OFS, OF_READ or OF_SHARE_DENY_READ);
  if fSrc = INVALID_HANDLE_VALUE then
  begin
    ShowError('Error at opening file');
    Exit;
  end;
  fDest:= CreateFile(PChar(edtFilePath.Text), GENERIC_READ or GENERIC_WRITE, 0, nil,
    CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL or FILE_ATTRIBUTE_ARCHIVE, 0);
  if fDest = INVALID_HANDLE_VALUE then
  begin
    ShowError('Error at writing file');
    Exit;
  end;
  InBuff:= nil;
  CRC32:= 0;
  try
    WriteFile(fDest, DumpData, SizeOf(DumpData), bWrite, nil);
    InBytes:= GetFileSize(fSrc, nil);
    GetMem(InBuff, InBytes);
    OutBuff:= nil;
    ReadFile(fSrc, InBuff^, InBytes, bWrite, nil);
    CloseHandle(fSrc);
    CRC32Full(InBuff, InBytes, CRC32);
    CompressBuff(InBuff, InBytes, OutBuff, OutBytes);
    if InBuff <> nil then FreeMem(InBuff);
    WriteFile(fDest, OutBuff^, OutBytes, bWrite, nil);
    if OutBuff <> nil then FreeMem(OutBuff);
    WriteFile(fDest, Flag, SizeOf(Flag), bWrite, nil);
    WriteFile(fDest, InBytes, SizeOf(InBytes), bWrite, nil);
    WriteFile(fDest, OutBytes, SizeOf(OutBytes), bWrite, nil);
    WriteFile(fDest, CRC32, SizeOf(CRC32), bWrite, nil);
  except
    CloseHandle(fSrc);
    CloseHandle(fDest);
    if InBuff <> nil then FreeMem(InBuff);
    if OutBuff <> nil then FreeMem(OutBuff);
    ShowError('Error at writing file');
    Exit;
  end;
  (*****************************************************************************)
  SetFilePointer(fDest, $3C, nil, 0);
  ReadFile(fDest, PEHeaderOffset, SizeOf(PEHeaderOffset), bWrite, nil);
  if PEHeaderOffset = 0 then goto down;
  //
  SetFilePointer(fDest, PEHeaderOffset, nil, 0);
  ReadFile(fDest, PESig, SizeOf(PESig), bWrite, nil);
  if PESig <> $4550 then goto down;
  //
  SetFilePointer(fDest, PEHeaderOffset + $06, nil, 0);
  ReadFile(fDest, NumOfSections, SizeOf(NumOfSections), bWrite, nil);
  if NumOfSections = 0 then goto down;
  //
  SetFilePointer(fDest, PEHeaderOffset + $34, nil, 0);
  ReadFile(fDest, ImageBase, SizeOf(ImageBase), bWrite, nil);
  if ImageBase = 0 then goto down;
  //
  SetFilePointer(fDest, PEHeaderOffset + $88, nil, 0);
  ReadFile(fDest, ResRVA, SizeOf(ResRVA), bWrite, nil);
  if ResRVA = 0 then goto down;
  ReadFile(fDest, ResSize, SizeOf(ResSize), bWrite, nil);
  if ResSize = 0 then goto down;
  //
  SetFilePointer(fDest, PEHeaderOffset + $F8, nil, 0);
  ResPhysOffset:= 0;
  ResPhysSize:= 0;
  for I:= 1 to NumOfSections do
  begin
    ReadFile(fDest, Section, SizeOf(Section), bWrite, nil);
    if (Section.VirtualSize = ResSize) and (Section.VirtualAddress = ResRVA) then
    begin
      ResPhysOffset:= Section.PhysicalOffset;
      ResPhysSize:= Section.PhysicalSize;
      Break;
    end;
  end;
  if ResPhysOffset = 0 then goto down;
  if ResPhysSize = 0 then goto down;
  //
  
  //
  (*****************************************************************************)
  down:
  CloseHandle(fDest);
  ShowMessage('File was succesful compressed');
end;

procedure TfrmMain.btnCloseClick(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TfrmMain.btnAboutClick(Sender: TObject);
begin
  MessageBox(Handle, PChar('PEZip v1.0' + #10#13 + 'Copyright