1323 lines
34 KiB
ObjectPascal
1323 lines
34 KiB
ObjectPascal
//unit unicodestringslcl;
|
|
//
|
|
//{$mode objfpc}{$H+}
|
|
//
|
|
//interface
|
|
//
|
|
//uses
|
|
// Classes, SysUtils;
|
|
|
|
{$ifdef SECTION_INTERFACE}
|
|
type
|
|
|
|
TUnicodeStrings = class;
|
|
|
|
{ TUnicodeStringsEnumerator class }
|
|
|
|
TUnicodeStringsEnumerator = class
|
|
private
|
|
FStrings: TUnicodeStrings;
|
|
FPosition: integer;
|
|
public
|
|
constructor Create(AStrings: TUnicodeStrings);
|
|
function GetCurrent: UnicodeString;
|
|
function MoveNext: boolean;
|
|
property Current: UnicodeString read GetCurrent;
|
|
end;
|
|
|
|
{ TStrings class }
|
|
|
|
TUnicodeStrings = class(TPersistent)
|
|
private
|
|
FSpecialCharsInited: boolean;
|
|
FQuoteChar: UnicodeChar;
|
|
FDelimiter: UnicodeChar;
|
|
FNameValueSeparator: UnicodeChar;
|
|
FUpdateCount: integer;
|
|
FAdapter: IStringsAdapter;
|
|
FLBS: TTextLineBreakStyle;
|
|
FStrictDelimiter: boolean;
|
|
// function GetCommaText: UnicodeString;
|
|
function GetName(Index: integer): UnicodeString;
|
|
function GetValue(const Name: UnicodeString): UnicodeString;
|
|
function GetLBS: TTextLineBreakStyle;
|
|
procedure SetLBS(AValue: TTextLineBreakStyle);
|
|
procedure ReadData(Reader: TReader);
|
|
// procedure SetCommaText(const Value: UnicodeString);
|
|
procedure SetStringsAdapter(const Value: IStringsAdapter);
|
|
procedure SetValue(const Name, Value: UnicodeString);
|
|
procedure SetDelimiter(c: UnicodeChar);
|
|
procedure SetQuoteChar(c: UnicodeChar);
|
|
procedure SetNameValueSeparator(c: UnicodeChar);
|
|
procedure WriteData(Writer: TWriter);
|
|
protected
|
|
procedure DefineProperties(Filer: TFiler); override;
|
|
procedure Error(const Msg: UnicodeString; Data: integer);
|
|
// procedure Error(const Msg: pstring; Data: integer);
|
|
function Get(Index: integer): UnicodeString; virtual; abstract;
|
|
function GetCapacity: integer; virtual;
|
|
function GetCount: integer; virtual; abstract;
|
|
function GetObject(Index: integer): TObject; virtual;
|
|
function GetTextStr: UnicodeString; virtual;
|
|
procedure Put(Index: integer; const S: UnicodeString); virtual;
|
|
procedure PutObject(Index: integer; AObject: TObject); virtual;
|
|
procedure SetCapacity(NewCapacity: integer); virtual;
|
|
procedure SetTextStr(const Value: UnicodeString); virtual;
|
|
procedure SetUpdateState(Updating: boolean); virtual;
|
|
property UpdateCount: integer read FUpdateCount;
|
|
function DoCompareText(const s1, s2: UnicodeString): PtrInt; virtual;
|
|
// function GetDelimitedText: UnicodeString;
|
|
// procedure SetDelimitedText(const AValue: UnicodeString);
|
|
function GetValueFromIndex(Index: integer): UnicodeString;
|
|
procedure SetValueFromIndex(Index: integer; const Value: UnicodeString);
|
|
procedure CheckSpecialChars;
|
|
public
|
|
destructor Destroy; override;
|
|
function Add(const S: UnicodeString): integer; virtual;
|
|
function AddObject(const S: UnicodeString; AObject: TObject): integer; virtual;
|
|
procedure Append(const S: UnicodeString);
|
|
procedure AddStrings(TheStrings: TUnicodeStrings); 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; override;
|
|
// function Equals(TheStrings: TUnicodeStrings): boolean; // overload;
|
|
procedure Exchange(Index1, Index2: integer); virtual;
|
|
function GetEnumerator: TUnicodeStringsEnumerator;
|
|
// function GetText: PUnicodeChar; virtual;
|
|
function IndexOf(const S: UnicodeString): integer; virtual;
|
|
function IndexOfName(const Name: UnicodeString): integer; virtual;
|
|
function IndexOfObject(AObject: TObject): integer; virtual;
|
|
procedure Insert(Index: integer; const S: UnicodeString); virtual; abstract;
|
|
procedure InsertObject(Index: integer; const S: UnicodeString; AObject: TObject);
|
|
procedure LoadFromFile(const FileName: String); virtual;
|
|
procedure LoadFromStream(Stream: TStream); virtual;
|
|
procedure Move(CurIndex, NewIndex: integer); virtual;
|
|
procedure SaveToFile(const FileName: String); virtual;
|
|
procedure SaveToStream(Stream: TStream); virtual;
|
|
procedure SetText(TheText: PUnicodeChar); virtual;
|
|
procedure GetNameValue(Index: integer; Out AName, AValue: UnicodeString);
|
|
function ExtractName(const S: UnicodeString): UnicodeString;
|
|
property TextLineBreakStyle: TTextLineBreakStyle read GetLBS write SetLBS;
|
|
property Delimiter: UnicodeChar read FDelimiter write SetDelimiter;
|
|
// property DelimitedText: UnicodeString read GetDelimitedText write SetDelimitedText;
|
|
property StrictDelimiter: boolean read FStrictDelimiter write FStrictDelimiter;
|
|
property QuoteChar: UnicodeChar read FQuoteChar write SetQuoteChar;
|
|
property NameValueSeparator: UnicodeChar read FNameValueSeparator write SetNameValueSeparator;
|
|
property ValueFromIndex[Index: integer]: UnicodeString
|
|
read GetValueFromIndex write SetValueFromIndex;
|
|
property Capacity: integer read GetCapacity write SetCapacity;
|
|
// property CommaText: UnicodeString read GetCommaText write SetCommaText;
|
|
property Count: integer read GetCount;
|
|
property Names[Index: integer]: UnicodeString read GetName;
|
|
property Objects[Index: integer]: TObject read GetObject write PutObject;
|
|
property Values[const Name: UnicodeString]: UnicodeString read GetValue write SetValue;
|
|
property Strings[Index: integer]: UnicodeString read Get write Put; default;
|
|
property Text: UnicodeString read GetTextStr write SetTextStr;
|
|
property StringsAdapter: IStringsAdapter read FAdapter write SetStringsAdapter;
|
|
end;
|
|
|
|
///
|
|
|
|
TUnicodeStringList = class;
|
|
TUnicodeStringListSortCompare = function(List: TUnicodeStringList; Index1, Index2: Integer): Integer;
|
|
|
|
PUnicodeStringItem = ^TUnicodeStringItem;
|
|
TUnicodeStringItem = record
|
|
FString: UnicodeString;
|
|
FObject: TObject;
|
|
end;
|
|
|
|
PUnicodeStringItemList = ^TUnicodeStringItemList;
|
|
TUnicodeStringItemList = array[0..MaxListSize] of TUnicodeStringItem;
|
|
|
|
TUnicodeStringList = class(TUnicodeStrings)
|
|
private
|
|
FList: PUnicodeStringItemList;
|
|
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: TUnicodeStringListSortCompare);
|
|
procedure SetSorted(Value: boolean);
|
|
procedure SetCaseSensitive(b: boolean);
|
|
protected
|
|
procedure Changed; virtual;
|
|
procedure Changing; virtual;
|
|
procedure CheckError(Index: integer);
|
|
function Get(Index: integer): UnicodeString; override;
|
|
function GetCapacity: integer; override;
|
|
function GetCount: integer; override;
|
|
function GetObject(Index: integer): TObject; override;
|
|
procedure Put(Index: integer; const S: UnicodeString); override;
|
|
procedure PutObject(Index: integer; AObject: TObject); override;
|
|
procedure SetCapacity(NewCapacity: integer); override;
|
|
procedure SetUpdateState(Updating: boolean); override;
|
|
procedure InsertItem(Index: integer; const S: UnicodeString); virtual; overload;
|
|
procedure InsertItem(Index: integer; const S: UnicodeString; O: TObject); virtual; overload;
|
|
function DoCompareText(const s1, s2: UnicodeString): PtrInt; override;
|
|
|
|
public
|
|
destructor Destroy; override;
|
|
function Add(const S: UnicodeString): integer; override;
|
|
procedure Clear; override;
|
|
procedure Delete(Index: integer); override;
|
|
procedure Exchange(Index1, Index2: integer); override;
|
|
function Find(const S: UnicodeString; var Index: integer): boolean; virtual;
|
|
function IndexOf(const S: UnicodeString): integer; override;
|
|
procedure Insert(Index: integer; const S: UnicodeString); override;
|
|
procedure Sort; virtual;
|
|
procedure CustomSort(CompareFn: TUnicodeStringListSortCompare); 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;
|
|
|
|
|
|
Const
|
|
// Ratio of Pointer and Word Size.
|
|
WordRatio = SizeOf(Pointer) Div SizeOf(Word);
|
|
|
|
{$endif}
|
|
|
|
//implementation
|
|
|
|
{$ifdef SECTION_IMPLEMENTATION}
|
|
|
|
{****************************************************************************}
|
|
{* TUnicodeStringsEnumerator *}
|
|
{****************************************************************************}
|
|
|
|
constructor TUnicodeStringsEnumerator.Create(AStrings: TUnicodeStrings);
|
|
begin
|
|
inherited Create;
|
|
FStrings := AStrings;
|
|
FPosition := -1;
|
|
end;
|
|
|
|
function TUnicodeStringsEnumerator.GetCurrent: UnicodeString;
|
|
begin
|
|
Result := FStrings[FPosition];
|
|
end;
|
|
|
|
function TUnicodeStringsEnumerator.MoveNext: boolean;
|
|
begin
|
|
Inc(FPosition);
|
|
Result := FPosition < FStrings.Count;
|
|
end;
|
|
|
|
{****************************************************************************}
|
|
{* TUnicodeStrings *}
|
|
{****************************************************************************}
|
|
|
|
// 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: UnicodeString; Quote: UnicodeString): UnicodeString;
|
|
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 TUnicodeStrings.CheckSpecialChars;
|
|
begin
|
|
if not FSpecialCharsInited then
|
|
begin
|
|
FQuoteChar := '"';
|
|
FDelimiter := ',';
|
|
FNameValueSeparator := '=';
|
|
FSpecialCharsInited := True;
|
|
FLBS := DefaultTextLineBreakStyle;
|
|
end;
|
|
end;
|
|
|
|
function TUnicodeStrings.GetLBS: TTextLineBreakStyle;
|
|
begin
|
|
CheckSpecialChars;
|
|
Result := FLBS;
|
|
end;
|
|
|
|
procedure TUnicodeStrings.SetLBS(AValue: TTextLineBreakStyle);
|
|
begin
|
|
CheckSpecialChars;
|
|
FLBS := AValue;
|
|
end;
|
|
|
|
procedure TUnicodeStrings.SetDelimiter(c: UnicodeChar);
|
|
begin
|
|
CheckSpecialChars;
|
|
FDelimiter := c;
|
|
end;
|
|
|
|
procedure TUnicodeStrings.SetQuoteChar(c: UnicodeChar);
|
|
begin
|
|
CheckSpecialChars;
|
|
FQuoteChar := c;
|
|
end;
|
|
|
|
procedure TUnicodeStrings.SetNameValueSeparator(c: UnicodeChar);
|
|
begin
|
|
CheckSpecialChars;
|
|
FNameValueSeparator := c;
|
|
end;
|
|
{
|
|
function TUnicodeStrings.GetCommaText: UnicodeString;
|
|
var
|
|
C1, C2: UnicodeChar;
|
|
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 TUnicodeStrings.GetDelimitedText: UnicodeString;
|
|
var
|
|
I: integer;
|
|
p: PUnicodeChar;
|
|
c: set of Char;
|
|
S: UnicodeString;
|
|
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 := PUnicodeChar(S);
|
|
while not (p^ in c) do
|
|
Inc(p);
|
|
// strings in list may contain #0
|
|
if (p <> PUnicodeChar(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 TUnicodeStrings.GetNameValue(Index: integer; Out AName, AValue: UnicodeString);
|
|
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 TUnicodeStrings.ExtractName(const s: UnicodeString): UnicodeString;
|
|
var
|
|
L: longint;
|
|
begin
|
|
CheckSpecialChars;
|
|
L := Pos(FNameValueSeparator, S);
|
|
if L <> 0 then
|
|
Result := Copy(S, 1, L - 1)
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
function TUnicodeStrings.GetName(Index: integer): UnicodeString;
|
|
var
|
|
V: UnicodeString;
|
|
begin
|
|
GetNameValue(Index, Result, V);
|
|
end;
|
|
|
|
function TUnicodeStrings.GetValue(const Name: UnicodeString): UnicodeString;
|
|
var
|
|
L: longint;
|
|
N: UnicodeString;
|
|
begin
|
|
Result := '';
|
|
L := IndexOfName(Name);
|
|
if L <> -1 then
|
|
GetNameValue(L, N, Result);
|
|
end;
|
|
|
|
function TUnicodeStrings.GetValueFromIndex(Index: integer): UnicodeString;
|
|
var
|
|
N: UnicodeString;
|
|
begin
|
|
GetNameValue(Index, N, Result);
|
|
end;
|
|
|
|
procedure TUnicodeStrings.SetValueFromIndex(Index: integer; const Value: UnicodeString);
|
|
begin
|
|
if (Value = '') then
|
|
Delete(Index)
|
|
else begin
|
|
if (Index < 0) then
|
|
Index := Add('');
|
|
CheckSpecialChars;
|
|
Strings[Index] := GetName(Index) + FNameValueSeparator + Value;
|
|
end;
|
|
end;
|
|
|
|
procedure TUnicodeStrings.ReadData(Reader: TReader);
|
|
begin
|
|
Reader.ReadListBegin;
|
|
BeginUpdate;
|
|
try
|
|
Clear;
|
|
while not Reader.EndOfList do
|
|
Add(UTF8Decode(Reader.ReadString));
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
Reader.ReadListEnd;
|
|
end;
|
|
{
|
|
procedure TUnicodeStrings.SetDelimitedText(const AValue: UnicodeString);
|
|
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 UnicodeString
|
|
if i <= length(AValue) then
|
|
begin
|
|
if AValue[i] = FQuoteChar then
|
|
begin
|
|
// next UnicodeString 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 UnicodeString 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 TUnicodeStrings.SetCommaText(const Value: UnicodeString);
|
|
var
|
|
C1, C2: UnicodeChar;
|
|
begin
|
|
CheckSpecialChars;
|
|
C1 := Delimiter;
|
|
C2 := QuoteChar;
|
|
Delimiter := ',';
|
|
QuoteChar := '"';
|
|
try
|
|
SetDelimitedText(Value);
|
|
finally
|
|
Delimiter := C1;
|
|
QuoteChar := C2;
|
|
end;
|
|
end;
|
|
}
|
|
procedure TUnicodeStrings.SetStringsAdapter(const Value: IStringsAdapter);
|
|
begin
|
|
end;
|
|
|
|
procedure TUnicodeStrings.SetValue(const Name, Value: UnicodeString);
|
|
var
|
|
L: longint;
|
|
begin
|
|
CheckSpecialChars;
|
|
L := IndexOfName(Name);
|
|
if L = -1 then
|
|
Add(Name + FNameValueSeparator + Value)
|
|
else
|
|
Strings[L] := Name + FNameValueSeparator + Value;
|
|
end;
|
|
|
|
procedure TUnicodeStrings.WriteData(Writer: TWriter);
|
|
var
|
|
i: integer;
|
|
begin
|
|
Writer.WriteListBegin;
|
|
for i := 0 to Count - 1 do
|
|
Writer.WriteString(UTF8Encode(Strings[i]));
|
|
Writer.WriteListEnd;
|
|
end;
|
|
|
|
procedure TUnicodeStrings.DefineProperties(Filer: TFiler);
|
|
var
|
|
HasData: boolean;
|
|
begin
|
|
if Assigned(Filer.Ancestor) then
|
|
// Only serialize if UnicodeString list is different from ancestor
|
|
if Filer.Ancestor.InheritsFrom(TUnicodeStrings) then
|
|
HasData := not Equals(TUnicodeStrings(Filer.Ancestor))
|
|
else
|
|
HasData := True
|
|
else
|
|
HasData := Count > 0;
|
|
Filer.DefineProperty('Strings', ReadData, WriteData, HasData);
|
|
end;
|
|
|
|
procedure TUnicodeStrings.Error(const Msg: UnicodeString; Data: integer);
|
|
begin
|
|
raise EStringListError.CreateFmt(UTF8Encode(Msg), [Data]) at get_caller_addr(get_frame);
|
|
end;
|
|
|
|
//procedure TUnicodeStrings.Error(const Msg: pstring; Data: integer);
|
|
//begin
|
|
// raise EStringListError.CreateFmt(Msg^, [Data]) at get_caller_addr(get_frame);
|
|
//end;
|
|
|
|
function TUnicodeStrings.GetCapacity: integer;
|
|
begin
|
|
Result := Count;
|
|
end;
|
|
|
|
function TUnicodeStrings.GetObject(Index: integer): TObject;
|
|
begin
|
|
Result := nil;
|
|
end;
|
|
|
|
function TUnicodeStrings.GetTextStr: UnicodeString;
|
|
var
|
|
P: PUnicodeChar;
|
|
I, L, NLS: longint;
|
|
S, NL: UnicodeString;
|
|
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(UnicodeChar));
|
|
P := P + L;
|
|
for L := 1 to NLS do
|
|
begin
|
|
P^ := NL[L];
|
|
Inc(P);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TUnicodeStrings.Put(Index: integer; const S: UnicodeString);
|
|
var
|
|
Obj: TObject;
|
|
begin
|
|
Obj := Objects[Index];
|
|
Delete(Index);
|
|
InsertObject(Index, S, Obj);
|
|
end;
|
|
|
|
procedure TUnicodeStrings.PutObject(Index: integer; AObject: TObject);
|
|
begin
|
|
// Empty.
|
|
end;
|
|
|
|
procedure TUnicodeStrings.SetCapacity(NewCapacity: integer);
|
|
begin
|
|
// Empty.
|
|
end;
|
|
|
|
function GetNextLine(const Value: UnicodeString; out S: UnicodeString; var P: integer): boolean;
|
|
var
|
|
PS: PUnicodeChar;
|
|
IP, L: integer;
|
|
begin
|
|
L := Length(Value);
|
|
S := '';
|
|
Result := False;
|
|
if ((L - P) < 0) then
|
|
exit;
|
|
if ((L - P) = 0) and (not (Value[P] in [#10, #13])) then
|
|
begin
|
|
s := Value[P];
|
|
Inc(P);
|
|
Exit(True);
|
|
end;
|
|
PS := PUnicodeChar(Value) + P - 1;
|
|
IP := P;
|
|
while ((L - P) >= 0) and (not (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(UnicodeChar));
|
|
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 TUnicodeStrings.SetTextStr(const Value: UnicodeString);
|
|
var
|
|
S: UnicodeString;
|
|
P: integer;
|
|
begin
|
|
try
|
|
beginUpdate;
|
|
Clear;
|
|
P := 1;
|
|
while GetNextLine(Value, S, P) do
|
|
Add(S);
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TUnicodeStrings.SetUpdateState(Updating: boolean);
|
|
begin
|
|
end;
|
|
|
|
destructor TUnicodeStrings.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TUnicodeStrings.Add(const S: UnicodeString): integer;
|
|
begin
|
|
Result := Count;
|
|
Insert(Count, S);
|
|
end;
|
|
|
|
function TUnicodeStrings.AddObject(const S: UnicodeString; AObject: TObject): integer;
|
|
begin
|
|
Result := Add(S);
|
|
Objects[Result] := AObject;
|
|
end;
|
|
|
|
procedure TUnicodeStrings.Append(const S: UnicodeString);
|
|
begin
|
|
Add(S);
|
|
end;
|
|
|
|
procedure TUnicodeStrings.AddStrings(TheStrings: TUnicodeStrings);
|
|
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 TUnicodeStrings.Assign(Source: TPersistent);
|
|
var
|
|
S: TUnicodeStrings;
|
|
begin
|
|
if Source is TUnicodeStrings then
|
|
begin
|
|
S := TUnicodeStrings(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 TUnicodeStrings.BeginUpdate;
|
|
begin
|
|
if FUpdateCount = 0 then
|
|
SetUpdateState(True);
|
|
Inc(FUpdateCount);
|
|
end;
|
|
|
|
procedure TUnicodeStrings.EndUpdate;
|
|
begin
|
|
if FUpdateCount > 0 then
|
|
Dec(FUpdateCount);
|
|
if FUpdateCount = 0 then
|
|
SetUpdateState(False);
|
|
end;
|
|
|
|
function TUnicodeStrings.Equals(Obj: TObject): boolean;
|
|
var
|
|
TheStrings: TUnicodeStrings absolute Obj;
|
|
Runner, Nr: longint;
|
|
begin
|
|
if Obj is TUnicodeStrings then
|
|
begin
|
|
Nr := Self.Count;
|
|
Result := Nr = TheStrings.Count;
|
|
if Result then
|
|
for Runner := 0 to Nr - 1 do
|
|
begin
|
|
Result := Strings[Runner] = TheStrings[Runner];
|
|
if not Result then
|
|
Break;
|
|
end;
|
|
end
|
|
else
|
|
Result := inherited Equals(Obj);
|
|
end;
|
|
|
|
procedure TUnicodeStrings.Exchange(Index1, Index2: integer);
|
|
var
|
|
Obj: TObject;
|
|
Str: UnicodeString;
|
|
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 TUnicodeStrings.GetEnumerator: TUnicodeStringsEnumerator;
|
|
begin
|
|
Result := TUnicodeStringsEnumerator.Create(Self);
|
|
end;
|
|
{
|
|
function TUnicodeStrings.GetText: PUnicodeChar;
|
|
begin
|
|
Result := StrNew(PUnicodeChar(Self.Text));
|
|
end;
|
|
}
|
|
function TUnicodeStrings.DoCompareText(const s1, s2: UnicodeString): PtrInt;
|
|
begin
|
|
Result := UnicodeCompareText(s1, s2);
|
|
end;
|
|
|
|
function TUnicodeStrings.IndexOf(const S: UnicodeString): 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 TUnicodeStrings.IndexOfName(const Name: UnicodeString): integer;
|
|
var
|
|
len: longint;
|
|
S: UnicodeString;
|
|
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 TUnicodeStrings.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 TUnicodeStrings.InsertObject(Index: integer; const S: UnicodeString; AObject: TObject);
|
|
|
|
begin
|
|
Insert(Index, S);
|
|
Objects[Index] := AObject;
|
|
end;
|
|
|
|
procedure TUnicodeStrings.LoadFromFile(const FileName: String);
|
|
var
|
|
TheStream: TFileStream;
|
|
begin
|
|
TheStream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
|
|
try
|
|
LoadFromStream(TheStream);
|
|
finally
|
|
TheStream.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TUnicodeStrings.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(UTF8Decode(Buffer));
|
|
SetLength(Buffer, 0);
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TUnicodeStrings.Move(CurIndex, NewIndex: integer);
|
|
var
|
|
Obj: TObject;
|
|
Str: UnicodeString;
|
|
begin
|
|
BeginUpdate;
|
|
Obj := Objects[CurIndex];
|
|
Str := Strings[CurIndex];
|
|
Delete(Curindex);
|
|
InsertObject(NewIndex, Str, Obj);
|
|
EndUpdate;
|
|
end;
|
|
|
|
procedure TUnicodeStrings.SaveToFile(const FileName: String);
|
|
var
|
|
TheStream: TFileStream;
|
|
begin
|
|
TheStream := TFileStream.Create(FileName, fmCreate);
|
|
try
|
|
SaveToStream(TheStream);
|
|
finally
|
|
TheStream.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TUnicodeStrings.SaveToStream(Stream: TStream);
|
|
var
|
|
S: UnicodeString;
|
|
begin
|
|
S := Text;
|
|
Stream.WriteBuffer(Pointer(S)^, Length(S));
|
|
end;
|
|
|
|
procedure TUnicodeStrings.SetText(TheText: PUnicodeChar);
|
|
var
|
|
S: UnicodeString;
|
|
begin
|
|
if TheText <> nil then
|
|
S := TheText
|
|
else
|
|
S := '';
|
|
SetTextStr(S);
|
|
end;
|
|
|
|
{****************************************************************************}
|
|
{* TUnicodeStringList *}
|
|
{****************************************************************************}
|
|
|
|
procedure TUnicodeStringList.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 TUnicodeStringList.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 TUnicodeStringList.QuickSort(L, R: integer; CompareFn: TUnicodeStringListSortCompare);
|
|
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 TUnicodeStringList.InsertItem(Index: integer; const S: UnicodeString);
|
|
begin
|
|
Changing;
|
|
if FCount = Fcapacity then
|
|
Grow;
|
|
if Index < FCount then
|
|
System.Move(FList^[Index], FList^[Index + 1],
|
|
(FCount - Index) * SizeOf(TUnicodeStringItem));
|
|
Pointer(Flist^[Index].Fstring) := nil; // Needed to initialize...
|
|
Flist^[Index].FString := S;
|
|
Flist^[Index].Fobject := nil;
|
|
Inc(FCount);
|
|
Changed;
|
|
end;
|
|
|
|
procedure TUnicodeStringList.InsertItem(Index: integer; const S: UnicodeString; O: TObject);
|
|
begin
|
|
Changing;
|
|
if FCount = Fcapacity then
|
|
Grow;
|
|
if Index < FCount then
|
|
System.Move(FList^[Index], FList^[Index + 1],
|
|
(FCount - Index) * SizeOf(TUnicodeStringItem));
|
|
Pointer(Flist^[Index].Fstring) := nil; // Needed to initialize...
|
|
Flist^[Index].FString := S;
|
|
Flist^[Index].FObject := O;
|
|
Inc(FCount);
|
|
Changed;
|
|
end;
|
|
|
|
procedure TUnicodeStringList.SetSorted(Value: boolean);
|
|
begin
|
|
if FSorted <> Value then
|
|
begin
|
|
if Value then
|
|
sort;
|
|
FSorted := Value;
|
|
end;
|
|
end;
|
|
|
|
procedure TUnicodeStringList.Changed;
|
|
begin
|
|
if (FUpdateCount = 0) then
|
|
if Assigned(FOnChange) then
|
|
FOnchange(Self);
|
|
end;
|
|
|
|
procedure TUnicodeStringList.Changing;
|
|
begin
|
|
if FUpdateCount = 0 then
|
|
if Assigned(FOnChanging) then
|
|
FOnchanging(Self);
|
|
end;
|
|
|
|
procedure TUnicodeStringList.CheckError(Index: integer);
|
|
begin
|
|
if (Index < 0) or (Index >= Fcount) then
|
|
raise Exception.Create(Format('Index %d out of range in TUnicodeStringList.', [Index]));
|
|
end;
|
|
|
|
function TUnicodeStringList.Get(Index: integer): UnicodeString;
|
|
begin
|
|
CheckError(Index);
|
|
Result := Flist^[Index].FString;
|
|
end;
|
|
|
|
function TUnicodeStringList.GetCapacity: integer;
|
|
begin
|
|
Result := FCapacity;
|
|
end;
|
|
|
|
function TUnicodeStringList.GetCount: integer;
|
|
begin
|
|
Result := FCount;
|
|
end;
|
|
|
|
function TUnicodeStringList.GetObject(Index: integer): TObject;
|
|
begin
|
|
CheckError(Index);
|
|
Result := Flist^[Index].FObject;
|
|
end;
|
|
|
|
procedure TUnicodeStringList.Put(Index: integer; const S: UnicodeString);
|
|
begin
|
|
if Sorted then
|
|
raise Exception.Create('List is sorted in TUnicodeStringList.Put.');
|
|
CheckError(Index);
|
|
Changing;
|
|
Flist^[Index].FString := S;
|
|
Changed;
|
|
end;
|
|
|
|
procedure TUnicodeStringList.PutObject(Index: integer; AObject: TObject);
|
|
begin
|
|
CheckError(Index);
|
|
Changing;
|
|
Flist^[Index].FObject := AObject;
|
|
Changed;
|
|
end;
|
|
|
|
procedure TUnicodeStringList.SetCapacity(NewCapacity: integer);
|
|
var
|
|
NewList: Pointer;
|
|
MSize: longint;
|
|
begin
|
|
Assert(NewCapacity >= 0);
|
|
if NewCapacity > FCapacity then
|
|
begin
|
|
GetMem(NewList, NewCapacity * SizeOf(TUnicodeStringItem));
|
|
if NewList = nil then
|
|
raise Exception.Create('NewList is Nil in TUnicodeStringList.SetCapacity.');
|
|
if Assigned(FList) then
|
|
begin
|
|
MSize := FCapacity * Sizeof(TUnicodeStringItem);
|
|
System.Move(FList^, NewList^, MSize);
|
|
FillQWord(PChar(NewList)[MSize], (NewCapacity - FCapacity) * (SizeOf(TUnicodeStringItem) div SizeOf(QWord)), 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(TUnicodeStringItem));
|
|
System.Move(FList^, NewList^, NewCapacity * SizeOf(TUnicodeStringItem));
|
|
FreeMem(FList);
|
|
FList := NewList;
|
|
end;
|
|
FCapacity := NewCapacity;
|
|
end;
|
|
end;
|
|
|
|
procedure TUnicodeStringList.SetUpdateState(Updating: boolean);
|
|
begin
|
|
if Updating then
|
|
Changing
|
|
else
|
|
Changed;
|
|
end;
|
|
|
|
destructor TUnicodeStringList.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 TUnicodeStringList.Add(const S: UnicodeString): integer;
|
|
begin
|
|
if not Sorted then
|
|
Result := FCount
|
|
else
|
|
if Find(S, Result) then
|
|
case Duplicates of
|
|
dupIgnore: Exit;
|
|
dupError: raise Exception.Create('TUnicodeStringList.Duplicates does not allow duplicates.');
|
|
end;
|
|
InsertItem(Result, S);
|
|
end;
|
|
|
|
procedure TUnicodeStringList.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 TUnicodeStringList.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(TUnicodeStringItem));
|
|
Changed;
|
|
end;
|
|
|
|
procedure TUnicodeStringList.Exchange(Index1, Index2: integer);
|
|
begin
|
|
CheckError(Index1);
|
|
CheckError(Index2);
|
|
Changing;
|
|
ExchangeItems(Index1, Index2);
|
|
changed;
|
|
end;
|
|
|
|
procedure TUnicodeStringList.SetCaseSensitive(b: boolean);
|
|
begin
|
|
if b <> FCaseSensitive then
|
|
begin
|
|
FCaseSensitive := b;
|
|
if FSorted then
|
|
sort;
|
|
end;
|
|
end;
|
|
|
|
function TUnicodeStringList.DoCompareText(const s1, s2: UnicodeString): PtrInt;
|
|
begin
|
|
if FCaseSensitive then
|
|
Result := UnicodeCompareStr(s1, s2)
|
|
else
|
|
Result := UnicodeCompareText(s1, s2);
|
|
end;
|
|
|
|
function TUnicodeStringList.Find(const S: UnicodeString; var Index: integer): boolean;
|
|
var
|
|
L, R, I: integer;
|
|
CompareRes: PtrInt;
|
|
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 TUnicodeStringList.IndexOf(const S: UnicodeString): 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 TUnicodeStringList.Insert(Index: integer; const S: UnicodeString);
|
|
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 TUnicodeStringList.', [Index]));
|
|
InsertItem(Index, S);
|
|
end;
|
|
|
|
procedure TUnicodeStringList.CustomSort(CompareFn: TUnicodeStringListSortCompare);
|
|
begin
|
|
if not Sorted and (FCount > 1) then
|
|
begin
|
|
Changing;
|
|
QuickSort(0, FCount - 1, CompareFn);
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
function StringListAnsiCompare(List: TUnicodeStringList; Index1, Index: integer): integer;
|
|
begin
|
|
Result := List.DoCompareText(List.FList^[Index1].FString,
|
|
List.FList^[Index].FString);
|
|
end;
|
|
|
|
procedure TUnicodeStringList.Sort;
|
|
begin
|
|
CustomSort(@StringListAnsiCompare);
|
|
end;
|
|
|
|
{$endif}
|
|
|
|
//end.
|
|
|