/KOLadd.pas

Large files files are truncated, but you can click here to view the full file

//[START OF KOL.pas]

{****************************************************************

                                                                    d       d

        KKKKK    KKKKK    OOOOOOOOO    LLLLL                        d       d

        KKKKK    KKKKK  OOOOOOOOOOOOO  LLLLL                        d       d

        KKKKK    KKKKK  OOOOO   OOOOO  LLLLL          aaaa          d       d

        KKKKK  KKKKK    OOOOO   OOOOO  LLLLL              a         d       d

        KKKKKKKKKK      OOOOO   OOOOO  LLLLL              a         d       d

        KKKKK  KKKKK    OOOOO   OOOOO  LLLLL          aaaaa    dddddd  dddddd

        KKKKK    KKKKK  OOOOO   OOOOO  LLLLL         a     a  d     d d     d

        KKKKK    KKKKK  OOOOOOOOOOOOO  LLLLLLLLLLLLL a     a  d     d d     d

        KKKKK    KKKKK    OOOOOOOOO    LLLLLLLLLLLLL  aaaaa aa dddddd  dddddd



  Key Objects Library (C) 2000 by Kladov Vladimir.



//[VERSION]

****************************************************************

* VERSION 2.04

****************************************************************

//[END OF VERSION]



The only reason why this part of KOL separated into another unit is that

Delphi has a restriction to DCU size exceeding which it is failed to debug

it normally and in attempt to execute code step by step an internal error

is occur which stops Delphi from working at all.



Version indicated above is a version of KOL, having place when KOLadd.pas was

modified last time, this is not a version of KOLadd itself.

}



unit KOLadd;



interface



{$I KOLDEF.INC}



uses Windows, KOL;



{------------------------------------------------------------------------------)

|                                                                              |

|                                  T L i s t E x                               |

|                                                                              |

(------------------------------------------------------------------------------}

type



//[TListEx DEFINITION]

  {++}(*TListEx = class;*){--}

  PListEx = {-}^{+}TListEx;

  TListEx = object( TObj )

  {* Extended list, with Objects[ ] property. Created calling NewListEx function. }

  protected

    fList: PList;

    fObjects: PList;

    function GetEx(Idx: Integer): Pointer;

    procedure PutEx(Idx: Integer; const Value: Pointer);

    function GetCount: Integer;

    function GetAddBy: Integer;

    procedure Set_AddBy(const Value: Integer);

  public

    destructor Destroy; {-}virtual;{+}{++}(*override;*){--}

    {* }

    property AddBy: Integer read GetAddBy write Set_AddBy;

    {* }

    property Items[ Idx: Integer ]: Pointer read GetEx write PutEx;

    {* }

    property Count: Integer read GetCount;

    {* }

    procedure Clear;

    {* }

    procedure Add( Value: Pointer );

    {* }

    procedure AddObj( Value, Obj: Pointer );

    {* }

    procedure Insert( Idx: Integer; Value: Pointer );

    {* }

    procedure InsertObj( Idx: Integer; Value, Obj: Pointer );

    {* }

    procedure Delete( Idx: Integer );

    {* }

    procedure DeleteRange( Idx, Len: Integer );

    {* }

    function IndexOf( Value: Pointer ): Integer;

    {* }

    function IndexOfObj( Obj: Pointer ): Integer;

    {* }

    procedure Swap( Idx1, Idx2: Integer );

    {* }

    procedure MoveItem( OldIdx, NewIdx: Integer );

    {* }

    property ItemsList: PList read fList;

    {* }

    property ObjList: PList read fObjects;

    {* }

    function Last: Pointer;

    {* }

    function LastObj: Pointer;

    {* }

  end;

//[END OF TListEx DEFINITION]



//[NewListEx DECLARATION]

function NewListEx: PListEx;

{* Creates extended list. }



{------------------------------------------------------------------------------)

|                                                                              |

|                                  T B i t s                                   |

|                                                                              |

(------------------------------------------------------------------------------}

type

//[TBits DEFINITION]

  {++}(*TBits = class;*){--}

  PBits = {-}^{+}TBits;

  TBits = object( TObj )

  {* Variable-length bits array object. Created using function NewBits. See also

     |<a href="kol_pas.htm#Small bit arrays (max 32 bits in array)">

     Small bit arrays (max 32 bits in array)

     |</a>. }

  protected

    fList: PList;

    fCount: Integer;

    function GetBit(Idx: Integer): Boolean;

    procedure SetBit(Idx: Integer; const Value: Boolean);

    function GetCapacity: Integer;

    function GetSize: Integer;

    procedure SetCapacity(const Value: Integer);

  public

    destructor Destroy; {-}virtual;{+}{++}(*override;*){--}

    {* }

    property Bits[ Idx: Integer ]: Boolean read GetBit write SetBit;

    {* }

    property Size: Integer read GetSize;

    {* Size in bytes of the array. To get know number of bits, use property Count. }

    property Count: Integer read fCount;

    {* Number of bits an the array. }

    property Capacity: Integer read GetCapacity write SetCapacity;

    {* Number of bytes allocated. Can be set before assigning bit values

       to improve performance (minimizing amount of memory allocation

       operations).  }

    function Copy( From, BitsCount: Integer ): PBits;

    {* Use this property to get a sub-range of bits starting from given bit

       and of BitsCount bits count. }

    function IndexOf( Value: Boolean ): Integer;

    {* Returns index of first bit with given value (True or False). }

    function OpenBit: Integer;

    {* Returns index of the first bit not set to true. }

    procedure Clear;

    {* Clears bits array. Count, Size and Capacity become 0. }

    function LoadFromStream( strm: PStream ): Integer;

    {* Loads bits from the stream. Data should be stored in the stream

       earlier using SaveToStream method. While loading, previous bits

       data are discarded and replaced with new one totally. In part,

       Count of bits also is changed. Count of bytes read from the stream

       while loading data is returned. }

    function SaveToStream( strm: PStream ): Integer;

    {* Saves entire array of bits to the stream. First, Count of bits

       in the array is saved, then all bytes containing bits data. }

    function Range( Idx, N: Integer ): PBits;

    {* Creates and returns new TBits object instance containing N bits

       starting from index Idx. If you call this method, you are responsible

       for destroying returned object when it become not neccessary. }

    procedure AssignBits( ToIdx: Integer; FromBits: PBits; FromIdx, N: Integer );

    {* Assigns bits from another bits array object. N bits are assigned

       starting at index ToIdx. }

  end;

//[END OF TBits DEFINITION]



//[NewBits DECLARATION]

function NewBits: PBits;

{* Creates variable-length bits array object. }



{------------------------------------------------------------------------------)

|                                                                              |

|                         T F a s t S t r L i s t                              |

|                                                                              |

(------------------------------------------------------------------------------}

type

  PFastStrListEx = ^TFastStrListEx;

  TFastStrListEx = object( TObj )

  private

    function GetItemLen(Idx: Integer): Integer;

    function GetObject(Idx: Integer): DWORD;

    procedure SetObject(Idx: Integer; const Value: DWORD);

    function GetValues(AName: PChar): PChar;

  protected

    procedure Init; virtual;

  protected

    fList: PList;

    fCount: Integer;

    fCaseSensitiveSort: Boolean;

    fTextBuf: PChar;

    fTextSiz: DWORD;

    fUsedSiz: DWORD;

  protected

    procedure ProvideSpace( AddSize: DWORD );

    function Get(Idx: integer): string;

    function GetTextStr: string;

    procedure Put(Idx: integer; const Value: string);

    procedure SetTextStr(const Value: string);

    function GetPChars( Idx: Integer ): PChar;

  {++}(*public*){--}

    destructor Destroy; {-}virtual;{+}{++}(*override;*){--}

  public

    function AddAnsi( const S: String ): Integer;

    {* Adds Ansi String to a list. }

    function AddAnsiObject( const S: String; Obj: DWORD ): Integer;

    {* Adds Ansi String and correspondent object to a list. }

    function Add(S: PChar): integer;

    {* Adds a string to list. }

    function AddLen(S: PChar; Len: Integer): integer;

    {* Adds a string to list. The string can contain #0 characters. }

  public

    FastClear: Boolean;

    {* }

    procedure Clear;

    {* Makes string list empty. }

    procedure Delete(Idx: integer);

    {* Deletes string with given index (it *must* exist). }

    function IndexOf(const S: string): integer;

    {* Returns index of first string, equal to given one. }

    function IndexOf_NoCase(const S: string): integer;

    {* Returns index of first string, equal to given one (while comparing it

       without case sensitivity). }

    function IndexOfStrL_NoCase( Str: PChar; L: Integer ): integer;

    {* Returns index of first string, equal to given one (while comparing it

       without case sensitivity). }

    function Find(const S: String; var Index: Integer): Boolean;

    {* Returns Index of the first string, equal or greater to given pattern, but

       works only for sorted TFastStrListEx object. Returns TRUE if exact string found,

       otherwise nearest (greater then a pattern) string index is returned,

       and the result is FALSE. }

    procedure InsertAnsi(Idx: integer; const S: String);

    {* Inserts ANSI string before one with given index. }

    procedure InsertAnsiObject(Idx: integer; const S: String; Obj: DWORD);

    {* Inserts ANSI string before one with given index. }

    procedure Insert(Idx: integer; S: PChar);

    {* Inserts string before one with given index. }

    procedure InsertLen( Idx: Integer; S: PChar; Len: Integer );

    {* Inserts string from given PChar. It can contain #0 characters. }

    function LoadFromFile(const FileName: string): Boolean;

    {* Loads string list from a file. (If file does not exist, nothing

       happens). Very fast even for huge text files. }

    procedure LoadFromStream(Stream: PStream; Append2List: boolean);

    {* Loads string list from a stream (from current position to the end of

       a stream). Very fast even for huge text. }

    procedure MergeFromFile(const FileName: string);

    {* Merges string list with strings in a file. Fast. }

    procedure Move(CurIndex, NewIndex: integer);

    {* Moves string to another location. }

    procedure SetText(const S: string; Append2List: boolean);

    {* Allows to set strings of string list from given string (in which

       strings are separated by $0D,$0A or $0D characters). Text can

       contain #0 characters. Works very fast. This method is used in

       all others, working with text arrays (LoadFromFile, MergeFromFile,

       Assign, AddStrings). }

    function SaveToFile(const FileName: string): Boolean;

    {* Stores string list to a file. }

    procedure SaveToStream(Stream: PStream);

    {* Saves string list to a stream (from current position). }

    function AppendToFile(const FileName: string): Boolean;

    {* Appends strings of string list to the end of a file. }

    property Count: integer read fCount;

    {* Number of strings in a string list. }

    property Items[Idx: integer]: string read Get write Put; default;

    {* Strings array items. If item does not exist, empty string is returned.

       But for assign to property, string with given index *must* exist. }

    property ItemPtrs[ Idx: Integer ]: PChar read GetPChars;

    {* Fast access to item strings as PChars. }

    property ItemLen[ Idx: Integer ]: Integer read GetItemLen;

    {* Length of string item. }

    function Last: String;

    {* Last item (or '', if string list is empty). }

    property Text: string read GetTextStr write SetTextStr;

    {* Content of string list as a single string (where strings are separated

       by characters $0D,$0A). }

    procedure Swap( Idx1, Idx2 : Integer );

    {* Swaps to strings with given indeces. }

    procedure Sort( CaseSensitive: Boolean );

    {* Call it to sort string list. }

  public

    function AddObject( S: PChar; Obj: DWORD ): Integer;

    {* Adds string S (null-terminated) with associated object Obj. }

    function AddObjectLen( S: PChar; Len: Integer; Obj: DWORD ): Integer;

    {* Adds string S of length Len with associated object Obj. }

    procedure InsertObject( Idx: Integer; S: PChar; Obj: DWORD );

    {* Inserts string S (null-terminated) at position Idx in the list,

       associating it with object Obj. }

    procedure InsertObjectLen( Idx: Integer; S: PChar; Len: Integer; Obj: DWORD );

    {* Inserts string S of length Len at position Idx in the list,

       associating it with object Obj. }

    property Objects[ Idx: Integer ]: DWORD read GetObject write SetObject;

    {* Access to objects associated with strings in the list. }

  public

    procedure Append( S: PChar );

    {* Appends S (null-terminated) to the last string in FastStrListEx object, very fast. }

    procedure AppendLen( S: PChar; Len: Integer );

    {* Appends S of length Len to the last string in FastStrListEx object, very fast. }

    procedure AppendInt2Hex( N: DWORD; MinDigits: Integer );

    {* Converts N to hexadecimal and appends resulting string to the last

       string, very fast. }

  public

    property Values[ Name: PChar ]: PChar read GetValues;

    {* Returns a value correspondent to the Name an ini-file-like string list

       (having Name1=Value1 Name2=Value2 etc. in each string). }

    function IndexOfName( AName: PChar ): Integer;

    {* Searches string starting from 'AName=' in string list like ini-file. }

  end;



function NewFastStrListEx: PFastStrListEx;

         {* Creates FastStrListEx object. }



var Upper: array[ Char ] of Char;

    {* An table to convert char to uppercase very fast. First call InitUpper. }



    Upper_Initialized: Boolean;

procedure InitUpper;

          {* Call this fuction ones to fill Upper[ ] table before using it. }



//[TWStrList]



{-}

{$IFNDEF _FPC}

procedure WStrCopy( Dest, Src: PWideChar );

{* Copies null-terminated Unicode string (terminated null also copied). }

function WStrCmp( W1, W2: PWideChar ): Integer;

{* Compares two null-terminated Unicode strings. }

{$ENDIF _FPC}



{$IFNDEF _D2} //------------------ WideString is not supported in D2 -----------



type

  PWStrList = ^TWstrList;

  {* }

//[TWstrList DEFINITION]

  TWStrList = object( TObj )

  {* String list to store Unicode (null-terminated) strings. }

  protected

    function GetCount: Integer;

    function GetItems(Idx: Integer): WideString;

    procedure SetItems(Idx: Integer; const Value: WideString);

    function GetPtrs(Idx: Integer): PWideChar;

    function GetText: WideString;

  protected

    fList: PList;

    fText: PWideChar;

    fTextBufSz: Integer;

    fTmp1, fTmp2: WideString;

    procedure Init; virtual;

  public

    procedure SetText(const Value: WideString);

    {* See also TStrList.SetText }

    destructor Destroy; virtual;

    {* }

    procedure Clear;

    {* See also TStrList.Clear }

    property Items[ Idx: Integer ]: WideString read GetItems write SetItems;

    {* See also TStrList.Items }

    property ItemPtrs[ Idx: Integer ]: PWideChar read GetPtrs;

    {* See also TStrList.ItemPtrs }

    property Count: Integer read GetCount;

    {* See also TStrList.Count }

    function Add( const W: WideString ): Integer;

    {* See also TStrList.Add }

    procedure Insert( Idx: Integer; const W: WideString );

    {* See also TStrList.Insert }

    procedure Delete( Idx: Integer );

    {* See also TStrList.Delete }

    property Text: WideString read GetText write SetText;

    {* See also TStrList.Text }

    procedure AddWStrings( WL: PWStrList );

    {* See also TStrList.AddStrings }

    procedure Assign( WL: PWStrList );

    {* See also TStrList.Assign }

    function LoadFromFile( const Filename: String ): Boolean;

    {* See also TStrList.LoadFromFile }

    procedure LoadFromStream( Strm: PStream );

    {* See also TStrList.LoadFromStream }

    function MergeFromFile( const Filename: String ): Boolean;

    {* See also TStrList.MergeFromFile }

    procedure MergeFromStream( Strm: PStream );

    {* See also TStrList.MergeFromStream }

    function SaveToFile( const Filename: String ): Boolean;

    {* See also TStrList.SaveToFile }

    procedure SaveToStream( Strm: PStream );

    {* See also TStrList.SaveToStream }

    function AppendToFile( const Filename: String ): Boolean;

    {* See also TStrList.AppendToFile }

    procedure Swap( Idx1, Idx2: Integer );

    {* See also TStrList.Swap }

    procedure Sort( CaseSensitive: Boolean );

    {* See also TStrList.Sort }

    procedure Move( IdxOld, IdxNew: Integer );

    {* See also TStrList.Move }

  end;

//[END OF TWStrList DEFINITION]



//[TWStrListEx]

  PWStrListEx = ^TWStrListEx;



//[TWStrListEx DEFINITION]

  TWStrListEx = object( TWStrList )

  {* Extended Unicode string list (with Objects). }

  protected

    function GetObjects(Idx: Integer): DWORD;

    procedure SetObjects(Idx: Integer; const Value: DWORD);

    procedure ProvideObjectsCapacity( NewCap: Integer );

  protected

    fObjects: PList;

    procedure Init; virtual;

  public

    destructor Destroy; virtual;

    {* }

    property Objects[ Idx: Integer ]: DWORD read GetObjects write SetObjects;

    {* }

    procedure AddWStrings( WL: PWStrListEx );

    {* }

    procedure Assign( WL: PWStrListEx );

    {* }

    procedure Clear;

    {* }

    procedure Delete( Idx: Integer );

    {* }

    procedure Move( IdxOld, IdxNew: Integer );

    {* }

    function AddObject( const S: WideString; Obj: DWORD ): Integer;

    {* Adds a string and associates given number with it. Index of the item added

       is returned. }

    procedure InsertObject( Before: Integer; const S: WideString; Obj: DWORD );

    {* Inserts a string together with object associated. }

    function IndexOfObj( Obj: Pointer ): Integer;

    {* Returns an index of a string associated with the object passed as a

       parameter. If there are no such strings, -1 is returned. }

  end;

//[END OF TWStrListEx DEFINITION]



//[NewWStrList DECLARATION]

function NewWStrList: PWStrList;

{* Creates new TWStrList object and returns a pointer to it. }



//[NewWStrListEx DECLARATION]

function NewWStrListEx: PWStrListEx;

{* Creates new TWStrListEx objects and returns a pointer to it. }



{$ENDIF}



//[CABINET FILES OBJECT]

type

  {++}(*TCabFile = class;*){--}

  PCABFile = {-}^{+}TCABFile;



  TOnNextCAB = function( Sender: PCABFile ): String of object;

  TOnCABFile = function( Sender: PCABFile; var FileName: String ): Boolean of object;



{ ----------------------------------------------------------------------



                TCabFile - windows cabinet files



----------------------------------------------------------------------- }

//[TCabFile DEFINITION]

  TCABFile = object( TObj )

  {* An object to simplify extracting files from a cabinet (.CAB) files.

     The only what need to use this object, setupapi.dll. It is provided

     with all latest versions of Windows. }

  protected

    FPaths: PStrList;

    FNames: PStrList;

    FOnNextCAB: TOnNextCAB;

    FOnFile: TOnCABFile;

    FTargetPath: String;

    FSetupapi: THandle;

    function GetNames(Idx: Integer): String;

    function GetCount: Integer;

    function GetPaths(Idx: Integer): String;

    function GetTargetPath: String;

  protected

    FGettingNames: Boolean;

    FCurCAB: Integer;

  public

    destructor Destroy; {-}virtual;{+}{++}(*override;*){--}

    {* }

    property Paths[ Idx: Integer ]: String read GetPaths;

    {* A list of CAB-files. It is stored, when constructing function

       OpenCABFile called. }

    property Names[ Idx: Integer ]: String read GetNames;

    {* A list of file names, stored in a sequence of CAB files. To get know,

       how many files are there, check Count property. }

    property Count: Integer read GetCount;

    {* Number of files stored in a sequence of CAB files. }

    function Execute: Boolean;

    {* Call this method to extract or enumerate files in CAB. For every

       file, found during executing, event OnFile is alled (if assigned).

       If the event handler (if any) does not provide full target path for

       a file to extract to, property TargetPath is applyed (also if it

       is assigned), or file is extracted to the default directory (usually

       the same directory there CAB file is located, or current directory

       - by a decision of the system).

       |<br>

       If a sequence of CAB files is used, and not all names for CAB files

       are provided (absent or represented by a string '?' ), an event

       OnNextCAB is called to obtain the name of the next CAB file.}

    property CurCAB: Integer read FCurCAB;

    {* Index of current CAB file in a sequence of CAB files. When OnNextCAB

       event is called (if any), CurCAB property is already set to the

       index of path, what should be provided. }

    property OnNextCAB: TOnNextCAB read FOnNextCAB write FOnNextCAB;

    {* This event is called, when a series of CAB files is needed and not

       all CAB file names are provided (absent or represented by '?' string).

       If this event is not assigned, the user is prompted to browse file. }

    property OnFile: TOnCABFile read FOnFile write FOnFile;

    {* This event is called for every file found during Execute method.

       In an event handler (if any assigned), it is possible to return

       False to skip file, or to provide another full target path for

       file to extract it to, then default. If the event is not assigned,

       all files are extracted either to default directory, or to the

       directory TargetPath, if it is provided. }

    property TargetPath: String read GetTargetPath write FTargetPath;

    {* Optional target directory to place there extracted files. }

  end;

//[END OF TCABFile DEFINITION]



//[OpenCABFile DECLARATION]

function OpenCABFile( const APaths: array of String ): PCABFile;

{* This function creates TCABFile object, passing a sequence of CAB file names

   (fully qualified). It is possible not to provide all names here, or pass '?'

   string in place of some of those. For such files, either an event OnNextCAB

   will be called, or (and) user will be prompted to browse file during

   executing (i.e. Extracting). }



//[DIRCHANGE]

type

  {++}(*TDirChange = class;*){--}

  PDirChange = {-}^{+}TDirChange;

  {* }



  TOnDirChange = procedure (Sender: PDirChange; const Path: string) of object;

  {* Event type to define OnChange event for folder monitoring objects. }



  TFileChangeFilters = (fncFileName, fncDirName, fncAttributes, fncSize,

      fncLastWrite, fncLastAccess, fncCreation, fncSecurity);

  {* Possible change monitor filters. }

  TFileChangeFilter = set of TFileChangeFilters;

  {* Set of filters to pass to a constructor of TDirChange object. }



{ ----------------------------------------------------------------------



                          TDirChange object



----------------------------------------------------------------------- }

//[TDirChange DEFINITION]

  TDirChange = object(TObj)

  {* Object type to monitor changes in certain folder. }

  protected

    FOnChange: TOnDirChange;

    FHandle: THandle;

    FPath: string;

    FMonitor: PThread;

    function Execute( Sender: PThread ): Integer;

    procedure Changed;

  protected

  {++}(*public*){--}

    destructor Destroy; {-}virtual;{+}{++}(*override;*){--}

    {*}

  public

    property Handle: THandle read FHandle;

    {* Handle of file change notification object. *}

    property Path: String read FPath; //write SetPath;

    {* Path to monitored folder (to a root, if tree of folders

       is under monitoring). }

  end;

//[END OF TDirChange DEFINITION]



//[NewDirChangeNotifier DECLARATION]

function NewDirChangeNotifier( const Path: String; Filter: TFileChangeFilter;

                               WatchSubtree: Boolean; ChangeProc: TOnDirChange ): PDirChange;

{* Creates notification object TDirChangeNotifier. If something wrong (e.g.,

   passed directory does not exist), nil is returned as a result. When change

   is notified, ChangeProc is called always in main thread context.

   (Please note, that ChangeProc can not be nil).

   If empty filter is passed, default filter is used:

   [fncFileName..fncLastWrite]. }



//[METAFILES]



type

  {++}(*TMetafile = class;*){--}

  PMetafile = {-}^{+}TMetafile;

{ ----------------------------------------------------------------------



      TMetafile - Windows metafile and Enchanced Metafile image



----------------------------------------------------------------------- }

//[TMetafile DEFINITION]

  TMetafile = object( TObj )

  {* Object type to incapsulate metafile image. }

  protected

    function GetHeight: Integer;

    function GetWidth: Integer;

    procedure SetHandle(const Value: THandle);

  protected

    fHandle: THandle;

    fHeader: PEnhMetaHeader;

    procedure RetrieveHeader;

  public

    destructor Destroy; {-}virtual;{+}{++}(*override;*){--}

    {* }

    procedure Clear;

    {* }

    function Empty: Boolean;

    {* Returns TRUE if empty}

    property Handle: THandle read fHandle write SetHandle;

    {* Returns handle of enchanced metafile. }

    function LoadFromStream( Strm: PStream ): Boolean;

    {* Loads emf or wmf file format from stream. }

    function LoadFromFile( const Filename: String ): Boolean;

    {* Loads emf or wmf from stream. }

    procedure Draw( DC: HDC; X, Y: Integer );

    {* Draws enchanced metafile on DC. }

    procedure StretchDraw( DC: HDC; const R: TRect );

    {* Draws enchanced metafile stretched. }

    property Width: Integer read GetWidth;

    {* Native width of the metafile. }

    property Height: Integer read GetHeight;

    {* Native height of the metafile. }

  end;

//[END OF TMetafile DEFINITION]



//[NewMetafile DECLARATION]

function NewMetafile: PMetafile;

{* Creates metafile object. }



//[Metafile CONSTANTS, STRUCTURES, ETC.]

const

  WMFKey = Integer($9AC6CDD7);

  WMFWord = $CDD7;

type

  TMetafileHeader = packed record

    Key: Longint;

    Handle: SmallInt;

    Box: TSmallRect;

    Inch: Word;

    Reserved: Longint;

    CheckSum: Word;

  end;



function ComputeAldusChecksum(var WMF: TMetafileHeader): Word;



{++}(*

function SetEnhMetaFileBits(p1: UINT; p2: PChar): HENHMETAFILE; stdcall;

function PlayEnhMetaFile(DC: HDC; p2: HENHMETAFILE; const p3: TRect): BOOL; stdcall;

*){--}



// NewActionList, TAction - by Yury Sidorov

//[ACTIONS OBJECT]

{ ----------------------------------------------------------------------



                TAction and TActionList



----------------------------------------------------------------------- }

type

  PControlRec = ^TControlRec;

  TOnUpdateCtrlEvent = procedure(Sender: PControlRec) of object;



  TCtrlKind = (ckControl, ckMenu, ckToolbar);

  TControlRec = record

    Ctrl: PObj;

    CtrlKind: TCtrlKind;

    ItemID: integer;

    UpdateProc: TOnUpdateCtrlEvent;

  end;



  {++}(* TAction = class;*){--}

  PAction = {-}^{+}TAction;



  {++}(* TActionList = class;*){--}

  PActionList = {-}^{+}TActionList;



//[TAction DEFINITION]

  TAction = {-} object( TObj ) {+}{++}(*class*){--}

  {*! Use action objects, in conjunction with action lists, to centralize the response

      to user commands (actions).

      Use AddControl, AddMenuItem, AddToolbarButton methods to link controls to an action.

      See also TActionList.

      }

  protected

    FControls: PList;

    FCaption: string;

    FChecked: boolean;

    FVisible: boolean;

    FEnabled: boolean;

    FHelpContext: integer;

    FHint: string;

    FOnExecute: TOnEvent;

    FAccelerator: TMenuAccelerator;

    FShortCut: string;

    procedure DoOnMenuItem(Sender: PMenu; Item: Integer);

    procedure DoOnToolbarButtonClick(Sender: PControl; BtnID: Integer);

    procedure DoOnControlClick(Sender: PObj);



    procedure SetCaption(const Value: string);

    procedure SetChecked(const Value: boolean);

    procedure SetEnabled(const Value: boolean);

    procedure SetHelpContext(const Value: integer);

    procedure SetHint(const Value: string);

    procedure SetVisible(const Value: boolean);

    procedure SetAccelerator(const Value: TMenuAccelerator);

    procedure UpdateControls;



    procedure LinkCtrl(ACtrl: PObj; ACtrlKind: TCtrlKind; AItemID: integer; AUpdateProc: TOnUpdateCtrlEvent);

    procedure SetOnExecute(const Value: TOnEvent);



    procedure UpdateCtrl(Sender: PControlRec);

    procedure UpdateMenu(Sender: PControlRec);

    procedure UpdateToolbar(Sender: PControlRec);



  public

    destructor Destroy; {-}virtual;{+}{++}(*override;*){--}

    procedure LinkControl(Ctrl: PControl);

    {* Add a link to a TControl or descendant control. }

    procedure LinkMenuItem(Menu: PMenu; MenuItemIdx: integer);

    {* Add a link to a menu item. }

    procedure LinkToolbarButton(Toolbar: PControl; ButtonIdx: integer);

    {* Add a link to a toolbar button. }

    procedure Execute;

    {* Executes a OnExecute event handler. }

    property Caption: string read FCaption write SetCaption;

    {* Text caption. }

    property Hint: string read FHint write SetHint;

    {* Hint (tooltip). Currently used for toolbar buttons only. }

    property Checked: boolean read FChecked write SetChecked;

    {* Checked state. }

    property Enabled: boolean read FEnabled write SetEnabled;

    {* Enabled state. }

    property Visible: boolean read FVisible write SetVisible;

    {* Visible state. }

    property HelpContext: integer read FHelpContext write SetHelpContext;

    {* Help context. }

    property Accelerator: TMenuAccelerator read FAccelerator write SetAccelerator;

    {* Accelerator for menu items. }

    property OnExecute: TOnEvent read FOnExecute write SetOnExecute;

    {* This event is executed when user clicks on a linked object or Execute method was called. }

  end;

//[END OF TAction DEFINITION]



//[TActionList DEFINITION]

  TActionList = {-} object( TObj ) {+}{++}(*class*){--}

  {*! TActionList maintains a list of actions used with components and controls,

     such as menu items and buttons.

     Action lists are used, in conjunction with actions, to centralize the response

     to user commands (actions).

     Write an OnUpdateActions handler to update actions state.

     Created using function NewActionList.

     See also TAction.

  }

  protected

    FOwner: PControl;

    FActions: PList;

    FOnUpdateActions: TOnEvent;

    function GetActions(Idx: integer): PAction;

    function GetCount: integer;

  protected

    procedure DoUpdateActions(Sender: PObj);

  public

    destructor Destroy; {-}virtual;{+}{++}(*override;*){--}

    function Add(const ACaption, AHint: string; OnExecute: TOnEvent): PAction;

    {* Add a new action to the list. Returns pointer to action object. }

    procedure Delete(Idx: integer);

    {* Delete action by index from list. }

    procedure Clear;

    {* Clear all actions in the list. }

    property Actions[Idx: integer]: PAction read GetActions;

    {* Access to actions in the list. }

    property Count: integer read GetCount;

    {* Number of actions in the list.. }

    property OnUpdateActions: TOnEvent read FOnUpdateActions write FOnUpdateActions;

    {* Event handler to update actions state. This event is called each time when application

      goes in the idle state (no messages in the queue). }

  end;

//[END OF TActionList DEFINITION]



//[NewActionList DECLARATION]

function NewActionList(AOwner: PControl): PActionList;

{* Action list constructor. AOwner - owner form. }





implementation



type

  PCrackList = ^TCrackList;

  TCrackList = object( TList )

  end;



{------------------------------------------------------------------------------)

|                                                                              |

|                                  T L i s t E x                               |

|                                                                              |

(------------------------------------------------------------------------------}

{ TListEx }



//[function NewListEx]

function NewListEx: PListEx;

begin

  {-}

  new( Result, Create );

  {+}{++}(*Result := PListEx.Create;*){--}

  Result.fList := NewList;

  Result.fObjects := NewList;

end;

//[END NewListEx]



//[procedure TListEx.Add]

procedure TListEx.Add(Value: Pointer);

begin

  AddObj( Value, nil );

end;



//[procedure TListEx.AddObj]

procedure TListEx.AddObj(Value, Obj: Pointer);

var C: Integer;

begin

  C := Count;

  fList.Add( Value );

  fObjects.Insert( C, Obj );

end;



//[procedure TListEx.Clear]

procedure TListEx.Clear;

begin

  fList.Clear;

  fObjects.Clear;

end;



//[procedure TListEx.Delete]

procedure TListEx.Delete(Idx: Integer);

begin

  DeleteRange( Idx, 1 );

end;



//[procedure TListEx.DeleteRange]

procedure TListEx.DeleteRange(Idx, Len: Integer);

begin

  fList.DeleteRange( Idx, Len );

  fObjects.DeleteRange( Idx, Len );

end;



//[destructor TListEx.Destroy]

destructor TListEx.Destroy;

begin

  fList.Free;

  fObjects.Free;

  inherited;

end;



//[function TListEx.GetAddBy]

function TListEx.GetAddBy: Integer;

begin

  Result := fList.AddBy;

end;



//[function TListEx.GetCount]

function TListEx.GetCount: Integer;

begin

  Result := fList.Count;

end;



//[function TListEx.GetEx]

function TListEx.GetEx(Idx: Integer): Pointer;

begin

  Result := fList.Items[ Idx ];

end;



//[function TListEx.IndexOf]

function TListEx.IndexOf(Value: Pointer): Integer;

begin

  Result := fList.IndexOf( Value );

end;



//[function TListEx.IndexOfObj]

function TListEx.IndexOfObj(Obj: Pointer): Integer;

begin

  Result := fObjects.IndexOf( Obj );

end;



//[procedure TListEx.Insert]

procedure TListEx.Insert(Idx: Integer; Value: Pointer);

begin

  InsertObj( Idx, Value, nil );

end;



//[procedure TListEx.InsertObj]

procedure TListEx.InsertObj(Idx: Integer; Value, Obj: Pointer);

begin

  fList.Insert( Idx, Value );

  fObjects.Insert( Idx, Obj );

end;



//[function TListEx.Last]

function TListEx.Last: Pointer;

begin

  Result := fList.Last;

end;



//[function TListEx.LastObj]

function TListEx.LastObj: Pointer;

begin

  Result := fObjects.Last;

end;



//[procedure TListEx.MoveItem]

procedure TListEx.MoveItem(OldIdx, NewIdx: Integer);

begin

  fList.MoveItem( OldIdx, NewIdx );

  fObjects.MoveItem( OldIdx, NewIdx );

end;



//[procedure TListEx.PutEx]

procedure TListEx.PutEx(Idx: Integer; const Value: Pointer);

begin

  fList.Items[ Idx ] := Value;

end;



//[procedure TListEx.Set_AddBy]

procedure TListEx.Set_AddBy(const Value: Integer);

begin

  fList.AddBy := Value;

  fObjects.AddBy := Value;

end;



//[procedure TListEx.Swap]

procedure TListEx.Swap(Idx1, Idx2: Integer);

begin

  fList.Swap( Idx1, Idx2 );

  fObjects.Swap( Idx1, Idx2 );

end;



{------------------------------------------------------------------------------)

|                                                                              |

|                                  T B i t s                                   |

|                                                                              |

(------------------------------------------------------------------------------}

{ TBits }



//[function NewBits]

function NewBits: PBits;

begin

  {-}

  new( Result, Create );

  {+}{++}(*Result := PBits.Create;*){--}

  Result.fList := NewList;

  //Result.fList.fAddBy := 1;

end;



//[procedure TBits.AssignBits]

procedure TBits.AssignBits(ToIdx: Integer; FromBits: PBits; FromIdx,

  N: Integer);

var i: Integer;

    NewCount: Integer;

begin

  if FromIdx >= FromBits.Count then Exit;

  if FromIdx + N > FromBits.Count then

    N := FromBits.Count - FromIdx;

  Capacity := (ToIdx + N + 8) div 8;

  NewCount := Max( Count, ToIdx + N - 1 );

  fCount := Max( NewCount, fCount );

  PCrackList( fList ).fCount := (Capacity + 3) div 4;

  while ToIdx and $1F <> 0 do

  begin

    Bits[ ToIdx ] := FromBits.Bits[ FromIdx ];

    Inc( ToIdx );

    Inc( FromIdx );

    Dec( N );

    if N = 0 then Exit;

  end;

  Move( PByte( Integer( PCrackList( FromBits.fList ).fItems ) + (FromIdx + 31) div 32 )^,

        PByte( Integer( PCrackList( fList ).fItems ) + ToIdx div 32 )^, (N + 31) div 32 );

  FromIdx := FromIdx and $1F;

  if FromIdx <> 0 then

  begin // shift data by (Idx and $1F) bits right

    for i := ToIdx div 32 to fList.Count-2 do

      fList.Items[ i ] := Pointer(

        (DWORD( fList.Items[ i ] ) shr FromIdx) or

        (DWORD( fList.Items[ i+1 ] ) shl (32 - FromIdx))

        );

    fList.Items[ fList.Count-1 ] := Pointer(

      DWORD( fList.Items[ fList.Count-1 ] ) shr FromIdx

      );

  end;

end;



//[function TBits.Copy]

procedure TBits.Clear;

begin

  fCount := 0;

  fList.Clear;

end;



function TBits.Copy(From, BitsCount: Integer): PBits;

var Shift, N: Integer;

    FirstItemPtr: Pointer;

begin

  Result := NewBits;

  if BitsCount = 0 then Exit;

  Result.Capacity := BitsCount + 32;

  Result.fCount := BitsCount;

  Move( PCrackList( fList ).fItems[ From shr 5 ],

        PCrackList( Result.fList ).fItems[ 0 ], (Count + 31) div 32 );

  Shift := From and $1F;

  if Shift <> 1 then

  begin

    N := (BitsCount + 31) div 32;

    FirstItemPtr := @ PCrackList( Result.fList ).fItems[ N - 1 ];

    asm

          PUSH  ESI

          PUSH  EDI

          MOV   ESI, FirstItemPtr

          MOV   EDI, ESI

          STD

          MOV   ECX, N

          XOR   EAX, EAX

          CDQ

    @@1:

          PUSH  ECX

          LODSD

          MOV   ECX, Shift

          SHRD  EAX, EDX, CL

          STOSD

          SUB   ECX, 32

          NEG   ECX

          SHR   EDX, CL

          POP   ECX



          LOOP  @@1



          CLD

          POP   EDI

          POP   ESI

    end {$IFDEF F_P} ['EAX','EDX','ECX'] {$ENDIF};

  end;

end;



//[destructor TBits.Destroy]

destructor TBits.Destroy;

begin

  fList.Free;

  inherited;

end;



//[function TBits.GetBit]

{$IFDEF ASM_VERSION}

function TBits.GetBit(Idx: Integer): Boolean;

asm

  CMP  EDX, [EAX].FCount

  JL   @@1

  XOR  EAX, EAX

  RET

@@1:

  MOV  EAX, [EAX].fList

  {TEST EAX, EAX

  JZ   @@exit}

  MOV  EAX, [EAX].TList.fItems

  BT   [EAX], EDX

  SETC AL

@@exit:

end;

{$ELSE}

function TBits.GetBit(Idx: Integer): Boolean;

begin

  if (Idx >= Count) {or (PCrackList( fList ).fItems = nil)} then Result := FALSE else

  Result := ( ( DWORD( PCrackList( fList ).fItems[ Idx shr 5 ] ) shr (Idx and $1F)) and 1 ) <> 0;

end;

{$ENDIF}



//[function TBits.GetCapacity]

function TBits.GetCapacity: Integer;

begin

  Result := fList.Capacity * 32;

end;



//[function TBits.GetSize]

function TBits.GetSize: Integer;

begin

  Result := ( PCrackList( fList ).fCount + 3) div 4;

end;



{$IFDEF ASM_noVERSION}

//[function TBits.IndexOf]

function TBits.IndexOf(Value: Boolean): Integer;

asm     //cmd    //opd

        PUSH     EDI

        MOV      EDI, [EAX].fList

        MOV      ECX, [EDI].TList.fCount

@@ret_1:

        OR       EAX, -1

        JECXZ    @@ret_EAX

        MOV      EDI, [EDI].TList.fItems

        TEST     DL, DL

        MOV      EDX, EDI

        JE       @@of_false

        INC      EAX

        REPZ     SCASD

        JE       @@ret_1

        MOV      EAX, [EDI-4]

        NOT      EAX

        JMP      @@calc_offset

        BSF      EAX, EAX

        SUB      EDI, EDX

        SHR      EDI, 2

        ADD      EAX, EDI

        JMP      @@ret_EAX

@@of_false:

        REPE     SCASD

        JE       @@ret_1

        MOV      EAX, [EDI-4]

@@calc_offset:

        BSF      EAX, EAX

        DEC      EAX

        SUB      EDI, 4

        SUB      EDI, EDX

        SHL      EDI, 3

        ADD      EAX, EDI

@@ret_EAX:

        POP      EDI

end;

{$ELSE ASM_VERSION} //Pascal

function TBits.IndexOf(Value: Boolean): Integer;

var I: Integer;

    D: DWORD;

begin

  Result := -1;

  if Value then

  begin

    for I := 0 to fList.Count-1 do

    begin

      D := DWORD( PCrackList( fList ).fItems[ I ] );

      if D <> 0 then

      begin

        asm

          MOV  EAX, D

          BSF  EAX, EAX

          MOV  D, EAX

        end {$IFDEF F_P} [ 'EAX' ] {$ENDIF};

        Result := I * 32 + Integer( D );

        break;

      end;

    end;

  end

    else

  begin

    for I := 0 to PCrackList( fList ).fCount-1 do

    begin

      D := DWORD( PCrackList( fList ).fItems[ I ] );

      if D <> $FFFFFFFF then

      begin

        asm

          MOV  EAX, D

          NOT  EAX

          BSF  EAX, EAX

          MOV  D, EAX

        end {$IFDEF F_P} [ 'EAX' ] {$ENDIF};

        Result := I * 32 + Integer( D );

        break;

      end;

    end;

  end;

end;

{$ENDIF ASM_VERSION}



//[function TBits.LoadFromStream]

function TBits.LoadFromStream(strm: PStream): Integer;

var

 i: Integer;

begin

 Result := strm.Read( i, 4 );

 if Result < 4 then Exit;

 

 bits[ i]:= false; //by miek

 fcount:= i;



 i := (i + 7) div 8;

 Inc( Result, strm.Read( PCrackList( fList ).fItems^, i ) );

end;



//[function TBits.OpenBit]

function TBits.OpenBit: Integer;

begin

  Result := IndexOf( FALSE );

  if Result < 0 then Result := Count;

end;



//[function TBits.Range]

function TBits.Range(Idx, N: Integer): PBits;

begin

  Result := NewBits;

  Result.AssignBits( 0, @ Self, Idx, N );

end;



//[function TBits.SaveToStream]

function TBits.SaveToStream(strm: PStream): Integer;

begin

  Result := strm.Write( fCount, 4 );

  if fCount = 0 then Exit;

  Inc( Result, strm.Write( PCrackList( fList ).fItems^, (fCount + 7) div 8 ) );

end;



//[procedure TBits.SetBit]

{$IFDEF ASM_VERSION}

procedure TBits.SetBit(Idx: Integer; const Value: Boolean);

asm

  PUSH ECX

  MOV  ECX, [EAX].fList

  MOV  ECX, [ECX].TList.fCapacity

  SHL  ECX, 5

  CMP  EDX, ECX

  JLE  @@1



  PUSH EDX

  INC  EDX

  PUSH EAX

  CALL SetCapacity

  POP  EAX

  POP  EDX



@@1:

  CMP  EDX, [EAX].FCount

  JL   @@2

  INC  EDX

  MOV  [EAX].fCount, EDX

  DEC  EDX

@@2:

  POP  ECX

  MOV  EAX, [EAX].fList

  MOV  EAX, [EAX].TList.fItems

  SHR  ECX, 1

  JC   @@2set

  BTR  [EAX], EDX

  JMP  @@exit

@@2set:

  BTS  [EAX], EDX

@@exit:

end;

{$ELSE}

procedure TBits.SetBit(Idx: Integer; const Value: Boolean);

var Msk: DWORD;

begin

  if Idx >= Capacity then

    Capacity := Idx + 1;

  Msk := 1 shl (Idx and $1F);

  if Value then

    PCrackList( fList ).fItems[ Idx shr 5 ] := Pointer(

                  DWORD(PCrackList( fList ).fItems[ Idx shr 5 ]) or Msk)

  else

    PCrackList( fList ).fItems[ Idx shr 5 ] := Pointer(

                  DWORD(PCrackList( fList ).fItems[ Idx shr 5 ]) and not Msk);

  if Idx >= fCount then

    fCount := Idx + 1;

end;

{$ENDIF}



//[procedure TBits.SetCapacity]

procedure TBits.SetCapacity(const Value: Integer);

var OldCap: Integer;

begin

  OldCap := fList.Capacity;

  fList.Capacity := (Value + 31) div 32;

  if OldCap < fList.Capacity then

    FillChar( PChar( Integer( PCrackList( fList ).fItems ) + OldCap * Sizeof( Pointer ) )^,

              (fList.Capacity - OldCap) * sizeof( Pointer ), 0 );

end;



{------------------------------------------------------------------------------)

|                                                                              |

|                         T F a s t S t r L i s t                              |

|                                                                              |

(------------------------------------------------------------------------------}



function NewFastStrListEx: PFastStrListEx;

begin

  new( Result, Create );

end;



procedure InitUpper;

var c: Char;

begin

  for c := #0 to #255 do

    Upper[ c ] := AnsiUpperCase( c + #0 )[ 1 ];

  Upper_Initialized := TRUE;

end;



{ TFastStrListEx }



function TFastStrListEx.AddAnsi(const S: String): Integer;

begin

  Result := AddObjectLen( PChar( S ), Length( S ), 0 );

end;



function TFastStrListEx.AddAnsiObject(const S: String; Obj: DWORD): Integer;

begin

  Result := AddObjectLen( PChar( S ), Length( S ), Obj );

end;



function TFastStrListEx.Add(S: PChar): integer;

begin

  Result := AddObjectLen( S, StrLen( S ), 0 )

end;



function TFastStrListEx.AddLen(S: PChar; Len: Integer): integer;

begin

  Result := AddObjectLen( S, Len, 0 )

end;



function TFastStrListEx.AddObject(S: PChar; Obj: DWORD): Integer;

begin

  Result := AddObjectLen( S, StrLen( S ), Obj )

end;



function TFastStrListEx.AddObjectLen(S: PChar; Len: Integer; Obj: DWORD): Integer;

var Dest: PChar;

begin

  ProvideSpace( Len + 9 );

  Dest := PChar( DWORD( fTextBuf ) + fUsedSiz );

  Result := fCount;

  Inc( fCount );

  fList.Add( Pointer( DWORD(Dest)-DWORD(fTextBuf) ) );

  PDWORD( Dest )^ := Obj;

  Inc( Dest, 4 );

  PDWORD( Dest )^ := Len;

  Inc( Dest, 4 );

  if S <> nil then

    System.Move( S^, Dest^, Len );

  Inc( Dest, Len );

  Dest^ := #0;

  Inc( fUsedSiz, Len+9 );

end;



function TFastStrListEx.AppendToFile(const FileName: string): Boolean;

var F: HFile;

    Txt: String;

begin

  Txt := Text;

  F := FileCreate( FileName, ofOpenAlways or ofOpenReadWrite or ofShareDenyWrite );

  if F = INVALID_HANDLE_VALUE then Result := FALSE

  else begin

         FileSeek( F, 0, spEnd );

         Result := FileWrite( F, PChar( Txt )^, Length( Txt ) ) = DWORD( Length( Txt ) );

         FileClose( F );

       end;

end;



procedure TFastStrListEx.Clear;

begin

  if FastClear then

  begin

    if fList.Count > 0 then

      PCrackList(fList).FCount := 0;

  end

    else

  begin

    fList.Clear;

    if fTextBuf <> nil then

      FreeMem( fTextBuf );

    fTextBuf := nil;

  end;

  fTextSiz := 0;

  fUsedSiz := 0;

  fCount := 0;

end;



procedure TFastStrListEx.Delete(Idx: integer);

begin

  if (Idx < 0) or (Idx >= Count) then Exit;

  if Idx = Count-1 then

    Dec( fUsedSiz, ItemLen[ Idx ]+9 );

  fList.Delete( Idx );

  Dec( fCount );

end;



destructor TFastStrListEx.Destroy;

begin

  FastClear := FALSE;

  Clear;

  fList.Free;

  inherited;

end;



function TFastStrListEx.Find(const S: String; var Index: Integer): Boolean;

var i: Integer;

begin

  for i := 0 to Count-1 do

    if (ItemLen[ i ] = Length( S )) and

       ((S = '') or CompareMem( ItemPtrs[ i ], @ S[ 1 ], Length( S ) )) then

       begin

         Index := i;

         Result := TRUE;

         Exit;

       end;

  Result := FALSE;

end;



function TFastStrListEx.Get(Idx: integer): string;

begin

  if (Idx >= 0) and (Idx <= Count) then

    SetString( Result, PChar( DWORD( fTextBuf ) + DWORD( fList.Items[ Idx ] ) + 8 ),

               ItemLen[ Idx ] )

  else

    Result := '';

end;



function TFastStrListEx.GetItemLen(Idx: Integer): Integer;

var Src: PDWORD;

begin

  if (Idx >= 0) and (Idx <= Count) then

  begin

    Src := PDWORD( DWORD( fTextBuf ) + DWORD( fList.Items[ Idx ] ) + 4 );

    Result := Src^

  end

    else Result := 0;

end;



function TFastStrListEx.GetObject(Idx: Integer): DWORD;

var Src: PDWORD;

begin

  if (Idx >= 0) and (Idx <= Count) then

  begin

    Src := PDWORD( DWORD( fTextBuf ) + DWORD( fList.Items[ Idx ] ) );

    Result := Src^

  end

    else Result := 0;

end;



function TFastStrListEx.GetPChars(Idx: Integer): PChar;

begin

  if (Idx >= 0) and (Idx <= Count) then

    Result := PChar( DWORD( fTextBuf ) + DWORD( fList.Items[ Idx ] ) + 8 )

  else Result := nil;

end;



function TFastStrListEx.GetTextStr: string;

var L, i: Integer;

    p: PChar;

begin

  L := 0;

  for i := 0 to Count-1 do

    Inc( L, ItemLen[ i ] + 2 );

  SetLength( Result, L );

  p := PChar( Result );

  for i := 0 to Count-1 do

  begin

    L := ItemLen[ i ];

    if L > 0 then

    begin

      System.Move( ItemPtrs[ i ]^, p^, L );

      Inc( p, L );

    end;

    p^ := #13; Inc( p );

    p^ := #10; Inc( p );

  end;

end;



function TFastStrListEx.IndexOf(const S: string): integer;

begin

  if not Find( S, Result ) then Result := -1;

end;



function TFastStrListEx.IndexOf_NoCase(const S: string): integer;

begin

  Result := IndexOfStrL_NoCase( PChar( S ), Length( S ) );

end;



function TFastStrListEx.IndexOfStrL_NoCase(Str: PChar;

  L: Integer): integer;

var i: Integer;

begin

  for i := 0 to Count-1 do

    if (ItemLen[ i ] = L) and

       ((L = 0) or (StrLComp_NoCase( ItemPtrs[ i ], Str, L ) = 0)) then

       begin

         Result := i;

         Exit;

       end;

  Result := -1;

end;



procedure TFastStrListEx.Init;

begin

  fList := NewList;

  FastClear := TRUE;

end;



procedure TFastStrListEx.InsertAnsi(Idx: integer; const S: String);

begin

  InsertObjectLen( Idx, PChar( S ), Length( S ), 0 );

end;



procedure TFastStrListEx.InsertAnsiObject(Idx: integer; const S: String;

  Obj: DWORD);

begin

  InsertObjectLen( Idx, PChar( S ), Length( S ), Obj );

end;



procedure TFastStrListEx.Insert(Idx: integer; S: PChar);

begin

  InsertObjectLen( Idx, S, StrLen( S ), 0 )

end;



procedure TFastStrListEx.InsertLen(Idx: Integer; S: PChar; Len: Integer);

begin

  InsertObjectLen( Idx, S, Len, 0 )

end;



procedure TFastStrListEx.InsertObject(Idx: Integer; S: PChar; Obj: DWORD);

begin

  Ins…