-----------
ComUtil.pas   Classes.pas extension. Low-level unit (above classes, below graphics)
-----------

Most notable procedures:

procedure SaveFree(pobj: pointer);
// Usage SaveFree(@Some_Object);
// Sets Some_Object:=nil; before freeing it (if free makes exception)
// (That's similar to FreeAndNil in Delphi5).
// But it tests, that Some_Object is an object - that it has not been already free'd...
function Is_Object(Obj: TObject): Boolean;

function ExtractToken(var Line: string; sep: char): string;
function PeekToken(const Line: string; sep: char): string;
function ExtractLine(var text: PChar): string;


//___New object classes___//

///////// Lists /////////
  TDualStringList=class(TStrings)
  end;
  Has no Objects[?]
  Has Values[?]: string;
  procedure AddValue(const Name,Value: string);

  //---------------------------------------------------------
  // TDualList
  // TList with 2 pointers per item...  Called "Item" & "Value"
  TDualList=class(TObject)
  public
    property  Capacity: Integer read FCapacity write SetCapacity;
    property  Count: Integer read FCount write SetCount;
    property  Items[Index: Integer]: Pointer read Get write Put; default;
    property  Values[Index: Integer]: Pointer read GetValue write PutValue;
    property  List: PDualListItemArray read FList;
  end;
  
  //---------------------------------------------------------
  // TSortedList - TList, sorted -la TStringList...

  TSortedList=class(TList)
  public
    function  Find(Item: Pointer; var Index: integer): Boolean; virtual;
    // Properties:
    property  Compare: TListSortCompare read FCompare write SetCompare;
    property  Duplicates: Boolean read FDuplicates write FDuplicates;
  end;
  //Insert & Move just raise exception!
  
  TSubStrings=class(TStrings)
  public
    constructor Create(Master: TStrings; FromIndex,ToIndex: integer); // high-bound is exclusive!
    destructor Destroy; override;
    procedure Lock;
    procedure UnLock;
    property  FirstLine: integer; // relative to Master...
    property  LastLine: integer; // rel.to M... Exclusive! Is not part of these SubStrings!
    property  Master: TStrings;
    property  ReadOnly: Boolean; // Abort on writing...
    property  Colleagues: TList; // other sub-strings over same master...
  end;
  // SubStrings   - a sub-set of another strings...
  // - is thread-safe with other SubStrings over same master
  // - you cannot operate on a Master, while SubStrings exists
  // - if you need to operate on a Master, create another sub-strings or call appropriate Notifications...
  // - high-bound is exclusive (ie. ToIndex is NOT part of subset)...
  // - ToIndex<0 in Create : until Master.Count

  Used to fill for ex. attachment in middle of large mail message...
  Create sub-strings, which contain only the attachment body,
  use Get,Put,Clear etc...

  // TSubFiller - TSubStrings used to Clear&Append into part of large strings, without actually moving 100000 other lines, if not really necessary...
  //            - until their window is filled, they overwrite master items, then insert...
  //            - Cut deletes master items, which were not replaced... (is called from Destroy!)
  TSubFiller=class(TSubStrings)
  public
    procedure Cut; // delete from master lines between last..ceiling...
    property  Ceiling: integer; 
  end;


  TNamedInterfaceList=class(TStringList)  // Is not exactly thread-safe... You can use Classes.TInterfaceList instead...
  public
    // New:
    function  AddIntf(const Name: string; const Intf: IUnknown): integer; // Use instead of AddObject !
    procedure InsertIntf(Index: integer; const Name: string; const Intf: IUnknown);
    property  Intf[Index: integer]: IUnknown read GetIntf write PutIntf;
  end;

///////// Streams /////////

  //---------------------------------------------------------
  // SubStream - window into another stream...
  //           - is NOT thread-safe... use other locking mechanism instead
  //           - Master must be seekable
  //           - use instead of copying part of a stream into memory-stream...
  //           - Offset<0 in constructor: uses current position as an offset...
  //           - Size<0 in constructor: From offset until end of Master...
  //           - if not ReadOnly, only into the window can be written,
  //           - if WarnOverflow, ESubStreamOverflow is raised, if trying to write more data,
  //             than fits into the window, else the overflowing data are silently discarded by Write (--> exception in WriteBuffer!)
  //             Descendant class may override the OverFlow function and store the data elsewhere???
  ESubStreamOverflow=class(Exception);

  TSubStream=class(TStream)
  protected
    function Overflow(const Buffer; Count: Longint): Longint; virtual;
  public
    constructor Create(Master: TStream; Offset,Size: integer);
    property  Master: TStream read FMaster;
    property  ReadOnly: Boolean read FReadOnly write FReadOnly default True;
    property  WarnOverflow: Boolean read FWarn write FWarn default True;
  end;

  TTempFileStream=class(TFileStream)
  public
    constructor Create; // Makes random file in TEMP folder...
    destructor Destroy; override; // Deletes the file...
    property  FileName: string read FFileName;
  end;

  //--------------------------------------------------------------------
  // TStreamLineReader - read any stream line-by-line
  //                   - effective buffering
  //                   - UnGetLine & PeekLine
  //                   - stream doesn't have to be seekable
  //                   - is NOT thread-safe... use other locking mechanism to lock the stream...
  //                   - no-one else should access the stream!
  TStreamLineReader=class(TObject)
  public
    constructor Create(InStream: TStream);
    function    ReadLine: string;               // get next line from stream...
    procedure   UnGetLine(const Line: string);  // give a line back to the logical head of a stream...
    function    PeekLine: string;               // get next line without removing it from the logical head of a stream...
    property    EOF: Boolean read FEOF;
    property    Position: integer read FPosition;
    property    RealPos: integer read FRealPos;
  end;

// Use LoadStrings instead of TStrings.LoadFromStream... Spares memory (but is a little slower - but not much)
// (LoadFromStream loads whole stream into a string, and breaks it into the lines)
// This reads in 8k buffers onto the stack and caches lines into a string-list... 
procedure LoadStrings(Strings: TStrings; Stream: TStream);

function CopyStream(Source,Dest: TStream; RewindSource: Boolean): integer; // Works with non-seakable streams also...
function CopyStreamEx(Source,Dest: TStream; RewindSource: Boolean; CopySize: integer): integer; // Works with non-seakable streams also (if you don't set RewindSource)...

///////// Allocator /////////

  //--------------------------------------------------------------------
  // TEqPoolAllocator - Pool allocator, equal-size blocks
  // Can alloc many blocks and free them in one step...

  TFinalizeProc=procedure(Item: Pointer);

  TEqPoolAllocator=class(TObject)
  protected
    procedure SetItemSize(Value: integer); virtual; // EXC, if not empty!
    function  AllocBlock(var BlockSize: integer): Pointer; virtual;
    procedure FreeBlock(Block: Pointer); virtual;
    function  InWhichBlock(Ptr: Pointer; Suggest: integer): integer; virtual;
  public
    destructor Destroy; override;
    //
    property  ItemSize: integer read FItemSize write SetItemSize;
    function  AllocItem: Pointer;
    function  FreeItem(kit: Pointer): Boolean;
    //
    procedure Clear;
    procedure CollectFree; // if some blocks are entirelly un-used, frees them...
    property  OnFinalizeItem: TFinalizeProc read FOnFinal write SetOnFinal;
  end;

  It's usefull for allocating Data for TreeNode's, or records of a table,
  or any set of equal-sized and mostly-equal-life-time records...
  If records contain AnsiStrings~WideStrings, set OnFinalizeItem to
  some procedure, that knows, how to dispose them
  (Usually:
    procedure FinalizeMyRecord(Item: Pointer);
    begin
      Finalize(PMyRecord(Item)^);
    end;
  )

///////// VCL Hacks /////////

Get into any private property, if you recognize it (pointer)
or can toggle it (any byte)!
Get UpdateCounts, window states or handles, component-list or what you need.

But remember, that most private things are private because wrong
manipulation may leed to undesired consequences!

type
  TToggleProc=procedure(Obj: TObject; SetIt: Boolean);
  TListScanProc=function(Obj: TObject; List,Arg: Pointer): Boolean;
  TListScanProcEx=function(Obj: TObject; List,Arg: Pointer; Offset: integer): Boolean;

// Find offset of private variable, if you know, how to toggle it:
// ToggleProc is called twice:  Once SetIt=True, Second time SetIt=False
// Object is snapped between the steps and compared at the end to find the byte, that changed...
// Beware of side effects, when toggling the property!
function GetPrivateOffset(Obj: TObject; ToggleProc: TToggleProc): integer;

// Find offset of private list, if you would recognize it:
// List is a pointer (a dw-round number)...
// Any pointer is passed to ScanProc, until it recognizes the list.
// (Often you know the type of the list (for ex. TList) and its items (for ex. TWinControl.Controls[i]), but don't know it's address...)
// Use Is_Object(List) in order not to test some other pointer!
function GetPrivateListOffset(Obj: TObject; ListScanProc: TListScanProc; Arg: Pointer): integer;
function GetPrivateListOffsetEx(Obj: TObject; ListScanProcEx: TListScanProcEx; Arg: Pointer): integer;

// Applications:
function GetStringListList(List: TStringList): PStringItemList;
function GetStringsUpdateCount(List: TStrings): integer;

