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