WStrings.pas
上传用户:yjb1804
上传日期:2021-01-30
资源大小:3105k
文件大小:18k
源码类别:

Email服务器

开发平台:

Delphi

  1. unit WStrings;
  2. interface
  3. uses
  4.   Classes, SysUtils, ComCtrls;
  5. type
  6.   TWStrings = class(TPersistent)
  7.   private
  8.     FUpdateCount: Integer;
  9.     function GetName(Index: Integer): WideString;
  10.     function GetValue(const Name: WideString): WideString;
  11.     procedure SetValue(const Name, Value: WideString);
  12.   protected
  13.     procedure Error(const Msg: String; Data: Integer);
  14.     function Get(Index: Integer): WideString; virtual; abstract;
  15.     function GetCapacity: Integer; virtual;
  16.     function GetCount: Integer; virtual; abstract;
  17.     function GetObject(Index: Integer): TObject; virtual;
  18.     function GetTextStr: WideString; virtual;
  19.     procedure Put(Index: Integer; const S: WideString); virtual;
  20.     procedure PutObject(Index: Integer; AObject: TObject); virtual;
  21.     procedure SetCapacity(NewCapacity: Integer); virtual;
  22.     procedure SetTextStr(const Value: WideString); virtual;
  23.     procedure SetUpdateState(Updating: Boolean); virtual;
  24.   public
  25.     function Add(const S: WideString): Integer; virtual;
  26.     function AddObject(const S: WideString; AObject: TObject): Integer; virtual;
  27.     procedure Append(const S: WideString);
  28.     procedure AddStrings(WStrings: TWStrings); virtual;
  29.     procedure Assign(Source: TPersistent); override;
  30.     procedure BeginUpdate;
  31.     procedure Clear; virtual; abstract;
  32.     procedure Delete(Index: Integer); virtual; abstract;
  33.     procedure EndUpdate;
  34.     function Equals(WStrings: TWStrings): Boolean;
  35.     procedure Exchange(Index1, Index2: Integer); virtual;
  36.     function IndexOf(const S: WideString): Integer; virtual;
  37.     function IndexOfName(const Name: WideString): Integer;
  38.     function IndexOfObject(AObject: TObject): Integer;
  39.     procedure Insert(Index: Integer; const S: WideString); virtual; abstract;
  40.     procedure InsertObject(Index: Integer; const S: WideString;
  41.       AObject: TObject);
  42.     procedure LoadFromFile(const FileName: String); virtual;
  43.     procedure LoadFromStream(Stream: TStream); virtual;
  44.     procedure Move(CurIndex, NewIndex: Integer); virtual;
  45.     procedure SaveToFile(const FileName: String); virtual;
  46.     procedure SaveToStream(Stream: TStream); virtual;
  47.     property Capacity: Integer read GetCapacity write SetCapacity;
  48.     property Count: Integer read GetCount;
  49.     property Names[Index: Integer]: WideString read GetName;
  50.     property Objects[Index: Integer]: TObject read GetObject write PutObject;
  51.     property Values[const Name: WideString]: WideString read GetValue write SetValue;
  52.     property Strings[Index: Integer]: WideString read Get write Put; default;
  53.     property Text: WideString read GetTextStr write SetTextStr;
  54.   end;
  55.   PWStringItem = ^TWStringItem;
  56.   TWStringItem = record
  57.     FString: WideString;
  58.     FObject: TObject;
  59.   end;
  60.   PWStringItemList = ^TWStringItemList;
  61.   TWStringItemList = array[0..MaxListSize] of TWStringItem;
  62.   TWStringList = class(TWStrings)
  63.   private
  64.     FList: PWStringItemList;
  65.     FCount: Integer;
  66.     FCapacity: Integer;
  67.     FSorted: Boolean;
  68.     FDuplicates: TDuplicates;
  69.     FOnChange: TNotifyEvent;
  70.     FOnChanging: TNotifyEvent;
  71.     procedure ExchangeItems(Index1, Index2: Integer);
  72.     procedure Grow;
  73.     procedure QuickSort(L, R: Integer);
  74.     procedure InsertItem(Index: Integer; const S: WideString);
  75.     procedure SetSorted(Value: Boolean);
  76.   protected
  77.     procedure Changed; virtual;
  78.     procedure Changing; virtual;
  79.     function  Get(Index: Integer): WideString; override;
  80.     function  GetCapacity: Integer; override;
  81.     function  GetCount: Integer; override;
  82.     function  GetObject(Index: Integer): TObject; override;
  83.     procedure Put(Index: Integer; const S: WideString); override;
  84.     procedure PutObject(Index: Integer; AObject: TObject); override;
  85.     procedure SetCapacity(NewCapacity: Integer); override;
  86.     procedure SetUpdateState(Updating: Boolean); override;
  87.   public
  88.     destructor Destroy; override;
  89.     function  Add(const S: WideString): Integer; override;
  90.     procedure Clear; override;
  91.     procedure Delete(Index: Integer); override;
  92.     procedure Exchange(Index1, Index2: Integer); override;
  93.     function  Find(const S: WideString; var Index: Integer): Boolean; virtual;
  94.     function  IndexOf(const S: WideString): Integer; override;
  95.     procedure Insert(Index: Integer; const S: WideString); override;
  96.     procedure Sort; virtual;
  97.     property Duplicates: TDuplicates read FDuplicates write FDuplicates;
  98.     property Sorted: Boolean read FSorted write SetSorted;
  99.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  100.     property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
  101.   end;
  102. function WidePos(const Substr, S: WideString): Integer;
  103. function WidePosEx(const Substr, S: WideString; Options: TSearchTypes): Integer;
  104. function WideCompareStr(const S1, S2: WideString): Integer;
  105. implementation
  106. {$IFDEF VER100}{$DEFINE D6_BELOW}{$ENDIF}
  107. {$IFDEF VER120}{$DEFINE D6_BELOW}{$ENDIF}
  108. {$IFDEF VER130}{$DEFINE D6_BELOW}{$ENDIF}
  109. uses
  110.   Consts{$IFNDEF D6_BELOW}, RTLConsts{$ENDIF};
  111. const
  112.   WordDelimiters = [0..32, 127];
  113. function IsWholeWord(const S: WideString; Start, Len: Integer): Boolean;
  114. begin
  115.   Result := false;
  116.   if (Start > 1) and not (Ord(S[Start - 1]) in WordDelimiters) then
  117.     Exit;
  118.   if ((Start + Len) < Length(S)) and not (Ord(S[Start + Len]) in WordDelimiters) then
  119.     Exit;
  120.   Result := true
  121. end;
  122. function WidePos(const Substr, S: WideString): Integer;
  123.   function TestPos(P: Integer): Boolean;
  124.   var
  125.     I: Integer;
  126.   begin
  127.     Result := false;
  128.     for I := 1 to Length(Substr) do
  129.       if S[P + I - 1] <> Substr[I] then
  130.         Exit;
  131.     Result := true
  132.   end;
  133. begin
  134.   for Result := 1 to Length(S) - Length(Substr) + 1 do
  135.     if TestPos(Result) then
  136.       Exit;
  137.   Result := 0
  138. end;
  139. function WidePosEx(const Substr, S: WideString; Options: TSearchTypes): Integer;
  140. begin
  141.   if not (stMatchCase in Options) then
  142.     Result := WidePos(LowerCase(Substr), LowerCase(S))
  143.   else
  144.     Result := WidePos(Substr, S);
  145.   if (Result = 0) or not (stWholeWord in Options) then
  146.     Exit;
  147.   if not IsWholeWord(S, Result, Length(Substr)) then
  148.     Result := 0
  149. end;
  150. function WideCompareStr(const S1, S2: WideString): Integer;
  151. begin
  152.   if S1 < S2 then
  153.     Result := -1
  154.   else
  155.   if S1 > S2 then
  156.     Result := 1
  157.   else
  158.     Result := 0
  159. end;
  160. function TWStrings.Add(const S: WideString): Integer;
  161. begin
  162.   Result := GetCount;
  163.   Insert(Result, S)
  164. end;
  165. function TWStrings.AddObject(const S: WideString; AObject: TObject): Integer;
  166. begin
  167.   Result := Add(S);
  168.   PutObject(Result, AObject)
  169. end;
  170. procedure TWStrings.Append(const S: WideString);
  171. begin
  172.   Add(S)
  173. end;
  174. procedure TWStrings.AddStrings(WStrings: TWStrings);
  175. var
  176.   I: Integer;
  177. begin
  178.   BeginUpdate;
  179.   try
  180.     for I := 0 to WStrings.Count - 1 do
  181.       AddObject(WStrings[I], WStrings.Objects[I])
  182.   finally
  183.     EndUpdate
  184.   end
  185. end;
  186. procedure TWStrings.Assign(Source: TPersistent);
  187. begin
  188.   if Source is TWStrings then
  189.   begin
  190.     BeginUpdate;
  191.     try
  192.       Clear;
  193.       AddStrings(TWStrings(Source))
  194.     finally
  195.       EndUpdate
  196.     end;
  197.     Exit
  198.   end;
  199.   inherited Assign(Source)
  200. end;
  201. procedure TWStrings.BeginUpdate;
  202. begin
  203.   if FUpdateCount = 0 then SetUpdateState(true);
  204.   Inc(FUpdateCount)
  205. end;
  206. procedure TWStrings.EndUpdate;
  207. begin
  208.   Dec(FUpdateCount);
  209.   if FUpdateCount = 0 then SetUpdateState(false)
  210. end;
  211. function TWStrings.Equals(WStrings: TWStrings): Boolean;
  212. var
  213.   I, Count: Integer;
  214. begin
  215.   Result := false;
  216.   Count := GetCount;
  217.   if Count <> WStrings.GetCount then
  218.     Exit;
  219.   for I := 0 to Count - 1 do
  220.     if Get(I) <> WStrings.Get(I) then
  221.       Exit;
  222.   Result := true
  223. end;
  224. procedure TWStrings.Error(const Msg: String; Data: Integer);
  225.   function ReturnAddr: Pointer;
  226.   asm
  227.     MOV    EAX,[EBP+4]
  228.   end;
  229. begin
  230.   raise EStringListError.CreateFmt(Msg, [Data]) at ReturnAddr;
  231. end;
  232. procedure TWStrings.Exchange(Index1, Index2: Integer);
  233. var
  234.   TempObject: TObject;
  235.   TempString: WideString;
  236. begin
  237.   BeginUpdate;
  238.   try
  239.     TempString := Strings[Index1];
  240.     TempObject := Objects[Index1];
  241.     Strings[Index1] := Strings[Index2];
  242.     Objects[Index1] := Objects[Index2];
  243.     Strings[Index2] := TempString;
  244.     Objects[Index2] := TempObject
  245.   finally
  246.     EndUpdate
  247.   end
  248. end;
  249. function TWStrings.GetCapacity: Integer;
  250. begin
  251.   Result := Count
  252. end;
  253. function TWStrings.GetName(Index: Integer): WideString;
  254. var
  255.   P: Integer;
  256. begin
  257.   Result := Get(Index);
  258.   P := WidePos('=', Result);
  259.   if P <> 0 then
  260.     SetLength(Result, P-1)
  261.   else
  262.     SetLength(Result, 0)
  263. end;
  264. function TWStrings.GetObject(Index: Integer): TObject;
  265. begin
  266.   Result := nil
  267. end;
  268. function TWStrings.GetTextStr: WideString;
  269. var
  270.   I, L, Size, Count: Integer;
  271.   P: PWideChar;
  272.   S: WideString;
  273. begin
  274.   Count := GetCount;
  275.   Size := 0;
  276.   for I := 0 to Count - 1 do
  277.     Inc(Size, Length(Get(I)) + 2);
  278.   SetLength(Result, Size);
  279.   P := Pointer(Result);
  280.   for I := 0 to Count - 1 do
  281.   begin
  282.     S := Get(I);
  283.     L := Length(S);
  284.     if L <> 0 then
  285.     begin
  286.       System.Move(Pointer(S)^, P^, SizeOf(WideChar) * L);
  287.       Inc(P, L);
  288.     end;
  289.     P^ := #13;
  290.     Inc(P);
  291.     P^ := #10;
  292.     Inc(P)
  293.   end
  294. end;
  295. function TWStrings.GetValue(const Name: WideString): WideString;
  296. var
  297.   I: Integer;
  298. begin
  299.   I := IndexOfName(Name);
  300.   if I >= 0 then
  301.     Result := Copy(Get(I), Length(Name) + 2, MaxInt)
  302.   else
  303.     Result := ''
  304. end;
  305. function TWStrings.IndexOf(const S: WideString): Integer;
  306. begin
  307.   for Result := 0 to GetCount - 1 do
  308.     if WideCompareStr(Get(Result), S) = 0 then
  309.       Exit;
  310.   Result := -1
  311. end;
  312. function TWStrings.IndexOfName(const Name: WideString): Integer;
  313. var
  314.   P: Integer;
  315.   S: WideString;
  316. begin
  317.   for Result := 0 to GetCount - 1 do
  318.   begin
  319.     S := Get(Result);
  320.     P := WidePos('=', S);
  321.     if (P <> 0) and (WideCompareStr(Copy(S, 1, P - 1), Name) = 0) then
  322.       Exit
  323.   end;
  324.   Result := -1
  325. end;
  326. function TWStrings.IndexOfObject(AObject: TObject): Integer;
  327. begin
  328.   for Result := 0 to GetCount - 1 do
  329.     if GetObject(Result) = AObject then
  330.       Exit;
  331.   Result := -1
  332. end;
  333. procedure TWStrings.InsertObject(Index: Integer; const S: WideString;
  334.   AObject: TObject);
  335. begin
  336.   Insert(Index, S);
  337.   PutObject(Index, AObject)
  338. end;
  339. procedure TWStrings.LoadFromFile(const FileName: String);
  340. var
  341.   Stream: TStream;
  342. begin
  343.   Stream := TFileStream.Create(FileName, fmOpenRead);
  344.   try
  345.     LoadFromStream(Stream)
  346.   finally
  347.     Stream.Free
  348.   end
  349. end;
  350. procedure TWStrings.LoadFromStream(Stream: TStream);
  351. var
  352.   Size: Integer;
  353.   S: WideString;
  354. begin
  355.   BeginUpdate;
  356.   try
  357.     Size := (Stream.Size - Stream.Position) div SizeOf(WideChar);
  358.     SetLength(S, Size);
  359.     Stream.Read(Pointer(S)^, SizeOf(WideChar) * Size);
  360.     SetTextStr(S)
  361.   finally
  362.     EndUpdate
  363.   end
  364. end;
  365. procedure TWStrings.Move(CurIndex, NewIndex: Integer);
  366. var
  367.   TempObject: TObject;
  368.   TempString: WideString;
  369. begin
  370.   if CurIndex <> NewIndex then
  371.   begin
  372.     BeginUpdate;
  373.     try
  374.       TempString := Get(CurIndex);
  375.       TempObject := GetObject(CurIndex);
  376.       Delete(CurIndex);
  377.       InsertObject(NewIndex, TempString, TempObject)
  378.     finally
  379.       EndUpdate
  380.     end
  381.   end
  382. end;
  383. procedure TWStrings.Put(Index: Integer; const S: WideString);
  384. var
  385.   TempObject: TObject;
  386. begin
  387.   TempObject := GetObject(Index);
  388.   Delete(Index);
  389.   InsertObject(Index, S, TempObject)
  390. end;
  391. procedure TWStrings.PutObject(Index: Integer; AObject: TObject);
  392. begin
  393. end;
  394. procedure TWStrings.SaveToFile(const FileName: String);
  395. var
  396.   Stream: TStream;
  397. begin
  398.   Stream := TFileStream.Create(FileName, fmCreate);
  399.   try
  400.     SaveToStream(Stream)
  401.   finally
  402.     Stream.Free
  403.   end
  404. end;
  405. procedure TWStrings.SaveToStream(Stream: TStream);
  406. var
  407.   S: WideString;
  408. begin
  409.   S := GetTextStr;
  410.   Stream.WriteBuffer(Pointer(S)^, SizeOf(WideChar) * Length(S));
  411. end;
  412. procedure TWStrings.SetCapacity(NewCapacity: Integer);
  413. begin
  414. end;
  415. procedure TWStrings.SetTextStr(const Value: WideString);
  416. var
  417.   P, Start: PWideChar;
  418.   S: WideString;
  419. begin
  420.   BeginUpdate;
  421.   try
  422.     Clear;
  423.     P := Pointer(Value);
  424.     if P <> nil then
  425.       while P^ <> #0 do
  426.       begin
  427.         Start := P;
  428.         while not (P^ in [WideChar(#0), WideChar(#10), WideChar(#13)]) do
  429.           Inc(P);
  430.         SetString(S, Start, P - Start);
  431.         Add(S);
  432.         if P^ = #13 then
  433.           Inc(P);
  434.         if P^ = #10 then
  435.           Inc(P)
  436.       end
  437.   finally
  438.     EndUpdate
  439.   end
  440. end;
  441. procedure TWStrings.SetUpdateState(Updating: Boolean);
  442. begin
  443. end;
  444. procedure TWStrings.SetValue(const Name, Value: WideString);
  445. var
  446.   I: Integer;
  447. begin
  448.   I := IndexOfName(Name);
  449.   if Value <> '' then
  450.   begin
  451.     if I < 0 then
  452.       I := Add('');
  453.     Put(I, Name + '=' + Value)
  454.   end
  455.   else
  456.     if I >= 0 then
  457.       Delete(I)
  458. end;
  459. destructor TWStringList.Destroy;
  460. begin
  461.   FOnChange := nil;
  462.   FOnChanging := nil;
  463.   inherited Destroy;
  464.   if FCount <> 0 then
  465.     Finalize(FList^[0], FCount);
  466.   FCount := 0;
  467.   SetCapacity(0)
  468. end;
  469. function TWStringList.Add(const S: WideString): Integer;
  470. begin
  471.   if not Sorted then
  472.     Result := FCount
  473.   else
  474.     if Find(S, Result) then
  475.       case Duplicates of
  476.         dupIgnore: Exit;
  477.         dupError: Error(SDuplicateString, 0);
  478.       end;
  479.   InsertItem(Result, S)
  480. end;
  481. procedure TWStringList.Changed;
  482. begin
  483.   if (FUpdateCount = 0) and Assigned(FOnChange) then
  484.     FOnChange(Self)
  485. end;
  486. procedure TWStringList.Changing;
  487. begin
  488.   if (FUpdateCount = 0) and Assigned(FOnChanging) then
  489.     FOnChanging(Self)
  490. end;
  491. procedure TWStringList.Clear;
  492. begin
  493.   if FCount <> 0 then
  494.   begin
  495.     Changing;
  496.     Finalize(FList^[0], FCount);
  497.     FCount := 0;
  498.     SetCapacity(0);
  499.     Changed
  500.   end
  501. end;
  502. procedure TWStringList.Delete(Index: Integer);
  503. begin
  504.   if (Index < 0) or (Index >= FCount) then
  505.     Error(SListIndexError, Index);
  506.   Changing;
  507.   Finalize(FList^[Index]);
  508.   Dec(FCount);
  509.   if Index < FCount then
  510.     System.Move(FList^[Index + 1], FList^[Index],
  511.       (FCount - Index) * SizeOf(TWStringItem));
  512.   Changed
  513. end;
  514. procedure TWStringList.Exchange(Index1, Index2: Integer);
  515. begin
  516.   if (Index1 < 0) or (Index1 >= FCount) then
  517.     Error(SListIndexError, Index1);
  518.   if (Index2 < 0) or (Index2 >= FCount) then
  519.     Error(SListIndexError, Index2);
  520.   Changing;
  521.   ExchangeItems(Index1, Index2);
  522.   Changed
  523. end;
  524. procedure TWStringList.ExchangeItems(Index1, Index2: Integer);
  525. var
  526.   Temp: Integer;
  527.   Item1, Item2: PWStringItem;
  528. begin
  529.   Item1 := @FList^[Index1];
  530.   Item2 := @FList^[Index2];
  531.   Temp := Integer(Item1^.FString);
  532.   Integer(Item1^.FString) := Integer(Item2^.FString);
  533.   Integer(Item2^.FString) := Temp;
  534.   Temp := Integer(Item1^.FObject);
  535.   Integer(Item1^.FObject) := Integer(Item2^.FObject);
  536.   Integer(Item2^.FObject) := Temp
  537. end;
  538. function TWStringList.Find(const S: WideString; var Index: Integer): Boolean;
  539. var
  540.   L, H, I, C: Integer;
  541. begin
  542.   Result := false;
  543.   L := 0;
  544.   H := FCount - 1;
  545.   while L <= H do
  546.   begin
  547.     I := (L + H) shr 1;
  548.     C := WideCompareStr(FList^[I].FString, S);
  549.     if C < 0 then
  550.       L := I + 1
  551.     else
  552.     begin
  553.       H := I - 1;
  554.       if C = 0 then
  555.       begin
  556.         Result := true;
  557.         if Duplicates <> dupAccept then
  558.           L := I
  559.       end
  560.     end
  561.   end;
  562.   Index := L
  563. end;
  564. function TWStringList.Get(Index: Integer): WideString;
  565. begin
  566.   if (Index < 0) or (Index >= FCount) then
  567.     Error(SListIndexError, Index);
  568.   Result := FList^[Index].FString
  569. end;
  570. function TWStringList.GetCapacity: Integer;
  571. begin
  572.   Result := FCapacity
  573. end;
  574. function TWStringList.GetCount: Integer;
  575. begin
  576.   Result := FCount
  577. end;
  578. function TWStringList.GetObject(Index: Integer): TObject;
  579. begin
  580.   if (Index < 0) or (Index >= FCount) then
  581.     Error(SListIndexError, Index);
  582.   Result := FList^[Index].FObject
  583. end;
  584. procedure TWStringList.Grow;
  585. var
  586.   Delta: Integer;
  587. begin
  588.   if FCapacity > 64 then
  589.     Delta := FCapacity div 4
  590.   else
  591.   if FCapacity > 8 then
  592.     Delta := 16
  593.   else
  594.     Delta := 4;
  595.   SetCapacity(FCapacity + Delta)
  596. end;
  597. function TWStringList.IndexOf(const S: WideString): Integer;
  598. begin
  599.   if not Sorted then
  600.     Result := inherited IndexOf(S)
  601.   else
  602.   if not Find(S, Result) then
  603.     Result := -1
  604. end;
  605. procedure TWStringList.Insert(Index: Integer; const S: WideString);
  606. begin
  607.   if Sorted then
  608.     Error(SSortedListError, 0);
  609.   if (Index < 0) or (Index > FCount) then
  610.     Error(SListIndexError, Index);
  611.   InsertItem(Index, S)
  612. end;
  613. procedure TWStringList.InsertItem(Index: Integer; const S: WideString);
  614. begin
  615.   Changing;
  616.   if FCount = FCapacity then
  617.     Grow;
  618.   if Index < FCount then
  619.     System.Move(FList^[Index], FList^[Index + 1],
  620.       (FCount - Index) * SizeOf(TWStringItem));
  621.   with FList^[Index] do
  622.   begin
  623.     Pointer(FString) := nil;
  624.     FObject := nil;
  625.     FString := S
  626.   end;
  627.   Inc(FCount);
  628.   Changed
  629. end;
  630. procedure TWStringList.Put(Index: Integer; const S: WideString);
  631. begin
  632.   if Sorted then
  633.     Error(SSortedListError, 0);
  634.   if (Index < 0) or (Index >= FCount) then
  635.     Error(SListIndexError, Index);
  636.   Changing;
  637.   FList^[Index].FString := S;
  638.   Changed
  639. end;
  640. procedure TWStringList.PutObject(Index: Integer; AObject: TObject);
  641. begin
  642.   if (Index < 0) or (Index >= FCount) then
  643.     Error(SListIndexError, Index);
  644.   Changing;
  645.   FList^[Index].FObject := AObject;
  646.   Changed
  647. end;
  648. procedure TWStringList.QuickSort(L, R: Integer);
  649. var
  650.   I, J: Integer;
  651.   P: String;
  652. begin
  653.   repeat
  654.     I := L;
  655.     J := R;
  656.     P := FList^[(L + R) shr 1].FString;
  657.     repeat
  658.       while WideCompareStr(FList^[I].FString, P) < 0 do
  659.         Inc(I);
  660.       while WideCompareStr(FList^[J].FString, P) > 0 do
  661.         Dec(J);
  662.       if I <= J then
  663.       begin
  664.         ExchangeItems(I, J);
  665.         Inc(I);
  666.         Dec(J)
  667.       end
  668.     until I > J;
  669.     if L < J then
  670.       QuickSort(L, J);
  671.     L := I
  672.   until I >= R
  673. end;
  674. procedure TWStringList.SetCapacity(NewCapacity: Integer);
  675. begin
  676.   ReallocMem(FList, NewCapacity * SizeOf(TWStringItem));
  677.   FCapacity := NewCapacity
  678. end;
  679. procedure TWStringList.SetSorted(Value: Boolean);
  680. begin
  681.   if FSorted <> Value then
  682.   begin
  683.     if Value then
  684.       Sort;
  685.     FSorted := Value
  686.   end
  687. end;
  688. procedure TWStringList.SetUpdateState(Updating: Boolean);
  689. begin
  690.   if Updating then
  691.     Changing
  692.   else
  693.     Changed
  694. end;
  695. procedure TWStringList.Sort;
  696. begin
  697.   if not Sorted and (FCount > 1) then
  698.   begin
  699.     Changing;
  700.     QuickSort(0, FCount - 1);
  701.     Changed
  702.   end
  703. end;
  704. end.