home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 January / Chip_1999-01_cd.bin / zkuste / delphi / D / QLISTS.ZIP / qlists.pas
Encoding:
Pascal/Delphi Source File  |  1998-06-28  |  38.6 KB  |  1,534 lines
  1.  
  2. unit QLists;
  3.  
  4. (*
  5.                   TQList and TQStringList v1.02
  6.                   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  7.                       Robert R. Marsh, SJ
  8.                         rrm@sprynet.com
  9.                 http://home.sprynet.com/sprynet/rrm/
  10.  
  11.    Instead of using a single array of pointers to implement a list
  12.    (which TList does) TQList uses a Hashed Array Tree as described
  13.    by Edward Sitarski (Dr. Dobb's Journal, September 1996, 107-110).
  14.    The advantage is an overall reduced memory requirement, much
  15.    reduced memory fragmentation, and more efficient growth of the
  16.    list. The trade-off is with access time which is about doubled.
  17.    As implemented here TQList could hold (memory permitting) just
  18.    short of 27 million pointers in both D1 and D2/3 .
  19.  
  20.    The technique uses a top array filled with pointers to leaf arrays
  21.    which hold the pointers of the list. The top and leaf arrays are
  22.    the same size (always a power of two). Leaf arrays are only added
  23.    when required.
  24.  
  25.    I have tried to keep TQList and TQStringList as like TList and
  26.    TStringList as possible and attempted to make 32-bit functionality
  27.    available in D1 as well.
  28.  
  29.    If you like TQList and TQStringList and find yourself using them
  30.    please consider making a donation to your favorite charity. I
  31.    would also be pleased if you would make acknowledgement in any
  32.    projects that make use of them.
  33.  
  34.    QLists is supplied as is. The author disclaims all warranties,
  35.    expressed or implied, including, without limitation, the warranties
  36.    of merchantability and of fitness for any purpose. The author
  37.    assumes no liability for damages, direct or consequential, which
  38.    may result from the use of QLists.
  39.  
  40.            Copyright (c) 1997 Robert R. Marsh, S.J. &
  41.           the British Province of the Society of Jesus
  42.  
  43. *)
  44.  
  45. (*
  46.  
  47.    Version 1.02
  48.      fixes a bug in the SetCapacity method when a list is being
  49.        expanded before it is necessary to do so
  50.  
  51. *)
  52.  
  53. interface
  54.  
  55. uses
  56.   {$IFDEF WIN32}Windows{$ELSE}WinTypes, WinProcs{$ENDIF},
  57.   SysUtils, Classes;
  58.  
  59. { TQList class }
  60.  
  61. const
  62.   MaxBranchSize = (65536 div SizeOf(pointer)) - 1;
  63.   MaxListSize = MaxBranchSize * MaxBranchSize;
  64.  
  65.   SOutOfMemory = 'Not enough memory to expand the list';
  66.   SListIndexError = 'List index (%d) out of bounds';
  67.   SListCapacityError = 'Invalid capacity value (%d)';
  68.   SListCountError = 'Invalid count value (%d)';
  69.   SDuplicateString = 'List will not accept duplicates';
  70.   SNotStrings = 'Parameter is not a string list';
  71.   SSortedListError = 'Operation not allowed on a sorted list';
  72.  
  73. type
  74.   EQListError = class(Exception);
  75.  
  76. type
  77.   PLeafList = ^TLeafList;
  78.   TLeafList = array[0..MaxBranchSize - 1] of pointer;
  79.   PTopList = ^TTopList;
  80.   TTopList = array[0..MaxBranchSize - 1] of PLeafList;
  81.  
  82.   TQListCompare = function(item1, item2 : pointer) : longint;
  83.  
  84.   EListError = class(Exception);
  85.  
  86. type
  87.   TQList = class(TObject)
  88.   private
  89.     FList : PTopList;
  90.     FCount : longint;
  91.     FCapacity : longint;
  92.     LeafMask : longint;                           { used to find the index into a leaf }
  93.     LeafLength : longint;                         { the length of the Leaf array       }
  94.     LeafSize : longint;                           { the memory-size of the Leaf        }
  95.     TopSize : longint;                            { the memory-size of the Top array   }
  96.     Power : longint;                              { the power of two giving the length }
  97.     TopUsed : longint;                            { the number of active leaves        }
  98.     procedure AddLeaf;
  99.     procedure SetPower(p : longint);
  100.   protected
  101.     function Get(Index : longint) : pointer;
  102.     procedure Grow; virtual;
  103.     procedure QuickSort(L, R : longint; SCompare : TQListCompare);
  104.     procedure Put(Index : longint; Item : pointer);
  105.     procedure SetCapacity(NewCapacity : longint);
  106.     procedure SetCount(NewCount : longint);
  107.   public
  108.     constructor Create;
  109.     destructor Destroy; override;
  110.     function Add(Item : pointer) : longint;
  111.     procedure Clear;
  112.     procedure Delete(Index : longint);
  113.     class procedure Error(const Msg : string; Data : longint); virtual;
  114.     procedure Exchange(Index1, Index2 : longint);
  115.     function Expand : TQList;
  116.     function First : pointer;
  117.     function IndexOf(Item : pointer) : longint;
  118.     procedure Insert(Index : longint; Item : pointer);
  119.     function Last : pointer;
  120.     procedure Move(CurIndex, NewIndex : longint);
  121.     function Remove(Item : pointer) : longint;
  122.     procedure Pack;
  123.     procedure Sort(Compare : TQListCompare);
  124.     property Capacity : longint Read FCapacity Write SetCapacity;
  125.     property Count : longint Read FCount Write SetCount;
  126.     property Items[Index : longint] : pointer Read Get Write Put;
  127.     default;
  128.     property List : PTopList Read FList;
  129.   end;
  130.  
  131.  
  132.   { TQStringList class }
  133.  
  134.   TDuplicates = (dupIgnore, dupAccept, dupError);
  135.  
  136.   TQStringList = class(TPersistent)
  137.   private
  138.     FList : TQList;
  139.     FCaseSensitive : boolean;
  140.     FSorted : boolean;
  141.     FDuplicates : TDuplicates;
  142.     FUpdateCount : longint;
  143.     FOnChange : TNotifyEvent;
  144.     FOnChanging : TNotifyEvent;
  145.     function GetName(Index : longint) : string;
  146.     function GetValue(const Name : string) : string;
  147.     function GetValueByIndex(Index : longint) : string;
  148.     procedure QuickSortA(L, R : longint);         { case-insensitive }
  149.     procedure QuickSortB(L, R : longint);         { case-sensitive   }
  150.     procedure ReadData(Reader : TReader);
  151.     procedure SetCaseSensitive(Value : boolean);
  152.     procedure SetSorted(Value : boolean);
  153.     procedure SetValue(const Name, Value : string);
  154.     procedure SetValueByIndex(Index : longint; const Value : string);
  155.     procedure WriteData(Writer : TWriter);
  156.   protected
  157.     procedure DefineProperties(Filer : TFiler); override;
  158.     procedure Changed; virtual;
  159.     procedure Changing; virtual;
  160.     function Get(Index : longint) : string;
  161.     function GetCapacity : longint;
  162.     function GetCount : longint;
  163.     function GetObject(Index : longint) : TObject;
  164.     procedure Put(Index : longint; const S : string);
  165.     procedure PutObject(Index : longint; AObject : TObject);
  166.     procedure SetCapacity(NewCapacity : longint);
  167.     procedure SetUpdateState(Updating : boolean);
  168.   public
  169.     constructor Create;
  170.     destructor Destroy; override;
  171.     function Add(const S : string) : longint;
  172.     function AddObject(const S : string; AObject : TObject) : longint; virtual;
  173.     procedure AddStrings(Strings : TPersistent); virtual;
  174.     procedure Append(const S : string);
  175.     procedure Assign(Source : TPersistent); override;
  176.     procedure AssignTo(Dest : TPersistent); override;
  177.     procedure BeginUpdate;
  178.     procedure Clear;
  179.     procedure Delete(Index : longint);
  180.     procedure EndUpdate;
  181.     function Equals(Strings : TPersistent) : boolean;
  182.     class procedure Error(const Msg : string; Data : longint); virtual;
  183.     procedure Exchange(Index1, Index2 : longint);
  184.     function Find(const S : string; var Index : longint) : boolean; virtual;
  185.     function GetText : pchar; virtual;
  186.     function GetTextStr : string; virtual;
  187.     function IndexOf(const S : string) : longint;
  188.     function IndexOfName(const Name : string) : longint;
  189.     function IndexOfObject(AObject : TObject) : longint;
  190.     procedure Insert(Index : longint; const S : string);
  191.     procedure InsertObject(Index : longint; const S : string; AObject : TObject);
  192.     procedure LoadFromFile(const FileName : string); virtual;
  193.     procedure LoadFromStream(Stream : TStream); virtual;
  194.     procedure Move(CurIndex, NewIndex : longint); virtual;
  195.     procedure Reverse(SetSorted : boolean);
  196.     procedure SaveToFile(const FileName : string); virtual;
  197.     procedure SaveToStream(Stream : TStream); virtual;
  198.     procedure SetText(Text : pchar); virtual;
  199.     procedure SetTextStr(const Value : string); virtual;
  200.     procedure Sort; virtual;
  201.     property CaseSensitive : boolean Read FCaseSensitive Write SetCaseSensitive;
  202.     property Count : longint Read GetCount;
  203.     property Duplicates : TDuplicates Read FDuplicates Write FDuplicates;
  204.     property Sorted : boolean Read FSorted Write SetSorted;
  205.     property Names[Index : longint] : string Read GetName;
  206.     property Objects[Index : longint] : TObject Read GetObject Write PutObject;
  207.     property Values[const Name : string] : string Read GetValue Write SetValue;
  208.     property ValuesByIndex[Index : longint] : string Read GetValueByIndex Write SetValueByIndex;
  209.     property Strings[Index : longint] : string Read Get Write Put;
  210.     default;
  211.     property Text : string Read GetTextStr Write SetTextStr;
  212.     property OnChange : TNotifyEvent Read FOnChange Write FOnChange;
  213.     property OnChanging : TNotifyEvent Read FOnChanging Write FOnChanging;
  214.   end;
  215.  
  216.  
  217. implementation
  218.  
  219. { TQList }
  220.  
  221. const
  222.   PowerMin = 1;
  223.  
  224. constructor TQList.Create;
  225. begin
  226.   inherited Create;
  227.   FCount := 0;
  228.   FList := nil;
  229.   TopUsed := 0;
  230.   SetPower(PowerMin);
  231.   SetCapacity(0);
  232. end;
  233.  
  234. destructor TQList.Destroy;
  235. begin
  236.   while TopUsed > 0 do
  237.   begin
  238.     FreeMem(FList^[TopUsed - 1], LeafSize);
  239.     dec(TopUsed);
  240.   end;
  241.   if FList <> nil then
  242.   begin
  243.     FreeMem(FList, TopSize);
  244.     FList := nil;
  245.   end;
  246.   inherited Destroy;
  247. end;
  248.  
  249. function TQList.Add(Item : pointer) : longint;
  250. begin
  251.   Result := FCount;
  252.   if Result = FCapacity then
  253.     Grow;
  254.   if (Result and LeafMask) = 0 then
  255.     AddLeaf;
  256.   FList^[(Result shr Power)]^[(Result and LeafMask)] := Item;
  257.   inc(FCount);
  258. end;
  259.  
  260. procedure TQList.AddLeaf;
  261. var
  262.   NewLeaf : PLeafList;
  263. begin
  264.   try
  265.     GetMem(NewLeaf, LeafSize);
  266.     FList^[TopUsed] := NewLeaf;
  267.     inc(TopUsed);
  268.   except
  269.     on EOutOfMemory do
  270.       Error(SOutOfMemory, 0)
  271.   else
  272.     raise;
  273.   end;
  274. end;
  275.  
  276. procedure TQList.Clear;
  277. begin
  278.   while TopUsed > 0 do
  279.   begin
  280.     FreeMem(FList^[TopUsed - 1], LeafSize);
  281.     dec(TopUsed);
  282.   end;
  283.   FCount := 0;
  284.   SetCapacity(0);
  285. end;
  286.  
  287. procedure TQList.Delete(Index : longint);
  288. var
  289.   i : longint;
  290.   amount : longint;
  291. begin
  292.   if (Index < 0) or (Index >= FCount) then
  293.     Error(SListIndexError, Index);
  294.   amount := LeafLength - 1 - (Index and LeafMask);
  295.   { move the first chunk }
  296.   if amount > 0 then
  297.     System.Move(FList^[(Index shr Power)]^[(Index + 1) and LeafMask],
  298.       FList^[(Index shr Power)]^[Index and LeafMask], amount * SizeOf(pointer));
  299.   { then for each leaf upwards }
  300.   for i := (Index shr Power) to TopUsed - 2 do
  301.   begin
  302.     { bring one item down }
  303.     FList^[i]^[LeafLength - 1] := FList^[i + 1]^[0];
  304.     { shift the rest by one }
  305.     System.Move(FList^[i + 1]^[1], FList^[i + 1]^[0], LeafSize - SizeOf(pointer));
  306.   end;
  307.   dec(FCount);
  308.   if (FCount = 0) or (((FCount - 1) shr Power) < (TopUsed - 1)) then
  309.   begin
  310.     FreeMem(FList^[TopUsed - 1], LeafSize);
  311.     dec(TopUsed);
  312.   end;
  313. end;
  314.  
  315. class procedure TQList.Error(const Msg : string; Data : longint);
  316. { this way of locating the return address under all Delphi versions }
  317. { was devised by Robert Ro▀mair                                     }
  318. var
  319.   StackTop : record
  320.   end;
  321.   Stack : record
  322.     BPorEBP : integer;                            { 16 bit: BP, 32 bit: EBP }
  323.     ReturnAddress : pointer;
  324.   end absolute StackTop;
  325. begin
  326.   raise EQListError.CreateFmt(Msg, [Data])at Stack.ReturnAddress;
  327. end;
  328.  
  329. procedure TQList.Exchange(Index1, Index2 : longint);
  330. var
  331.   Item : pointer;
  332. begin
  333.   if (Index1 < 0) or (Index1 >= FCount) then
  334.     Error(SListIndexError, Index1);
  335.   if (Index2 < 0) or (Index2 >= FCount) then
  336.     Error(SListIndexError, Index2);
  337.   Item := FList^[(Index1 shr Power)]^[(Index1 and LeafMask)];
  338.   FList^[(Index1 shr Power)]^[(Index1 and LeafMask)] := FList^[(Index2 shr Power)]^[(Index2 and LeafMask)];
  339.   FList^[(Index2 shr Power)]^[(Index2 and LeafMask)] := Item;
  340. end;
  341.  
  342. function TQList.Expand : TQList;
  343. begin
  344.   if FCount = FCapacity then
  345.     Grow;
  346.   Result := Self;
  347. end;
  348.  
  349. function TQList.First : pointer;
  350. begin
  351.   Result := Get(0);
  352. end;
  353.  
  354. function TQList.Get(Index : longint) : pointer;
  355. begin
  356.   if (Index < 0) or (Index >= FCount) then
  357.     Error(SListIndexError, Index);
  358.   Result := FList^[(Index shr Power)]^[(Index and LeafMask)];
  359. end;
  360.  
  361. procedure TQList.Grow;
  362. begin
  363.   { SetCapacity will choose a suitable new value -- the list }
  364.   { capacity grows by powers of two                          }
  365.   SetCapacity(FCapacity + 1);
  366. end;
  367.  
  368. function TQList.IndexOf(Item : pointer) : longint;
  369. begin
  370.   Result := 0;
  371.   while (Result < FCount) and (FList^[(Result shr Power)]^[(Result and LeafMask)] <> Item) do
  372.     inc(Result);
  373.   if Result = FCount then
  374.     Result := -1;
  375. end;
  376.  
  377. procedure TQList.Insert(Index : longint; Item : pointer);
  378. var
  379.   i : longint;
  380.   amount : longint;
  381. begin
  382.   if (Index < 0) or (Index > FCount) then
  383.     Error(SListIndexError, Index);
  384.   if FCount = FCapacity then
  385.     Grow;
  386.   if (FCount and LeafMask) = 0 then
  387.     AddLeaf;
  388.   { for each leaf down to the place of insertion }
  389.   for i := TopUsed - 1 downto ((Index shr Power) + 1) do
  390.   begin
  391.     { shift one place up }
  392.     System.Move(FList^[i]^[0], FList^[i]^[1], LeafSize - SizeOf(pointer));
  393.     { bring one item up }
  394.     FList^[i]^[0] := FList^[i - 1]^[LeafLength - 1];
  395.   end;
  396.   amount := LeafLength - 1 - (Index and LeafMask);
  397.   { shift to make room for new item }
  398.   System.Move(FList^[Index shr Power]^[(Index and LeafMask)],
  399.     FList^[Index shr Power]^[(Index and LeafMask) + 1], amount * SizeOf(pointer));
  400.   { insert the item itself }
  401.   FList^[(Index shr Power)]^[(Index and LeafMask)] := Item;
  402.   inc(FCount);
  403. end;
  404.  
  405. function TQList.Last : pointer;
  406. begin
  407.   Result := Get(FCount - 1);
  408. end;
  409.  
  410. procedure TQList.Move(CurIndex, NewIndex : longint);
  411. var
  412.   Item : pointer;
  413. begin
  414.   if CurIndex <> NewIndex then
  415.   begin
  416.     if (NewIndex < 0) or (NewIndex >= FCount) then
  417.       Error(SListIndexError, NewIndex);
  418.     Item := Get(CurIndex);
  419.     Delete(CurIndex);
  420.     Insert(NewIndex, Item);
  421.   end;
  422. end;
  423.  
  424. procedure TQList.Put(Index : longint; Item : pointer);
  425. begin
  426.   if (Index < 0) or (Index >= FCount) then
  427.     Error(SListIndexError, Index);
  428.   FList^[(Index shr Power)]^[(Index and LeafMask)] := Item;
  429. end;
  430.  
  431. function TQList.Remove(Item : pointer) : longint;
  432. begin
  433.   Result := IndexOf(Item);
  434.   if Result <> -1 then
  435.     Delete(Result);
  436. end;
  437.  
  438. procedure TQList.Pack;
  439. var
  440.   i : longint;
  441. begin
  442.   for i := FCount - 1 downto 0 do
  443.     if Items[i] = nil then
  444.       Delete(i);
  445.   SetCapacity(FCount);
  446. end;
  447.  
  448. { this is one of the chief engines of the Hashed Array Tree ... }
  449.  
  450. procedure TQList.SetCapacity(NewCapacity : longint);
  451. var
  452.   NewPower : longint;
  453.   NewSize : longint;
  454.   NewList : PTopList;
  455.   NewLeaf : PLeafList;
  456.   NewTopUsed : longint;
  457.   Ratio : longint;
  458.   i, j : longint;
  459.  
  460.   function RecommendedPower(NewCapacity : longint) : longint;
  461.   begin
  462.     { compute the root of s to the nearest greater power of 2 }
  463.     Result := PowerMin;
  464.     while NewCapacity >= (1 shl (Result shl 1)) do
  465.       inc(Result);
  466.   end;
  467.  
  468. begin
  469.   { calculate the parameters of the 'new' qlist }
  470.   NewPower := RecommendedPower(NewCapacity);
  471.   NewSize := (1 shl NewPower) * SizeOf(pointer);
  472.   NewCapacity := (1 shl (NewPower shl 1));
  473.   if (NewCapacity < FCount) or (NewCapacity > MaxListSize) then
  474.     Error(SListCapacityError, NewCapacity);
  475.   if NewCapacity <> FCapacity then
  476.   begin
  477.     { begin to build a new qlist }
  478.     try
  479.       GetMem(NewList, NewSize);
  480.     except
  481.       on EOutOfMemory do
  482.         Error(SOutOfMemory, 0)
  483.     else
  484.       raise
  485.     end;
  486.     if FCount > 0 then
  487.     begin
  488.       { only relevant if the list has members }
  489.       NewTopUsed := ((FCount - 1) shr NewPower) + 1;
  490.       { how many old leaves fit into a new one }
  491.       Ratio := (NewSize div LeafSize);
  492.       { for each old leaf }
  493.       for i := 0 to TopUsed - 1 do
  494.       begin
  495.         { if a new leaf is needed }
  496.         if i mod Ratio = 0 then
  497.         begin
  498.           try
  499.             { add a new leaf }
  500.             GetMem(NewLeaf, NewSize);
  501.           except
  502.             on EOutOfMemory do
  503.               { get rid of the partly built qlist }
  504.             begin
  505.               j := i;
  506.               dec(j, Ratio);
  507.               while j >= 0 do
  508.                 FreeMem(NewList^[j], NewSize);
  509.               FreeMem(NewList, NewSize);
  510.               Error(SOutOfMemory, 0);
  511.             end
  512.           else
  513.             raise;
  514.           end;
  515.           { put the leaf into the tree }
  516.           NewList^[i div Ratio] := NewLeaf;
  517.         end;
  518.         { move the old leaf to its place in the new }
  519.         System.Move(FList^[i]^[0], NewList^[i div Ratio]^[(LeafLength * (i mod Ratio))], LeafSize);
  520.         { get rid of the old leaf }
  521.         FreeMem(FList^[i], LeafSize);
  522.       end;
  523.       TopUsed := NewTopUsed;
  524.     end;
  525.     { get rid of the old qlist }
  526.     if FList <> nil then
  527.       FreeMem(FList, TopSize);
  528.     { assign the new qlist instead }
  529.     FList := NewList;
  530.     { adjust the qlist parameters }
  531.     SetPower(NewPower);
  532.     FCapacity := NewCapacity;
  533.   end;
  534. end;
  535.  
  536. procedure TQList.SetCount(NewCount : longint);
  537. var
  538.   i : longint;
  539. begin
  540.   if (NewCount < 0) or (NewCount > MaxListSize) then
  541.     Error(SListCountError, NewCount);
  542.   if NewCount > FCapacity then
  543.     SetCapacity(NewCount);
  544.   { if we are shrinking the list we blank out the unwanted }
  545.   { items -- if they point to anything there'll be a leak  }
  546.   if NewCount > FCount then
  547.     for i := FCount to NewCount do
  548.       FList^[(i shr Power)]^[(i and LeafMask)] := nil;
  549.   FCount := NewCount;
  550. end;
  551.  
  552. procedure TQList.SetPower(p : longint);
  553. begin
  554.   Power := p;
  555.   LeafLength := (1 shl Power);
  556.   LeafSize := LeafLength * SizeOf(pointer);
  557.   LeafMask := LeafLength - 1;
  558.   TopSize := LeafSize;
  559. end;
  560.  
  561. procedure TQList.QuickSort(L, R : longint; SCompare : TQListCompare);
  562. var
  563.   i, j : longint;
  564.   p, T : pointer;
  565. begin
  566.   repeat
  567.     i := L;
  568.     j := R;
  569.     p := FList^[(((L + R) shr 1) shr Power)]^[(((L + R) shr 1) and LeafMask)];
  570.     repeat
  571.       while SCompare(FList^[(i shr Power)]^[(i and LeafMask)], p) < 0 do
  572.         inc(i);
  573.       while SCompare(FList^[(j shr Power)]^[(j and LeafMask)], p) > 0 do
  574.         dec(j);
  575.       if i <= j then
  576.       begin
  577.         T := FList^[(i shr Power)]^[(i and LeafMask)];
  578.         FList^[(i shr Power)]^[(i and LeafMask)] := FList^[(j shr Power)]^[(j and LeafMask)];
  579.         FList^[(j shr Power)]^[(j and LeafMask)] := T;
  580.         inc(i);
  581.         dec(j);
  582.       end;
  583.     until i > j;
  584.     if L < j then
  585.       QuickSort(L, j, SCompare);
  586.     L := i;
  587.   until i >= R;
  588. end;
  589.  
  590. procedure TQList.Sort(Compare : TQListCompare);
  591. begin
  592.   if (FList <> nil) and (Count > 0) then
  593.     QuickSort(0, Count - 1, Compare);
  594. end;
  595.  
  596.  
  597. { TQStringList }
  598.  
  599. const
  600.   CR = #13;
  601.   EoF = ^Z;
  602.   LF = #10;
  603.   NUL = #0;
  604.  
  605. type
  606.   PStrItem = ^TStrItem;
  607.   TStrItem = record
  608.     FString : pchar;
  609.     FObject : TObject;
  610.   end;
  611.  
  612. function NewStrItem(const AString : string; AObject : TObject) : PStrItem;
  613. var
  614.   p : PStrItem;
  615.   c : pchar;
  616. begin
  617.   GetMem(p, SizeOf(TStrItem));
  618.   GetMem(c, Length(AString) + 1);
  619.   StrPCopy(c, AString);
  620.   p^.FObject := AObject;
  621.   p^.FString := c;
  622.   Result := p;
  623. end;
  624.  
  625. procedure DisposeStrItem(p : PStrItem);
  626. begin
  627.   FreeMem(p^.FString, StrLen(p^.FString) + 1);
  628.   FreeMem(p, SizeOf(TStrItem));
  629. end;
  630.  
  631. { The following routines to manipulate huge pointers and to copy   }
  632. { and extract lines come from Secrets of Delphi 2, by Ray Lischner.}
  633. { (1996, Waite Group Press) Copyright ⌐ 1996 The Waite Group, Inc. }
  634.  
  635. procedure HugeShift;
  636.   far; external 'KERNEL' Index 113;
  637.  
  638. {$IFDEF WIN32}
  639.  
  640. function HugeOffset(p : pointer; size : longint) : pointer;
  641. begin
  642.   Result := pchar(p) + size;
  643. end;
  644.  
  645. procedure HMemCpy(PDest, PSource : pointer; size : longint);
  646. begin
  647.   System.Move(PSource^, PDest^, size);
  648. end;
  649.  
  650. {$ELSE}
  651.  
  652. function HugeOffset(p : pointer; size : longint) : pointer;
  653.   assembler;
  654. asm
  655.   mov ax, Size.Word[0]
  656.   mov dx, Size.Word[2]
  657.   add ax, p.Word[0]
  658.   adc dx, 0
  659.   mov cx, OFFSET HugeShift
  660.   shl dx, cl
  661.   add dx, p.Word[2]
  662. end;
  663. {$ENDIF}
  664.  
  665. { Copy the string, Str, to Text, and append a CR-LF.           }
  666. { Even though this function copies no more than 256 bytes, use }
  667. { HMemCopy, since Text might cross a segment boundary.         }
  668.  
  669. function CopyLine(Text : pchar; Str : pchar) : pchar;
  670. begin
  671.   HMemCpy(Text, Str, StrLen(Str));
  672.   Result := HugeOffset(Text, StrLen(Str));
  673.   { Now append the CR-LF }
  674.   Result^ := CR;
  675.   Result := HugeOffset(Result, 1);
  676.   Result^ := LF;
  677.   Result := HugeOffset(Result, 1);
  678. end;
  679.  
  680. { Extract the next line from Text, and copy it into Str.
  681.   Advance Text past the end of the string. A string ends with
  682.   a line ending (CRLF, CR, or LF), at the end of the string
  683.   (Ctrl+Z or zero byte), or at 255 bytes in Delphi 1.0. A string
  684.   can cross a segment boundary, so SetString cannot be used in
  685.   Delphi 1.0. The line ending is not included in the string Str. }
  686.  
  687. function ExtractLine(Text : pchar; var Str : string) : pchar;
  688. var
  689.   Len : integer;
  690. begin
  691.   Len := 0;
  692.   Result := Text;
  693.   while not (Result^ in [NUL, LF, CR, EoF]) do
  694.   begin
  695.     Result := HugeOffset(Result, 1);
  696.     inc(Len);
  697.     {$IFNDEF WIN32}
  698.     if Len = 255 then
  699.       Break;
  700.     {$ENDIF}
  701.   end;
  702.   {$IFDEF WIN32}
  703.   SetString(Str, Text, Len);
  704.   {$ELSE}
  705.   { Cannot use SetString, since Text might cross a segment boundary. }
  706.   Str[0] := chr(Len);
  707.   HMemCpy(@Str[1], Text, Len);
  708.   {$ENDIF}
  709.   if Result^ = CR then
  710.     Result := HugeOffset(Result, 1);
  711.   if Result^ = LF then
  712.     Result := HugeOffset(Result, 1);
  713. end;
  714.  
  715. constructor TQStringList.Create;
  716. begin
  717.   inherited Create;
  718.   FList := TQList.Create;
  719. end;
  720.  
  721. destructor TQStringList.Destroy;
  722. begin
  723.   FOnChange := nil;
  724.   FOnChanging := nil;
  725.   Clear;
  726.   FList.Free;
  727.   inherited Destroy;
  728. end;
  729.  
  730. function TQStringList.Add(const S : string) : longint;
  731. begin
  732.   if not Sorted then
  733.     Result := FList.Count
  734.   else
  735.     if Find(S, Result) then
  736.       case Duplicates of
  737.         dupIgnore :
  738.           exit;
  739.         dupError :
  740.           Error(SDuplicateString, 0);
  741.       end;
  742.   Changing;
  743.   FList.Insert(Result, NewStrItem(S, nil));
  744.   Changed;
  745. end;
  746.  
  747. function TQStringList.AddObject(const S : string; AObject : TObject) : longint;
  748. begin
  749.   if not Sorted then
  750.     Result := FList.Count
  751.   else
  752.     if Find(S, Result) then
  753.       case Duplicates of
  754.         dupIgnore :
  755.           exit;
  756.         dupError :
  757.           Error(SDuplicateString, 0);
  758.       end;
  759.   Changing;
  760.   FList.Insert(Result, NewStrItem(S, AObject));
  761.   Changed;
  762. end;
  763.  
  764. procedure TQStringList.AddStrings(Strings : TPersistent);
  765. var
  766.   i : longint;
  767. begin
  768.   if (Strings is TStrings) then
  769.   begin
  770.     BeginUpdate;
  771.     try
  772.       for i := 0 to TStrings(Strings).Count - 1 do
  773.         AddObject(TStrings(Strings)[i], TStrings(Strings).Objects[i]);
  774.     finally
  775.       EndUpdate;
  776.     end;
  777.     exit;
  778.   end;
  779.   if (Strings is TQStringList) then
  780.   begin
  781.     BeginUpdate;
  782.     try
  783.       for i := 0 to TQStringList(Strings).Count - 1 do
  784.         AddObject(TQStringList(Strings)[i], TQStringList(Strings).Objects[i]);
  785.     finally
  786.       EndUpdate;
  787.     end;
  788.     exit;
  789.   end;
  790.   Error(SNotStrings, 0);
  791. end;
  792.  
  793. procedure TQStringList.Append(const S : string);
  794. begin
  795.   Add(S);
  796. end;
  797.  
  798. procedure TQStringList.Assign(Source : TPersistent);
  799. begin
  800.   if (Source is TQStringList) or (Source is TStrings) then
  801.   begin
  802.     BeginUpdate;
  803.     try
  804.       Clear;
  805.       AddStrings(Source);
  806.     finally
  807.       EndUpdate;
  808.     end;
  809.     exit;
  810.   end;
  811.   inherited Assign(Source);
  812. end;
  813.  
  814. procedure TQStringList.AssignTo(Dest : TPersistent);
  815. var
  816.   i : longint;
  817.   p : PStrItem;
  818. begin
  819.   if Dest is TStrings then
  820.   begin
  821.     TStrings(Dest).BeginUpdate;
  822.     try
  823.       TStrings(Dest).Clear;
  824.       for i := 1 to Count do
  825.       begin
  826.         p := FList[i - 1];
  827.         TStrings(Dest).AddObject(StrPas(p^.FString), p^.FObject);
  828.       end;
  829.     finally
  830.       TStrings(Dest).EndUpdate;
  831.     end;
  832.     exit;
  833.   end;
  834.   if Dest is TQStringList then
  835.   begin
  836.     TQStringList(Dest).BeginUpdate;
  837.     try
  838.       TQStringList(Dest).Clear;
  839.       for i := 1 to Count do
  840.       begin
  841.         p := FList[i - 1];
  842.         TQStringList(Dest).AddObject(StrPas(p^.FString), p^.FObject);
  843.       end;
  844.     finally
  845.       TQStringList(Dest).EndUpdate;
  846.     end;
  847.     exit;
  848.   end;
  849.   inherited AssignTo(Dest);
  850. end;
  851.  
  852. procedure TQStringList.BeginUpdate;
  853. begin
  854.   if FUpdateCount = 0 then
  855.     SetUpdateState(true);
  856.   inc(FUpdateCount);
  857. end;
  858.  
  859. procedure TQStringList.Changed;
  860. begin
  861.   if (FUpdateCount = 0) and Assigned(FOnChange) then
  862.     FOnChange(Self);
  863. end;
  864.  
  865. procedure TQStringList.Changing;
  866. begin
  867.   if (FUpdateCount = 0) and Assigned(FOnChanging) then
  868.     FOnChanging(Self);
  869. end;
  870.  
  871. procedure TQStringList.Clear;
  872. var
  873.   i : longint;
  874. begin
  875.   Changing;
  876.   for i := 1 to FList.Count do
  877.   begin
  878.     DisposeStrItem(FList[i - 1]);
  879.     FList[i - 1] := nil;
  880.   end;
  881.   FList.Clear;
  882.   Changed;
  883. end;
  884.  
  885. procedure TQStringList.Delete(Index : longint);
  886. begin
  887.   if (Index < 0) or (Index >= FList.Count) then
  888.     Error(SListIndexError, Index);
  889.   Changing;
  890.   DisposeStrItem(FList[Index]);
  891.   FList.Delete(Index);
  892.   Changed;
  893. end;
  894.  
  895. procedure TQStringList.DefineProperties(Filer : TFiler);
  896.  
  897. {$IFDEF WIN32}
  898.  
  899.   function DoWrite : boolean;
  900.   begin
  901.     if Filer.Ancestor <> nil then
  902.     begin
  903.       Result := true;
  904.       if Filer.Ancestor is TQStringList then
  905.         Result := not Equals(TQStringList(Filer.Ancestor))
  906.     end
  907.     else
  908.       Result := Count > 0;
  909.   end;
  910.  
  911.   {$ENDIF}
  912.  
  913. begin
  914.   {$IFDEF WIN32}
  915.   Filer.DefineProperty('Strings', ReadData, WriteData, DoWrite);
  916.   {$ELSE}
  917.   Filer.DefineProperty('Strings', ReadData, WriteData, Count > 0);
  918.   {$ENDIF}
  919. end;
  920.  
  921. procedure TQStringList.EndUpdate;
  922. begin
  923.   dec(FUpdateCount);
  924.   if FUpdateCount = 0 then
  925.     SetUpdateState(false);
  926. end;
  927.  
  928. function TQStringList.Equals(Strings : TPersistent) : boolean;
  929. var
  930.   i : longint;
  931. begin
  932.   Result := false;
  933.   if Strings is TStrings then
  934.   begin
  935.     if Count <> TStrings(Strings).Count then
  936.       exit;
  937.     for i := 0 to Count - 1 do
  938.       if Get(i) <> TStrings(Strings)[i] then
  939.         exit;
  940.   end;
  941.   if Strings is TQStringList then
  942.   begin
  943.     if Count <> TQStringList(Strings).Count then
  944.       exit;
  945.     for i := 0 to Count - 1 do
  946.       if Get(i) <> TQStringList(Strings).Get(i) then
  947.         exit;
  948.   end;
  949.   Result := true;
  950. end;
  951.  
  952. class procedure TQStringList.Error(const Msg : string; Data : longint);
  953. { this way of locating the return address under all Delphi versions }
  954. { was devised by Robert Ro▀mair                                     }
  955. var
  956.   StackTop : record
  957.   end;
  958.   Stack : record
  959.     BPorEBP : integer;                            { 16 bit: BP, 32 bit: EBP }
  960.     ReturnAddress : pointer;
  961.   end absolute StackTop;
  962. begin
  963.   raise EQListError.CreateFmt(Msg, [Data])at Stack.ReturnAddress;
  964. end;
  965.  
  966. procedure TQStringList.Exchange(Index1, Index2 : longint);
  967. begin
  968.   if (Index1 < 0) or (Index1 >= FList.Count) then
  969.     Error(SListIndexError, Index1);
  970.   if (Index2 < 0) or (Index2 >= FList.Count) then
  971.     Error(SListIndexError, Index2);
  972.   Changing;
  973.   FList.Exchange(Index1, Index2);
  974.   Changed;
  975. end;
  976.  
  977. function TQStringList.Find(const S : string; var Index : longint) : boolean;
  978. var
  979.   L, H, i, c : longint;
  980. begin
  981.   Result := false;
  982.   L := 0;
  983.   H := FList.Count - 1;
  984.   while L <= H do
  985.   begin
  986.     i := (L + H) shr 1;
  987.     if CaseSensitive then
  988.       c := AnsiCompareStr(StrPas(PStrItem(FList[i])^.FString), S)
  989.     else
  990.       c := AnsiCompareText(StrPas(PStrItem(FList[i])^.FString), S);
  991.     if c < 0 then
  992.       L := i + 1
  993.     else
  994.     begin
  995.       H := i - 1;
  996.       if c = 0 then
  997.       begin
  998.         Result := true;
  999.         if Duplicates <> dupAccept then
  1000.           L := i;
  1001.       end;
  1002.     end;
  1003.   end;
  1004.   Index := L;
  1005. end;
  1006.  
  1007. function TQStringList.Get(Index : longint) : string;
  1008. begin
  1009.   if (Index < 0) or (Index >= FList.Count) then
  1010.     Error(SListIndexError, Index);
  1011.   Result := StrPas(PStrItem(FList[Index])^.FString);
  1012. end;
  1013.  
  1014. function TQStringList.GetCapacity : longint;
  1015. begin
  1016.   Result := FList.Capacity;
  1017. end;
  1018.  
  1019. function TQStringList.GetCount : longint;
  1020. begin
  1021.   Result := FList.Count;
  1022. end;
  1023.  
  1024. function TQStringList.GetName(Index : longint) : string;
  1025. var
  1026.   p : integer;
  1027. begin
  1028.   Result := Get(Index);
  1029.   p := Pos('=', Result);
  1030.   {$IFDEF WIN32}
  1031.   if p <> 0 then
  1032.     SetLength(Result, p - 1)
  1033.   else
  1034.     SetLength(Result, 0);
  1035.   {$ELSE}
  1036.   if p <> 0 then
  1037.     Result[0] := char(p - 1)
  1038.   else
  1039.     Result[0] := #0;
  1040.   {$ENDIF}
  1041. end;
  1042.  
  1043. function TQStringList.GetObject(Index : longint) : TObject;
  1044. begin
  1045.   if (Index < 0) or (Index >= FList.Count) then
  1046.     Error(SListIndexError, Index);
  1047.   Result := PStrItem(FList[Index])^.FObject;
  1048. end;
  1049.  
  1050. function TQStringList.GetText : pchar;
  1051. var
  1052.   i, size : longint;
  1053.   p : pchar;
  1054. begin
  1055.   { how big must the text be }
  1056.   size := 1;                                      { for the trailing #0 byte }
  1057.   for i := 0 to Count - 1 do
  1058.     size := size + StrLen(PStrItem(FList.Items[i])^.FString) + 2; { for the CR-LF }
  1059.   Result := GlobalAllocPtr(GMem_Fixed or GMem_Share, size);
  1060.   if Result = nil then
  1061.     OutOfMemoryError;
  1062.   { then copy all the strings into the result }
  1063.   p := Result;
  1064.   for i := 0 to Count - 1 do
  1065.     p := CopyLine(p, PStrItem(FList.Items[i])^.FString);
  1066.   p[0] := NUL;
  1067. end;
  1068.  
  1069. function TQStringList.GetTextStr : string;
  1070. begin
  1071.   Result := StrPas(GetText);
  1072. end;
  1073.  
  1074. function TQStringList.GetValue(const Name : string) : string;
  1075. var
  1076.   i : longint;
  1077. begin
  1078.   i := IndexOfName(Name);
  1079.   if i >= 0 then
  1080.     Result := Copy(Get(i), Length(Name) + 2, MaxInt)
  1081.   else
  1082.     Result := '';
  1083. end;
  1084.  
  1085. function TQStringList.GetValueByIndex(Index : longint) : string;
  1086. var
  1087.   p : integer;
  1088.   S : string;
  1089. begin
  1090.   if (Index < 0) or (Index >= FList.Count) then
  1091.     Error(SListIndexError, Index);
  1092.   S := Get(Index);
  1093.   p := Pos('=', S);
  1094.   if p <> 0 then
  1095.     Result := Copy(S, p + 1, MaxInt)
  1096.   else
  1097.     Result := '';
  1098. end;
  1099.  
  1100. function TQStringList.IndexOf(const S : string) : longint;
  1101. begin
  1102.   if not Sorted then
  1103.   begin
  1104.     for Result := 0 to FList.Count - 1 do
  1105.       if AnsiCompareText(Get(Result), S) = 0 then
  1106.         exit;
  1107.     Result := -1;
  1108.   end
  1109.   else
  1110.     if not Find(S, Result) then
  1111.       Result := -1;
  1112. end;
  1113.  
  1114. function TQStringList.IndexOfName(const Name : string) : longint;
  1115. var
  1116.   p : longint;
  1117.   S : string;
  1118. begin
  1119.   for Result := 0 to FList.Count - 1 do
  1120.   begin
  1121.     S := Get(Result);
  1122.     p := Pos('=', S);
  1123.     if FCaseSensitive then
  1124.     begin
  1125.       if (p <> 0) and (AnsiCompareStr(Copy(S, 1, p - 1), Name) = 0) then
  1126.         exit;
  1127.     end
  1128.     else
  1129.     begin
  1130.       if (p <> 0) and (AnsiCompareText(Copy(S, 1, p - 1), Name) = 0) then
  1131.         exit;
  1132.     end;
  1133.   end;
  1134.   Result := -1;
  1135. end;
  1136.  
  1137. function TQStringList.IndexOfObject(AObject : TObject) : longint;
  1138. begin
  1139.   for Result := 0 to GetCount - 1 do
  1140.     if GetObject(Result) = AObject then
  1141.       exit;
  1142.   Result := -1;
  1143. end;
  1144.  
  1145. procedure TQStringList.Insert(Index : longint; const S : string);
  1146. begin
  1147.   if Sorted then
  1148.     Error(SSortedListError, 0);
  1149.   if (Index < 0) or (Index > FList.Count) then
  1150.     Error(SListIndexError, Index);
  1151.   Changing;
  1152.   FList.Insert(Index, NewStrItem(S, nil));
  1153.   Changed;
  1154. end;
  1155.  
  1156. procedure TQStringList.InsertObject(Index : longint; const S : string; AObject : TObject);
  1157. begin
  1158.   if Sorted then
  1159.     Error(SSortedListError, 0);
  1160.   if (Index < 0) or (Index > FList.Count) then
  1161.     Error(SListIndexError, Index);
  1162.   Changing;
  1163.   FList.Insert(Index, NewStrItem(S, AObject));
  1164.   Changed;
  1165. end;
  1166.  
  1167. procedure TQStringList.LoadFromFile(const FileName : string);
  1168. var
  1169.   Stream : TStream;
  1170. begin
  1171.   Stream := TFileStream.Create(FileName, fmOpenRead);
  1172.   try
  1173.     LoadFromStream(Stream);
  1174.   finally
  1175.     Stream.Free;
  1176.   end;
  1177. end;
  1178.  
  1179. procedure TQStringList.LoadFromStream(Stream : TStream);
  1180. const
  1181.   BufSize = 8192;
  1182. var
  1183.   Len : longint;
  1184.   Buffer, BufPtr, BufEnd, BufLast : pchar;
  1185.   LineLast : pchar;
  1186.   S : string;
  1187. begin
  1188.   BeginUpdate;
  1189.   try
  1190.     Clear;
  1191.     GetMem(Buffer, BufSize);
  1192.     try
  1193.       BufEnd := Buffer + BufSize;
  1194.       BufLast := BufEnd;
  1195.       LineLast := BufLast;
  1196.       repeat
  1197.         { Copy the last partial line to the start of the buffer }
  1198.         Len := BufLast - LineLast;
  1199.         if Len <> 0 then
  1200.           System.Move(LineLast^, Buffer^, Len);
  1201.         BufLast := Buffer + Len;
  1202.         { fill the rest of the buffer }
  1203.         BufLast := BufLast + Stream.Read(BufLast^, BufEnd - BufLast);
  1204.         { find the last end-of-line in the buffer }
  1205.         LineLast := BufLast;
  1206.         while LineLast > Buffer do
  1207.         begin
  1208.           dec(LineLast);
  1209.           if LineLast^ in [NUL, LF, CR, EoF] then
  1210.             Break;
  1211.         end;
  1212.         if LineLast^ = CR then
  1213.           inc(LineLast);
  1214.         if LineLast^ = LF then
  1215.           inc(LineLast);
  1216.         { Now split the buffer into lines }
  1217.         BufPtr := Buffer;
  1218.         while (BufPtr < LineLast) and (LineLast > Buffer) do
  1219.         begin
  1220.           BufPtr := ExtractLine(BufPtr, S);
  1221.           Add(S);
  1222.         end;
  1223.       until BufLast = Buffer;
  1224.     finally
  1225.       FreeMem(Buffer, BufSize);
  1226.     end;
  1227.   finally
  1228.     EndUpdate;
  1229.   end;
  1230. end;
  1231.  
  1232. procedure TQStringList.Move(CurIndex, NewIndex : longint);
  1233. begin
  1234.   Changing;
  1235.   FList.Move(CurIndex, NewIndex);
  1236.   Changed;
  1237. end;
  1238.  
  1239. procedure TQStringList.Put(Index : longint; const S : string);
  1240. var
  1241.   p : PStrItem;
  1242. begin
  1243.   if Sorted then
  1244.     Error(SSortedListError, 0);
  1245.   if (Index < 0) or (Index >= FList.Count) then
  1246.     Error(SListIndexError, Index);
  1247.   Changing;
  1248.   p := FList[Index];
  1249.   FList[Index] := NewStrItem(S, p^.FObject);
  1250.   DisposeStrItem(p);
  1251.   Changed;
  1252. end;
  1253.  
  1254. procedure TQStringList.PutObject(Index : longint; AObject : TObject);
  1255. var
  1256.   p : PStrItem;
  1257. begin
  1258.   if (Index < 0) or (Index >= FList.Count) then
  1259.     Error(SListIndexError, Index);
  1260.   Changing;
  1261.   p := FList[Index];
  1262.   FList[Index] := NewStrItem(Strings[Index], AObject);
  1263.   DisposeStrItem(p);
  1264.   Changed;
  1265. end;
  1266.  
  1267. procedure TQStringList.QuickSortA(L, R : longint);
  1268. var
  1269.   i, j : longint;
  1270.   p : string;
  1271. begin
  1272.   repeat
  1273.     i := L;
  1274.     j := R;
  1275.     p := StrPas(PStrItem(FList[(L + R) shr 1])^.FString);
  1276.     repeat
  1277.       while AnsiCompareText(StrPas(PStrItem(FList[i])^.FString), p) < 0 do
  1278.         inc(i);
  1279.       while AnsiCompareText(StrPas(PStrItem(FList[j])^.FString), p) > 0 do
  1280.         dec(j);
  1281.       if i <= j then
  1282.       begin
  1283.         FList.Exchange(i, j);
  1284.         inc(i);
  1285.         dec(j);
  1286.       end;
  1287.     until i > j;
  1288.     if L < j then
  1289.       QuickSortA(L, j);
  1290.     L := i;
  1291.   until i >= R;
  1292. end;
  1293.  
  1294. procedure TQStringList.QuickSortB(L, R : longint);
  1295. var
  1296.   i, j : longint;
  1297.   p : string;
  1298. begin
  1299.   repeat
  1300.     i := L;
  1301.     j := R;
  1302.     p := StrPas(PStrItem(FList[(L + R) shr 1])^.FString);
  1303.     repeat
  1304.       while AnsiCompareStr(StrPas(PStrItem(FList[i])^.FString), p) < 0 do
  1305.         inc(i);
  1306.       while AnsiCompareStr(StrPas(PStrItem(FList[j])^.FString), p) > 0 do
  1307.         dec(j);
  1308.       if i <= j then
  1309.       begin
  1310.         FList.Exchange(i, j);
  1311.         inc(i);
  1312.         dec(j);
  1313.       end;
  1314.     until i > j;
  1315.     if L < j then
  1316.       QuickSortB(L, j);
  1317.     L := i;
  1318.   until i >= R;
  1319. end;
  1320.  
  1321. procedure TQStringList.ReadData(Reader : TReader);
  1322. begin
  1323.   Reader.ReadListBegin;
  1324.   BeginUpdate;
  1325.   try
  1326.     Clear;
  1327.     while not Reader.EndOfList do
  1328.       Add(Reader.ReadString);
  1329.   finally
  1330.     EndUpdate;
  1331.   end;
  1332.   Reader.ReadListEnd;
  1333. end;
  1334.  
  1335.  
  1336. procedure TQStringList.Reverse(SetSorted : boolean);
  1337. var
  1338.   n, m : longint;
  1339. begin
  1340.   if Sorted then
  1341.     exit;
  1342.   n := 1;
  1343.   m := FList.Count;
  1344.   while n < m do
  1345.   begin
  1346.     FList.Exchange(n - 1, m - 1);
  1347.     inc(n);
  1348.     dec(m);
  1349.   end;
  1350.   if SetSorted then
  1351.     FSorted := true;
  1352. end;
  1353.  
  1354. procedure TQStringList.SaveToFile(const FileName : string);
  1355. var
  1356.   Stream : TStream;
  1357. begin
  1358.   Stream := TFileStream.Create(FileName, fmCreate);
  1359.   try
  1360.     SaveToStream(Stream);
  1361.   finally
  1362.     Stream.Free;
  1363.   end;
  1364. end;
  1365.  
  1366. procedure TQStringList.SaveToStream(Stream : TStream);
  1367. const
  1368.   BufSize = 8192;
  1369. var
  1370.   i : longint;
  1371.   Buffer, BufPtr : pchar;
  1372. begin
  1373.   GetMem(Buffer, BufSize);
  1374.   try
  1375.     BufPtr := Buffer;
  1376.     for i := 0 to Count - 1 do
  1377.     begin
  1378.       { Is there room for a string + CRLF? }
  1379.       if BufPtr - Buffer >= BufSize - 256 then
  1380.       begin
  1381.         Stream.WriteBuffer(Buffer[0], BufPtr - Buffer);
  1382.         BufPtr := Buffer;
  1383.       end;
  1384.       StrCopy(BufPtr, PStrItem(FList.Items[i])^.FString);
  1385.       inc(BufPtr, StrLen(PStrItem(FList.Items[i])^.FString));
  1386.       BufPtr[0] := CR;
  1387.       BufPtr[1] := LF;
  1388.       inc(BufPtr, 2);
  1389.     end;
  1390.     Stream.WriteBuffer(Buffer[0], BufPtr - Buffer);
  1391.   finally
  1392.     FreeMem(Buffer, BufSize);
  1393.   end;
  1394. end;
  1395.  
  1396. procedure TQStringList.SetCapacity(NewCapacity : longint);
  1397. begin
  1398.   FList.Capacity := NewCapacity;
  1399. end;
  1400.  
  1401. procedure TQStringList.SetCaseSensitive(Value : boolean);
  1402. var
  1403.   n : longint;
  1404. begin
  1405.   if Count = 0 then
  1406.     FCaseSensitive := Value;
  1407.   if FCaseSensitive <> Value then
  1408.   begin
  1409.     FCaseSensitive := Value;
  1410.     if not FCaseSensitive then
  1411.     begin
  1412.       {check for duplicates and delete them }
  1413.       n := Count - 1;
  1414.       while n > 0 do
  1415.       begin
  1416.         if AnsiCompareText(Get(n - 1), Get(n)) = 0 then
  1417.           Delete(n);
  1418.         dec(n);
  1419.       end;
  1420.     end;
  1421.   end;
  1422. end;
  1423.  
  1424. procedure TQStringList.SetSorted(Value : boolean);
  1425. begin
  1426.   if FSorted <> Value then
  1427.   begin
  1428.     if Value then
  1429.       Sort;
  1430.     FSorted := Value;
  1431.   end;
  1432. end;
  1433.  
  1434. procedure TQStringList.SetText(Text : pchar);
  1435. var
  1436.   S : string;
  1437. begin
  1438.   BeginUpdate;
  1439.   try
  1440.     Clear;
  1441.     while not (Text^ in [NUL, EoF]) do
  1442.     begin
  1443.       Text := ExtractLine(Text, S);
  1444.       Add(S);
  1445.     end;
  1446.   finally
  1447.     EndUpdate;
  1448.   end;
  1449. end;
  1450.  
  1451. procedure TQStringList.SetTextStr(const Value : string);
  1452. var
  1453.   p : pchar;
  1454. begin
  1455.   BeginUpdate;
  1456.   try
  1457.     p := StrAlloc(Length(Value) + 1);
  1458.     try
  1459.       StrPCopy(p, Value);
  1460.       SetText(p);
  1461.     finally
  1462.       StrDispose(p);
  1463.     end;
  1464.   finally
  1465.     EndUpdate;
  1466.   end;
  1467. end;
  1468.  
  1469. procedure TQStringList.SetUpdateState(Updating : boolean);
  1470. begin
  1471.   if Updating then
  1472.     Changing
  1473.   else
  1474.     Changed;
  1475. end;
  1476.  
  1477. procedure TQStringList.SetValue(const Name, Value : string);
  1478. var
  1479.   i : longint;
  1480. begin
  1481.   i := IndexOfName(Name);
  1482.   if Value <> '' then
  1483.   begin
  1484.     if i < 0 then
  1485.       i := Add('');
  1486.     Put(i, Name + '=' + Value);
  1487.   end
  1488.   else
  1489.   begin
  1490.     if i >= 0 then
  1491.       Delete(i);
  1492.   end;
  1493. end;
  1494.  
  1495. procedure TQStringList.SetValueByIndex(Index : longint; const Value : string);
  1496. begin
  1497.   if Value <> '' then
  1498.   begin
  1499.     Put(Index, GetName(Index) + '=' + Value);
  1500.   end
  1501.   else
  1502.   begin
  1503.     if Index >= 0 then
  1504.       Delete(Index);
  1505.   end;
  1506. end;
  1507.  
  1508. procedure TQStringList.Sort;
  1509. begin
  1510.   if not Sorted and (FList.Count > 1) then
  1511.   begin
  1512.     Changing;
  1513.     if FCaseSensitive then
  1514.       QuickSortB(0, FList.Count - 1)
  1515.     else
  1516.       QuickSortA(0, FList.Count - 1);
  1517.     Changed;
  1518.   end;
  1519. end;
  1520.  
  1521. procedure TQStringList.WriteData(Writer : TWriter);
  1522. var
  1523.   i : longint;
  1524. begin
  1525.   Writer.WriteListBegin;
  1526.   for i := 0 to Count - 1 do
  1527.     Writer.WriteString(Get(i));
  1528.   Writer.WriteListEnd;
  1529. end;
  1530.  
  1531.  
  1532. end.
  1533.  
  1534.