www.pudn.com > HgzVip1.2_code.rar > IconLibrary.pas

//             ____                 __    _ __ 
//            /  _/________  ____  / /   (_) /_  _________ ________  __ 
//            / // ___/ __ \/ __ \/ /   / / __ \/ ___/ __ `/ ___/ / / / 
//          _/ // /__/ /_/ / / / / /___/ / /_/ / /  / /_/ / /  / /_/ / 
//         /___/\___/\____/_/ /_/_____/_/_.___/_/   \__,_/_/   \__, / 
//                                                            /____/ 
 
(******************************************************************************* 
* IconTools 1.5                                                                * 
*                                                                              * 
* This file is part of the IconTools class library                             * 
*                                                                              * 
******************************************************************************** 
*                                                                              * 
* If you find bugs, has ideas for missing featurs, feel free to contact me     * 
*                           jpstotz@gmx.de                                     * 
*                                                                              * 
* The latest version of TShelltree can be found at:                            * 
*     http://members.tripod.com/~JPStotz/IconTools/IconTools.html              * 
******************************************************************************** 
* Date last modified:   May 12, 1999                                           * 
*******************************************************************************) 
 
unit IconLibrary; 
 
interface 
 
{.$Define Overseer} 
 
{$IfDEF Overseer} 
  {$DEFINE Writer16} 
{$EndIf} 
 
uses 
{$IfDEF Overseer} 
  udbg, 
{$EndIf} 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  IconTools, IconTypes, ShellAPI; 
 
(********************************************************************) 
(**                      TIconLibrary declaration                  **) 
(********************************************************************) 
 
type 
  TIconLibrary = class 
  private 
    FFilename : String; 
  protected 
    FIcons : TStringList; 
  public 
    constructor Create; virtual; 
    destructor Destroy; override; 
 
    procedure LoadFromFile(Filename : String); 
    procedure SaveToFile(Filename : String); 
 
    property Icons : TStringList read FIcons; 
    property Filename : String read FFilename; 
  end; 
 
(********************************************************************) 
(**                TICLReader abstract declaration                 **) 
(********************************************************************) 
 
type 
  TICLReader = class 
  private 
  protected 
    FFilename : String; 
    FIcons : TStringList; 
  public 
    constructor Create(Filename : String); virtual; 
    destructor Destroy; override; 
    function Execute : Boolean; virtual; abstract; 
    property Icons : TStringList read FIcons; 
  end; 
 
(********************************************************************) 
(**                    T32BitReader declaration                    **) 
(********************************************************************) 
 
type 
  T32BitReader = class(TICLReader) 
  private 
  protected 
    Instance : THandle; 
    FreeLib  : Boolean; 
    procedure IconResFound(ResName : PChar); 
  public 
    constructor Create(Filename : String); override; 
    function Execute : Boolean; override; 
    destructor Destroy; override; 
  end; 
 
(********************************************************************) 
(**                     TICL32Icon declaration                     **) 
(********************************************************************) 
 
type 
  TICL32Icon = class(TResourceIcon) 
  private 
 
  protected 
    FIconData : TMemoryStream; 
    procedure BufferIconData; 
    procedure LoadIconResInfos(Stream : TStream;Var Valid : Boolean;Var Count : Word); override; 
    function  GetHIcon(Index : Word) : HIcon; override; 
  public 
    procedure WriteIconDataToStream(Stream : TStream;Index : Integer); override; 
    destructor Destroy; override; 
  end; 
 
(********************************************************************) 
(**                    T16BitReader declaration                    **) 
(********************************************************************) 
 
type 
  T16BitReader = class(TICLReader) 
  private 
    FStream : TStream; 
    FAlignShift         : Word; 
    FWin16Offset        : Word; 
    FResourceTableStart : DWord; 
    FNamestableStart    : DWord; 
    FIconCount          : Word; 
    FGroupIconCount     : Word; 
    FICLName            : String; 
    FIconsRes           : PNameRecArray; 
    FGroupIconsRes      : PNameRecArray; 
  protected 
    procedure ReadFileHeader; 
    procedure ReadResourceTable; 
    procedure ReadTypeInfo; 
    procedure ReadResourceNames; 
  public 
    constructor Create(AFilename : String); override; 
    destructor Destroy; override; 
    function Execute : Boolean; override; 
    function GetResourceIndex(ID : Word;GroupIcon : Boolean) : Integer; 
    procedure ReadResource(Index : Word;GroupIcon : Boolean;Stream : TStream;Var ResName : String); 
    property IconCount : Word read FGroupIconCount; 
  end; 
 
(********************************************************************) 
(**                    T16BitWriter declaration                    **) 
(********************************************************************) 
 
type 
  T16BitWriter = class 
  private 
    FShiftAlignOffs : DWord; 
    FNamesTableOffs : DWord; 
    FOfs_Icons  : PDWordArray; 
    FOfs_GIcons : PDWordArray; 
    FIcons      : Integer; 
    FIconLib    : TIconLibrary; 
    FAlignShift : Word; 
    FStream : TMemoryStream; 
    Null    : ARRAY[1..256] OF Char; 
  protected 
    procedure WriteShiftAlign; 
    procedure UpdateTableEntry(EntryPos : DWord;StartOffset,EndOffset : DWord); 
    procedure WriteHeader; 
    procedure WriteResTable; 
    procedure WriteNameTable; 
    procedure WriteIconData; 
    procedure Align; 
    property Stream : TMemoryStream read FStream; 
  public 
    constructor Create(AIconLib : TIconLibrary); 
    destructor Destroy; override; 
    procedure SaveToFile(Filename : String); 
    property IconLib : TIconLibrary read FIconLib; 
  end; 
 
(********************************************************************) 
(**                      TICL16Icon declaration                    **) 
(********************************************************************) 
 
type 
  TICL16Icon = class(TMultiIcon) 
  private 
    FResName : String; 
    FICLReader : T16BitReader; 
    function GeTICL16IconResInfo(Index : Word) : TFileIconResInfo; 
  protected 
    Icons : TMemoryStream; 
    function GetHIcon(Index : Word) : HIcon; override; 
    function GetIconSize(Index : Word) : TSize; override; 
    procedure LoadIconResInfos(Stream : TStream;Var Valid : Boolean;Var Count : Word);override; 
    function GetIconResInfo(Index : Word) : TIconResInfo; override; 
  public 
    procedure WriteIconDataToStream(Stream : TStream;Index : Integer); override; 
    constructor ICLCreate(ICLReader : T16BitReader;Index : Word); 
    destructor Destroy; override; 
    property ResName : String read FResName; 
    property ICLIconResInfo[Index : Word] : TFileIconResInfo read GeTICL16IconResInfo; 
  end; 
 
implementation 
 
{$R-} 
 
type 
  EICLReadError  = class (Exception); 
  EICLWriteError = class (Exception); 
 
const 
  IMAGE_DOS_SIGNATURE    = $5A4D;       { MZ } 
  IMAGE_IM_SIGNATURE     = $4D49;       { IM } 
  IMAGE_OS2_SIGNATURE    = $454E;       { NE } 
  IMAGE_W32_SIGNATURE    = $4550;       { PE } 
  IMAGE_NAMETABLE_ICL  : ARRAY[0..3] OF Char = 'ICL'+#0; 
 
  E_R_InvWin16Offs    = 'Invalid Windows 16 Offset'; 
  E_R_InvWin16Header  = 'Invalid Windows 16 Header'; 
  E_R_NotValid16Bit   = 'Not a valid ICL File'; 
  E_R_NoResources     = 'No Resources in file'; 
  E_R_NoNamesTable    = 'Names Table not found'; 
  E_R_IconResNotFound = 'Icon Resource Not Found'; 
  E_R_ResTableError   = 'ResourceTable has an Error'; 
  E_W_NoIcons         = 'Unable to write Iconlibrary with no icons'; 
  E_W_TooManyIcons    = 'Iconlibraries with more than 32767 are not possible'; 
 
procedure ICLReadError(const ErrMsg: string); 
begin 
  raise EICLReadError.Create(ErrMsg); 
end; 
 
procedure ICLWriteError(const ErrMsg: string); 
begin 
  raise EICLReadError.Create(ErrMsg); 
end; 
 
function IsValidLib(Filename : String;Var Is32Bit : Boolean) : Boolean; 
Var 
  F : TFileStream; 
  Sig : Word; 
begin 
  Result:=False; 
  F:=TFileStream.Create(Filename,fmOpenRead or fmShareDenyWrite); 
  With F DO 
  try 
    Read(Sig,SizeOf(Sig)); 
    IF (Sig <>IMAGE_DOS_SIGNATURE) Then exit; 
    Seek($3C,soFromBeginning); 
    Read(Sig,SizeOf(Sig)); 
    Seek(Sig,soFromBeginning); 
    Read(Sig,SizeOf(Sig)); 
    Result:=(Sig = IMAGE_W32_SIGNATURE) OR (Sig = IMAGE_OS2_SIGNATURE); 
    Is32Bit:=(Sig = IMAGE_W32_SIGNATURE); 
  finally 
    F.Free; 
  end; 
end; 
 
(********************************************************************) 
(**                  TIconLibrary implementation                   **) 
(********************************************************************) 
 
constructor TIconLibrary.Create; 
begin 
  FIcons := TStringList.Create; 
end; 
 
destructor TIconLibrary.Destroy; 
Var 
  I : Integer; 
begin 
  FOR I:=1 TO Icons.Count Do TMultiIcon(Icons.Objects[I-1]).Free; 
  FIcons.Free; 
end; 
 
procedure TIconLibrary.LoadFromFile(Filename : String); 
Var 
  LoadedIcons,IconCount : Integer; 
  Is32Bit : Boolean; 
  Reader : TICLReader; 
begin 
  LoadedIcons:=0; 
  IconCount:=ExtractIcon(HInstance,PChar(Filename),dword(-1)); 
  IF (IconCount=0) Then exit; 
  IF NOT IsValidLib(Filename,Is32Bit) Then exit; 
  FFilename:=Filename; 
  IF NOT Is32Bit Then 
    Reader:=T16BitReader.Create(Filename) 
  else 
    Reader:=T32BitReader.Create(Filename); 
  try 
    IF Reader.Execute Then begin 
      LoadedIcons:=Reader.Icons.Count; 
      Icons.Assign(Reader.Icons); 
    end; 
  finally 
    Reader.Free; 
  end; 
  IF LoadedIcons<>IconCount Then begin 
    beep; 
  end;   
end; 
 
procedure TIconLibrary.SaveToFile(Filename : String); 
Var 
  ICLFile  : T16BitWriter; 
begin 
  IF Icons.Count=0 Then ICLWriteError(E_W_NoIcons); 
  IF Icons.Count>=$8000 Then ICLWriteError(E_W_TooManyIcons); 
  ICLFile:=T16BitWriter.Create(self); 
  try 
    ICLFile.SaveToFile(Filename); 
  finally 
    ICLFile.Free; 
  end; 
end; 
 
(********************************************************************) 
(**                  TICLReader implementation                     **) 
(********************************************************************) 
 
constructor TICLReader.Create(Filename : String); 
begin 
  FIcons:=TStringList.Create; 
  FFilename:=Filename; 
end; 
 
destructor TICLReader.Destroy; 
begin 
  IF Assigned(FIcons) Then FIcons.free; 
  inherited; 
end; 
 
(********************************************************************) 
(**                 T32BitReader implementation                    **) 
(********************************************************************) 
 
function EnumResNameProc(hModule : THandle;lpszType,lpszName : PChar;lParam : lParam) : Bool; stdcall; 
begin 
  Result:=True; 
  T32BitReader(lParam).IconResFound(lpszName); 
end; 
 
constructor T32BitReader.Create(Filename : String); 
begin 
  inherited; 
  FreeLib:=False; 
  Instance:=0; 
end; 
 
function T32BitReader.Execute : Boolean; 
begin 
  Result:=False; 
  try 
    Instance:= windows.LoadLibraryEx(PChar(FFilename), 0, LOAD_LIBRARY_AS_DATAFILE); 
  finally 
  end; 
  IF Instance=0 then exit; 
  FreeLib:=True; 
  Result:=True; 
  EnumResourcenames(Instance,RT_GROUP_ICON,@EnumResNameProc,Integer(self)); 
end; 
 
procedure T32BitReader.IconResFound(ResName : PChar); 
Var 
  Ico : TICL32Icon; 
  IsID : Boolean; 
  RName : String; 
begin 
  IsID:=IsBadStringPtr(ResName,63); 
  IF IsID Then begin 
    Ico:=TICL32Icon.CreateFromID(Instance,Loword(Integer(ResName))); 
    RName:=InttoStr(Integer(Resname)); 
  end else begin 
    Ico:=TICL32Icon.Create(Instance,Strpas(ResName)); 
    Rname:=Strpas(ResName); 
  end; 
  FIcons.AddObject(RName,Ico); 
end; 
 
destructor T32BitReader.Destroy; 
begin 
  inherited; 
  IF FreeLib Then FreeLibrary(Instance); 
end; 
 
(********************************************************************) 
(**                   TICL32Icon implementation                    **) 
(********************************************************************) 
 
procedure TICL32Icon.BufferIconData; 
Var 
  I : Integer; 
  RStream : TResourceStream; 
  SPos : DWord; 
begin 
  FIconData:=TMemoryStream.Create; 
  With FIconData DO begin 
    Clear; 
    Seek(IconCount*SizeOf(DWord),soFromBeginning); 
    FOR I:=1 TO IconCount DO 
      With PResourceIconDirList(IconDirList)^[I-1] do begin 
        RStream:=TResourceStream.CreateFromID(Instance,ID,RT_ICON); 
        try 
          SPos:=Position; 
          Position:=SizeOf(DWord)*(I-1); 
          Write(SPos,SizeOf(DWord)); 
          Position:=SPos; 
          ResInfo.BytesInRes:=RStream.Size; 
          CopyFrom(RStream,RStream.Size); 
        finally 
          RStream.Free; 
        end; 
      end; 
  end; 
end; 
 
function TICL32Icon.GetHIcon(Index : Word) : HIcon; 
Var 
  DW : DWord; 
begin 
  Result:=0; 
  IF Index>=IconCount Then exit; 
  IF IconHandleList^[Index]=0 Then begin 
    with ResourceIconResInfo[Index] do begin 
      FIconData.Position:=Index*SizeOf(DWord); 
      FIcondata.Read(DW,SizeOf(DWord)); 
      FIconData.Position:=DW; 
      Result:=CreateIconFromStream(FIconData,ResInfo.BytesInRes,ResInfo); 
      IconHandleList^[Index]:=Result; 
    end; 
  end else 
    Result:=IconHandleList^[Index]; 
end; 
 
procedure TICL32Icon.WriteIconDataToStream(Stream : TStream;Index : Integer); 
Var 
  DW : DWord; 
begin 
  IF Index>=IconCount Then exit; 
  with ResourceIconResInfo[Index] do begin 
    FIconData.Position:=Index*SizeOf(DWord); 
    FIcondata.Read(DW,SizeOf(DWord)); 
    FIconData.Position:=DW; 
    Stream.CopyFrom(FIconData,ResInfo.BytesInRes); 
  end; 
end; 
 
procedure TICL32Icon.LoadIconResInfos(Stream : TStream;Var Valid : Boolean;Var Count : Word); 
begin 
  inherited; 
  BufferIconData; 
end; 
 
destructor TICL32Icon.Destroy; 
begin 
  IF Assigned(FIconData) Then FIconData.Free; 
  inherited; 
end; 
 
(********************************************************************) 
(**                  T16BitReader implementation                   **) 
(********************************************************************) 
 
function T16BitReader.GetResourceIndex(ID : Word;GroupIcon : Boolean) : Integer; 
Var 
  Res : PNameRecArray; 
  I,IMax : Integer; 
begin 
  Result:=-1; 
  IF GroupIcon Then begin 
    Res:=FGroupIconsRes; 
    IMax:=FGroupIconCount; 
  end else begin 
    Res:=FIconsRes; 
    IMax:=FIconCount; 
  end; 
  I:=0; 
  While (I=0 Then exit; 
  ICLReadError(E_R_IconResNotFound); 
end; 
 
 
procedure T16BitReader.ReadResource(Index : Word;GroupIcon : Boolean; 
          Stream : TStream;Var ResName : String); 
Var 
  Namerec : TNameRec; 
  ResStartPos : Longint; 
  ResLength   : Longint; 
begin 
  IF GroupIcon Then NameRec:=FGroupIconsRes^[Index] 
    else NameRec:=FIconsRes^[Index]; 
  ResName:=Format('%s %0.3d',[FICLName,Index+1]); 
  ResStartPos:=NameRec.rnOffset shl FAlignShift; 
  ResLength  :=NameRec.rnLength shl FAlignShift; 
  FStream.Position:=ResStartPos; 
  Stream.CopyFrom(FStream,ResLength); 
end; 
 
constructor T16BitReader.Create(AFilename : String); 
begin 
  inherited; 
  FStream:=TFileStream.Create(AFilename,fmOpenRead or fmShareDenyWrite); 
  FStream.Position:=0; 
  FICLName:=ExtractFilename(AFilename); 
  Delete(FICLName,Length(FICLName)-Length(ExtractFileExt(FICLname))+1,30); 
end; 
 
destructor T16BitReader.Destroy; 
begin 
  FStream.Free; 
  inherited; 
end; 
 
function T16BitReader.Execute : Boolean; 
Var 
  ICLIcon : TICL16Icon; 
  I,L : Integer; 
  S : String; 
  NameOfList : Boolean; 
  SL : TStringList; 
begin 
  try 
    FIconsRes:=nil; 
    FGroupIconsRes:=nil; 
    FIcons.Clear; 
    ReadFileHeader; 
    ReadResourceTable; 
    SL:=TStringList.Create; 
    try 
      L:=FGroupIconCount; 
      NameOfList:=(FIcons.Count=FGroupIconCount); 
      FOR I:=1 TO L DO begin 
        ICLIcon:=TICL16Icon.ICLCreate(self,I-1); 
        IF NameOfList Then 
          S:=FIcons.Strings[I-1] 
        else 
          S:=ICLIcon.ResName; 
        SL.AddObject(S,ICLIcon); 
      end; 
      FIcons.Assign(SL); 
    finally 
      SL.Free; 
    end;   
  except 
    Result:=False; 
    exit; 
  end; 
  Result:=True; 
end; 
 
procedure T16BitReader.ReadFileHeader; 
Var 
  DosSignature     : Word; 
  Win16Signature   : Word; 
  ResTableOffset   : Word; 
  NamesTableOffset : Word; 
begin 
  With FStream DO begin 
    Read(DosSignature,SizeOf(DosSignature)); 
    IF (DosSignature<>IMAGE_DOS_SIGNATURE) Then ICLReadError(E_R_NotValid16Bit); 
    Seek($3C,soFromBeginning); 
    Read(FWin16Offset,SizeOf(Word)); 
    IF (FWin16Offset<$3C) Then ICLReadError(E_R_InvWin16Offs); 
    Seek(FWin16Offset,soFromBeginning); 
    Read(Win16Signature,SizeOf(Win16Signature)); 
    IF (Win16Signature<>IMAGE_OS2_SIGNATURE) Then ICLReadError(E_R_InvWin16Header); 
    Seek($22,soFromCurrent); 
    Read(ResTableOffset,SizeOf(Word)); 
    IF (ResTableOffset=0) Then ICLReadError(E_R_NoResources); 
    FResourceTableStart:=ResTableOffset+FWin16Offset; 
    Read(NamesTableOffset,SizeOf(NamesTableOffset)); 
    IF (NamesTableOffset=0) Then ICLReadError(E_R_NoNamesTable); 
    FNamesTableStart:=NamesTableOffset+FWin16Offset; 
  end; 
end; 
 
procedure T16BitReader.ReadResourceTable; 
Var 
  EndTypes : Word; 
begin 
  with FStream DO begin 
    Seek(FResourceTableStart,soFromBeginning); 
    Read(FAlignShift,SizeOf(Word)); 
    Read(EndTypes,SizeOf(Word)); 
    While (Endtypes>0) DO begin 
      Seek(-SizeOf(Word),sofromCurrent); 
      ReadTypeInfo; 
      Read(EndTypes,SizeOf(Word)); 
    end; 
    IF (FGroupIconsRes=nil) OR (FIconsRes=nil) Then ICLReadError(E_R_ResTableError); 
    ReadResourceNames; 
  end; 
end; 
 
procedure T16BitReader.ReadResourceNames; 
Var 
  NameLen : byte; 
  S : String; 
begin 
  With FStream DO begin 
    Read(NameLen,SizeOf(NameLen)); 
    While (NameLen>0) DO begin 
      SetString(S,nil,NameLen); 
      Read(Pointer(S)^,NameLen); 
      IF NOT ((FIcons.Count=0) AND (CompareStr(S,StrPas(IMAGE_NAMETABLE_ICL))=0)) Then 
        FIcons.Add(S); 
      Read(NameLen,SizeOf(NameLen)); 
    end; 
  end; 
end; 
 
procedure T16BitReader.ReadTypeInfo; 
Var 
  TypeInfo : TTypeRec; 
  I : Integer; 
  TypeRead : Boolean; 
begin 
  With FStream DO begin 
    Read(TypeInfo,SizeOf(TypeInfo)); 
    With TypeInfo DO begin 
      I:=SizeOf(TNameRec)*rtResourceCount; 
      TypeRead:=false; 
      IF (rtTypeID or $8000 = rtTypeID) Then begin 
        IF (Lo(rtTypeID)=Word(RT_ICON))       Then begin 
          FIconCount:=rtResourceCount; 
          GetMem(FIconsRes,I); 
          Read(FIconsRes^,I); 
          TypeRead:=True; 
        end; 
        IF (Lo(rtTypeID)=Word(RT_GROUP_ICON)) Then begin 
          FGroupIconCount:=rtResourceCount; 
          GetMem(FGroupIconsRes,I); 
          Read(FGroupIconsRes^,I); 
          TypeRead:=True; 
        end; 
      end; 
    end; 
    IF NOT TypeRead Then Seek(I,soFromCurrent); 
  end; 
end; 
 
(********************************************************************) 
(**                  T16BitWriter implementation                   **) 
(********************************************************************) 
 
constructor T16BitWriter.Create(AIconLib : TIconLibrary); 
Var 
  I : Integer; 
begin 
  {$IFDEF Writer16} Debugger.Enterproc('Constructor Create');{$ENDIF} 
  FIconLib:=AIconLib; 
  FIcons:=0; 
  FStream:=TMemoryStream.Create; 
  FOR I:=1 TO IconLib.Icons.Count DO 
    INC(FIcons,TMultiIcon(IconLib.Icons.Objects[I-1]).IconCount); 
  FAlignShift:=1; 
  GetMem(FOfs_Icons,FIcons*SizeOf(DWord)); 
  GetMem(FOfs_GIcons,IconLib.Icons.Count*SizeOf(DWord)); 
  FillChar(Null,SizeOf(Null),#0); 
  {$IFDEF Writer16} Debugger.Leaveproc('Constructor Create');{$ENDIF} 
end; 
 
procedure T16BitWriter.WriteShiftAlign; 
Var 
  I,J : Integer; 
  Ico : TMultiIcon; 
  IconDataSize : DWord; 
  SavedPos : Cardinal; 
begin 
  {$IFDEF Writer16} Debugger.Enterproc('WriteShiftAlign');{$ENDIF} 
  IconDataSize:=Stream.Position; 
  FOR I:=1 TO IconLib.Icons.Count DO begin 
    Ico:=TMultiIcon(IconLib.Icons.Objects[I-1]); 
    INC(FIcons,Ico.IconCount); 
    INC(IconDataSize,SizeOf(TIconHeader)); 
    FOR J:=1 TO Ico.IconCount DO begin 
      INC(IconDataSize,SizeOf(TResourceIconResInfo)); 
      INC(IconDataSize,Ico.IconResInfo[J-1].BytesInRes); 
    end; 
  end; 
  FAlignShift:=0; 
  While ((MaxWord shl FAlignShift) Operating System = Windows 
    Write(W,SizeOf(W)); 
    Write(Null,7); 
    W:=$3; // 3Eh -> expected Windows version number 
    Write(W,1); 
  end; 
  {$IFDEF Writer16} Debugger.Leaveproc('WriteHeader');{$ENDIF} 
end; 
 
procedure T16BitWriter.WriteResTable; 
var 
  W : Word; 
  DW : DWord; 
  I : Integer; 
  NameInfo : TNameRec; 
begin 
  {$IFDEF Writer16} Debugger.Enterproc('WriteResTable');{$ENDIF} 
  DW:=0; 
  W:=0; 
  With Stream DO begin 
    FShiftAlignOffs:=Position; 
    Write(W,SizeOf(W)); // rscAlignShift written later; 
    W:=$800E; 
    Write(W,SizeOf(W)); //rt_GroupIcon TypeInfo 
    W:=IconLib.Icons.Count; 
    Write(W,SizeOf(W)); //ResourceCount rt_GroupIcon 
    Write(DW,SizeOf(DW)); 
    FillChar(NameInfo,SizeOf(NameInfo),#0); 
    NameInfo.rnFlags:=$1C30; 
    NameInfo.rnOffset:=$FF; 
    NameInfo.rnLength:=$FF00; 
  {$IFDEF Writer16} Debugger.Enterproc('Loop 1');{$ENDIF} 
    FOR I:=1 TO IconLib.Icons.Count DO begin 
      NameInfo.rnID:=I or $8000; 
      FOfs_GIcons^[I-1]:=Position; 
      Write(NameInfo,SizeOf(NameInfo)); 
    end; 
  {$IFDEF Writer16} Debugger.Leaveproc('Loop 1');{$ENDIF} 
    W:=$8003; 
    Write(W,SizeOf(W)); //rt_Icon TypeInfo 
    W:=FIcons; 
    Write(W,SizeOf(W)); //ResourceCount rt_GroupIcon 
    Write(DW,SizeOf(DW)); 
  {$IFDEF Writer16} Debugger.Enterproc('Loop 2');{$ENDIF} 
    FOR I:=1 TO FIcons DO begin 
      NameInfo.rnID:=I or $8000; 
      FOfs_Icons^[I-1]:=Position; 
      Write(NameInfo,SizeOf(NameInfo)); 
    end; 
  {$IFDEF Writer16} Debugger.Leaveproc('Loop 2');{$ENDIF} 
    W:=0; 
    Write(W,SizeOf(W)); 
  end; 
  {$IFDEF Writer16} Debugger.Leaveproc('WriteResTable');{$ENDIF} 
end; 
 
procedure T16BitWriter.WriteNameTable; 
Var 
  B : byte; 
  I : Integer; 
  S : String; 
  Pos : Integer; 
  W : Word; 
begin 
  {$IFDEF Writer16} Debugger.Enterproc('WriteNameTable');{$ENDIF} 
  With Stream DO begin 
    Pos:=Position; 
    Position:=FNamesTableOffs; 
    W:=Pos-$80; 
    Write(W,SizeOf(Word)); 
    Position:=Pos; 
    B:=3; 
    Write(B,SizeOf(B)); 
    Write(IMAGE_NAMETABLE_ICL,3); 
    FOR I:=1 TO IconLib.Icons.Count DO begin 
      S:=IconLib.Icons.Strings[I-1]; 
      B:=Length(S); 
      Write(B,SizeOf(B)); 
      Write(Pointer(S)^,B) 
    end; 
    B:=0; 
    Write(B,SizeOf(B)); 
  end; 
  {$IFDEF Writer16} Debugger.Leaveproc('WriteNameTable');{$ENDIF} 
end; 
 
procedure T16BitWriter.Align; 
Var 
  C : Integer; 
begin 
  With Stream DO begin 
    C:=(Position shr FAlignShift); 
    IF (C shl FAlignShift)=Position Then exit; 
    INC(C); 
    C:=(C shl FAlignShift)-Position; 
    IF C>SizeOf(Null) Then begin 
      While (C>SizeOf(Null)) DO begin 
        Write(Null,SizeOf(Null)); 
        DEC(C,SizeOf(Null)); 
      end; 
    end; 
    Write(Null,C) 
  end; 
end; 
 
procedure T16BitWriter.WriteIconData; 
Var 
  IID : Word; 
  I,J : Integer; 
  Ico : TMultiIcon; 
  Header : TIconHeader; 
  ResInfo : TResourceIconResInfo; 
  SOffset,EOffset : DWord; 
  W : Word; 
begin 
  {$IFDEF Writer16} Debugger.Enterproc('WriteIconData');{$ENDIF} 
  Header.wReserved:=0; 
  Header.wType:=1; 
  IID:=1; 
  Align; 
  With Stream DO begin 
    FOR I:=1 TO IconLib.Icons.Count DO begin 
      SOffset:=Position; 
      Ico:=TMultiIcon(IconLib.Icons.Objects[I-1]); 
      Header.wCount:=Ico.IconCount; 
      Write(Header,SizeOf(Header)); 
      FOR J:=1 TO Header.wCount DO begin 
        ResInfo.ResInfo:=Ico.IconResInfo[J-1]; 
        ResInfo.ID:=IID; 
        Write(ResInfo,SizeOf(ResInfo)); 
        INC(IID); 
      end; 
      Align; 
      EOffset:=Position; 
      UpdateTableEntry(FOfs_GIcons^[I-1],SOffset,EOffset); 
    end; 
    IID:=1; 
    FOR I:=1 TO IconLib.Icons.Count DO begin 
      Ico:=TMultiIcon(IconLib.Icons.Objects[I-1]); 
      FOR J:=1 TO Ico.IconCount DO begin 
        SOffset:=Position; 
        Ico.WriteIconDataToStream(Stream,J-1); 
        Align; 
        EOffset:=Position; 
        UpdateTableEntry(FOfs_Icons^[IID-1],SOffset,EOffset); 
        INC(IID); 
      end; 
    end; 
    W:=0; 
    Write(W,SizeOf(W)); 
  end; 
  {$IFDEF Writer16} Debugger.Leaveproc('WriteIconData');{$ENDIF} 
end; 
 
procedure T16BitWriter.UpdateTableEntry(EntryPos : DWord;StartOffset,EndOffset : DWord); 
Var 
  OldPos : cardinal; 
  W : Word; 
begin 
  With Stream DO begin 
    OldPos:=Position; 
    try 
      Position:=EntryPos; 
      W:=StartOffset shr FAlignShift; 
      Write(W,SizeOf(Word)); 
      W:=(EndOffset-StartOffset) shr FAlignShift; 
      Write(W,SizeOf(Word)); 
    finally 
      Position:=OldPos; 
    end; 
  end; 
end; 
 
(********************************************************************) 
(**                    TICL16Icon implementation                   **) 
(********************************************************************) 
 
constructor TICL16Icon.ICLCreate(ICLReader : T16BitReader;Index : Word); 
Var 
  GroupIcon : TMemoryStream; 
begin 
  FICLReader:=ICLReader; 
  CreateDefaults; 
  Icons:=TMemoryStream.Create; 
  GroupIcon:=TMemoryStream.Create; 
  try 
    ICLReader.ReadResource(Index,True,GroupIcon,FResname); 
    GroupIcon.Position:=0; 
    InitHeaders(GroupIcon); 
  finally 
    GroupIcon.Free; 
  end; 
end; 
 
destructor TICL16Icon.Destroy; 
begin 
  Icons.free; 
  inherited; 
end; 
 
function TICL16Icon.GeTICL16IconResInfo(Index : Word) : TFileIconResInfo; 
begin 
  IF Index>=IconCount Then exit; 
  Result:=PFileIconDirList(IconDirList)^[Index]; 
end; 
 
function TICL16Icon.GetHIcon(Index : Word) : HIcon; 
begin 
  Result:=0; 
  IF Index>=IconCount Then exit; 
  IF IconHandleList^[Index]=0 Then begin 
    with ICLIconResInfo[Index] do begin 
      Icons.Position:=dwImageOffset; 
      Result:=CreateIconFromStream(Icons,ResInfo.BytesInres,ResInfo); 
      IconHandleList^[Index]:=Result; 
    end; 
  end else 
    Result:=IconHandleList^[Index]; 
end; 
 
function TICL16Icon.GetIconSize(Index : Word) : TSize; 
begin 
  with IconResInfo[Index] do begin 
    Result.cx:=Width; 
    Result.cy:=Height; 
  end; 
end; 
 
procedure TICL16Icon.LoadIconResInfos(Stream : TStream;Var Valid : Boolean;Var Count : Word); 
Var 
  I,ID          : Word; 
  StartHeader : TIconHeader; 
  TmpDirListLen  : Integer; 
  TmpIconDirList : PResourceIconDirList; 
  S : String; 
begin 
  With Stream DO begin 
    Read(StartHeader,sizeOf(StartHeader)); 
    Valid:=((StartHeader.wReserved=0) AND (StartHeader.wType=1)); 
    IF NOT Valid Then exit; 
    Count:=StartHeader.wCount; 
    TmpDirListLen:=Count*SizeOf(TResourceIconResInfo); 
    DirListLen   :=Count*SizeOf(TFileIconResInfo); 
    HandleListLen:=Count*SizeOf(HIcon); 
    TmpIconDirList:=AllocMem(TmpDirListlen); 
    IconDirList   :=AllocMem(DirListlen); 
    IconHandleList:=AllocMem(HandleListlen); 
    FOR I:=1 TO IconCount DO IconHandleList^[I-1]:=0; 
    ReadBuffer(TmpIconDirList^,TmpDirListLen); 
  end; 
  FOR I:=1 TO IconCount DO begin 
    PFileIconDirList(IconDirList)^[I-1].ResInfo:=TmpIconDirList^[I-1].ResInfo; 
    PFileIconDirList(IconDirList)^[I-1].dwImageOffset:=Icons.Position; 
    ID:=FICLReader.GetResourceIndex(TmpIconDirList^[I-1].ID,False); 
    IF ID>=0 Then FICLReader.ReadResource(ID,False,Icons,S); 
  end; 
end; 
 
function TICL16Icon.GetIconResInfo(Index : Word) : TIconResInfo; 
begin 
  IF Index>=IconCount Then exit; 
  Result:=PFileIconDirList(IconDirList)^[Index].ResInfo; 
end; 
 
procedure TICL16Icon.WriteIconDataToStream(Stream : TStream;Index : Integer); 
begin 
  IF Index>=IconCount Then exit; 
  with ICLIconResInfo[Index] do begin 
    Icons.Position:=dwImageOffset; 
    Stream.CopyFrom(Icons,ResInfo.BytesInres); 
  end; 
end; 
 
initialization 
{$IfDEF Overseer} 
  Debugger.Clear; 
{$EndIf} 
end.