Permalink
Find file
Fetching contributors…
Cannot retrieve contributors at this time
1424 lines (1219 sloc) 37 KB
unit OWideSupp;
{
Author:
Ondrej Pokorny, http://www.kluug.net
All Rights Reserved.
License:
MPL 1.1 / GPLv2 / LGPLv2 / FPC modified LGPLv2
Please see the /license.txt file for more information.
}
{
OWideSupp.pas
A collection of types, classes and methods to support WideStrings across all
compilers.
OWideString type:
Default string type that supports unicode characters
- Delphi 2009+ String (UTF-16)
- Delphi 2007- WideString (UTF-16)
- FPC String (UTF-8)
ORealWideString type:
Always a UTF-16 string type
- Delphi 2009+ String (UTF-16)
- Delphi 2007- WideString (UTF-16)
- FPC UnicodeString (UTF-16)
OFastString type:
The fastest possible character container for unicode characters
!!! must be converted with OFastToWide/OWideToFast to OWideString !!!
- should be used as internal string storage where high performance is needed
(basically only for D6-D2007 - their WideString performance is bad)
- Delphi 2009+ String (UTF-16)
- Delphi 2007- String (UTF-16 is stored inside!!!)
- FPC String (UTF-8)
TOWideStringList
- For Delphi 7-2007: TStringList replacement with WideStrings
}
{$I OXml.inc}
{$IFDEF O_DELPHI_XE4_UP}
{$ZEROBASEDSTRINGS OFF}
{$ENDIF}
{$IFDEF FPC}
{$MODE DELPHI}
{$ENDIF}
{$BOOLEVAL OFF}
interface
uses
{$IFDEF O_NAMESPACES}
System.SysUtils, System.Classes
{$ELSE}
SysUtils, Classes
{$ENDIF}
{$IF DEFINED(O_DELPHI_2006_UP) AND DEFINED(O_DELPHI_2007_DOWN)}
, WideStrUtils
{$IFEND}
{$IFDEF O_DELPHI_XE3_UP}
, Character
{$ENDIF}
{$IFDEF O_GENERICS}
{$IFDEF O_NAMESPACES}
, System.Generics.Collections
{$ELSE}
, Generics.Collections
{$ENDIF}
{$ENDIF}
;
type
{$IFDEF FPC}
OWideString = String;//UTF-8
ORealWideString = UnicodeString;//UTF-16
OWideChar = Char;
POWideChar = PChar;
ORawByteString = AnsiString;
ONativeInt = NativeInt;
ONativeUInt = NativeUInt;
{$ELSE}
{$IFDEF O_UNICODE}
OWideString = String;//UTF-16
ORealWideString = String;//UTF-16
OWideChar = Char;
POWideChar = PChar;
{$IFDEF O_RAWBYTESTRING}
ORawByteString = RawByteString;
{$ENDIF}
{$IFDEF O_DELPHI_2010_UP}
ONativeInt = NativeInt;
ONativeUInt = NativeUInt;
{$ELSE}
//D2009 bug
ONativeInt = Integer;
ONativeUInt = Cardinal;
{$ENDIF}
{$ELSE}
OWideString = WideString;//UTF-16
ORealWideString = WideString;//UTF-16
OWideChar = WideChar;
POWideChar = PWideChar;
ORawByteString = AnsiString;
ONativeInt = Integer;
ONativeUInt = Cardinal;
{$ENDIF}
{$ENDIF}
//OFastString is the fastest possible WideString replacement
//Unicode Delphi: String
//Non-unicode Delphi: WideString casted as AnsiString
//Lazarus: UTF8
{$IFDEF O_UNICODE}
OFastString = String;
{$ELSE}
OFastString = String;//WideString data is stored inside -> with double char size!!!
{$ENDIF}
TOWideStringArray = array of OWideString;
{$IFNDEF O_UNICODE}
TOWideStringList = class;
TOWideStringListSortCompare = function(List: TOWideStringList; Index1, Index2: Integer): Integer;
TOWideStringList = class(TPersistent)
protected
fList: TStringList;
private
function GetI(Index: Integer): OWideString;
function GetCount: Integer;
function GetText: OWideString;
function GetCapacity: Integer;
function GetCommaText: OWideString;
function GetDelimitedText: OWideString;
function GetDelimiter: Char;
function GetName(Index: Integer): OWideString;
function GetObject(Index: Integer): TObject;
function GetQuoteChar: Char;
function GetValue(const Name: OWideString): OWideString;
function GetCaseSensitive: Boolean;
function GetDuplicates: TDuplicates;
function GetOnChange: TNotifyEvent;
function GetOnChanging: TNotifyEvent;
function GetSorted: Boolean;
procedure SetI(Index: Integer; const Value: OWideString);
procedure SetText(const Value: OWideString);
procedure SetObject(Index: Integer; const Value: TObject);
procedure SetCapacity(const Value: Integer);
procedure SetCommaText(const Value: OWideString);
procedure SetDelimitedText(const Value: OWideString);
procedure SetDelimiter(const Value: Char);
procedure SetQuoteChar(const Value: Char);
procedure SetValue(const Name, Value: OWideString);
procedure SetCaseSensitive(const Value: Boolean);
procedure SetDuplicates(const Value: TDuplicates);
procedure SetOnChange(const Value: TNotifyEvent);
procedure SetOnChanging(const Value: TNotifyEvent);
procedure SetSorted(const Value: Boolean);
{$IFDEF O_DELPHI_7_UP}
function GetNameValueSeparator: Char;
function GetValueFromIndex(Index: Integer): OWideString;
procedure SetNameValueSeparator(const Value: Char);
procedure SetValueFromIndex(Index: Integer; const Value: OWideString);
{$ENDIF}
{$IFDEF O_DELPHI_2006_UP}
function GetLineBreak: OWideString;
procedure SetLineBreak(const Value: OWideString);
function GetStrictDelimiter: Boolean;
procedure SetStrictDelimiter(const Value: Boolean);
{$ENDIF}
protected
procedure Changed;
procedure Changing;
function CompareStrings(const S1, S2: OWideString): Integer;
public
constructor Create;
destructor Destroy; override;
public
function Add(const S: OWideString): Integer;
function AddObject(const S: OWideString; AObject: TObject): Integer;
procedure AddStrings(Strings: TStrings); overload;
procedure AddStrings(Strings: TOWideStringList); overload;
procedure Assign(Source: TPersistent); override;
procedure BeginUpdate;
procedure Clear;
procedure Delete(Index: Integer);
procedure EndUpdate;
function Equals(Strings: TOWideStringList): Boolean; reintroduce;
procedure Exchange(Index1, Index2: Integer);
function IndexOf(const S: OWideString): Integer;
function IndexOfName(const Name: OWideString): Integer;
function IndexOfObject(AObject: TObject): Integer;
procedure Insert(Index: Integer; const S: OWideString);
procedure InsertObject(Index: Integer; const S: OWideString;
AObject: TObject);
procedure LoadFromFile(const FileName: String);
procedure LoadFromStream(Stream: TStream);
procedure Move(CurIndex, NewIndex: Integer);
procedure SaveToFile(const FileName: string);
procedure SaveToStream(Stream: TStream);
procedure Sort;
procedure CustomSort(Compare: TOWideStringListSortCompare); virtual;
procedure QuickSort(L, R: Integer; SCompare: TOWideStringListSortCompare);
public
property Capacity: Integer read GetCapacity write SetCapacity;
property Count: Integer read GetCount;
property CommaText: OWideString read GetCommaText write SetCommaText;
property Delimiter: Char read GetDelimiter write SetDelimiter;
property DelimitedText: OWideString read GetDelimitedText write SetDelimitedText;
property Names[Index: Integer]: OWideString read GetName;
property Objects[Index: Integer]: TObject read GetObject write SetObject;
property QuoteChar: Char read GetQuoteChar write SetQuoteChar;
property Values[const Name: OWideString]: OWideString read GetValue write SetValue;
property Strings[Index: Integer]: OWideString read GetI write SetI; default;
property Text: OWideString read GetText write SetText;
property Duplicates: TDuplicates read GetDuplicates write SetDuplicates;
property Sorted: Boolean read GetSorted write SetSorted;
property CaseSensitive: Boolean read GetCaseSensitive write SetCaseSensitive;
property OnChange: TNotifyEvent read GetOnChange write SetOnChange;
property OnChanging: TNotifyEvent read GetOnChanging write SetOnChanging;
{$IFDEF O_DELPHI_7_UP}
property NameValueSeparator: Char read GetNameValueSeparator write SetNameValueSeparator;
property ValueFromIndex[Index: Integer]: OWideString read GetValueFromIndex write SetValueFromIndex;
{$ENDIF}
{$IFDEF O_DELPHI_2006_UP}
property LineBreak: OWideString read GetLineBreak write SetLineBreak;
property StrictDelimiter: Boolean read GetStrictDelimiter write SetStrictDelimiter;
{$ENDIF}
end;
{$ELSE}
TOWideStringList = TStringList;
{$ENDIF}
TOTextBuffer = class(TPersistent)
private
fBuffer: Array of OWideChar;//Faster in D7 than OWideString
fAllocLength: Integer;//allocated length
fUsedLength: Integer;//used length
fRemaining: Integer;//fAllocLength-fUsedLength
fDefBufferLength: Integer;
protected
procedure AssignTo(Dest: TPersistent); override;
public
procedure Clear(const aFullClear: Boolean = True);
procedure GetBuffer(var outString: OWideString); overload;
procedure GetBuffer(var outString: OWideString; const aPosition, aLength: Integer); overload;
function GetBuffer: OWideString; overload;
procedure RemoveLastChar;
procedure RemoveLastString(const aLength: Integer);
procedure WriteChar(const aChar: OWideChar);
procedure WriteString(const aString: OWideString); overload;//outPosition 1-based!
procedure WriteString(const aString: OWideString; var outPosition, outLength: Integer); overload;//outPosition 1-based!
procedure Grow(const aMinChars: Integer);
constructor Create(const aBufferLength: Integer = 1024);
public
property UsedLength: Integer read fUsedLength;
property AllocLength: Integer read fAllocLength;
end;
TOWideStringStackItem = packed record
Position: Integer;
Length: Integer;
end;
POWideStringStackItem = ^TOWideStringStackItem;
TOWideStringStackArray = Array of TOWideStringStackItem;
POWideStringStackArray = ^TOWideStringStackArray;
TOBufferWideStrings = class(TPersistent)
private
fBuffer: TOTextBuffer;
{$IFDEF O_GENERICS}
fItems: TList<POWideStringStackArray>;//Memory blocks of 1024 elements. Do not reallocate its memory!
{$ELSE}
fItems: TList;
{$ENDIF}
fItemsAllocCount: Integer;//allocated count
fItemsUsedCount: Integer;//used count
private
function GetItem(const aIndex: Integer; var outItem: POWideStringStackItem): Boolean;
protected
procedure Grow;
procedure DoCreate; virtual;
procedure AssignTo(Dest: TPersistent); override;
public
constructor Create;
destructor Destroy; override;
public
function Add(const aString: OWideString): Integer;
function Get(const aIndex: Integer): OWideString; overload; {$IFDEF O_INLINE}inline;{$ENDIF}
procedure Get(const aIndex: Integer; var outString: OWideString); overload; {$IFDEF O_INLINE}inline;{$ENDIF}
procedure DeleteLast;
procedure Clear(const aFullClear: Boolean = True);
public
property Count: Integer read fItemsUsedCount;
end;
function OStringReplace(const S, OldPattern, NewPattern: OWideString;
Flags: TReplaceFlags): OWideString; {$IFDEF O_INLINE}inline;{$ENDIF}
function OLowerCase(const aStr: OWideString): OWideString; {$IFDEF O_INLINE}inline;{$ENDIF}
function OUpperCase(const aStr: OWideString): OWideString; {$IFDEF O_INLINE}inline;{$ENDIF}
{$IFNDEF NEXTGEN}
//CharInSet for all compilers
function OCharInSet(const aChar: OWideChar; const aSet: TSysCharSet): Boolean; {$IFDEF O_INLINE}inline;{$ENDIF}
{$ENDIF}
//really WideString enabled CharInSet -> but slower!
function OCharInSetW(const aChar: OWideChar; const aCharArray: Array of OWideChar): Boolean;//TRUE WIDE SUPPORT
{$IFDEF O_DELPHI_6_DOWN}
type
TFormatSettings = record
DecimalSeparator: AnsiChar;
ThousandSeparator: AnsiChar;
TimeSeparator: AnsiChar;
ListSeparator: AnsiChar;
ShortDateFormat: AnsiString;
LongDateFormat: AnsiString;
ShortTimeFormat: AnsiString;
LongTimeFormat: AnsiString;
end;
{$ENDIF}
//GetLocaleFormatSettings for all compilers
function OGetLocaleFormatSettings: TFormatSettings; {$IFDEF O_INLINE}inline;{$ENDIF}
{$IFNDEF NEXTGEN}
//wide string to owidestring and back
function WSToOWS(const aWS: WideString): OWideString; {$IFDEF O_INLINE}inline;{$ENDIF}
function OWSToWS(const aOWS: OWideString): WideString; {$IFDEF O_INLINE}inline;{$ENDIF}
//ansi string to owidestring and back
function ASToOWS(const aAS: AnsiString): OWideString; {$IFDEF O_INLINE}inline;{$ENDIF}
function OWSLength(const aOWS: OWideString): Integer; {$IFDEF O_INLINE}inline;{$ENDIF}
{$ENDIF}
//ofaststring to owidestring and back
{$IFNDEF O_UNICODE}
function OFastToWide(const aSourceFast: OFastString): OWideString; {$IFDEF O_INLINE}inline;{$ENDIF}
function OWideToFast(const aSourceWide: OWideString): OFastString; overload; {$IFDEF O_INLINE}inline;{$ENDIF}
procedure OWideToFast(const aSourceWide: OWideString; var outDestFast: OFastString); overload; {$IFDEF O_INLINE}inline;{$ENDIF}
{$ENDIF}
//split a text to pieces with a delimiter
//if aConsiderQuotes=True, delimiters in quotes are ignored
//quotes must be escaped in XML-style, i.e. escaping with backslash is not considered as escaped: \" will not work
procedure OExplode(const aText: OWideString; const aDelimiter: OWideChar;
const aStrList: TOWideStringList; const aConsiderQuotes: Boolean = False);
procedure OExpandPath(const aReferencePath, aVarPath: TOWideStringList);
function OReplaceLineBreaks(const aString: OWideString; const aLineBreak: OWideString = sLineBreak): OWideString;
implementation
function OReplaceLineBreaks(const aString: OWideString; const aLineBreak: OWideString = sLineBreak): OWideString;
var
IRes, IStr: Integer;
xStrLen: Integer;
xLineBreakByteSize: Integer;
xExtraLineBreakInc: Integer;
procedure _CopyLineBreak;
begin
if xLineBreakByteSize > 0 then
Move(aLineBreak[1], Result[IRes], xLineBreakByteSize);
if xExtraLineBreakInc <> 0 then
Inc(IRes, xExtraLineBreakInc);
end;
begin
xStrLen := Length(aString);
xLineBreakByteSize := Length(aLineBreak)*SizeOf(OWideChar);
xExtraLineBreakInc := Length(aLineBreak)-1;
SetLength(Result, xStrLen*2);//worst case #10 -> #13#10
IRes := 1;
IStr := 1;
while IStr <= xStrLen do begin
case aString[IStr] of
#13: begin
_CopyLineBreak;
if (IStr < xStrLen) and (aString[IStr+1] = #10) then
Inc(IStr);
end;
#10: _CopyLineBreak;
else
Result[IRes] := aString[IStr];
end;
Inc(IRes);
Inc(IStr);
end;
SetLength(Result, IRes-1);
end;
procedure OExpandPath(const aReferencePath, aVarPath: TOWideStringList);
var
xNewPath: TOWideStringList;
I: Integer;
begin
if (aVarPath.Count > 0) and (aVarPath[aVarPath.Count-1] = '') then//delete last empty element ("root/name/")
aVarPath.Delete(aVarPath.Count-1);
if (aVarPath.Count = 0) then begin//current directory
aVarPath.Assign(aReferencePath);
Exit;
end;
xNewPath := TOWideStringList.Create;
try
if (aVarPath[0] <> '') then//is relative path
xNewPath.Assign(aReferencePath);
for I := 0 to aVarPath.Count-1 do begin
if aVarPath[I] = '..' then
begin
//go up
if xNewPath.Count > 0 then
xNewPath.Delete(xNewPath.Count-1);
end
else
if (aVarPath[I] <> '.') and (aVarPath[I] <> '') then//not current directory
begin
xNewPath.Add(aVarPath[I]);
end;
end;
aVarPath.Assign(xNewPath);
finally
xNewPath.Free;
end;
end;
procedure OExplode(const aText: OWideString; const aDelimiter: OWideChar;
const aStrList: TOWideStringList; const aConsiderQuotes: Boolean);
var
xBuffer: OWideString;
xI, xTextLength: Integer;
xC: OWideChar;
procedure _ClearBuffer;
begin
xBuffer := '';
end;
function _ReadChar: Boolean;
begin
Result := (xI <= xTextLength);
if Result then begin
xC := aText[xI];
Inc(xI);
xBuffer := xBuffer + xC;
end;
end;
procedure _DeleteLastCharFromBuffer;
begin
if xBuffer <> '' then
SetLength(xBuffer, Length(xBuffer)-1);
end;
procedure _AddBufferToStrList;
begin
aStrList.Add(xBuffer);
_ClearBuffer;
end;
begin
aStrList.Clear;
xTextLength := Length(aText);
if xTextLength = 0 then
Exit;
xI := 1;
while _ReadChar do begin
if aConsiderQuotes then begin
case xC of
'"':begin
while _ReadChar do
if xC = '"' then
Break;
end;
'''': begin
while _ReadChar do
if xC = '''' then
Break;
end;
end;
end;
if xC = aDelimiter then begin
_DeleteLastCharFromBuffer;
_AddBufferToStrList;
end;
end;
_AddBufferToStrList;//must be here
end;
function OLowerCase(const aStr: OWideString): OWideString;
begin
{$IFDEF O_UNICODE}
Result := LowerCase(aStr);
{$ELSE}
Result := WideLowerCase(aStr);
{$ENDIF}
end;
function OUpperCase(const aStr: OWideString): OWideString;
begin
{$IFDEF O_UNICODE}
Result := UpperCase(aStr);
{$ELSE}
Result := WideUpperCase(aStr);
{$ENDIF}
end;
{$IFNDEF O_UNICODE}
function OFastToWide(const aSourceFast: OFastString): OWideString;
var
xL: Integer;
xS: PWideChar;
I: Integer;
begin
xL := Length(aSourceFast) div SizeOf(OWideChar);
SetLength(Result, xL);
if xL > 0 then
begin
xS := @aSourceFast[1];
for I := 1 to xL do
begin
Result[I] := xS^;
Inc(xS);
end;
end;
end;
function OWideToFast(const aSourceWide: OWideString): OFastString;
begin
OWideToFast(aSourceWide, Result);
end;
procedure OWideToFast(const aSourceWide: OWideString; var outDestFast: OFastString);
var
xL: Integer;
xR: PWideChar;
I: Integer;
begin
xL := Length(aSourceWide);
SetLength(outDestFast, xL*SizeOf(OWideChar));
if xL > 0 then
begin
xR := @outDestFast[1];
for I := 1 to xL do
begin
xR^ := aSourceWide[I];
Inc(xR);
end;
end;
end;
{$ENDIF}
{$IFNDEF NEXTGEN}
function OCharInSet(const aChar: OWideChar; const aSet: TSysCharSet): Boolean;
begin
Result := (Ord(aChar) <= 255) and ({$IFDEF NEXTGEN}Char{$ELSE}AnsiChar{$ENDIF}(aChar) in aSet);
end;
{$ENDIF}
function OCharInSetW(const aChar: OWideChar; const aCharArray: Array of OWideChar): Boolean;
var I: Integer;
begin
for I := Low(aCharArray) to High(aCharArray) do
if aChar = aCharArray[I] then begin
Result := True;
Exit;
end;
Result := False;
end;
function OWSLength(const aOWS: OWideString): Integer; {$IFDEF O_INLINE}inline;{$ENDIF}
begin
{$IFDEF FPC}
Result := Length(OWSToWS(aOWS));
{$ELSE}
Result := Length(aOWS);
{$ENDIF}
end;
{$IFNDEF NEXTGEN}
function ASToOWS(const aAS: AnsiString): OWideString; {$IFDEF O_INLINE}inline;{$ENDIF}
begin
{$IFDEF FPC}
Result := AnsiToUtf8(aAS);
{$ELSE}
Result := OWideString(aAS);
{$ENDIF}
end;
function WSToOWS(const aWS: WideString): OWideString; {$IFDEF O_INLINE}inline;{$ENDIF}
begin
{$IFDEF FPC}
Result := UTF8Encode(aWS);
{$ELSE}
Result := aWS;
{$ENDIF}
end;
function OWSToWS(const aOWS: OWideString): WideString; {$IFDEF O_INLINE}inline;{$ENDIF}
begin
{$IFDEF FPC}
Result := UTF8Decode(aOWS);
{$ELSE}
Result := aOWS;
{$ENDIF}
end;
{$ENDIF}
function OGetLocaleFormatSettings: TFormatSettings;
begin
{$IF DEFINED(FPC)}
Result := DefaultFormatSettings;
{$ELSEIF DEFINED(O_DELPHI_XE_UP)}
Result := TFormatSettings.Create;
{$ELSEIF DEFINED(O_DELPHI_6_DOWN)}
Result.DecimalSeparator := DecimalSeparator;
Result.ThousandSeparator := #0;
Result.TimeSeparator := TimeSeparator;
Result.ListSeparator := ListSeparator;
Result.ShortDateFormat := ShortDateFormat;
Result.LongDateFormat := LongDateFormat;
Result.ShortTimeFormat := ShortTimeFormat;
Result.LongTimeFormat := LongTimeFormat;
{$ELSE}
GetLocaleFormatSettings(0, Result);
{$IFEND}
end;
{$IF NOT DEFINED(O_DELPHI_2006_UP)}
//Delphi 6, 7
function WideStringReplace(const S, OldPattern, NewPattern: WideString;
Flags: TReplaceFlags): WideString; {$IFDEF O_INLINE}inline;{$ENDIF}
var
SearchStr, OldPatt: WideString;
I, L, K, OldPattLength, NewPattLength, SLength: Integer;
begin
if (OldPattern = '') or (S = '') then
Exit;
if rfIgnoreCase in Flags then
begin
SearchStr := WideUpperCase(S);
OldPatt := WideUpperCase(OldPattern);
end
else
begin
SearchStr := S;
OldPatt := OldPattern;
end;
OldPattLength := Length(OldPatt);
NewPattLength := Length(NewPattern);
SLength := Length(S);
if NewPattLength <= OldPattLength then
SetLength(Result, SLength)
else
SetLength(Result, (SLength*NewPattLength) div OldPattLength + OldPattLength);//maximum length + some extra buffer just in case...
I := 1;//position in S
L := 1;//position in Result
while I <= SLength-OldPattLength+1 do
begin
if CompareMem(@SearchStr[I], @OldPatt[1], OldPattLength*SizeOf(WideChar)) then
begin
//pattern found
for K := 1 to NewPattLength do
begin
Result[L] := NewPattern[K];
Inc(L);
end;
Inc(I, OldPattLength);
if not(rfReplaceAll in Flags) then
break;
end
else
begin
//pattern not found
Result[L] := S[I];
Inc(I);
Inc(L);
end;
end;
//write trail
while I <= SLength do
begin
Result[L] := S[I];
Inc(I);
Inc(L);
end;
if Length(Result) <> L-1 then
SetLength(Result, L-1);
end;
{$IFEND}
function OStringReplace(const S, OldPattern, NewPattern: OWideString;
Flags: TReplaceFlags): OWideString;
begin
{$IF DEFINED(O_UNICODE)}
//D2009+, FPC
Result := StringReplace(S, OldPattern, NewPattern, Flags);
{$ELSE}
//D6-D2007
Result := WideStringReplace(S, OldPattern, NewPattern, Flags);
{$IFEND}
end;
{$IFNDEF O_UNICODE}
{ TOWideStringList }
function TOWideStringList.Add(const S: OWideString): Integer;
begin
Result := fList.Add(UTF8Decode(S));
end;
function TOWideStringList.AddObject(const S: OWideString; AObject: TObject): Integer;
begin
Result := fList.AddObject(UTF8Decode(S), AObject);
end;
procedure TOWideStringList.AddStrings(Strings: TOWideStringList);
var
I: Integer;
begin
BeginUpdate;
try
for I := 0 to Strings.Count - 1 do
fList.AddObject(Strings.fList[I], Strings.fList.Objects[I]);
finally
EndUpdate;
end;
end;
procedure TOWideStringList.Assign(Source: TPersistent);
begin
if Source is TStrings then
fList.Assign(Source)
else if Source is TOWideStringList then
fList.Assign(TOWideStringList(Source).fList);
end;
procedure TOWideStringList.BeginUpdate;
begin
fList.BeginUpdate;
end;
procedure TOWideStringList.AddStrings(Strings: TStrings);
begin
fList.AddStrings(Strings);
end;
type
TMyStringList = class(TStringList);
procedure TOWideStringList.Changed;
begin
TMyStringList(fList).Changed;
end;
procedure TOWideStringList.Changing;
begin
TMyStringList(fList).Changing;
end;
procedure TOWideStringList.Clear;
begin
fList.Clear;
end;
function TOWideStringList.CompareStrings(const S1, S2: OWideString): Integer;
begin
Result := WideCompareText(S1, S2);
end;
constructor TOWideStringList.Create;
begin
inherited Create;
fList := TStringList.Create;
end;
procedure TOWideStringList.CustomSort(Compare: TOWideStringListSortCompare);
begin
if not Sorted and (Count > 1) then
begin
BeginUpdate;
try
QuickSort(0, Count - 1, Compare);
finally
EndUpdate;
end;
end;
end;
procedure TOWideStringList.Delete(Index: Integer);
begin
fList.Delete(Index);
end;
destructor TOWideStringList.Destroy;
begin
fList.Destroy;
inherited;
end;
procedure TOWideStringList.EndUpdate;
begin
fList.EndUpdate;
end;
function TOWideStringList.Equals(Strings: TOWideStringList): Boolean;
begin
Result := fList.Equals(Strings.fList);
end;
procedure TOWideStringList.Exchange(Index1, Index2: Integer);
begin
fList.Exchange(Index1, Index2);
end;
function TOWideStringList.GetCapacity: Integer;
begin
Result := fList.Capacity;
end;
function TOWideStringList.GetCaseSensitive: Boolean;
begin
Result := fList.CaseSensitive;
end;
function TOWideStringList.GetCommaText: OWideString;
begin
Result := UTF8Decode(fList.CommaText);
end;
function TOWideStringList.GetCount: Integer;
begin
Result := fList.Count;
end;
function TOWideStringList.GetDelimitedText: OWideString;
begin
Result := UTF8Decode(fList.DelimitedText);
end;
function TOWideStringList.GetDelimiter: Char;
begin
Result := fList.Delimiter;
end;
function TOWideStringList.GetDuplicates: TDuplicates;
begin
Result := fList.Duplicates;
end;
function TOWideStringList.GetI(Index: Integer): OWideString;
begin
Result := UTF8Decode(fList[Index]);
end;
function TOWideStringList.GetName(Index: Integer): OWideString;
begin
Result := UTF8Decode(fList.Names[Index]);
end;
function TOWideStringList.GetObject(Index: Integer): TObject;
begin
Result := fList.Objects[Index];
end;
function TOWideStringList.GetOnChange: TNotifyEvent;
begin
Result := fList.OnChange;
end;
function TOWideStringList.GetOnChanging: TNotifyEvent;
begin
Result := fList.OnChanging;
end;
function TOWideStringList.GetQuoteChar: Char;
begin
Result := fList.QuoteChar;
end;
function TOWideStringList.GetSorted: Boolean;
begin
Result := fList.Sorted;
end;
function TOWideStringList.GetText: OWideString;
begin
Result := UTF8Decode(fList.Text);
end;
function TOWideStringList.GetValue(const Name: OWideString): OWideString;
begin
Result := UTF8Decode(fList.Values[UTF8Encode(Name)]);
end;
function TOWideStringList.IndexOf(const S: OWideString): Integer;
begin
Result := fList.IndexOf(UTF8Encode(S));
end;
function TOWideStringList.IndexOfName(const Name: OWideString): Integer;
begin
Result := fList.IndexOfName(UTF8Encode(Name));
end;
function TOWideStringList.IndexOfObject(AObject: TObject): Integer;
begin
Result := fList.IndexOfObject(AObject);
end;
procedure TOWideStringList.Insert(Index: Integer; const S: OWideString);
begin
fList.Insert(Index, UTF8Encode(S));
end;
procedure TOWideStringList.InsertObject(Index: Integer; const S: OWideString;
AObject: TObject);
begin
fList.InsertObject(Index, UTF8Encode(S), AObject);
end;
procedure TOWideStringList.LoadFromFile(const FileName: string);
begin
fList.LoadFromFile(FileName);
end;
procedure TOWideStringList.LoadFromStream(Stream: TStream);
begin
fList.LoadFromStream(Stream);
end;
procedure TOWideStringList.Move(CurIndex, NewIndex: Integer);
begin
fList.Move(CurIndex, NewIndex);
end;
procedure TOWideStringList.QuickSort(L, R: Integer;
SCompare: TOWideStringListSortCompare);
var
I, J, P: Integer;
begin
BeginUpdate;
try
repeat
I := L;
J := R;
P := (L + R) shr 1;
repeat
while SCompare(Self, I, P) < 0 do Inc(I);
while SCompare(Self, J, P) > 0 do Dec(J);
if I <= J then
begin
if I <> J then
Exchange(I, J);
if P = I then
P := J
else if P = J then
P := I;
Inc(I);
Dec(J);
end;
until I > J;
if L < J then QuickSort(L, J, SCompare);
L := I;
until I >= R;
finally
EndUpdate;
end;
end;
procedure TOWideStringList.SaveToFile(const FileName: string);
begin
fList.SaveToFile(FileName);
end;
procedure TOWideStringList.SaveToStream(Stream: TStream);
begin
fList.SaveToStream(Stream);
end;
procedure TOWideStringList.SetCapacity(const Value: Integer);
begin
fList.Capacity := Value;
end;
procedure TOWideStringList.SetCaseSensitive(const Value: Boolean);
begin
fList.CaseSensitive := Value;
end;
procedure TOWideStringList.SetCommaText(const Value: OWideString);
begin
fList.CommaText := UTF8Encode(Value);
end;
procedure TOWideStringList.SetDelimitedText(const Value: OWideString);
begin
fList.DelimitedText := UTF8Encode(Value);
end;
procedure TOWideStringList.SetDelimiter(const Value: Char);
begin
fList.Delimiter := Value;
end;
procedure TOWideStringList.SetDuplicates(const Value: TDuplicates);
begin
fList.Duplicates := Value;
end;
procedure TOWideStringList.SetI(Index: Integer; const Value: OWideString);
begin
fList[Index] := UTF8Encode(Value);
end;
procedure TOWideStringList.SetObject(Index: Integer; const Value: TObject);
begin
fList.Objects[Index] := Value;
end;
procedure TOWideStringList.SetOnChange(const Value: TNotifyEvent);
begin
fList.OnChange := Value;
end;
procedure TOWideStringList.SetOnChanging(const Value: TNotifyEvent);
begin
fList.OnChanging := Value;
end;
procedure TOWideStringList.SetQuoteChar(const Value: Char);
begin
fList.QuoteChar := Value;
end;
procedure TOWideStringList.SetSorted(const Value: Boolean);
begin
fList.Sorted := Value;
end;
procedure TOWideStringList.SetText(const Value: OWideString);
begin
fList.Text := UTF8Encode(Value);
end;
procedure TOWideStringList.SetValue(const Name, Value: OWideString);
begin
fList.Values[UTF8Encode(Name)] := UTF8Encode(Value);
end;
function OWideStringListCompareStrings(List: TOWideStringList; Index1, Index2: Integer): Integer;
begin
Result := List.CompareStrings(List[Index1],
List[Index2]);
end;
procedure TOWideStringList.Sort;
begin
CustomSort(OWideStringListCompareStrings);
end;
{$IFDEF O_DELPHI_7_UP}
function TOWideStringList.GetNameValueSeparator: Char;
begin
Result := fList.NameValueSeparator;
end;
procedure TOWideStringList.SetNameValueSeparator(const Value: Char);
begin
fList.NameValueSeparator := Value;
end;
function TOWideStringList.GetValueFromIndex(Index: Integer): OWideString;
begin
Result := UTF8Decode(fList.ValueFromIndex[Index]);
end;
procedure TOWideStringList.SetValueFromIndex(Index: Integer;
const Value: OWideString);
begin
fList.ValueFromIndex[Index] := UTF8Encode(Value);
end;
{$ENDIF}
{$IFDEF O_DELPHI_2006_UP}
function TOWideStringList.GetLineBreak: OWideString;
begin
Result := UTF8Decode(fList.LineBreak);
end;
function TOWideStringList.GetStrictDelimiter: Boolean;
begin
Result := fList.StrictDelimiter;
end;
procedure TOWideStringList.SetLineBreak(const Value: OWideString);
begin
fList.LineBreak := UTF8Encode(Value);
end;
procedure TOWideStringList.SetStrictDelimiter(const Value: Boolean);
begin
fList.StrictDelimiter := Value;
end;
{$ENDIF}
{$ENDIF O_UNICODE}//TOWideStringList
{ TOBufferWideStrings }
function TOBufferWideStrings.Add(const aString: OWideString): Integer;
var
xNewItem: POWideStringStackItem;
begin
Result := fItemsUsedCount;
if fItemsUsedCount = fItemsAllocCount then
Grow;
Inc(fItemsUsedCount);
GetItem(fItemsUsedCount-1, {%H-}xNewItem);
fBuffer.WriteString(aString, xNewItem.Position, xNewItem.Length);
end;
procedure TOBufferWideStrings.AssignTo(Dest: TPersistent);
var
xDestStrL: TStrings;
xDestWStrL: TOWideStringList;
xDestBWS: TOBufferWideStrings;
I: Integer;
begin
if Dest is TOWideStringList then begin
xDestWStrL := TOWideStringList(Dest);
xDestWStrL.Clear;
for I := 0 to Count-1 do
xDestWStrL.Add(Get(I));
end else
if Dest is TStrings then begin
xDestStrL := TStrings(Dest);
xDestStrL.Clear;
for I := 0 to Count-1 do
xDestStrL.Add(Get(I));
end else
if Dest is TOBufferWideStrings then begin
xDestBWS := TOBufferWideStrings(Dest);
xDestBWS.Clear;
for I := 0 to Count-1 do
xDestBWS.Add(Get(I));
end else
inherited;
end;
procedure TOBufferWideStrings.Clear(const aFullClear: Boolean);
begin
fItemsUsedCount := 0;
fBuffer.Clear(aFullClear);
end;
constructor TOBufferWideStrings.Create;
begin
inherited Create;
DoCreate;
end;
procedure TOBufferWideStrings.DeleteLast;
var
xItem: POWideStringStackItem;
begin
if fItemsUsedCount = 0 then
Exit;
GetItem(fItemsUsedCount-1, {%H-}xItem);
Dec(fItemsUsedCount);
fBuffer.RemoveLastString(xItem.Length);
end;
destructor TOBufferWideStrings.Destroy;
var
I: Integer;
begin
for I := 0 to fItems.Count-1 do
Dispose(POWideStringStackArray(fItems[I]));
fBuffer.Free;
fItems.Free;
inherited;
end;
procedure TOBufferWideStrings.DoCreate;
begin
{$IFDEF O_GENERICS}
fItems := TList<POWideStringStackArray>.Create;
{$ELSE}
fItems := TList.Create;
{$ENDIF}
fBuffer := TOTextBuffer.Create(1024);
end;
function TOBufferWideStrings.Get(const aIndex: Integer): OWideString;
begin
Get(aIndex, {%H-}Result);
end;
procedure TOBufferWideStrings.Get(const aIndex: Integer;
var outString: OWideString);
var
xItem: POWideStringStackItem;
begin
if GetItem(aIndex, {%H-}xItem) then
fBuffer.GetBuffer({%H-}outString, xItem.Position, xItem.Length)
else
outString := '';
end;
function TOBufferWideStrings.GetItem(const aIndex: Integer; var outItem: POWideStringStackItem): Boolean;
begin
Result := (aIndex >= 0) and (aIndex < fItemsUsedCount);
if Result then
outItem := @(POWideStringStackArray(fItems[aIndex shr 10])^)[aIndex and 1023]//= [aNode div 1024][aNode mod 1024]
else
outItem := nil;
end;
procedure TOBufferWideStrings.Grow;
var
xNewArray: POWideStringStackArray;
begin
fItemsAllocCount := fItemsAllocCount+1024;
New(xNewArray);
SetLength(xNewArray^, 1024);
fItems.Add(xNewArray);
end;
{ TOTextBuffer }
procedure TOTextBuffer.AssignTo(Dest: TPersistent);
var
xDest: TOTextBuffer;
begin
if Dest is TOTextBuffer then begin
xDest := TOTextBuffer(Dest);
if xDest.fAllocLength < Self.fAllocLength then begin
xDest.fAllocLength := Self.fAllocLength;
SetLength(xDest.fBuffer, xDest.fAllocLength);
end;
xDest.fUsedLength := Self.fUsedLength;
xDest.fRemaining := Self.fRemaining;
xDest.fBuffer := Copy(Self.fBuffer, 0, Self.fUsedLength);
end else
inherited;
end;
procedure TOTextBuffer.Clear(const aFullClear: Boolean);
begin
if aFullClear and (fAllocLength > fDefBufferLength) then begin
fAllocLength := fDefBufferLength;
SetLength(fBuffer, fAllocLength);
end;
fUsedLength := 0;
fRemaining := fAllocLength;
end;
constructor TOTextBuffer.Create(const aBufferLength: Integer);
begin
inherited Create;
fDefBufferLength := aBufferLength;
fAllocLength := aBufferLength;
fRemaining := fAllocLength;
fUsedLength := 0;
SetLength(fBuffer, fAllocLength);
end;
procedure TOTextBuffer.GetBuffer(var outString: OWideString);
begin
GetBuffer(outString, 1, fUsedLength);
end;
procedure TOTextBuffer.GetBuffer(var outString: OWideString; const aPosition,
aLength: Integer);
{$IFDEF O_DELPHI_2007_DOWN}
var
I: Integer;
{$ENDIF}
begin
SetLength(outString, aLength);
if aLength > 0 then
begin
{$IFDEF O_DELPHI_2007_DOWN}
//Move() is extremly slow here in Delphi 7, copy char-by-char is faster for short strings
if aLength < 5 then begin
for I := 0 to aLength-1 do
outString[I+1] := fBuffer[aPosition+I-1];
end else begin
Move(fBuffer[aPosition-1], outString[1], aLength*SizeOf(OWideChar));
end;
{$ELSE}
Move(fBuffer[aPosition-1], outString[1], aLength*SizeOf(OWideChar));
{$ENDIF}
end;
end;
function TOTextBuffer.GetBuffer: OWideString;
begin
GetBuffer({%H-}Result);
end;
procedure TOTextBuffer.Grow(const aMinChars: Integer);
var
xGrowSize: Integer;
begin
xGrowSize := 0;
while fRemaining+xGrowSize < aMinChars do
Inc(xGrowSize, fAllocLength+xGrowSize);
Inc(fRemaining, xGrowSize);
Inc(fAllocLength, xGrowSize);
SetLength(fBuffer, fAllocLength);
end;
procedure TOTextBuffer.RemoveLastChar;
begin
Dec(fUsedLength);
Inc(fRemaining);
if fUsedLength < 0 then begin
fUsedLength := 0;
fRemaining := fAllocLength;
end;
end;
procedure TOTextBuffer.RemoveLastString(const aLength: Integer);
begin
Dec(fUsedLength, aLength);
Inc(fRemaining, aLength);
if fUsedLength < 0 then begin
fUsedLength := 0;
fRemaining := fAllocLength;
end;
end;
procedure TOTextBuffer.WriteChar(const aChar: OWideChar);
begin
if fRemaining = 0 then
Grow(1);
Inc(fUsedLength);
Dec(fRemaining);
fBuffer[fUsedLength-1] := aChar;
end;
procedure TOTextBuffer.WriteString(const aString: OWideString);
var
xPos, xLen: Integer;
begin
WriteString(aString, {%H-}xPos, {%H-}xLen);
end;
procedure TOTextBuffer.WriteString(const aString: OWideString; var outPosition,
outLength: Integer);
begin
outLength := Length(aString);
outPosition := fUsedLength+1;
if outLength > 0 then begin
if fRemaining < outLength then
Grow(outLength);
Inc(fUsedLength, outLength);
Dec(fRemaining, outLength);
Move(aString[1], fBuffer[outPosition-1], outLength*SizeOf(OWideChar));
end;
end;
end.