1 { Version 050602. Copyright � Alexey A.Chernobaev, 1996-2005 }
2 
3 unit StrLst;
4 
5 interface
6 
7 {$I VCheck.inc}
8 
9 uses
10   {$IFDEF WIN32}Windows,{$ENDIF} SysUtils,
11   ExtType, ExtSys, Vectors, Pointerv, VectStr,
12   {$IFDEF USE_STREAM64}VStrm64{$ELSE}VStream{$ENDIF}, VTxtStrm, VectErr;
13 
14 type
15   TOnCompareStrings = function (const S1, S2: String): Int32 of object;
16 
17   { ������ ����� ��� ����� �������� ��������, � ������ ����������� (�����
18     "Compare" ���������� AnsiCompareText) }
19   { string list without case sensitivity which is affected by locale ("Compare"
20     method uses AnsiCompareText) }
21   TStrLst = class(TPointerVector)
22   protected
23     procedure ClearItems(FromIndex: Integer);
24     procedure SetCount(ACount: Integer); override;
GetItemnull25     function GetItem(I: Integer): String;
26     (* {$IFDEF V_INLINE}inline;{$ENDIF}
27        - this inline doesn't speed-up (Pentium IV) *)
28     procedure SetItem(I: Integer; const Value: String);
29     (* {$IFDEF V_INLINE}inline;{$ENDIF}
30        - this inline doesn't speed-up (Pentium IV) *)
GetNamenull31     function GetName(I: Integer): String;
GetValuenull32     function GetValue(I: Integer): String;
GetTextnull33     function GetText: String;
34     procedure SetText(const AText: String);
GetCommaText2null35     function GetCommaText2: String;
GetCommaText1null36     function GetCommaText1: String;
37     procedure SetCommaText2(const Value: String);
38     procedure SetCommaText1(const Value: String);
GetLastnull39     function GetLast: String;
40     procedure SetLast(Value: String);
41   public
CreateCompatibleVectornull42     function CreateCompatibleVector: TPointerVector; override;
43     destructor Destroy; override;
44     procedure WriteToStream(VStream: TVStream); override;
45     procedure ReadFromStream(VStream: TVStream); override;
46     procedure WriteToTextStream(TextStream: TTextStream);
47     procedure ReadFromTextStream(TextStream: TTextStream);
48     procedure Assign(Source: TVector); override;
EqualTonull49     function EqualTo(V: TVector): Bool; override;
50     procedure Delete(I: Integer); override;
51     procedure DeleteRange(I, ACount: Integer); override;
52     procedure GetUntyped(I: Integer; var Result); override;
53     procedure SetUntyped(I: Integer; const Value); override;
CompareStringsnull54     class function CompareStrings(const S1, S2: String): Int32; virtual;
Comparenull55     function Compare(I: Integer; const V): Int32; override;
56     procedure SetToDefault; override;
57     procedure SetItems(Values: array of String);
58     { ������������� �������� ��������� ������ � Values (Count:=High(Values) + 1) }
59     { sets the list elements to Values (Count:=High(Values) + 1) }
60     procedure Insert(I: Integer; const Value: String); virtual;
61     { ��������� �������� Value � ������� I }
62     { inserts Value in the position I }
Addnull63     function Add(const Value: String): Integer; virtual;
64     { ��������� �������� � ����� ������ � ���������� ��� ������ (Count - 1) }
65     { appends Value to the end of the list and returns it's index (Count - 1) }
66     procedure Move(CurIndex, NewIndex: Integer); override;
67     { �������� ������� �������� CurIndex �� NewIndex }
68     { moves the element from the position CurIndex to NewIndex }
IndexFromnull69     function IndexFrom(I: Integer; const Value: String): Integer; virtual;
70     { ���������� ������ �������, ������� � I, ��������� �������� Value � ������,
71       ���� -1, ���� ������ ��������� �� ���������� }
72     { returns the index of the first occurrence of Value in the list beginning
73       from I or -1 if there's no such occurrence }
IndexOfnull74     function IndexOf(const Value: String): Integer;
75     { IndexOf(Value) = IndexFrom(0, Value) }
LastIndexFromnull76     function LastIndexFrom(I: Integer; const Value: String): Integer; virtual;
77     { ���������� ������ ���������� ��������� �������� Value � ������, �������
78       �� ��������� I, ���� -1, ���� ��� ����� ��������� }
79     { returns the index of the last occurrence of Value in the list which is not
80       greater then I or -1 if there's no such occurrence }
LastIndexOfnull81     function LastIndexOf(const Value: String): Integer;
82     { LastIndexOf(Value) = LastIndexFrom(Count - 1, Value) }
Removenull83     function Remove(const Value: String): Integer;
84     { ������� ������ ��������� Value � ������, ������� ��� ������� Delete �
85       ���������� ������ ���������� ��������, ���� -1, ���� Value �� ������� }
86     { searches for the first occurrence of Value in the list, deletes it with
87       Delete and returns the index of the deleted value or -1 if Value wasn't
88       found }
RemoveLastnull89     function RemoveLast(const Value: String): Integer;
90     { ������� ��������� ��������� Value � ������, ������� ��� ������� Delete �
91       ���������� ������ ���������� ��������, ���� -1, ���� Value �� ������� }
92     { searches for the last occurrence of Value in the list, deletes it with
93       Delete and returns the index of the deleted value or -1 if Value wasn't
94       found }
RemoveFromnull95     function RemoveFrom(I: Integer; const Value: String): Integer;
96     { ������� ������, ������� � I, ��������� Value � ������, ������� ��� �������
97       Delete � ���������� ������ ���������� ��������, ���� -1, ���� Value
98       �� ������� }
99     { searches for the first occurrence of Value in the list beginning from I,
100       deletes it with Delete and returns the index of the deleted value or -1 if
101       Value wasn't found }
RemoveLastFromnull102     function RemoveLastFrom(I: Integer; const Value: String): Integer;
103     { ������� ���������, �� �� ������ I, ��������� Value � ������ � ������� ���
104       ������� Delete, ��������� ������ ���������� ��������, ���� -1, ���� Value
105       �� ������� }
106     { searches for the last occurrence of Value in the list which is not greater
107       then I, deletes it with Delete and returns the index of the deleted value
108       or -1 if Value wasn't found }
NumberOfValuesnull109     function NumberOfValues(const Value: String): Integer;
110     { ���������� ���������� ���������, ������ Value }
111     { returns the number of elements equal to Value }
FindInSortedRangenull112     function FindInSortedRange(const Value: String; L, H: Integer): Integer;
113     { ������� ������������� �������� Value � ������������� �� �����������
114       ������, ������� � ������� L � ������ H; ���������� ����������� ������
115       ���������� ��������, ���� -1, ���� �������� �� ������� }
116     { searches for the Value in the sorted (ascending) list dichotomically
117       from the index L to H; returns the minimum index of Value or -1 if Value
118       wasn't found }
FindInSortednull119     function FindInSorted(const Value: String): Integer;
120     { ���� �������� Value � ������������� �� ����������� ������ �������������;
121       ���������� ����������� ������ ���������� ��������, ���� -1, ���� ��������
122       �� ������� }
123     { searches for the Value in the sorted (ascending) list dichotomically;
124       returns the minimum index of Value or -1 if Value wasn't found }
FindInsertPositionnull125     function FindInsertPosition(const Value: String; L, H: Integer;
126       var Index: Integer): Bool;
127     { ���� �������� Value � ������������� �� ����������� ������ �������������,
128       ������� � ������� L � ������ H; ���������� True, ���� �������� �������
129       (��� ���� Index ����� ������������ ������� ���������� ��������), �����
130       ���������� False (��� ���� Index ���������, ���� ���� �������� Value,
131       ����� ������ ������� �������������) }
132     { searches for the Value in the sorted (ascending) list dichotomically
133       from the index L to H; returns True if Value was found (in such case Index
134       is equal to the minimum index of Value), otherwise returns False (in such
135       case Index is equal to the position where Value can be inserted so that
136       the list remains sorted) }
Findnull137     function Find(const Value: String; var Index: Integer): Bool;
138     { ������ FindInsertPosition ��� ����� ������}
139     { analog of FindInsertPosition for the whole list }
140     procedure AddStrings(List: TStrLst);
141     { �������� ������ List }
142     { adds strings List }
Popnull143     function Pop: String;
144     { ���������� ��������� ������� ������ (������� �� ������ ���� ������)
145       � ������� ��� (�.�. ��������� ����� ������ �� �������) }
146     { returns the last element of the list (which must be non-empty) and removes
147       it (i.e. decreases the length of the list by one) }
148     procedure ConcatenateWith(V: TPointerVector); override;
149     procedure FreeItems; override;
GetCommaTextnull150     function GetCommaText(DoubleQuote: Bool; Delimiter: Char;
151       DelimChars: TCharSet): String;
152     procedure SetCommaText(const Value: String; QuoteChar: Char;
153       const DelimChars: TCharSet; AddEmpty: Bool);
Equalsnull154     function Equals(Strings: TStrLst): Bool;
155     { ���������� ������ Self �� �������� Strings }
156     { compares strings in Self with strings in Strings }
157     property CommaText: String read GetCommaText2 write SetCommaText2;
158     { ������������ ������ � ���� ������, ��������� �� ���� ��� ���������,
159       ������� ��������� �������� � ��������� � ������� �������, ���� � �������
160       ������ �������, �������� �� ��������� ����, ���� � ���� ������ ��������
161       (��. CheckText � ������ VectStr) }
162     { presents the list as a single comma-delimited string where the list
163       elements are separated with commas and enclosed in the double quotes if
164       they contain characters other then the Latin letters, digits and several
165       other characters (see ChectText in the unit VectStr) }
166     property CommaText1: String read GetCommaText1 write SetCommaText1;
167     { ������������ ������ � ���� ������, ��������� �� ���� ��� ���������,
168       ������� ��������� �������� � ��������� � ��������� �������, ���� � �������
169       ������ �������, �������� �� ��������� ����, ���� � ���� ������ ��������
170       (��. CheckText � ������ VectStr) }
171     { presents the list as a single comma-delimited string where the list
172       elements are separated with commas and enclosed in the single quotes if
173       they contain characters other then the Latin letters, digits and several
174       other characters (see ChectText in the unit VectStr) }
175     property Items[I: Integer]: String read GetItem write SetItem; {$IFDEF V_32}default;{$ENDIF}
176     property Strings[I: Integer]: String read GetItem write SetItem; { for compatibility }
177     property Names[I: Integer]: String read GetName;
178     property Values[I: Integer]: String read GetValue;
179     property Text: String read GetText write SetText;
180     property Last: String read GetLast write SetLast;
181     { ���������� ��� ������������� ��������� ������� ������ (������ �� ������
182       ���� ������) }
183     { gets or sets the last element of the list (the list must not be empty) }
184     procedure DebugWrite;
185     { ���������� ������; ��� ������ ���������� ���������� � �����������
186       Win32-����������� ���������� ������� ������� � ������� AllocConsole }
187     { debug write; to use in Win32 GUI applications it's necessary to create
188       console with AllocConsole }
189   end;
190 
191   TStrLstClass = class of TStrLst;
192 
193   { ������ ����� � ������ �������� ��������, �� ��� ����� ����������� (�����
194     "Compare" ���������� CompareText) }
195   { string list without case sensitivity which is not affected by locale
196     ("Compare" method uses CompareText) }
197   TASCIIStrLst = class(TStrLst)
CreateCompatibleVectornull198     function CreateCompatibleVector: TPointerVector; override;
CompareStringsnull199     class function CompareStrings(const S1, S2: String): Int32; override;
200   end;
201 
202   TASCIIStrLstClass = class of TASCIIStrLst;
203 
204   { ������ ����� � ������ �������� �������� � ����������� (����� "Compare"
205     ���������� AnsiCompareStr) }
206   { string list with case sensitivity which is affected by locale ("Compare"
207     method uses AnsiCompareStr) }
208   TCaseSensStrLst = class(TStrLst)
CreateCompatibleVectornull209     function CreateCompatibleVector: TPointerVector; override;
CompareStringsnull210     class function CompareStrings(const S1, S2: String): Int32; override;
211   end;
212 
213   TCaseSensStrLstClass = class of TCaseSensStrLst;
214 
215   { ������ ����� � ������ �������� ��������, �� ��� ����� ����������� (�����
216     "Compare" ���������� CompareStr) }
217   { string list without case sensitivity which is not affected by locale
218     ("Compare" method uses CompareStr) }
219   TExactStrLst = class(TStrLst)
CreateCompatibleVectornull220     function CreateCompatibleVector: TPointerVector; override;
CompareStringsnull221     class function CompareStrings(const S1, S2: String): Int32; override;
222   end;
223 
224   TExactStrLstClass = class of TExactStrLst;
225 
226   { ������ ����� � ������������ ������������� �������� ��������� ����� }
227   { string list with user-defined string compare method }
228   TUserCompareStrLst = class(TStrLst)
229     OnCompareStrings: TOnCompareStrings;
230     procedure Assign(Source: TVector); override;
Comparenull231     function Compare(I: Integer; const V): Int32; override;
CreateCompatibleVectornull232     function CreateCompatibleVector: TPointerVector; override;
CompareStringsnull233     class function CompareStrings(const S1, S2: String): Int32; override;
234   end;
235 
236   TUserCompareStrLstClass = class of TUserCompareStrLst;
237 
238   TSortedStrLst = class(TStrLst)
CreateCompatibleVectornull239     function CreateCompatibleVector: TPointerVector; override;
240     procedure Insert(I: Integer; const Value: String); override;
Addnull241     function Add(const Value: String): Integer; override;
242     procedure Move(CurIndex, NewIndex: Integer); override;
IndexFromnull243     function IndexFrom(I: Integer; const Value: String): Integer; override;
LastIndexFromnull244     function LastIndexFrom(I: Integer; const Value: String): Integer; override;
245   end;
246 
247   TSortedStrLstClass = class of TSortedStrLst;
248 
249   TASCIISortedStrLst = class(TSortedStrLst)
CreateCompatibleVectornull250     function CreateCompatibleVector: TPointerVector; override;
CompareStringsnull251     class function CompareStrings(const S1, S2: String): Int32; override;
252   end;
253 
254   TASCIISortedStrLstClass = class of TASCIISortedStrLst;
255 
256   TCaseSensSortedStrLst = class(TSortedStrLst)
CreateCompatibleVectornull257     function CreateCompatibleVector: TPointerVector; override;
CompareStringsnull258     class function CompareStrings(const S1, S2: String): Int32; override;
259   end;
260 
261   TCaseSensSortedStrLstClass = class of TCaseSensSortedStrLst;
262 
263   TExactSortedStrLst = class(TSortedStrLst)
CreateCompatibleVectornull264     function CreateCompatibleVector: TPointerVector; override;
CompareStringsnull265     class function CompareStrings(const S1, S2: String): Int32; override;
266   end;
267 
268   TExactSortedStrLstClass = class of TExactSortedStrLst;
269 
270   { ������ ����� � ���������������� ��������� }
271   { string list with associated objects }
272 
273   TString = String;
274 
275   TStrObj = class(TStrLst)
276   {$I StrObj.def}
277 
278   TStrLstObj = TStrObj;
279 
280   TStrLstObjClass = class of TStrLstObj;
281 
282   TASCIIStrLstObj = class(TStrLstObj)
CreateCompatibleVectornull283     function CreateCompatibleVector: TPointerVector; override;
CompareStringsnull284     class function CompareStrings(const S1, S2: String): Int32; override;
285   end;
286 
287   TASCIIStrLstObjClass = class of TASCIIStrLstObj;
288 
289   TCaseSensStrLstObj = class(TStrLstObj)
CreateCompatibleVectornull290     function CreateCompatibleVector: TPointerVector; override;
CompareStringsnull291     class function CompareStrings(const S1, S2: String): Int32; override;
292   end;
293 
294   TCaseSensStrLstObjClass = class of TCaseSensStrLstObj;
295 
296   TExactStrLstObj = class(TStrLstObj)
CreateCompatibleVectornull297     function CreateCompatibleVector: TPointerVector; override;
CompareStringsnull298     class function CompareStrings(const S1, S2: String): Int32; override;
299   end;
300 
301   TExactStrLstObjClass = class of TExactStrLstObj;
302 
303   TUserCompareStrLstObj = class(TStrLstObj)
304     OnCompareStrings: TOnCompareStrings;
Comparenull305     function Compare(I: Integer; const V): Int32; override;
306     procedure Assign(Source: TVector); override;
CreateCompatibleVectornull307     function CreateCompatibleVector: TPointerVector; override;
CompareStringsnull308     class function CompareStrings(const S1, S2: String): Int32; override;
309   end;
310 
311   TUserCompareStrLstObjClass = class of TUserCompareStrLstObj;
312 
313 implementation
314 
315 { TStrLst }
316 
317 procedure TStrLst.ClearItems(FromIndex: Integer);
318 var
319   I: Integer;
320 begin
321   for I:=FromIndex to Count - 1 do
322     Items[I]:='';
323 end;
324 
325 procedure TStrLst.SetCount(ACount: Integer);
326 begin
327   if ACount < Count then
328     ClearItems(ACount);
329   inherited SetCount(ACount);
330 end;
331 
GetItemnull332 function TStrLst.GetItem(I: Integer): String;
333 var
334   P: PVString;
335 begin
336   {$IFDEF CHECK_VECTORS}
337   if (I < 0) or (I >= Count) then ErrorFmt(SRangeError_d, [I]);
338   {$ENDIF}
339   P:=PPointerArray(FItems)^[I];
340   if P <> nil then
341     Result:=P^
342   else
343     Result:='';
344 end;
345 
346 procedure TStrLst.SetItem(I: Integer; const Value: String);
347 begin
348   {$IFDEF CHECK_VECTORS}
349   if (I < 0) or (I >= Count) then ErrorFmt(SRangeError_d, [I]);
350   {$ENDIF}
351   DisposeVStr(PPointerArray(FItems)^[I]);
352   PPointerArray(FItems)^[I]:=NewVStr(Value);
353 end;
354 
GetNamenull355 function TStrLst.GetName(I: Integer): String;
356 begin
357   Result:=Items[I];
358   I:=CharPos('=', Result, 1);
359   if I > 0 then
360     Dec(I);
361   SetLength(Result, I);
362 end;
363 
TStrLst.GetValuenull364 function TStrLst.GetValue(I: Integer): String;
365 begin
366   Result:=Items[I];
367   I:=CharPos('=', Result, 1);
368   if I > 0 then
369     System.Delete(Result, 1, I)
370   else
371     Result:='';
372 end;
373 
GetTextnull374 function TStrLst.GetText: String;
375 var
376   I, L, N, Sz: Integer;
377   P: PChar;
378   S: String;
379 begin
380   N:=Count;
381   Sz:=0;
382   for I:=0 to N - 1 do
383     Inc(Sz, Length(Items[I]));
384   Inc(Sz, N{$IFNDEF UNIX} * 2{$ENDIF});
385   SetLength(Result, Sz);
386   {$IFDEF V_LONGSTRINGS}
387   P:=Pointer(Result);
388   {$ELSE}
389   P:=@Result[1];
390   {$ENDIF}
391   for I:=0 to N - 1 do begin
392     S:=Items[I];
393     L:=Length(S);
394     if L <> 0 then begin
395       System.Move({$IFDEF V_LONGSTRINGS}Pointer(S)^{$ELSE}S[1]{$ENDIF}, P^, L);
396       Inc(P, L);
397     end;
398     {$IFNDEF UNIX}
399     P^:=#13;
400     Inc(P);
401     {$ENDIF}
402     P^:=#10;
403     Inc(P);
404   end;
405 end;
406 
407 procedure TStrLst.SetText(const AText: String);
408 var
409   P, Limit, Start: PChar;
410   S: String;
411 begin
412   Clear;
413   {$IFDEF V_LONGSTRINGS}
414   P:=Pointer(AText);
415   {$ELSE}
416   P:=@AText[1];
417   {$ENDIF}
418   Limit:=P + Length(AText);
419   while P < Limit do begin
420     Start:=P;
421     repeat
422       if P^ in [#10, #13] then
423         Break;
424       Inc(P);
425     until P >= Limit;
426     SetString(S, Start, P - Start);
427     Add(S);
428     if P >= Limit then
429       Break;
430     if P^ = #13 then begin
431       Inc(P);
432       if P >= Limit then
433         Break;
434     end;
435     if P^ = #10 then
436       Inc(P);
437   end;
438 end;
439 
TStrLst.GetCommaText2null440 function TStrLst.GetCommaText2: String;
441 begin
442   Result:=GetCommaText(True, ',', []);
443 end;
444 
TStrLst.GetCommaText1null445 function TStrLst.GetCommaText1: String;
446 begin
447   Result:=GetCommaText(False, ',', []);
448 end;
449 
450 procedure TStrLst.SetCommaText2(const Value: String);
451 begin
452   SetCommaText(Value, '"', [','], True);
453 end;
454 
455 procedure TStrLst.SetCommaText1(const Value: String);
456 begin
457   SetCommaText(Value, '''', [','], True);
458 end;
459 
GetLastnull460 function TStrLst.GetLast: String;
461 begin
462   Result:=GetItem(FCount - 1);
463 end;
464 
465 procedure TStrLst.SetLast(Value: String);
466 begin
467   SetItem(FCount - 1, Value);
468 end;
469 
TStrLst.CreateCompatibleVectornull470 function TStrLst.CreateCompatibleVector: TPointerVector;
471 begin
472   Result:=TStrLst.Create;
473 end;
474 
475 destructor TStrLst.Destroy;
476 begin
477   ClearItems(0);
478   inherited Destroy;
479 end;
480 
481 procedure TStrLst.WriteToStream(VStream: TVStream);
482 var
483   I: Integer;
484 begin
485   VStream.WriteInt32(FCount);
486   for I:=0 to FCount - 1 do
487     VStream.WriteString(Items[I]);
488 end;
489 
490 procedure TStrLst.ReadFromStream(VStream: TVStream);
491 var
492   I: Integer;
493 begin
494   Clear;
495   for I:=0 to VStream.ReadInt32 - 1 do
496     Add(VStream.ReadString);
497 end;
498 
499 procedure TStrLst.WriteToTextStream(TextStream: TTextStream);
500 var
501   I: Integer;
502 begin
503   for I:=0 to FCount - 1 do
504     TextStream.WriteString(Items[I]);
505 end;
506 
507 procedure TStrLst.ReadFromTextStream(TextStream: TTextStream);
508 begin
509   Clear;
510   while not TextStream.Eof do
511     Add(TextStream.ReadString);
512 end;
513 
514 procedure TStrLst.Delete(I: Integer);
515 begin
516   Items[I]:='';
517   inherited Delete(I);
518 end;
519 
520 procedure TStrLst.DeleteRange(I, ACount: Integer);
521 var
522   J: Integer;
523 begin
524   for J:=I to I + ACount - 1 do
525     Items[J]:='';
526   inherited DeleteRange(I, ACount);
527 end;
528 
529 procedure TStrLst.GetUntyped(I: Integer; var Result);
530 begin
531   PVString(Result):=inherited GetValue(I);
532 end;
533 
534 procedure TStrLst.SetUntyped(I: Integer; const Value);
535 begin
536   Items[I]:=PVString(Value)^;
537 end;
538 
TStrLst.CompareStringsnull539 class function TStrLst.CompareStrings(const S1, S2: String): Int32;
540 begin
541   {$IFDEF WIN32} { for efficiency }
542   Result:=CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, PChar(S1),
543     Length(S1), PChar(S2), Length(S2)) - 2;
544   {$ELSE}
545   Result:=AnsiCompareText(S1, S2);
546   {$ENDIF}
547 end;
548 
Comparenull549 function TStrLst.Compare(I: Integer; const V): Int32;
550 var
551   S: String;
552 begin
553   if PVString(V) <> nil then
554     S:=PVString(V)^
555   else
556     S:='';
557   Result:=CompareStrings(Items[I], S);
558 end;
559 
560 procedure TStrLst.SetToDefault;
561 begin
562   ClearItems(0);
563 end;
564 
565 procedure TStrLst.SetItems(Values: array of String);
566 var
567   I: Integer;
568 begin
569   Count:=High(Values) + 1;
570   for I:=0 to High(Values) do
571     Items[I]:=Values[I];
572 end;
573 
574 procedure TStrLst.Insert(I: Integer; const Value: String);
575 begin
576   inherited Insert(I, nil);
577   PPointerArray(FItems)^[I]:=NewVStr(Value);
578 end;
579 
Addnull580 function TStrLst.Add(const Value: String): Integer;
581 begin
582   Result:=Count;
583   Insert(Result, Value);
584 end;
585 
586 procedure TStrLst.Move(CurIndex, NewIndex: Integer);
587 var
588   T: String;
589 begin
590   if CurIndex <> NewIndex then begin
591     T:=Items[CurIndex];
592     Delete(CurIndex);
593     Insert(NewIndex, T);
594   end;
595 end;
596 
IndexFromnull597 function TStrLst.IndexFrom(I: Integer; const Value: String): Integer;
598 var
599   ACount: Integer;
600   P: PVString;
601 begin
602   Result:=I;
603   ACount:=Count;
604   P:=@Value;
605   while Result < ACount do begin
606     if Compare(Result, P) = 0 then
607       Exit;
608     Inc(Result);
609   end;
610   Result:=-1;
611 end;
612 
TStrLst.IndexOfnull613 function TStrLst.IndexOf(const Value: String): Integer;
614 begin
615   Result:=IndexFrom(0, Value);
616 end;
617 
LastIndexFromnull618 function TStrLst.LastIndexFrom(I: Integer; const Value: String): Integer;
619 var
620   P: PVString;
621 begin
622   P:=@Value;
623   Result:=I;
624   while Result >= 0 do begin
625     if Compare(Result, P) = 0 then
626       Exit;
627     Dec(Result);
628   end;
629 end;
630 
LastIndexOfnull631 function TStrLst.LastIndexOf(const Value: String): Integer;
632 begin
633   Result:=LastIndexFrom(Count - 1, Value);
634 end;
635 
TStrLst.Removenull636 function TStrLst.Remove(const Value: String): Integer;
637 begin
638   Result:=IndexOf(Value);
639   if Result >= 0 then
640     Delete(Result);
641 end;
642 
RemoveLastnull643 function TStrLst.RemoveLast(const Value: String): Integer;
644 begin
645   Result:=LastIndexOf(Value);
646   if Result >= 0 then
647     Delete(Result);
648 end;
649 
RemoveFromnull650 function TStrLst.RemoveFrom(I: Integer; const Value: String): Integer;
651 begin
652   Result:=IndexFrom(I, Value);
653   if Result >= 0 then
654     Delete(Result);
655 end;
656 
TStrLst.RemoveLastFromnull657 function TStrLst.RemoveLastFrom(I: Integer; const Value: String): Integer;
658 begin
659   Result:=LastIndexFrom(I, Value);
660   if Result >= 0 then
661     Delete(Result);
662 end;
663 
NumberOfValuesnull664 function TStrLst.NumberOfValues(const Value: String): Integer;
665 var
666   I: Integer;
667   P: PVString;
668 begin
669   P:=@Value;
670   Result:=0;
671   for I:=0 to Count - 1 do
672     if Compare(I, P) = 0 then
673       Inc(Result);
674 end;
675 
TStrLst.FindInsertPositionnull676 function TStrLst.FindInsertPosition(const Value: String; L, H: Integer;
677   var Index: Integer): Bool;
678 var
679   I, C: Integer;
680   P: PVString;
681 begin
682   Result:=False;
683   P:=@Value;
684   while L <= H do begin
685     I:=(L + H) div 2;
686     C:=Compare(I, P);
687     if C < 0 then
688       L:=I + 1
689     else begin
690       H:=I - 1;
691       if C = 0 then
692         Result:=True;
693     end;
694   end;
695   Index:=L;
696 end;
697 
TStrLst.Findnull698 function TStrLst.Find(const Value: String; var Index: Integer): Bool;
699 begin
700   Result:=FindInsertPosition(Value, 0, FCount - 1, Index);
701 end;
702 
TStrLst.FindInSortedRangenull703 function TStrLst.FindInSortedRange(const Value: String; L, H: Integer): Integer;
704 begin
705   if not FindInsertPosition(Value, L, H, Result) then
706     Result:=-1;
707 end;
708 
FindInSortednull709 function TStrLst.FindInSorted(const Value: String): Integer;
710 begin
711   if not FindInsertPosition(Value, 0, FCount - 1, Result) then
712     Result:=-1;
713 end;
714 
715 procedure TStrLst.Assign(Source: TVector);
716 var
717   I: Integer;
718 begin
719   if not (Source is TStrLst) then
720     Error(SAssignError);
721   Count:=Source.Count;
722   for I:=0 to Count - 1 do
723     Items[I]:=TStrLst(Source).Items[I];
724 end;
725 
TStrLst.EqualTonull726 function TStrLst.EqualTo(V: TVector): Bool;
727 var
728   I: Integer;
729 begin
730   if not (V is TStrLst) then
731     Error(SIncompatibleClasses);
732   Result:=False;
733   if FCount = V.Count then begin
734     for I:=0 to FCount - 1 do
735       if Compare(I, PPointerArray(TStrLst(V).FItems)^[I]) <> 0 then
736         Exit;
737     Result:=True;
738   end;
739 end;
740 
741 procedure TStrLst.AddStrings(List: TStrLst);
742 begin
743   ConcatenateWith(List);
744 end;
745 
Popnull746 function TStrLst.Pop: String;
747 var
748   N: Integer;
749 begin
750   N:=Count - 1;
751   Result:=Items[N];
752   Count:=N;
753 end;
754 
755 procedure TStrLst.ConcatenateWith(V: TPointerVector);
756 var
757   I: Integer;
758 begin
759   if not (V is TStrLst) then
760     Error(SIncompatibleClasses);
761   for I:=0 to TStrLst(V).Count - 1 do
762     Add(TStrLst(V).Items[I]);
763 end;
764 
765 procedure TStrLst.FreeItems;
766 begin
767   Error(SMethodNotApplicable);
768 end;
769 
TStrLst.GetCommaTextnull770 function TStrLst.GetCommaText(DoubleQuote: Bool; Delimiter: Char;
771   DelimChars: TCharSet): String;
772 type
773   TFunc = function (const S: String): String;
774 var
775   I: Integer;
776   S: String;
777   Func1, Func2: TFunc;
778 begin
779   if DoubleQuote then begin
780     Func1:=TextToLiteral2;
781     Func2:=StringToLiteral2;
782   end
783   else begin
784     Func1:=TextToLiteral;
785     Func2:=StringToLiteral;
786   end;
787   Include(DelimChars, Delimiter);
788   Result:='';
789   for I:=0 to Count - 1 do begin
790     if I > 0 then
791       Result:=Result + Delimiter;
792     S:=Items[I];
793     if ContainsChars(S, DelimChars) then
794       S:=Func2(S)
795     else
796       S:=Func1(S);
797     Result:=Result + S;
798   end;
799 end;
800 
801 procedure TStrLst.SetCommaText(const Value: String; QuoteChar: Char;
802   const DelimChars: TCharSet; AddEmpty: Bool);
803 var
804   I: Integer;
805   Delim, Quote, Coming: Bool;
806   C: Char;
807   S: String;
808 begin
809   Clear;
810   S:='';
811   Quote:=False;
812   Coming:=False;
813   for I:=1 to Length(Value) do begin
814     C:=Value[I];
815     Delim:=C in DelimChars;
816     if  Quote or not Delim then begin
817       if C = QuoteChar then
818         Quote:=not Quote;
819       S:=S + C;
820       Coming:=True;
821     end
822     else begin
823       S:=LiteralToString(S);
824       if AddEmpty or (S <> '') then
825         Add(S);
826       S:='';
827       Coming:=Delim;
828     end;
829   end;
830   if Coming and (AddEmpty or (S <> '')) then
831     Add(LiteralToString(S));
832 end;
833 
Equalsnull834 function TStrLst.Equals(Strings: TStrLst): Bool;
835 begin
836   Result:=EqualTo(Strings);
837 end;
838 
839 procedure TStrLst.DebugWrite;
840 var
841   I, N: Integer;
842 begin
843   N:=FCount - 1;
844   for I:=0 to N do begin
845     write(Items[I]);
846     if I < N then
847       write(', ')
848     else
849       writeln;
850   end;
851 end;
852 
853 { TASCIIStrLst }
854 
TASCIIStrLst.CreateCompatibleVectornull855 function TASCIIStrLst.CreateCompatibleVector: TPointerVector;
856 begin
857   Result:=TASCIIStrLst.Create;
858 end;
859 
TASCIIStrLst.CompareStringsnull860 class function TASCIIStrLst.CompareStrings(const S1, S2: String): Int32;
861 begin
862   Result:=CompareText(S1, S2);
863 end;
864 
865 { TCaseSensStrLst }
866 
TCaseSensStrLst.CreateCompatibleVectornull867 function TCaseSensStrLst.CreateCompatibleVector: TPointerVector;
868 begin
869   Result:=TCaseSensStrLst.Create;
870 end;
871 
TCaseSensStrLst.CompareStringsnull872 class function TCaseSensStrLst.CompareStrings(const S1, S2: String): Int32;
873 begin
874   {$IFDEF WIN32} { for efficiency }
875   Result:=CompareString(LOCALE_USER_DEFAULT, 0, PChar(S1), Length(S1),
876     PChar(S2), Length(S2)) - 2;
877   {$ELSE}
878   Result:=AnsiCompareStr(S1, S2);
879   {$ENDIF}
880 end;
881 
882 { TExactStrLst }
883 
TExactStrLst.CreateCompatibleVectornull884 function TExactStrLst.CreateCompatibleVector: TPointerVector;
885 begin
886   Result:=TExactStrLst.Create;
887 end;
888 
TExactStrLst.CompareStringsnull889 class function TExactStrLst.CompareStrings(const S1, S2: String): Int32;
890 begin
891   Result:=CompareStr(S1, S2);
892 end;
893 
894 { TUserCompareStrLst }
895 
896 procedure TUserCompareStrLst.Assign(Source: TVector);
897 begin
898   inherited Assign(Source);
899   if Source is TUserCompareStrLst then
900     OnCompareStrings:=TUserCompareStrLst(Source).OnCompareStrings
901   else if Source is TUserCompareStrLstObj then
902     OnCompareStrings:=TUserCompareStrLstObj(Source).OnCompareStrings;
903 end;
904 
TUserCompareStrLst.Comparenull905 function TUserCompareStrLst.Compare(I: Integer; const V): Int32;
906 var
907   S: String;
908 begin
909   if PVString(V) <> nil then
910     S:=PVString(V)^
911   else
912     S:='';
913   Result:=OnCompareStrings(Items[I], S);
914 end;
915 
TUserCompareStrLst.CreateCompatibleVectornull916 function TUserCompareStrLst.CreateCompatibleVector: TPointerVector;
917 begin
918   Result:=TUserCompareStrLst.Create;
919 end;
920 
921 {$IFDEF NOWARN}{$WARNINGS OFF}{$ENDIF}
TUserCompareStrLst.CompareStringsnull922 class function TUserCompareStrLst.CompareStrings(const S1, S2: String): Int32;
923 begin
924   Error(SMethodNotApplicable);
925 end;
926 {$IFDEF NOWARN}{$WARNINGS ON}{$ENDIF}
927 
928 { TSortedStrLst }
929 
TSortedStrLst.CreateCompatibleVectornull930 function TSortedStrLst.CreateCompatibleVector: TPointerVector;
931 begin
932   Result:=TSortedStrLst.Create;
933 end;
934 
935 procedure TSortedStrLst.Insert(I: Integer; const Value: String);
936 begin
937   Error(SMethodNotApplicable);
938 end;
939 
Addnull940 function TSortedStrLst.Add(const Value: String): Integer;
941 begin
942   if FindInsertPosition(Value, 0, FCount - 1, Result) then
943     Error(SDuplicateError)
944   else
945     inherited Insert(Result, Value);
946 end;
947 
948 procedure TSortedStrLst.Move(CurIndex, NewIndex: Integer);
949 begin
950   Error(SMethodNotApplicable);
951 end;
952 
TSortedStrLst.IndexFromnull953 function TSortedStrLst.IndexFrom(I: Integer; const Value: String): Integer;
954 begin
955   Result:=FindInSorted(Value);
956 end;
957 
LastIndexFromnull958 function TSortedStrLst.LastIndexFrom(I: Integer; const Value: String): Integer;
959 begin
960   Result:=FindInSorted(Value);
961 end;
962 
963 { TASCIISortedStrLst }
964 
TASCIISortedStrLst.CreateCompatibleVectornull965 function TASCIISortedStrLst.CreateCompatibleVector: TPointerVector;
966 begin
967   Result:=TASCIISortedStrLst.Create;
968 end;
969 
TASCIISortedStrLst.CompareStringsnull970 class function TASCIISortedStrLst.CompareStrings(const S1, S2: String): Int32;
971 begin
972   Result:=TASCIIStrLst.CompareStrings(S1, S2);
973 end;
974 
975 { TCaseSensSortedStrLst }
976 
TCaseSensSortedStrLst.CreateCompatibleVectornull977 function TCaseSensSortedStrLst.CreateCompatibleVector: TPointerVector;
978 begin
979   Result:=TCaseSensSortedStrLst.Create;
980 end;
981 
TCaseSensSortedStrLst.CompareStringsnull982 class function TCaseSensSortedStrLst.CompareStrings(const S1, S2: String): Int32;
983 begin
984   Result:=TCaseSensStrLst.CompareStrings(S1, S2);
985 end;
986 
987 { TExactSortedStrLst }
988 
TExactSortedStrLst.CreateCompatibleVectornull989 function TExactSortedStrLst.CreateCompatibleVector: TPointerVector;
990 begin
991   Result:=TExactSortedStrLst.Create;
992 end;
993 
TExactSortedStrLst.CompareStringsnull994 class function TExactSortedStrLst.CompareStrings(const S1, S2: String): Int32;
995 begin
996   Result:=TExactStrLst.CompareStrings(S1, S2);
997 end;
998 
999 { TStrLstObj }
1000 
1001 {$I StrObj.imp}
1002 
1003 { TASCIIStrLstObj }
1004 
TASCIIStrLstObj.CreateCompatibleVectornull1005 function TASCIIStrLstObj.CreateCompatibleVector: TPointerVector;
1006 begin
1007   Result:=TASCIIStrLstObj.Create;
1008 end;
1009 
TASCIIStrLstObj.CompareStringsnull1010 class function TASCIIStrLstObj.CompareStrings(const S1, S2: String): Int32;
1011 begin
1012   Result:=TASCIIStrLst.CompareStrings(S1, S2);
1013 end;
1014 
1015 { TCaseSensStrLstObj }
1016 
CreateCompatibleVectornull1017 function TCaseSensStrLstObj.CreateCompatibleVector: TPointerVector;
1018 begin
1019   Result:=TCaseSensStrLstObj.Create;
1020 end;
1021 
TCaseSensStrLstObj.CompareStringsnull1022 class function TCaseSensStrLstObj.CompareStrings(const S1, S2: String): Int32;
1023 begin
1024   Result:=TCaseSensStrLst.CompareStrings(S1, S2);
1025 end;
1026 
1027 { TExactStrLstObj }
1028 
TExactStrLstObj.CreateCompatibleVectornull1029 function TExactStrLstObj.CreateCompatibleVector: TPointerVector;
1030 begin
1031   Result:=TExactStrLstObj.Create;
1032 end;
1033 
TExactStrLstObj.CompareStringsnull1034 class function TExactStrLstObj.CompareStrings(const S1, S2: String): Int32;
1035 begin
1036   Result:=TExactStrLst.CompareStrings(S1, S2);
1037 end;
1038 
1039 { TUserCompareStrLstObj }
1040 
1041 procedure TUserCompareStrLstObj.Assign(Source: TVector);
1042 begin
1043   inherited Assign(Source);
1044   if Source is TUserCompareStrLst then
1045     OnCompareStrings:=TUserCompareStrLst(Source).OnCompareStrings
1046   else if Source is TUserCompareStrLstObj then
1047     OnCompareStrings:=TUserCompareStrLstObj(Source).OnCompareStrings;
1048 end;
1049 
TUserCompareStrLstObj.Comparenull1050 function TUserCompareStrLstObj.Compare(I: Integer; const V): Int32;
1051 var
1052   S: String;
1053 begin
1054   if PVString(V) <> nil then
1055     S:=PVString(V)^
1056   else
1057     S:='';
1058   Result:=OnCompareStrings(Items[I], S);
1059 end;
1060 
CreateCompatibleVectornull1061 function TUserCompareStrLstObj.CreateCompatibleVector: TPointerVector;
1062 begin
1063   Result:=TUserCompareStrLstObj.Create;
1064 end;
1065 
1066 {$IFDEF NOWARN}{$WARNINGS OFF}{$ENDIF}
TUserCompareStrLstObj.CompareStringsnull1067 class function TUserCompareStrLstObj.CompareStrings(const S1, S2: String): Int32;
1068 begin
1069   Error(SMethodNotApplicable);
1070 end;
1071 {$IFDEF NOWARN}{$WARNINGS ON}{$ENDIF}
1072 
1073 end.
1074