utilunit.pas

Delphi版pe加壳程序

unit UtilUnit;

interface

uses
  SysUtils, Classes, JwaWinnt, Graphics, JwaWinGDI,
  JwaWinBase, JwaWintype, JwaWinUser;

const
  NULL_VALUE = $FFFFFFFF;

function PtrAdd(Ptr: Pointer; Delta: integer): Pointer;
function PtrDiff(Ptr1, Ptr2: Pointer): integer;
function Min(p1, p2: Cardinal): Cardinal;
{Copy from jcl}
procedure SaveIconToFile(Icon: HICON; const FileName: string);
procedure WriteIcon(Stream: TStream; ColorBitmap, MaskBitmap: HBITMAP;
  WriteLength: Boolean = False); overload;
procedure WriteIcon(Stream: TStream; Icon: HICON; WriteLength: Boolean = False); overload;
                                                                                           
procedure PoorCreateMainIcon(IconStream: TMemoryStream; RVA: Cardinal);

implementation

const
  rc3_Icon = 1;

type
  PCursorOrIcon = ^TCursorOrIcon;
  TCursorOrIcon = packed record
    Reserved: Word;
    wType: Word;
    Count: Word;
  end;

  PIconRec = ^TIconRec;
  TIconRec = packed record
    Width: Byte;
    Height: Byte;
    Colors: Word;
    Reserved1: Word;
    Reserved2: Word;
    DIBSize: Longint;
    DIBOffset: Longint;
  end;


type
  PIconHeader = ^TIconHeader;
  TIconHeader = packed record
    wReserved: WORD;          // Currently zero
    wType: WORD;              // 1 for icons
    wCount: WORD;             // Number of components
    bWidth: BYTE;
    bHeight: BYTE;
    bColorCount: BYTE;
    bReserved: BYTE;
    wPlanes: WORD;
    wBitCount: WORD;
    lBytesInRes: DWORD;
    wNameOrdinal: WORD;       // Points to component
  end;

function PtrAdd(Ptr: Pointer; Delta: integer): Pointer;
begin
  result := Pointer(integer(Ptr) + Delta);
end;

function PtrDiff(Ptr1, Ptr2: Pointer): integer;
begin
  result := Cardinal(Ptr1) - Cardinal(Ptr2);
end;

function Min(p1, p2: Cardinal): Cardinal;
begin
  if p1 < p2 then
    result := p1
  else
    result := p2;
end;

{Copy from jcl}
procedure WriteIcon(Stream: TStream; ColorBitmap, MaskBitmap: HBITMAP; WriteLength: Boolean = False);
var
  MonoInfoSize, ColorInfoSize: DWORD;
  MonoBitsSize, ColorBitsSize: DWORD;
  MonoInfo, MonoBits, ColorInfo, ColorBits: Pointer;
  CI: TCursorOrIcon;
  List: TIconRec;
  Length: Longint;
begin
  FillChar(CI, SizeOf(CI), 0);
  FillChar(List, SizeOf(List), 0);
  GetDIBSizes(MaskBitmap, MonoInfoSize, MonoBitsSize);
  GetDIBSizes(ColorBitmap, ColorInfoSize, ColorBitsSize);
  MonoInfo := nil;
  MonoBits := nil;
  ColorInfo := nil;
  ColorBits := nil;
  try
    MonoInfo := AllocMem(MonoInfoSize);
    MonoBits := AllocMem(MonoBitsSize);
    ColorInfo := AllocMem(ColorInfoSize);
    ColorBits := AllocMem(ColorBitsSize);
    GetDIB(MaskBitmap, 0, MonoInfo^, MonoBits^);
    GetDIB(ColorBitmap, 0, ColorInfo^, ColorBits^);
    if WriteLength then
    begin
      Length := SizeOf(CI) + SizeOf(List) + ColorInfoSize +
        ColorBitsSize + MonoBitsSize;
      Stream.Write(Length, SizeOf(Length));
    end;
    with CI do
    begin
      CI.wType := RC3_ICON;
      CI.Count := 1;
    end;
    Stream.Write(CI, SizeOf(CI));
    with List, PBitmapInfoHeader(ColorInfo)^ do
    begin
      Width := biWidth;
      Height := biHeight;
      Colors := biPlanes * biBitCount;
      DIBSize := ColorInfoSize + ColorBitsSize + MonoBitsSize;
      DIBOffset := SizeOf(CI) + SizeOf(List);
    end;
    Stream.Write(List, SizeOf(List));
    with PBitmapInfoHeader(ColorInfo)^ do
      Inc(biHeight, biHeight); { color height includes mono bits }
    Stream.Write(ColorInfo^, ColorInfoSize);
    Stream.Write(ColorBits^, ColorBitsSize);
    Stream.Write(MonoBits^, MonoBitsSize);
  finally
    FreeMem(ColorInfo, ColorInfoSize);
    FreeMem(ColorBits, ColorBitsSize);
    FreeMem(MonoInfo, MonoInfoSize);
    FreeMem(MonoBits, MonoBitsSize);
  end;
end;

// WriteIcon depends on unit Graphics by use of GetDIBSizes and GetDIB

procedure WriteIcon(Stream: TStream; Icon: HICON; WriteLength: Boolean = False);
var
  IconInfo: TIconInfo;
begin
  if GetIconInfo(Icon, IconInfo) then
  try
    WriteIcon(Stream, IconInfo.hbmColor, IconInfo.hbmMask, WriteLength);
  finally
    DeleteObject(IconInfo.hbmColor);
    DeleteObject(IconInfo.hbmMask);
  end
  else
    RaiseLastOSError;
end;

procedure SaveIconToFile(Icon: HICON; const FileName: string);
var
  Stream: TFileStream;
begin
  Stream := TFileStream.Create(FileName, fmCreate);
  try
    WriteIcon(Stream, Icon, False);
  finally
    Stream.Free;
  end;
end;

procedure PoorCreateMainIcon(IconStream: TMemoryStream; RVA: Cardinal);
var
  ResBuf: Pointer;
  ResSize: Cardinal;
  IconSize: Cardinal;
  PIco: PIconHeader;
  off: Cardinal;   
  pResDir: PImageResourceDirectory;
  pResDirEntery: PImageResourceDirectoryEntry;
  pResDataEntry: PImageResourceDataEntry;
begin
  IconSize := IconStream.Size;

  ResSize := 5 * (SizeOf(TImageResourceDirectory) + SizeOf(TImageResourceDirectoryEntry)) +
             2 * SizeOf(TImageResourceDataEntry) + SizeOf(TImageResourceDirectoryEntry) + $18 + IconSize;

  ResBuf := AllocMem(ResSize);

  pResDir := ResBuf;                                                    // #1  dir
  pResDir^.MajorVersion := $A001;
  pResDir^.NumberOfIdEntries := 2;
  off := SizeOf(TImageResourceDirectory);
  pResDirEntery := PtrAdd(ResBuf, off);
  inc(off, SizeOf(TImageResourceDirectoryEntry) * 2);
  pResDirEntery^.Name.Name := $3;
  pResDirEntery^.Directory.OffsetToDirectory := $80000000 + off;

  pResDir := PtrAdd(ResBuf, off);
  inc(off, SizeOf(TImageResourceDirectory));                           // #2  dir
  pResDir^.MajorVersion := $A001;
  pResDir^.NumberOfIdEntries := 1;
  pResDirEntery := PtrAdd(ResBuf, off);
  inc(off, SizeOf(TImageResourceDirectoryEntry));
  pResDirEntery^.Name.Name := 1;
  pResDirEntery^.Directory.OffsetToDirectory := $80000000 + off;

  pResDir := PtrAdd(ResBuf, off);
  inc(off, SizeOf(TImageResourceDirectory));                           // #2  dir
  pResDir^.MajorVersion := $A002;
  pResDir^.NumberOfIdEntries := 1;
  pResDirEntery := PtrAdd(ResBuf, off);
  inc(off, SizeOf(TImageResourceDirectoryEntry));
  pResDirEntery^.Name.Name := 1;
  pResDirEntery^.Directory.OffsetToDirectory := off;

  pResDataEntry := PtrAdd(ResBuf, off);  // #3 - Data
  pResDataEntry^.OffsetToData := RVA + ResSize - IconSize;
  pResDataEntry^.Size := IconSize;
  inc(off, SizeOf(TImageResourceDataEntry));
  //=======================
  pResDirEntery := PtrAdd(ResBuf, SizeOf(TImageResourceDirectory) + SizeOf(TImageResourceDirectoryEntry));
  pResDirEntery^.Name.Name := $E;
  pResDirEntery^.Directory.OffsetToDirectory := $80000000 + off;

  pResDir := PtrAdd(ResBuf, off);
  inc(off, SizeOf(TImageResourceDirectory));                           // #2  dir  WriteIcon
  pResDir^.MajorVersion := $B001;
  pResDir^.NumberOfIdEntries := 1;
  pResDirEntery := PtrAdd(ResBuf, off);
  inc(off, SizeOf(TImageResourceDirectoryEntry));
  pResDirEntery^.Name.Name := 1;
  pResDirEntery^.Directory.OffsetToDirectory := $80000000 + off;

  pResDir := PtrAdd(ResBuf, off);
  inc(off, SizeOf(TImageResourceDirectory));                           // #2  dir
  pResDir^.MajorVersion := $B002;
  pResDir^.NumberOfIdEntries := 1;
  pResDirEntery := PtrAdd(ResBuf, off);
  inc(off, SizeOf(TImageResourceDirectoryEntry));
  pResDirEntery^.Name.Name := 1;
  pResDirEntery^.Directory.OffsetToDirectory := off;

  pResDataEntry := PtrAdd(ResBuf, off);  // #3 - Data
  pResDataEntry^.OffsetToData := RVA + ResSize - IconSize - $18;
  pResDataEntry^.Size := $18;

  PIco := PtrAdd(pResDataEntry, SizeOf(TImageResourceDataEntry));
  CopyMemory(PIco, IconStream.Memory, $18);
{  PIco^.wType := 1;
  PIco^.wCount := 1;
  PIco^.bWidth := $20;
  PIco^.bHeight := $20;
  PIco^.bColorCount := $0;
  PIco^.wPlanes := 1;
  PIco^.wBitCount := 8;
  PIco^.lBytesInRes := IconSize; }
  PIco^.wNameOrdinal := 1;
  CopyMemory(PtrAdd(pResDataEntry, SizeOf(TImageResourceDataEntry) + $18), PtrAdd(IconStream.Memory, 22), IconSize);
  IconStream.Clear;
  IconStream.Write(ResBuf^, ResSize);
  FreeMem(ResBuf);
end;

end.