1321 lines
33 KiB
ObjectPascal
1321 lines
33 KiB
ObjectPascal
unit frxWideStringsEarlyDelphi;
|
|
|
|
// Not including Compiler18_Plus / Delphi10
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils;
|
|
|
|
type
|
|
|
|
TWideStrings = class;
|
|
|
|
{ TWideStringsEnumerator class }
|
|
|
|
TWideStringsEnumerator = class
|
|
private
|
|
FStrings: TWideStrings;
|
|
FPosition: integer;
|
|
public
|
|
constructor Create(AStrings: TWideStrings);
|
|
function GetCurrent: WideString;
|
|
function MoveNext: boolean;
|
|
|
|
property Current: WideString read GetCurrent;
|
|
end;
|
|
|
|
{ TStrings class }
|
|
|
|
TWideStrings = class(TPersistent)
|
|
private
|
|
FSpecialCharsInited: boolean;
|
|
FQuoteChar: WideChar;
|
|
FDelimiter: WideChar;
|
|
FNameValueSeparator: WideChar;
|
|
FUpdateCount: integer;
|
|
FAdapter: IStringsAdapter;
|
|
FLBS: TTextLineBreakStyle;
|
|
FStrictDelimiter: boolean;
|
|
|
|
// function GetCommaText: WideString;
|
|
function GetName(Index: integer): WideString;
|
|
function GetValue(const Name: WideString): WideString;
|
|
function GetLBS: TTextLineBreakStyle;
|
|
procedure SetLBS(AValue: TTextLineBreakStyle);
|
|
procedure ReadData(Reader: TReader);
|
|
// procedure SetCommaText(const Value: WideString);
|
|
procedure SetStringsAdapter(const Value: IStringsAdapter);
|
|
procedure SetValue(const Name, Value: WideString);
|
|
procedure SetDelimiter(c: WideChar);
|
|
procedure SetQuoteChar(c: WideChar);
|
|
procedure SetNameValueSeparator(c: WideChar);
|
|
procedure WriteData(Writer: TWriter);
|
|
protected
|
|
procedure DefineProperties(Filer: TFiler); override;
|
|
procedure Error(const Msg: WideString; Data: integer);
|
|
// procedure Error(const Msg: pstring; Data: integer);
|
|
function Get(Index: integer): WideString; virtual; abstract;
|
|
function GetCapacity: integer; virtual;
|
|
function GetCount: integer; virtual; abstract;
|
|
function GetObject(Index: integer): TObject; virtual;
|
|
function GetTextStr: WideString; virtual;
|
|
procedure Put(Index: integer; const S: WideString); virtual;
|
|
procedure PutObject(Index: integer; AObject: TObject); virtual;
|
|
procedure SetCapacity(NewCapacity: integer); virtual;
|
|
procedure SetTextStr(const Value: WideString); virtual;
|
|
procedure SetUpdateState(Updating: boolean); virtual;
|
|
function DoCompareText(const s1, s2: WideString): Integer; virtual;
|
|
// function GetDelimitedText: WideString;
|
|
// procedure SetDelimitedText(const AValue: WideString);
|
|
function GetValueFromIndex(Index: integer): WideString;
|
|
procedure SetValueFromIndex(Index: integer; const Value: WideString);
|
|
procedure CheckSpecialChars;
|
|
|
|
property UpdateCount: integer read FUpdateCount;
|
|
public
|
|
destructor Destroy; override;
|
|
function Add(const S: WideString): integer; virtual;
|
|
function AddObject(const S: WideString; AObject: TObject): integer; virtual;
|
|
procedure Append(const S: WideString);
|
|
procedure AddStrings(TheStrings: TWideStrings); virtual;
|
|
procedure Assign(Source: TPersistent); override;
|
|
procedure BeginUpdate;
|
|
procedure Clear; virtual; abstract;
|
|
procedure Delete(Index: integer); virtual; abstract;
|
|
procedure EndUpdate;
|
|
// function Equals(Obj: TObject): boolean; overload;
|
|
function Equals(TheStrings: TWideStrings): boolean; // overload;
|
|
procedure Exchange(Index1, Index2: integer); virtual;
|
|
function GetEnumerator: TWideStringsEnumerator;
|
|
// function GetText: PWideChar; virtual;
|
|
function IndexOf(const S: WideString): integer; virtual;
|
|
function IndexOfName(const Name: WideString): integer; virtual;
|
|
function IndexOfObject(AObject: TObject): integer; virtual;
|
|
procedure Insert(Index: integer; const S: WideString); virtual; abstract;
|
|
procedure InsertObject(Index: integer; const S: WideString; AObject: TObject);
|
|
procedure LoadFromFile(const FileName: WideString); virtual;
|
|
procedure LoadFromStream(Stream: TStream); virtual;
|
|
procedure Move(CurIndex, NewIndex: integer); virtual;
|
|
procedure SaveToFile(const FileName: WideString); virtual;
|
|
procedure SaveToStream(Stream: TStream); virtual;
|
|
procedure SetText(TheText: PWideChar); virtual;
|
|
procedure GetNameValue(Index: integer; Out AName, AValue: WideString);
|
|
function ExtractName(const S: WideString): WideString;
|
|
|
|
property TextLineBreakStyle: TTextLineBreakStyle read GetLBS write SetLBS;
|
|
property Delimiter: WideChar read FDelimiter write SetDelimiter;
|
|
// property DelimitedText: WideString read GetDelimitedText write SetDelimitedText;
|
|
property StrictDelimiter: boolean read FStrictDelimiter write FStrictDelimiter;
|
|
property QuoteChar: WideChar read FQuoteChar write SetQuoteChar;
|
|
property NameValueSeparator: WideChar read FNameValueSeparator write SetNameValueSeparator;
|
|
property ValueFromIndex[Index: integer]: WideString
|
|
read GetValueFromIndex write SetValueFromIndex;
|
|
property Capacity: integer read GetCapacity write SetCapacity;
|
|
// property CommaText: WideString read GetCommaText write SetCommaText;
|
|
property Count: integer read GetCount;
|
|
property Names[Index: integer]: WideString read GetName;
|
|
property Objects[Index: integer]: TObject read GetObject write PutObject;
|
|
property Values[const Name: WideString]: WideString read GetValue write SetValue;
|
|
property Strings[Index: integer]: WideString read Get write Put; default;
|
|
property Text: WideString read GetTextStr write SetTextStr;
|
|
property StringsAdapter: IStringsAdapter read FAdapter write SetStringsAdapter;
|
|
end;
|
|
|
|
///
|
|
|
|
TWideStringList = class;
|
|
TWideStringListSortCompare = function(List: TWideStringList; Index1, Index2: Integer): Integer;
|
|
|
|
PWideStringItem = ^TWideStringItem;
|
|
TWideStringItem = record
|
|
FString: WideString;
|
|
FObject: TObject;
|
|
end;
|
|
|
|
PWideStringItemList = ^TWideStringItemList;
|
|
TWideStringItemList = array[0..MaxListSize] of TWideStringItem;
|
|
|
|
TWideStringList = class(TWideStrings)
|
|
private
|
|
FList: PWideStringItemList;
|
|
FCount: integer;
|
|
FCapacity: integer;
|
|
FOnChange: TNotifyEvent;
|
|
FOnChanging: TNotifyEvent;
|
|
FDuplicates: TDuplicates;
|
|
FCaseSensitive: boolean;
|
|
FSorted: boolean;
|
|
FOwnsObjects: boolean;
|
|
|
|
procedure ExchangeItems(Index1, Index2: integer);
|
|
procedure Grow;
|
|
procedure QuickSort(L, R: integer; CompareFn: TWideStringListSortCompare);
|
|
procedure SetSorted(Value: boolean);
|
|
procedure SetCaseSensitive(b: boolean);
|
|
protected
|
|
procedure Changed; virtual;
|
|
procedure Changing; virtual;
|
|
procedure CheckError(Index: integer);
|
|
function Get(Index: integer): WideString; override;
|
|
function GetCapacity: integer; override;
|
|
function GetCount: integer; override;
|
|
function GetObject(Index: integer): TObject; override;
|
|
procedure Put(Index: integer; const S: WideString); override;
|
|
procedure PutObject(Index: integer; AObject: TObject); override;
|
|
procedure SetCapacity(NewCapacity: integer); override;
|
|
procedure SetUpdateState(Updating: boolean); override;
|
|
procedure InsertItem(Index: integer; const S: WideString); overload;
|
|
procedure InsertItem(Index: integer; const S: WideString; O: TObject); overload;
|
|
function DoCompareText(const s1, s2: WideString): Integer; override;
|
|
|
|
public
|
|
destructor Destroy; override;
|
|
function Add(const S: WideString): integer; override;
|
|
procedure Clear; override;
|
|
procedure Delete(Index: integer); override;
|
|
procedure Exchange(Index1, Index2: integer); override;
|
|
function Find(const S: WideString; var Index: integer): boolean; virtual;
|
|
function IndexOf(const S: WideString): integer; override;
|
|
procedure Insert(Index: integer; const S: WideString); override;
|
|
procedure Sort; virtual;
|
|
procedure CustomSort(CompareFn: TWideStringListSortCompare); virtual;
|
|
|
|
property Duplicates: TDuplicates read FDuplicates write FDuplicates;
|
|
property Sorted: boolean read FSorted write SetSorted;
|
|
property CaseSensitive: boolean read FCaseSensitive write SetCaseSensitive;
|
|
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
|
property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
|
|
property OwnsObjects: boolean read FOwnsObjects write FOwnsObjects;
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
{****************************************************************************}
|
|
{* TWideStringsEnumerator *}
|
|
{****************************************************************************}
|
|
|
|
constructor TWideStringsEnumerator.Create(AStrings: TWideStrings);
|
|
begin
|
|
inherited Create;
|
|
FStrings := AStrings;
|
|
FPosition := -1;
|
|
end;
|
|
|
|
function TWideStringsEnumerator.GetCurrent: WideString;
|
|
begin
|
|
Result := FStrings[FPosition];
|
|
end;
|
|
|
|
function TWideStringsEnumerator.MoveNext: boolean;
|
|
begin
|
|
Inc(FPosition);
|
|
Result := FPosition < FStrings.Count;
|
|
end;
|
|
|
|
{****************************************************************************}
|
|
{* TWideStrings *}
|
|
{****************************************************************************}
|
|
|
|
// Function to quote text. Should move maybe to sysutils !!
|
|
// Also, it is not clear at this point what exactly should be done.
|
|
|
|
{ //!! is used to mark unsupported things. }
|
|
|
|
function QuoteString(const S: WideString; Quote: WideString): WideString;
|
|
var
|
|
I, J: integer;
|
|
begin
|
|
J := 0;
|
|
Result := S;
|
|
for i := 1 to length(s) do
|
|
begin
|
|
Inc(j);
|
|
if S[i] = Quote then
|
|
begin
|
|
System.Insert(Quote, Result, J);
|
|
Inc(j);
|
|
end;
|
|
end;
|
|
Result := Quote + Result + Quote;
|
|
end;
|
|
|
|
{
|
|
For compatibility we can't add a Constructor to TucStrings to initialize
|
|
the special characters. Therefore we add a routine which is called whenever
|
|
the special chars are needed.
|
|
}
|
|
|
|
procedure TWideStrings.CheckSpecialChars;
|
|
begin
|
|
if not FSpecialCharsInited then
|
|
begin
|
|
FQuoteChar := '"';
|
|
FDelimiter := ',';
|
|
FNameValueSeparator := '=';
|
|
FSpecialCharsInited := True;
|
|
FLBS := DefaultTextLineBreakStyle;
|
|
end;
|
|
end;
|
|
|
|
function TWideStrings.GetLBS: TTextLineBreakStyle;
|
|
begin
|
|
CheckSpecialChars;
|
|
Result := FLBS;
|
|
end;
|
|
|
|
procedure TWideStrings.SetLBS(AValue: TTextLineBreakStyle);
|
|
begin
|
|
CheckSpecialChars;
|
|
FLBS := AValue;
|
|
end;
|
|
|
|
procedure TWideStrings.SetDelimiter(c: WideChar);
|
|
begin
|
|
CheckSpecialChars;
|
|
FDelimiter := c;
|
|
end;
|
|
|
|
procedure TWideStrings.SetQuoteChar(c: WideChar);
|
|
begin
|
|
CheckSpecialChars;
|
|
FQuoteChar := c;
|
|
end;
|
|
|
|
procedure TWideStrings.SetNameValueSeparator(c: WideChar);
|
|
begin
|
|
CheckSpecialChars;
|
|
FNameValueSeparator := c;
|
|
end;
|
|
{
|
|
function TWideStrings.GetCommaText: WideString;
|
|
var
|
|
C1, C2: WideChar;
|
|
FSD: boolean;
|
|
begin
|
|
CheckSpecialChars;
|
|
FSD := StrictDelimiter;
|
|
C1 := Delimiter;
|
|
C2 := QuoteChar;
|
|
Delimiter := ',';
|
|
QuoteChar := '"';
|
|
StrictDelimiter := False;
|
|
try
|
|
Result := GetDelimitedText;
|
|
finally
|
|
Delimiter := C1;
|
|
QuoteChar := C2;
|
|
StrictDelimiter := FSD;
|
|
end;
|
|
end;
|
|
|
|
function TWideStrings.GetDelimitedText: WideString;
|
|
var
|
|
I: integer;
|
|
p: PWideChar;
|
|
c: set of Char;
|
|
S: WideString;
|
|
begin
|
|
CheckSpecialChars;
|
|
Result := '';
|
|
if StrictDelimiter then
|
|
c := [#0, Delimiter]
|
|
else
|
|
c := [#0..' ', QuoteChar, Delimiter];
|
|
for i := 0 to Count - 1 do
|
|
begin
|
|
S := Strings[i];
|
|
p := PWideChar(S);
|
|
while not (p^ in c) do
|
|
Inc(p);
|
|
// strings in list may contain #0
|
|
if (p <> PWideChar(S) + length(S)) and not StrictDelimiter then
|
|
Result := Result + QuoteString(S, QuoteChar)
|
|
else
|
|
Result := Result + S;
|
|
if I < Count - 1 then
|
|
Result := Result + Delimiter;
|
|
end;
|
|
if (Length(Result) = 0) and (Count = 1) then
|
|
Result := QuoteChar + QuoteChar;
|
|
end;
|
|
}
|
|
procedure TWideStrings.GetNameValue(Index: integer; Out AName, AValue: WideString);
|
|
var
|
|
L: longint;
|
|
begin
|
|
CheckSpecialChars;
|
|
AValue := Strings[Index];
|
|
L := Pos(FNameValueSeparator, AValue);
|
|
if L <> 0 then
|
|
begin
|
|
AName := Copy(AValue, 1, L - 1);
|
|
System.Delete(AValue, 1, L);
|
|
end
|
|
else
|
|
AName := '';
|
|
end;
|
|
|
|
function TWideStrings.ExtractName(const s: WideString): WideString;
|
|
var
|
|
L: longint;
|
|
begin
|
|
CheckSpecialChars;
|
|
L := Pos(FNameValueSeparator, S);
|
|
if L <> 0 then
|
|
Result := Copy(S, 1, L - 1)
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
function TWideStrings.GetName(Index: integer): WideString;
|
|
var
|
|
V: WideString;
|
|
begin
|
|
GetNameValue(Index, Result, V);
|
|
end;
|
|
|
|
function TWideStrings.GetValue(const Name: WideString): WideString;
|
|
var
|
|
L: longint;
|
|
N: WideString;
|
|
begin
|
|
Result := '';
|
|
L := IndexOfName(Name);
|
|
if L <> -1 then
|
|
GetNameValue(L, N, Result);
|
|
end;
|
|
|
|
function TWideStrings.GetValueFromIndex(Index: integer): WideString;
|
|
var
|
|
N: WideString;
|
|
begin
|
|
GetNameValue(Index, N, Result);
|
|
end;
|
|
|
|
procedure TWideStrings.SetValueFromIndex(Index: integer; const Value: WideString);
|
|
begin
|
|
if (Value = '') then
|
|
Delete(Index)
|
|
else begin
|
|
if (Index < 0) then
|
|
Index := Add('');
|
|
CheckSpecialChars;
|
|
Strings[Index] := GetName(Index) + FNameValueSeparator + Value;
|
|
end;
|
|
end;
|
|
|
|
procedure TWideStrings.ReadData(Reader: TReader);
|
|
begin
|
|
Reader.ReadListBegin;
|
|
BeginUpdate;
|
|
try
|
|
Clear;
|
|
while not Reader.EndOfList do
|
|
Add(Reader.ReadString);
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
Reader.ReadListEnd;
|
|
end;
|
|
{
|
|
procedure TWideStrings.SetDelimitedText(const AValue: WideString);
|
|
var
|
|
i, j: integer;
|
|
aNotFirst: boolean;
|
|
begin
|
|
CheckSpecialChars;
|
|
BeginUpdate;
|
|
i := 1;
|
|
j := 1;
|
|
aNotFirst := False;
|
|
try
|
|
Clear;
|
|
if StrictDelimiter then
|
|
begin
|
|
// Easier, faster loop.
|
|
while I <= Length(AValue) do
|
|
begin
|
|
if (AValue[I] in [FDelimiter, #0]) then
|
|
begin
|
|
Add(Copy(AValue, J, I - J));
|
|
J := I + 1;
|
|
end;
|
|
Inc(i);
|
|
end;
|
|
if (Length(AValue) > 0) then
|
|
Add(Copy(AValue, J, I - J));
|
|
end
|
|
else begin
|
|
while i <= length(AValue) do
|
|
begin
|
|
// skip delimiter
|
|
if aNotFirst and (i <= length(AValue)) and (AValue[i] = FDelimiter) then
|
|
Inc(i);
|
|
// skip spaces
|
|
while (i <= length(AValue)) and (Ord(AValue[i]) <= Ord(' ')) do
|
|
Inc(i);
|
|
// read next WideString
|
|
if i <= length(AValue) then
|
|
begin
|
|
if AValue[i] = FQuoteChar then
|
|
begin
|
|
// next WideString is quoted
|
|
j := i + 1;
|
|
while (j <= length(AValue)) and ((AValue[j] <> FQuoteChar) or
|
|
((j + 1 <= length(AValue)) and (AValue[j + 1] = FQuoteChar))) do
|
|
begin
|
|
if (j <= length(AValue)) and (AValue[j] = FQuoteChar) then
|
|
Inc(j, 2)
|
|
else
|
|
Inc(j);
|
|
end;
|
|
// j is position of closing quote
|
|
Add(StringReplace(Copy(AValue, i + 1, j - i - 1),
|
|
FQuoteChar + FQuoteChar, FQuoteChar, [rfReplaceAll]));
|
|
i := j + 1;
|
|
end
|
|
else begin
|
|
// next WideString is not quoted
|
|
j := i;
|
|
while (j <= length(AValue)) and (Ord(AValue[j]) > Ord(' ')) and
|
|
(AValue[j] <> FDelimiter) do
|
|
Inc(j);
|
|
Add(Copy(AValue, i, j - i));
|
|
i := j;
|
|
end;
|
|
end
|
|
else begin
|
|
if aNotFirst then
|
|
Add('');
|
|
end;
|
|
// skip spaces
|
|
while (i <= length(AValue)) and (Ord(AValue[i]) <= Ord(' ')) do
|
|
Inc(i);
|
|
aNotFirst := True;
|
|
end;
|
|
end;
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TWideStrings.SetCommaText(const Value: WideString);
|
|
var
|
|
C1, C2: WideChar;
|
|
begin
|
|
CheckSpecialChars;
|
|
C1 := Delimiter;
|
|
C2 := QuoteChar;
|
|
Delimiter := ',';
|
|
QuoteChar := '"';
|
|
try
|
|
SetDelimitedText(Value);
|
|
finally
|
|
Delimiter := C1;
|
|
QuoteChar := C2;
|
|
end;
|
|
end;
|
|
}
|
|
procedure TWideStrings.SetStringsAdapter(const Value: IStringsAdapter);
|
|
begin
|
|
end;
|
|
|
|
procedure TWideStrings.SetValue(const Name, Value: WideString);
|
|
var
|
|
L: longint;
|
|
begin
|
|
CheckSpecialChars;
|
|
L := IndexOfName(Name);
|
|
if L = -1 then
|
|
Add(Name + FNameValueSeparator + Value)
|
|
else
|
|
Strings[L] := Name + FNameValueSeparator + Value;
|
|
end;
|
|
|
|
procedure TWideStrings.WriteData(Writer: TWriter);
|
|
var
|
|
i: integer;
|
|
begin
|
|
Writer.WriteListBegin;
|
|
for i := 0 to Count - 1 do
|
|
Writer.WriteString(Strings[i]);
|
|
Writer.WriteListEnd;
|
|
end;
|
|
|
|
procedure TWideStrings.DefineProperties(Filer: TFiler);
|
|
var
|
|
HasData: boolean;
|
|
begin
|
|
if Assigned(Filer.Ancestor) then
|
|
// Only serialize if WideString list is different from ancestor
|
|
if Filer.Ancestor.InheritsFrom(TWideStrings) then
|
|
HasData := not Equals(TWideStrings(Filer.Ancestor))
|
|
else
|
|
HasData := True
|
|
else
|
|
HasData := Count > 0;
|
|
Filer.DefineProperty('Strings', ReadData, WriteData, HasData);
|
|
end;
|
|
|
|
procedure TWideStrings.Error(const Msg: WideString; Data: integer);
|
|
begin
|
|
raise EStringListError.CreateFmt(Msg, [Data]){ at get_caller_addr(get_frame)};
|
|
end;
|
|
|
|
//procedure TWideStrings.Error(const Msg: pstring; Data: integer);
|
|
//begin
|
|
// raise EStringListError.CreateFmt(Msg^, [Data]) at get_caller_addr(get_frame);
|
|
//end;
|
|
|
|
function TWideStrings.GetCapacity: integer;
|
|
begin
|
|
Result := Count;
|
|
end;
|
|
|
|
function TWideStrings.GetObject(Index: integer): TObject;
|
|
begin
|
|
Result := nil;
|
|
end;
|
|
|
|
function TWideStrings.GetTextStr: WideString;
|
|
var
|
|
P: PWideChar;
|
|
I, L, NLS: longint;
|
|
S, NL: WideString;
|
|
begin
|
|
CheckSpecialChars;
|
|
// Determine needed place
|
|
case FLBS of
|
|
tlbsLF: NL := #10;
|
|
tlbsCRLF: NL := #13#10;
|
|
// tlbsCR: NL := #13;
|
|
end;
|
|
L := 0;
|
|
NLS := Length(NL);
|
|
for I := 0 to Count - 1 do
|
|
L := L + Length(Strings[I]) + NLS;
|
|
Setlength(Result, L);
|
|
P := Pointer(Result);
|
|
for i := 0 to Count - 1 do
|
|
begin
|
|
S := Strings[I];
|
|
L := Length(S);
|
|
if L <> 0 then
|
|
System.Move(Pointer(S)^, P^, L * sizeof(WideChar));
|
|
P := P + L;
|
|
for L := 1 to NLS do
|
|
begin
|
|
P^ := NL[L];
|
|
Inc(P);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TWideStrings.Put(Index: integer; const S: WideString);
|
|
var
|
|
Obj: TObject;
|
|
begin
|
|
Obj := Objects[Index];
|
|
Delete(Index);
|
|
InsertObject(Index, S, Obj);
|
|
end;
|
|
|
|
procedure TWideStrings.PutObject(Index: integer; AObject: TObject);
|
|
begin
|
|
// Empty.
|
|
end;
|
|
|
|
procedure TWideStrings.SetCapacity(NewCapacity: integer);
|
|
begin
|
|
// Empty.
|
|
end;
|
|
|
|
function GetNextLine(const Value: WideString; out S: WideString; var P: integer): boolean;
|
|
var
|
|
PS: PWideChar;
|
|
IP, L: integer;
|
|
begin
|
|
L := Length(Value);
|
|
S := '';
|
|
Result := False;
|
|
if ((L - P) < 0) then
|
|
exit;
|
|
if ((L - P) = 0) and (not (AnsiChar(Value[P]) in [#10, #13])) then
|
|
begin
|
|
s := Value[P];
|
|
Inc(P);
|
|
Result := True;
|
|
Exit;
|
|
end;
|
|
PS := PWideChar(Value) + P - 1;
|
|
IP := P;
|
|
while ((L - P) >= 0) and (not (AnsiChar(PS^) in [#10, #13])) do
|
|
begin
|
|
P := P + 1;
|
|
Inc(PS);
|
|
end;
|
|
SetLength(S, P - IP);
|
|
System.Move(Value[IP], Pointer(S)^, (P - IP) * sizeof(WideChar));
|
|
if (P <= L) and (Value[P] = #13) then
|
|
Inc(P);
|
|
if (P <= L) and (Value[P] = #10) then
|
|
Inc(P); // Point to character after #10(#13)
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TWideStrings.SetTextStr(const Value: WideString);
|
|
var
|
|
S: WideString;
|
|
P: integer;
|
|
begin
|
|
try
|
|
beginUpdate;
|
|
Clear;
|
|
P := 1;
|
|
while GetNextLine(Value, S, P) do
|
|
Add(S);
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TWideStrings.SetUpdateState(Updating: boolean);
|
|
begin
|
|
end;
|
|
|
|
destructor TWideStrings.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TWideStrings.Add(const S: WideString): integer;
|
|
begin
|
|
Result := Count;
|
|
Insert(Count, S);
|
|
end;
|
|
|
|
function TWideStrings.AddObject(const S: WideString; AObject: TObject): integer;
|
|
begin
|
|
Result := Add(S);
|
|
Objects[Result] := AObject;
|
|
end;
|
|
|
|
procedure TWideStrings.Append(const S: WideString);
|
|
begin
|
|
Add(S);
|
|
end;
|
|
|
|
procedure TWideStrings.AddStrings(TheStrings: TWideStrings);
|
|
var
|
|
Runner: longint;
|
|
begin
|
|
try
|
|
beginupdate;
|
|
for Runner := 0 to TheStrings.Count - 1 do
|
|
self.AddObject(Thestrings[Runner], TheStrings.Objects[Runner]);
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TWideStrings.Assign(Source: TPersistent);
|
|
var
|
|
S: TWideStrings;
|
|
begin
|
|
if Source is TWideStrings then
|
|
begin
|
|
S := TWideStrings(Source);
|
|
BeginUpdate;
|
|
try
|
|
Clear;
|
|
FSpecialCharsInited := S.FSpecialCharsInited;
|
|
FQuoteChar := S.FQuoteChar;
|
|
FDelimiter := S.FDelimiter;
|
|
FNameValueSeparator := S.FNameValueSeparator;
|
|
FLBS := S.FLBS;
|
|
AddStrings(S);
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
procedure TWideStrings.BeginUpdate;
|
|
begin
|
|
if FUpdateCount = 0 then
|
|
SetUpdateState(True);
|
|
Inc(FUpdateCount);
|
|
end;
|
|
|
|
procedure TWideStrings.EndUpdate;
|
|
begin
|
|
if FUpdateCount > 0 then
|
|
Dec(FUpdateCount);
|
|
if FUpdateCount = 0 then
|
|
SetUpdateState(False);
|
|
end;
|
|
{
|
|
function TWideStrings.Equals(Obj: TObject): boolean;
|
|
begin
|
|
if Obj is TWideStrings then
|
|
Result := Equals(TWideStrings(Obj))
|
|
else
|
|
Result := inherited Equals(Obj);
|
|
end;
|
|
}
|
|
function TWideStrings.Equals(TheStrings: TWideStrings): boolean;
|
|
var
|
|
Runner, Nr: longint;
|
|
begin
|
|
Result := False;
|
|
Nr := Self.Count;
|
|
if Nr <> TheStrings.Count then
|
|
exit;
|
|
for Runner := 0 to Nr - 1 do
|
|
if Strings[Runner] <> TheStrings[Runner] then
|
|
exit;
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TWideStrings.Exchange(Index1, Index2: integer);
|
|
var
|
|
Obj: TObject;
|
|
Str: WideString;
|
|
begin
|
|
try
|
|
beginUpdate;
|
|
Obj := Objects[Index1];
|
|
Str := Strings[Index1];
|
|
Objects[Index1] := Objects[Index2];
|
|
Strings[Index1] := Strings[Index2];
|
|
Objects[Index2] := Obj;
|
|
Strings[Index2] := Str;
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
function TWideStrings.GetEnumerator: TWideStringsEnumerator;
|
|
begin
|
|
Result := TWideStringsEnumerator.Create(Self);
|
|
end;
|
|
{
|
|
function TWideStrings.GetText: PWideChar;
|
|
begin
|
|
Result := StrNew(PWideChar(Self.Text));
|
|
end;
|
|
}
|
|
function TWideStrings.DoCompareText(const s1, s2: WideString): Integer;
|
|
begin
|
|
Result := WideCompareText(s1, s2);
|
|
end;
|
|
|
|
function TWideStrings.IndexOf(const S: WideString): integer;
|
|
begin
|
|
Result := 0;
|
|
while (Result < Count) and (DoCompareText(Strings[Result], S) <> 0) do
|
|
Result := Result + 1;
|
|
if Result = Count then
|
|
Result := -1;
|
|
end;
|
|
|
|
function TWideStrings.IndexOfName(const Name: WideString): integer;
|
|
var
|
|
len: longint;
|
|
S: WideString;
|
|
begin
|
|
CheckSpecialChars;
|
|
Result := 0;
|
|
while (Result < Count) do
|
|
begin
|
|
S := Strings[Result];
|
|
len := pos(FNameValueSeparator, S) - 1;
|
|
if (len > 0) and (DoCompareText(Name, Copy(S, 1, Len)) = 0) then
|
|
exit;
|
|
Inc(Result);
|
|
end;
|
|
Result := -1;
|
|
end;
|
|
|
|
function TWideStrings.IndexOfObject(AObject: TObject): integer;
|
|
begin
|
|
Result := 0;
|
|
while (Result < Count) and (Objects[Result] <> AObject) do
|
|
Result := Result + 1;
|
|
if Result = Count then
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TWideStrings.InsertObject(Index: integer; const S: WideString; AObject: TObject);
|
|
|
|
begin
|
|
Insert(Index, S);
|
|
Objects[Index] := AObject;
|
|
end;
|
|
|
|
procedure TWideStrings.LoadFromFile(const FileName: WideString);
|
|
var
|
|
TheStream: TFileStream;
|
|
begin
|
|
TheStream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
|
|
try
|
|
LoadFromStream(TheStream);
|
|
finally
|
|
TheStream.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TWideStrings.LoadFromStream(Stream: TStream);
|
|
{
|
|
Borlands method is no good, since a pipe for
|
|
instance doesn't have a size.
|
|
So we must do it the hard way.
|
|
}
|
|
const
|
|
BufSize = 1024;
|
|
MaxGrow = 1 shl 29;
|
|
var
|
|
Buffer: ansistring;
|
|
BytesRead, BufLen, I, BufDelta: longint;
|
|
begin
|
|
// reread into a buffer
|
|
try
|
|
beginupdate;
|
|
Buffer := '';
|
|
BufLen := 0;
|
|
I := 1;
|
|
repeat
|
|
BufDelta := BufSize * I;
|
|
SetLength(Buffer, BufLen + BufDelta);
|
|
BytesRead := Stream.Read(Buffer[BufLen + 1], BufDelta);
|
|
Inc(BufLen, BufDelta);
|
|
if I < MaxGrow then
|
|
I := I shl 1;
|
|
until BytesRead <> BufDelta;
|
|
SetLength(Buffer, BufLen - BufDelta + BytesRead);
|
|
SetTextStr(Buffer);
|
|
SetLength(Buffer, 0);
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TWideStrings.Move(CurIndex, NewIndex: integer);
|
|
var
|
|
Obj: TObject;
|
|
Str: WideString;
|
|
begin
|
|
BeginUpdate;
|
|
Obj := Objects[CurIndex];
|
|
Str := Strings[CurIndex];
|
|
Delete(Curindex);
|
|
InsertObject(NewIndex, Str, Obj);
|
|
EndUpdate;
|
|
end;
|
|
|
|
procedure TWideStrings.SaveToFile(const FileName: WideString);
|
|
var
|
|
TheStream: TFileStream;
|
|
begin
|
|
TheStream := TFileStream.Create(FileName, fmCreate);
|
|
try
|
|
SaveToStream(TheStream);
|
|
finally
|
|
TheStream.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TWideStrings.SaveToStream(Stream: TStream);
|
|
var
|
|
S: WideString;
|
|
begin
|
|
S := Text;
|
|
Stream.WriteBuffer(Pointer(S)^, Length(S));
|
|
end;
|
|
|
|
procedure TWideStrings.SetText(TheText: PWideChar);
|
|
var
|
|
S: WideString;
|
|
begin
|
|
if TheText <> nil then
|
|
S := TheText
|
|
else
|
|
S := '';
|
|
SetTextStr(S);
|
|
end;
|
|
|
|
{****************************************************************************}
|
|
{* TWideStringList *}
|
|
{****************************************************************************}
|
|
|
|
procedure TWideStringList.ExchangeItems(Index1, Index2: integer);
|
|
var
|
|
P1, P2: Pointer;
|
|
begin
|
|
P1 := Pointer(Flist^[Index1].FString);
|
|
P2 := Pointer(Flist^[Index1].FObject);
|
|
Pointer(Flist^[Index1].Fstring) := Pointer(Flist^[Index2].Fstring);
|
|
Pointer(Flist^[Index1].FObject) := Pointer(Flist^[Index2].FObject);
|
|
Pointer(Flist^[Index2].Fstring) := P1;
|
|
Pointer(Flist^[Index2].FObject) := P2;
|
|
end;
|
|
|
|
procedure TWideStringList.Grow;
|
|
var
|
|
NC: integer;
|
|
begin
|
|
NC := FCapacity;
|
|
if NC >= 256 then
|
|
NC := NC + (NC div 4)
|
|
else if NC = 0 then
|
|
NC := 4
|
|
else
|
|
NC := NC * 4;
|
|
SetCapacity(NC);
|
|
end;
|
|
|
|
procedure TWideStringList.QuickSort(L, R: integer; CompareFn: TWideStringListSortCompare);
|
|
var
|
|
Pivot, vL, vR: integer;
|
|
begin
|
|
if R - L <= 1 then
|
|
begin // a little bit of time saver
|
|
if L < R then
|
|
if CompareFn(Self, L, R) > 0 then
|
|
ExchangeItems(L, R);
|
|
Exit;
|
|
end;
|
|
vL := L;
|
|
vR := R;
|
|
Pivot := L + Random(R - L); // they say random is best
|
|
while vL < vR do
|
|
begin
|
|
while (vL < Pivot) and (CompareFn(Self, vL, Pivot) <= 0) do
|
|
Inc(vL);
|
|
while (vR > Pivot) and (CompareFn(Self, vR, Pivot) > 0) do
|
|
Dec(vR);
|
|
ExchangeItems(vL, vR);
|
|
if Pivot = vL then // swap pivot if we just hit it from one side
|
|
Pivot := vR
|
|
else if Pivot = vR then
|
|
Pivot := vL;
|
|
end;
|
|
if Pivot - 1 >= L then
|
|
QuickSort(L, Pivot - 1, CompareFn);
|
|
if Pivot + 1 <= R then
|
|
QuickSort(Pivot + 1, R, CompareFn);
|
|
end;
|
|
|
|
procedure TWideStringList.InsertItem(Index: integer; const S: WideString);
|
|
begin
|
|
Changing;
|
|
if FCount = Fcapacity then
|
|
Grow;
|
|
if Index < FCount then
|
|
System.Move(FList^[Index], FList^[Index + 1],
|
|
(FCount - Index) * SizeOf(TWideStringItem));
|
|
Pointer(Flist^[Index].Fstring) := nil; // Needed to initialize...
|
|
Flist^[Index].FString := S;
|
|
Flist^[Index].Fobject := nil;
|
|
Inc(FCount);
|
|
Changed;
|
|
end;
|
|
|
|
procedure TWideStringList.InsertItem(Index: integer; const S: WideString; O: TObject);
|
|
begin
|
|
Changing;
|
|
if FCount = Fcapacity then
|
|
Grow;
|
|
if Index < FCount then
|
|
System.Move(FList^[Index], FList^[Index + 1],
|
|
(FCount - Index) * SizeOf(TWideStringItem));
|
|
Pointer(Flist^[Index].Fstring) := nil; // Needed to initialize...
|
|
Flist^[Index].FString := S;
|
|
Flist^[Index].FObject := O;
|
|
Inc(FCount);
|
|
Changed;
|
|
end;
|
|
|
|
procedure TWideStringList.SetSorted(Value: boolean);
|
|
begin
|
|
if FSorted <> Value then
|
|
begin
|
|
if Value then
|
|
sort;
|
|
FSorted := Value;
|
|
end;
|
|
end;
|
|
|
|
procedure TWideStringList.Changed;
|
|
begin
|
|
if (FUpdateCount = 0) then
|
|
if Assigned(FOnChange) then
|
|
FOnchange(Self);
|
|
end;
|
|
|
|
procedure TWideStringList.Changing;
|
|
begin
|
|
if FUpdateCount = 0 then
|
|
if Assigned(FOnChanging) then
|
|
FOnchanging(Self);
|
|
end;
|
|
|
|
procedure TWideStringList.CheckError(Index: integer);
|
|
begin
|
|
if (Index < 0) or (Index >= Fcount) then
|
|
raise Exception.Create(Format('Index %d out of range in TWideStringList.', [Index]));
|
|
end;
|
|
|
|
function TWideStringList.Get(Index: integer): WideString;
|
|
begin
|
|
CheckError(Index);
|
|
Result := Flist^[Index].FString;
|
|
end;
|
|
|
|
function TWideStringList.GetCapacity: integer;
|
|
begin
|
|
Result := FCapacity;
|
|
end;
|
|
|
|
function TWideStringList.GetCount: integer;
|
|
begin
|
|
Result := FCount;
|
|
end;
|
|
|
|
function TWideStringList.GetObject(Index: integer): TObject;
|
|
begin
|
|
CheckError(Index);
|
|
Result := Flist^[Index].FObject;
|
|
end;
|
|
|
|
procedure TWideStringList.Put(Index: integer; const S: WideString);
|
|
begin
|
|
if Sorted then
|
|
raise Exception.Create('List is sorted in TWideStringList.Put.');
|
|
CheckError(Index);
|
|
Changing;
|
|
Flist^[Index].FString := S;
|
|
Changed;
|
|
end;
|
|
|
|
procedure TWideStringList.PutObject(Index: integer; AObject: TObject);
|
|
begin
|
|
CheckError(Index);
|
|
Changing;
|
|
Flist^[Index].FObject := AObject;
|
|
Changed;
|
|
end;
|
|
|
|
procedure TWideStringList.SetCapacity(NewCapacity: integer);
|
|
var
|
|
NewList: Pointer;
|
|
MSize: longint;
|
|
begin
|
|
Assert(NewCapacity >= 0);
|
|
if NewCapacity > FCapacity then
|
|
begin
|
|
GetMem(NewList, NewCapacity * SizeOf(TWideStringItem));
|
|
if NewList = nil then
|
|
raise Exception.Create('NewList is Nil in TWideStringList.SetCapacity.');
|
|
if Assigned(FList) then
|
|
begin
|
|
MSize := FCapacity * Sizeof(TWideStringItem);
|
|
System.Move(FList^, NewList^, MSize);
|
|
// FillQWord(PChar(NewList)[MSize], (NewCapacity - FCapacity) * (SizeOf(TWideStringItem) div SizeOf(QWord)), 0);
|
|
FillChar(PChar(NewList)[MSize], (NewCapacity - FCapacity) * SizeOf(TWideStringItem), 0);
|
|
FreeMem(FList, MSize);
|
|
end;
|
|
Flist := NewList;
|
|
FCapacity := NewCapacity;
|
|
end
|
|
else if NewCapacity < FCapacity then
|
|
begin
|
|
if NewCapacity = 0 then
|
|
begin
|
|
FreeMem(FList);
|
|
FList := nil;
|
|
end
|
|
else begin
|
|
GetMem(NewList, NewCapacity * SizeOf(TWideStringItem));
|
|
System.Move(FList^, NewList^, NewCapacity * SizeOf(TWideStringItem));
|
|
FreeMem(FList);
|
|
FList := NewList;
|
|
end;
|
|
FCapacity := NewCapacity;
|
|
end;
|
|
end;
|
|
|
|
procedure TWideStringList.SetUpdateState(Updating: boolean);
|
|
begin
|
|
if Updating then
|
|
Changing
|
|
else
|
|
Changed;
|
|
end;
|
|
|
|
destructor TWideStringList.Destroy;
|
|
var
|
|
I: longint;
|
|
begin
|
|
FOnChange := nil;
|
|
FOnChanging := nil;
|
|
// This will force a dereference. Can be done better...
|
|
for I := 0 to FCount - 1 do
|
|
FList^[I].FString := '';
|
|
FCount := 0;
|
|
SetCapacity(0);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TWideStringList.Add(const S: WideString): integer;
|
|
begin
|
|
if not Sorted then
|
|
Result := FCount
|
|
else
|
|
if Find(S, Result) then
|
|
case Duplicates of
|
|
dupIgnore: Exit;
|
|
dupError: raise Exception.Create('TWideStringList.Duplicates does not allow duplicates.');
|
|
end;
|
|
InsertItem(Result, S);
|
|
end;
|
|
|
|
procedure TWideStringList.Clear;
|
|
var
|
|
I: longint;
|
|
begin
|
|
if FCount = 0 then
|
|
Exit;
|
|
Changing;
|
|
if FOwnsObjects then
|
|
begin
|
|
for I := 0 to FCount - 1 do
|
|
begin
|
|
Flist^[I].FString := '';
|
|
FreeAndNil(Flist^[i].FObject);
|
|
end;
|
|
end
|
|
else begin
|
|
for I := 0 to FCount - 1 do
|
|
Flist^[I].FString := '';
|
|
end;
|
|
FCount := 0;
|
|
SetCapacity(0);
|
|
Changed;
|
|
end;
|
|
|
|
procedure TWideStringList.Delete(Index: integer);
|
|
begin
|
|
CheckError(Index);
|
|
Changing;
|
|
Flist^[Index].FString := '';
|
|
if FOwnsObjects then
|
|
FreeAndNil(Flist^[Index].FObject);
|
|
Dec(FCount);
|
|
if Index < FCount then
|
|
System.Move(Flist^[Index + 1], Flist^[Index], (Fcount - Index) * SizeOf(TWideStringItem));
|
|
Changed;
|
|
end;
|
|
|
|
procedure TWideStringList.Exchange(Index1, Index2: integer);
|
|
begin
|
|
CheckError(Index1);
|
|
CheckError(Index2);
|
|
Changing;
|
|
ExchangeItems(Index1, Index2);
|
|
changed;
|
|
end;
|
|
|
|
procedure TWideStringList.SetCaseSensitive(b: boolean);
|
|
begin
|
|
if b <> FCaseSensitive then
|
|
begin
|
|
FCaseSensitive := b;
|
|
if FSorted then
|
|
sort;
|
|
end;
|
|
end;
|
|
|
|
function TWideStringList.DoCompareText(const s1, s2: WideString): Integer;
|
|
begin
|
|
if FCaseSensitive then
|
|
Result := WideCompareStr(s1, s2)
|
|
else
|
|
Result := WideCompareText(s1, s2);
|
|
end;
|
|
|
|
function TWideStringList.Find(const S: WideString; var Index: integer): boolean;
|
|
var
|
|
L, R, I: integer;
|
|
CompareRes: Integer;
|
|
begin
|
|
Result := False;
|
|
// Use binary search.
|
|
L := 0;
|
|
R := Count - 1;
|
|
while (L <= R) do
|
|
begin
|
|
I := L + (R - L) div 2;
|
|
CompareRes := DoCompareText(S, Flist^[I].FString);
|
|
if (CompareRes > 0) then
|
|
L := I + 1
|
|
else begin
|
|
R := I - 1;
|
|
if (CompareRes = 0) then
|
|
begin
|
|
Result := True;
|
|
if (Duplicates <> dupAccept) then
|
|
L := I; // forces end of while loop
|
|
end;
|
|
end;
|
|
end;
|
|
Index := L;
|
|
end;
|
|
|
|
function TWideStringList.IndexOf(const S: WideString): integer;
|
|
begin
|
|
if not Sorted then
|
|
Result := inherited indexOf(S)
|
|
else
|
|
// faster using binary search...
|
|
if not Find(S, Result) then
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TWideStringList.Insert(Index: integer; const S: WideString);
|
|
begin
|
|
if Sorted then
|
|
raise Exception.Create('Operation not allowed on sorted list');
|
|
if (Index < 0) or (Index > Fcount) then
|
|
raise Exception.Create(Format('Index %d out of range in TWideStringList.', [Index]));
|
|
InsertItem(Index, S);
|
|
end;
|
|
|
|
procedure TWideStringList.CustomSort(CompareFn: TWideStringListSortCompare);
|
|
begin
|
|
if not Sorted and (FCount > 1) then
|
|
begin
|
|
Changing;
|
|
QuickSort(0, FCount - 1, CompareFn);
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
function StringListAnsiCompare(List: TWideStringList; Index1, Index: integer): integer;
|
|
begin
|
|
Result := List.DoCompareText(List.FList^[Index1].FString,
|
|
List.FList^[Index].FString);
|
|
end;
|
|
|
|
procedure TWideStringList.Sort;
|
|
begin
|
|
CustomSort(@StringListAnsiCompare);
|
|
end;
|
|
|
|
end.
|
|
|