david
13eee3f7f4
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.jcl@20 c37d764d-f447-7644-a108-883140d013fb
2877 lines
93 KiB
ObjectPascal
2877 lines
93 KiB
ObjectPascal
{**************************************************************************************************}
|
|
{ }
|
|
{ Project JEDI Code Library (JCL) }
|
|
{ }
|
|
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
|
|
{ you may not use this file except in compliance with the License. You may obtain a copy of the }
|
|
{ License at http://www.mozilla.org/MPL/ }
|
|
{ }
|
|
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
|
|
{ ANY KIND, either express or implied. See the License for the specific language governing rights }
|
|
{ and limitations under the License. }
|
|
{ }
|
|
{ The Original Code is AbstractContainer.pas and DCL_Util.pas. }
|
|
{ }
|
|
{ The Initial Developer of the Original Code is Jean-Philippe BEMPEL aka RDM. Portions created by }
|
|
{ Jean-Philippe BEMPEL are Copyright (C) Jean-Philippe BEMPEL (rdm_30 att yahoo dott com) }
|
|
{ All rights reserved. }
|
|
{ }
|
|
{ Contributors: }
|
|
{ Daniele Teti (dade2004) }
|
|
{ Robert Marquardt (marquardt) }
|
|
{ Florent Ouchet (outchy) }
|
|
{ }
|
|
{**************************************************************************************************}
|
|
{ }
|
|
{ The Delphi Container Library }
|
|
{ }
|
|
{**************************************************************************************************}
|
|
{ }
|
|
{ Last modified: $Date:: 2009-09-12 12:57:33 +0200 (sam., 12 sept. 2009) $ }
|
|
{ Revision: $Rev:: 2993 $ }
|
|
{ Author: $Author:: outchy $ }
|
|
{ }
|
|
{**************************************************************************************************}
|
|
|
|
unit JclAbstractContainers;
|
|
|
|
{$I jcl.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF UNITVERSIONING}
|
|
JclUnitVersioning,
|
|
{$ENDIF UNITVERSIONING}
|
|
{$IFDEF HAS_UNIT_LIBC}
|
|
Libc,
|
|
{$ENDIF HAS_UNIT_LIBC}
|
|
Classes,
|
|
JclBase, JclContainerIntf, JclSynch, JclSysUtils,
|
|
JclWideStrings,
|
|
JclAnsiStrings;
|
|
|
|
type
|
|
{$IFDEF KEEP_DEPRECATED}
|
|
TJclIntfCriticalSection = JclSysUtils.TJclIntfCriticalSection;
|
|
{$ENDIF KEEP_DEPRECATED}
|
|
|
|
TJclAbstractLockable = class(TInterfacedObject {$IFDEF THREADSAFE}, IJclLockable {$ENDIF THREADSAFE})
|
|
{$IFDEF THREADSAFE}
|
|
protected
|
|
FThreadSafe: Boolean;
|
|
FSyncReaderWriter: TJclMultiReadExclusiveWrite;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
property SyncReaderWriter: TJclMultiReadExclusiveWrite read FSyncReaderWriter;
|
|
{ IJclLockable }
|
|
procedure ReadLock;
|
|
procedure ReadUnlock;
|
|
procedure WriteLock;
|
|
procedure WriteUnlock;
|
|
{$ENDIF THREADSAFE}
|
|
end;
|
|
|
|
TJclAbstractContainerBase = class(TJclAbstractLockable, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
|
|
IJclCloneable, IJclIntfCloneable, IJclContainer)
|
|
protected
|
|
FAllowDefaultElements: Boolean;
|
|
FDuplicates: TDuplicates;
|
|
FRemoveSingleElement: Boolean;
|
|
FReturnDefaultElements: Boolean;
|
|
FReadOnly: Boolean;
|
|
FCapacity: Integer;
|
|
FSize: Integer;
|
|
FAutoGrowParameter: Integer;
|
|
FAutoGrowStrategy: TJclAutoGrowStrategy;
|
|
FAutoPackParameter: Integer;
|
|
FAutoPackStrategy: TJclAutoPackStrategy;
|
|
procedure AutoGrow; virtual;
|
|
procedure AutoPack; virtual;
|
|
function CheckDuplicate: Boolean;
|
|
function CreateEmptyContainer: TJclAbstractContainerBase; virtual; abstract;
|
|
procedure AssignDataTo(Dest: TJclAbstractContainerBase); virtual;
|
|
procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); virtual;
|
|
public
|
|
constructor Create;
|
|
{ IJclContainer }
|
|
procedure Assign(const Source: IJclContainer);
|
|
procedure AssignTo(const Dest: IJclContainer);
|
|
function GetAllowDefaultElements: Boolean; virtual;
|
|
function GetContainerReference: TObject;
|
|
function GetDuplicates: TDuplicates; virtual;
|
|
function GetReadOnly: Boolean; virtual;
|
|
function GetRemoveSingleElement: Boolean; virtual;
|
|
function GetReturnDefaultElements: Boolean; virtual;
|
|
function GetThreadSafe: Boolean; virtual;
|
|
procedure SetAllowDefaultElements(Value: Boolean); virtual;
|
|
procedure SetDuplicates(Value: TDuplicates); virtual;
|
|
procedure SetReadOnly(Value: Boolean); virtual;
|
|
procedure SetRemoveSingleElement(Value: Boolean); virtual;
|
|
procedure SetReturnDefaultElements(Value: Boolean); virtual;
|
|
procedure SetThreadSafe(Value: Boolean); virtual;
|
|
property AllowDefaultElements: Boolean read GetAllowDefaultElements write SetAllowDefaultElements;
|
|
property Duplicates: TDuplicates read GetDuplicates write SetDuplicates;
|
|
property ReadOnly: Boolean read GetReadOnly write SetReadOnly;
|
|
property RemoveSingleElement: Boolean read GetRemoveSingleElement write SetRemoveSingleElement;
|
|
property ReturnDefaultElements: Boolean read GetReturnDefaultElements write SetReturnDefaultElements;
|
|
property ThreadSafe: Boolean read GetThreadSafe write SetThreadSafe;
|
|
{ IJclCloneable }
|
|
function ObjectClone: TObject;
|
|
{ IJclIntfCloneable }
|
|
function IntfClone: IInterface;
|
|
// IJclGrowable is not in interface list because some descendants won't use this code
|
|
{ IJclGrowable }
|
|
function CalcGrowCapacity(ACapacity, ASize: Integer): Integer; virtual;
|
|
function GetAutoGrowParameter: Integer; virtual;
|
|
function GetAutoGrowStrategy: TJclAutoGrowStrategy; virtual;
|
|
procedure Grow; virtual;
|
|
procedure SetAutoGrowParameter(Value: Integer); virtual;
|
|
procedure SetAutoGrowStrategy(Value: TJclAutoGrowStrategy); virtual;
|
|
property AutoGrowParameter: Integer read GetAutoGrowParameter write SetAutoGrowParameter;
|
|
property AutoGrowStrategy: TJclAutoGrowStrategy read GetAutoGrowStrategy write SetAutoGrowStrategy;
|
|
// IJclPackable is not in interface list because some descendants won't use this code
|
|
{ IJclPackable }
|
|
function CalcPackCapacity(ACapacity, ASize: Integer): Integer; virtual;
|
|
function GetAutoPackParameter: Integer; virtual;
|
|
function GetAutoPackStrategy: TJclAutoPackStrategy; virtual;
|
|
function GetCapacity: Integer; virtual;
|
|
procedure Pack; virtual;
|
|
procedure SetAutoPackParameter(Value: Integer); virtual;
|
|
procedure SetAutoPackStrategy(Value: TJclAutoPackStrategy); virtual;
|
|
procedure SetCapacity(Value: Integer); virtual;
|
|
property AutoPackParameter: Integer read GetAutoPackParameter write SetAutoPackParameter;
|
|
property AutoPackStrategy: TJclAutoPackStrategy read GetAutoPackStrategy write SetAutoPackStrategy;
|
|
end;
|
|
|
|
TJclAbstractIterator = class(TJclAbstractLockable, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
|
|
IJclCloneable, IJclIntfCloneable, IJclAbstractIterator)
|
|
private
|
|
FValid: Boolean;
|
|
protected
|
|
procedure CheckValid;
|
|
function CreateEmptyIterator: TJclAbstractIterator; virtual; abstract;
|
|
procedure AssignPropertiesTo(Dest: TJclAbstractIterator); virtual;
|
|
public
|
|
constructor Create(AValid: Boolean);
|
|
property Valid: Boolean read FValid write FValid;
|
|
{ IJclAbstractIterator }
|
|
procedure Assign(const Source: IJclAbstractIterator);
|
|
procedure AssignTo(const Dest: IJclAbstractIterator);
|
|
function GetIteratorReference: TObject;
|
|
{ IJclCloneable }
|
|
function ObjectClone: TObject;
|
|
{ IJclIntfCloneable }
|
|
function IntfClone: IInterface;
|
|
end;
|
|
|
|
TJclIntfAbstractContainer = class(TJclAbstractContainerBase, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
|
|
IJclCloneable, IJclIntfCloneable, IJclContainer, IJclIntfEqualityComparer, IJclIntfComparer, IJclIntfHashConverter)
|
|
protected
|
|
FEqualityCompare: TIntfEqualityCompare;
|
|
FCompare: TIntfCompare;
|
|
FHashConvert: TIntfHashConvert;
|
|
procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
|
|
function FreeObject(var AInterface: IInterface): IInterface;
|
|
public
|
|
{ IJclIntfEqualityComparer }
|
|
function GetEqualityCompare: TIntfEqualityCompare; virtual;
|
|
procedure SetEqualityCompare(Value: TIntfEqualityCompare); virtual;
|
|
function ItemsEqual(const A, B: IInterface): Boolean; virtual;
|
|
property EqualityCompare: TIntfEqualityCompare read GetEqualityCompare write SetEqualityCompare;
|
|
{ IJclIntfComparer }
|
|
function GetCompare: TIntfCompare; virtual;
|
|
procedure SetCompare(Value: TIntfCompare); virtual;
|
|
function ItemsCompare(const A, B: IInterface): Integer; virtual;
|
|
property Compare: TIntfCompare read GetCompare write SetCompare;
|
|
{ IJclIntfHashConverter }
|
|
function GetHashConvert: TIntfHashConvert; virtual;
|
|
procedure SetHashConvert(Value: TIntfHashConvert); virtual;
|
|
function Hash(const AInterface: IInterface): Integer; virtual;
|
|
property HashConvert: TIntfHashConvert read GetHashConvert write SetHashConvert;
|
|
end;
|
|
|
|
TJclStrAbstractContainer = class(TJclAbstractContainerBase, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
|
|
IJclCloneable, IJclIntfCloneable, IJclContainer, IJclStrContainer)
|
|
protected
|
|
FCaseSensitive: Boolean;
|
|
procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
|
|
public
|
|
{ IJclStrContainer }
|
|
function GetCaseSensitive: Boolean; virtual;
|
|
procedure SetCaseSensitive(Value: Boolean); virtual;
|
|
property CaseSensitive: Boolean read GetCaseSensitive write SetCaseSensitive;
|
|
end;
|
|
|
|
TJclAnsiStrAbstractContainer = class(TJclStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
|
|
IJclCloneable, IJclIntfCloneable, IJclContainer, IJclStrContainer, IJclAnsiStrContainer,
|
|
IJclAnsiStrEqualityComparer, IJclAnsiStrComparer, IJclAnsiStrHashConverter)
|
|
protected
|
|
FEncoding: TJclAnsiStrEncoding;
|
|
FEqualityCompare: TAnsiStrEqualityCompare;
|
|
FCompare: TAnsiStrCompare;
|
|
FHashConvert: TAnsiStrHashConvert;
|
|
procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
|
|
function FreeString(var AString: AnsiString): AnsiString;
|
|
public
|
|
{ IJclAnsiStrContainer }
|
|
function GetEncoding: TJclAnsiStrEncoding; virtual;
|
|
procedure SetEncoding(Value: TJclAnsiStrEncoding); virtual;
|
|
property Encoding: TJclAnsiStrEncoding read GetEncoding write SetEncoding;
|
|
{ IJclAnsiStrEqualityComparer }
|
|
function GetEqualityCompare: TAnsiStrEqualityCompare; virtual;
|
|
procedure SetEqualityCompare(Value: TAnsiStrEqualityCompare); virtual;
|
|
function ItemsEqual(const A, B: AnsiString): Boolean; virtual;
|
|
property EqualityCompare: TAnsiStrEqualityCompare read GetEqualityCompare write SetEqualityCompare;
|
|
{ IJclAnsiStrComparer }
|
|
function GetCompare: TAnsiStrCompare; virtual;
|
|
procedure SetCompare(Value: TAnsiStrCompare); virtual;
|
|
function ItemsCompare(const A, B: AnsiString): Integer; virtual;
|
|
property Compare: TAnsiStrCompare read GetCompare write SetCompare;
|
|
{ IJclAnsiStrHashConverter }
|
|
function GetHashConvert: TAnsiStrHashConvert; virtual;
|
|
procedure SetHashConvert(Value: TAnsiStrHashConvert); virtual;
|
|
function Hash(const AString: AnsiString): Integer; virtual;
|
|
property HashConvert: TAnsiStrHashConvert read GetHashConvert write SetHashConvert;
|
|
end;
|
|
|
|
TJclWideStrAbstractContainer = class(TJclStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
|
|
IJclCloneable, IJclIntfCloneable, IJclContainer, IJclStrContainer, IJclWideStrContainer,
|
|
IJclWideStrEqualityComparer, IJclWideStrComparer, IJclWideStrHashConverter)
|
|
protected
|
|
FEncoding: TJclWideStrEncoding;
|
|
FEqualityCompare: TWideStrEqualityCompare;
|
|
FCompare: TWideStrCompare;
|
|
FHashConvert: TWideStrHashConvert;
|
|
procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
|
|
function FreeString(var AString: WideString): WideString;
|
|
public
|
|
{ IJclWideStrContainer }
|
|
function GetEncoding: TJclWideStrEncoding; virtual;
|
|
procedure SetEncoding(Value: TJclWideStrEncoding); virtual;
|
|
property Encoding: TJclWideStrEncoding read GetEncoding write SetEncoding;
|
|
{ IJclWideStrEqualityComparer }
|
|
function GetEqualityCompare: TWideStrEqualityCompare; virtual;
|
|
procedure SetEqualityCompare(Value: TWideStrEqualityCompare); virtual;
|
|
function ItemsEqual(const A, B: WideString): Boolean; virtual;
|
|
property EqualityCompare: TWideStrEqualityCompare read GetEqualityCompare write SetEqualityCompare;
|
|
{ IJclWideStrComparer }
|
|
function GetCompare: TWideStrCompare; virtual;
|
|
procedure SetCompare(Value: TWideStrCompare); virtual;
|
|
function ItemsCompare(const A, B: WideString): Integer; virtual;
|
|
property Compare: TWideStrCompare read GetCompare write SetCompare;
|
|
{ IJclWideStrHashConverter }
|
|
function GetHashConvert: TWideStrHashConvert; virtual;
|
|
procedure SetHashConvert(Value: TWideStrHashConvert); virtual;
|
|
function Hash(const AString: WideString): Integer; virtual;
|
|
property HashConvert: TWideStrHashConvert read GetHashConvert write SetHashConvert;
|
|
end;
|
|
|
|
{$IFDEF SUPPORTS_UNICODE_STRING}
|
|
TJclUnicodeStrAbstractContainer = class(TJclStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
|
|
IJclCloneable, IJclIntfCloneable, IJclContainer, IJclStrContainer, IJclUnicodeStrContainer,
|
|
IJclUnicodeStrEqualityComparer, IJclUnicodeStrComparer, IJclUnicodeStrHashConverter)
|
|
protected
|
|
FEqualityCompare: TUnicodeStrEqualityCompare;
|
|
FCompare: TUnicodeStrCompare;
|
|
FHashConvert: TUnicodeStrHashConvert;
|
|
procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
|
|
function FreeString(var AString: UnicodeString): UnicodeString;
|
|
public
|
|
{ IJclUnicodeStrEqualityComparer }
|
|
function GetEqualityCompare: TUnicodeStrEqualityCompare; virtual;
|
|
procedure SetEqualityCompare(Value: TUnicodeStrEqualityCompare); virtual;
|
|
function ItemsEqual(const A, B: UnicodeString): Boolean; virtual;
|
|
property EqualityCompare: TUnicodeStrEqualityCompare read GetEqualityCompare write SetEqualityCompare;
|
|
{ IJclUnicodeStrComparer }
|
|
function GetCompare: TUnicodeStrCompare; virtual;
|
|
procedure SetCompare(Value: TUnicodeStrCompare); virtual;
|
|
function ItemsCompare(const A, B: UnicodeString): Integer; virtual;
|
|
property Compare: TUnicodeStrCompare read GetCompare write SetCompare;
|
|
{ IJclUnicodeStrHashConverter }
|
|
function GetHashConvert: TUnicodeStrHashConvert; virtual;
|
|
procedure SetHashConvert(Value: TUnicodeStrHashConvert); virtual;
|
|
function Hash(const AString: UnicodeString): Integer; virtual;
|
|
property HashConvert: TUnicodeStrHashConvert read GetHashConvert write SetHashConvert;
|
|
end;
|
|
{$ENDIF SUPPORTS_UNICODE_STRING}
|
|
|
|
TJclSingleAbstractContainer = class(TJclAbstractContainerBase, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
|
|
IJclCloneable, IJclIntfCloneable, IJclContainer, IJclSingleContainer, IJclSingleEqualityComparer,
|
|
IJclSingleComparer, IJclSingleHashConverter)
|
|
protected
|
|
FPrecision: Single;
|
|
FEqualityCompare: TSingleEqualityCompare;
|
|
FCompare: TSingleCompare;
|
|
FHashConvert: TSingleHashConvert;
|
|
procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
|
|
function FreeSingle(var AValue: Single): Single;
|
|
public
|
|
{ IJclSingleContainer }
|
|
function GetPrecision: Single; virtual;
|
|
procedure SetPrecision(const Value: Single); virtual;
|
|
property Precision: Single read GetPrecision write SetPrecision;
|
|
{ IJclSingleEqualityComparer }
|
|
function GetEqualityCompare: TSingleEqualityCompare; virtual;
|
|
procedure SetEqualityCompare(Value: TSingleEqualityCompare); virtual;
|
|
function ItemsEqual(const A, B: Single): Boolean; virtual;
|
|
property EqualityCompare: TSingleEqualityCompare read GetEqualityCompare write SetEqualityCompare;
|
|
{ IJclSingleComparer }
|
|
function GetCompare: TSingleCompare; virtual;
|
|
procedure SetCompare(Value: TSingleCompare); virtual;
|
|
function ItemsCompare(const A, B: Single): Integer; virtual;
|
|
property Compare: TSingleCompare read GetCompare write SetCompare;
|
|
{ IJclSingleHashConverter }
|
|
function GetHashConvert: TSingleHashConvert; virtual;
|
|
procedure SetHashConvert(Value: TSingleHashConvert); virtual;
|
|
function Hash(const AValue: Single): Integer; virtual;
|
|
property HashConvert: TSingleHashConvert read GetHashConvert write SetHashConvert;
|
|
end;
|
|
|
|
TJclDoubleAbstractContainer = class(TJclAbstractContainerBase, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
|
|
IJclCloneable, IJclIntfCloneable, IJclContainer, IJclDoubleContainer, IJclDoubleEqualityComparer,
|
|
IJclDoubleComparer, IJclDoubleHashConverter)
|
|
protected
|
|
FPrecision: Double;
|
|
FEqualityCompare: TDoubleEqualityCompare;
|
|
FCompare: TDoubleCompare;
|
|
FHashConvert: TDoubleHashConvert;
|
|
procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
|
|
function FreeDouble(var AValue: Double): Double;
|
|
public
|
|
{ IJclDoubleContainer }
|
|
function GetPrecision: Double; virtual;
|
|
procedure SetPrecision(const Value: Double); virtual;
|
|
property Precision: Double read GetPrecision write SetPrecision;
|
|
{ IJclDoubleEqualityComparer }
|
|
function GetEqualityCompare: TDoubleEqualityCompare; virtual;
|
|
procedure SetEqualityCompare(Value: TDoubleEqualityCompare); virtual;
|
|
function ItemsEqual(const A, B: Double): Boolean; virtual;
|
|
property EqualityCompare: TDoubleEqualityCompare read GetEqualityCompare write SetEqualityCompare;
|
|
{ IJclDoubleComparer }
|
|
function GetCompare: TDoubleCompare; virtual;
|
|
procedure SetCompare(Value: TDoubleCompare); virtual;
|
|
function ItemsCompare(const A, B: Double): Integer; virtual;
|
|
property Compare: TDoubleCompare read GetCompare write SetCompare;
|
|
{ IJclDoubleHashConverter }
|
|
function GetHashConvert: TDoubleHashConvert; virtual;
|
|
procedure SetHashConvert(Value: TDoubleHashConvert); virtual;
|
|
function Hash(const AValue: Double): Integer; virtual;
|
|
property HashConvert: TDoubleHashConvert read GetHashConvert write SetHashConvert;
|
|
end;
|
|
|
|
TJclExtendedAbstractContainer = class(TJclAbstractContainerBase, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
|
|
IJclCloneable, IJclIntfCloneable, IJclContainer, IJclExtendedContainer, IJclExtendedEqualityComparer,
|
|
IJclExtendedComparer, IJclExtendedHashConverter)
|
|
protected
|
|
FPrecision: Extended;
|
|
FEqualityCompare: TExtendedEqualityCompare;
|
|
FCompare: TExtendedCompare;
|
|
FHashConvert: TExtendedHashConvert;
|
|
procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
|
|
function FreeExtended(var AValue: Extended): Extended;
|
|
public
|
|
{ IJclExtendedContainer }
|
|
function GetPrecision: Extended; virtual;
|
|
procedure SetPrecision(const Value: Extended); virtual;
|
|
property Precision: Extended read GetPrecision write SetPrecision;
|
|
{ IJclExtendedEqualityComparer }
|
|
function GetEqualityCompare: TExtendedEqualityCompare; virtual;
|
|
procedure SetEqualityCompare(Value: TExtendedEqualityCompare); virtual;
|
|
function ItemsEqual(const A, B: Extended): Boolean; virtual;
|
|
property EqualityCompare: TExtendedEqualityCompare read GetEqualityCompare write SetEqualityCompare;
|
|
{ IJclExtendedComparer }
|
|
function GetCompare: TExtendedCompare; virtual;
|
|
procedure SetCompare(Value: TExtendedCompare); virtual;
|
|
function ItemsCompare(const A, B: Extended): Integer; virtual;
|
|
property Compare: TExtendedCompare read GetCompare write SetCompare;
|
|
{ IJclExtendedHashConverter }
|
|
function GetHashConvert: TExtendedHashConvert; virtual;
|
|
procedure SetHashConvert(Value: TExtendedHashConvert); virtual;
|
|
function Hash(const AValue: Extended): Integer; virtual;
|
|
property HashConvert: TExtendedHashConvert read GetHashConvert write SetHashConvert;
|
|
end;
|
|
|
|
TJclIntegerAbstractContainer = class(TJclAbstractContainerBase, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
|
|
IJclCloneable, IJclIntfCloneable, IJclContainer, IJclIntegerEqualityComparer, IJclIntegerComparer,
|
|
IJclIntegerHashConverter)
|
|
protected
|
|
FEqualityCompare: TIntegerEqualityCompare;
|
|
FCompare: TIntegerCompare;
|
|
FHashConvert: TIntegerHashConvert;
|
|
procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
|
|
function FreeInteger(var AValue: Integer): Integer;
|
|
public
|
|
{ IJclIntegerEqualityComparer }
|
|
function GetEqualityCompare: TIntegerEqualityCompare; virtual;
|
|
procedure SetEqualityCompare(Value: TIntegerEqualityCompare); virtual;
|
|
function ItemsEqual(A, B: Integer): Boolean; virtual;
|
|
property EqualityCompare: TIntegerEqualityCompare read GetEqualityCompare write SetEqualityCompare;
|
|
{ IJclIntegerComparer }
|
|
function GetCompare: TIntegerCompare; virtual;
|
|
procedure SetCompare(Value: TIntegerCompare); virtual;
|
|
function ItemsCompare(A, B: Integer): Integer; virtual;
|
|
property Compare: TIntegerCompare read GetCompare write SetCompare;
|
|
{ IJclIntegerHashConverter }
|
|
function GetHashConvert: TIntegerHashConvert; virtual;
|
|
procedure SetHashConvert(Value: TIntegerHashConvert); virtual;
|
|
function Hash(AValue: Integer): Integer; virtual;
|
|
property HashConvert: TIntegerHashConvert read GetHashConvert write SetHashConvert;
|
|
end;
|
|
|
|
TJclCardinalAbstractContainer = class(TJclAbstractContainerBase, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
|
|
IJclCloneable, IJclIntfCloneable, IJclContainer, IJclCardinalEqualityComparer, IJclCardinalComparer,
|
|
IJclCardinalHashConverter)
|
|
protected
|
|
FEqualityCompare: TCardinalEqualityCompare;
|
|
FCompare: TCardinalCompare;
|
|
FHashConvert: TCardinalHashConvert;
|
|
procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
|
|
function FreeCardinal(var AValue: Cardinal): Cardinal;
|
|
public
|
|
{ IJclIntegerEqualityComparer }
|
|
function GetEqualityCompare: TCardinalEqualityCompare; virtual;
|
|
procedure SetEqualityCompare(Value: TCardinalEqualityCompare); virtual;
|
|
function ItemsEqual(A, B: Cardinal): Boolean; virtual;
|
|
property EqualityCompare: TCardinalEqualityCompare read GetEqualityCompare write SetEqualityCompare;
|
|
{ IJclIntegerComparer }
|
|
function GetCompare: TCardinalCompare; virtual;
|
|
procedure SetCompare(Value: TCardinalCompare); virtual;
|
|
function ItemsCompare(A, B: Cardinal): Integer; virtual;
|
|
property Compare: TCardinalCompare read GetCompare write SetCompare;
|
|
{ IJclIntegerHashConverter }
|
|
function GetHashConvert: TCardinalHashConvert; virtual;
|
|
procedure SetHashConvert(Value: TCardinalHashConvert); virtual;
|
|
function Hash(AValue: Cardinal): Integer; virtual;
|
|
property HashConvert: TCardinalHashConvert read GetHashConvert write SetHashConvert;
|
|
end;
|
|
|
|
TJclInt64AbstractContainer = class(TJclAbstractContainerBase, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
|
|
IJclCloneable, IJclIntfCloneable, IJclContainer, IJclInt64EqualityComparer, IJclInt64Comparer,
|
|
IJclInt64HashConverter)
|
|
protected
|
|
FEqualityCompare: TInt64EqualityCompare;
|
|
FCompare: TInt64Compare;
|
|
FHashConvert: TInt64HashConvert;
|
|
procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
|
|
function FreeInt64(var AValue: Int64): Int64;
|
|
public
|
|
{ IJclInt64EqualityComparer }
|
|
function GetEqualityCompare: TInt64EqualityCompare; virtual;
|
|
procedure SetEqualityCompare(Value: TInt64EqualityCompare); virtual;
|
|
function ItemsEqual(const A, B: Int64): Boolean; virtual;
|
|
property EqualityCompare: TInt64EqualityCompare read GetEqualityCompare write SetEqualityCompare;
|
|
{ IJclInt64Comparer }
|
|
function GetCompare: TInt64Compare; virtual;
|
|
procedure SetCompare(Value: TInt64Compare); virtual;
|
|
function ItemsCompare(const A, B: Int64): Integer; virtual;
|
|
property Compare: TInt64Compare read GetCompare write SetCompare;
|
|
{ IJclInt64HashConverter }
|
|
function GetHashConvert: TInt64HashConvert; virtual;
|
|
procedure SetHashConvert(Value: TInt64HashConvert); virtual;
|
|
function Hash(const AValue: Int64): Integer; virtual;
|
|
property HashConvert: TInt64HashConvert read GetHashConvert write SetHashConvert;
|
|
end;
|
|
|
|
TJclPtrAbstractContainer = class(TJclAbstractContainerBase, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
|
|
IJclCloneable, IJclIntfCloneable, IJclContainer, IJclPtrEqualityComparer, IJclPtrComparer, IJclPtrHashConverter)
|
|
protected
|
|
FEqualityCompare: TPtrEqualityCompare;
|
|
FCompare: TPtrCompare;
|
|
FHashConvert: TPtrHashConvert;
|
|
procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
|
|
function FreePointer(var APtr: Pointer): Pointer;
|
|
public
|
|
{ IJclPtrEqualityComparer }
|
|
function GetEqualityCompare: TPtrEqualityCompare; virtual;
|
|
procedure SetEqualityCompare(Value: TPtrEqualityCompare); virtual;
|
|
function ItemsEqual(A, B: Pointer): Boolean; virtual;
|
|
property EqualityCompare: TPtrEqualityCompare read GetEqualityCompare write SetEqualityCompare;
|
|
{ IJclPtrComparer }
|
|
function GetCompare: TPtrCompare; virtual;
|
|
procedure SetCompare(Value: TPtrCompare); virtual;
|
|
function ItemsCompare(A, B: Pointer): Integer; virtual;
|
|
property Compare: TPtrCompare read GetCompare write SetCompare;
|
|
{ IJclPtrHashConverter }
|
|
function GetHashConvert: TPtrHashConvert; virtual;
|
|
procedure SetHashConvert(Value: TPtrHashConvert); virtual;
|
|
function Hash(APtr: Pointer): Integer; virtual;
|
|
property HashConvert: TPtrHashConvert read GetHashConvert write SetHashConvert;
|
|
end;
|
|
|
|
TJclAbstractContainer = class(TJclAbstractContainerBase, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
|
|
IJclCloneable, IJclIntfCloneable, IJclContainer, IJclObjectOwner, IJclEqualityComparer, IJclComparer,
|
|
IJclHashConverter)
|
|
protected
|
|
FOwnsObjects: Boolean;
|
|
FEqualityCompare: TEqualityCompare;
|
|
FCompare: TCompare;
|
|
FHashConvert: THashConvert;
|
|
procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
|
|
public
|
|
constructor Create(AOwnsObjects: Boolean);
|
|
{ IJclObjectOwner }
|
|
function FreeObject(var AObject: TObject): TObject; virtual;
|
|
function GetOwnsObjects: Boolean; virtual;
|
|
property OwnsObjects: Boolean read FOwnsObjects;
|
|
{ IJclEqualityComparer }
|
|
function GetEqualityCompare: TEqualityCompare; virtual;
|
|
procedure SetEqualityCompare(Value: TEqualityCompare); virtual;
|
|
function ItemsEqual(A, B: TObject): Boolean; virtual;
|
|
property EqualityCompare: TEqualityCompare read GetEqualityCompare write SetEqualityCompare;
|
|
{ IJclComparer }
|
|
function GetCompare: TCompare; virtual;
|
|
procedure SetCompare(Value: TCompare); virtual;
|
|
function ItemsCompare(A, B: TObject): Integer; virtual;
|
|
property Compare: TCompare read GetCompare write SetCompare;
|
|
{ IJclHashConverter }
|
|
function GetHashConvert: THashConvert; virtual;
|
|
procedure SetHashConvert(Value: THashConvert); virtual;
|
|
function Hash(AObject: TObject): Integer; virtual;
|
|
property HashConvert: THashConvert read GetHashConvert write SetHashConvert;
|
|
end;
|
|
|
|
{$IFDEF SUPPORTS_GENERICS}
|
|
TJclAbstractContainer<T> = class(TJclAbstractContainerBase, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
|
|
IJclCloneable, IJclIntfCloneable, IJclContainer, IJclItemOwner<T>, IJclEqualityComparer<T>, IJclComparer<T>,
|
|
IJclHashConverter<T>)
|
|
protected
|
|
FOwnsItems: Boolean;
|
|
FEqualityCompare: TEqualityCompare<T>;
|
|
FCompare: TCompare<T>;
|
|
FHashConvert: THashConvert<T>;
|
|
procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
|
|
public
|
|
constructor Create(AOwnsItems: Boolean);
|
|
{ IJclItemOwner<T> }
|
|
function FreeItem(var AItem: T): T; virtual;
|
|
function GetOwnsItems: Boolean; virtual;
|
|
property OwnsItems: Boolean read FOwnsItems;
|
|
{ IJclEqualityComparer<T> }
|
|
function GetEqualityCompare: TEqualityCompare<T>; virtual;
|
|
procedure SetEqualityCompare(Value: TEqualityCompare<T>); virtual;
|
|
function ItemsEqual(const A, B: T): Boolean; virtual;
|
|
property EqualityCompare: TEqualityCompare<T> read GetEqualityCompare write SetEqualityCompare;
|
|
{ IJclComparer<T> }
|
|
function GetCompare: TCompare<T>; virtual;
|
|
procedure SetCompare(Value: TCompare<T>); virtual;
|
|
function ItemsCompare(const A, B: T): Integer; virtual;
|
|
property Compare: TCompare<T> read GetCompare write SetCompare;
|
|
{ IJclHashConverter<T> }
|
|
function GetHashConvert: THashConvert<T>; virtual;
|
|
procedure SetHashConvert(Value: THashConvert<T>); virtual;
|
|
function Hash(const AItem: T): Integer; virtual;
|
|
property HashConvert: THashConvert<T> read GetHashConvert write SetHashConvert;
|
|
end;
|
|
{$ENDIF SUPPORTS_GENERICS}
|
|
|
|
TJclAnsiStrAbstractCollection = class(TJclAnsiStrAbstractContainer,
|
|
{$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclCloneable, IJclIntfCloneable, IJclContainer,
|
|
IJclStrContainer, IJclAnsiStrContainer, IJclAnsiStrFlatContainer, IJclAnsiStrCollection,
|
|
IJclAnsiStrEqualityComparer, IJclAnsiStrComparer)
|
|
public
|
|
{ IJclAnsiStrCollection }
|
|
function Add(const AString: AnsiString): Boolean; virtual; abstract;
|
|
function AddAll(const ACollection: IJclAnsiStrCollection): Boolean; virtual; abstract;
|
|
procedure Clear; virtual; abstract;
|
|
function Contains(const AString: AnsiString): Boolean; virtual; abstract;
|
|
function ContainsAll(const ACollection: IJclAnsiStrCollection): Boolean; virtual; abstract;
|
|
function CollectionEquals(const ACollection: IJclAnsiStrCollection): Boolean; virtual; abstract;
|
|
function Extract(const AString: AnsiString): Boolean; virtual; abstract;
|
|
function ExtractAll(const ACollection: IJclAnsiStrCollection): Boolean; virtual; abstract;
|
|
function First: IJclAnsiStrIterator; virtual; abstract;
|
|
function IsEmpty: Boolean; virtual; abstract;
|
|
function Last: IJclAnsiStrIterator; virtual; abstract;
|
|
function Remove(const AString: AnsiString): Boolean; virtual; abstract;
|
|
function RemoveAll(const ACollection: IJclAnsiStrCollection): Boolean; virtual; abstract;
|
|
function RetainAll(const ACollection: IJclAnsiStrCollection): Boolean; virtual; abstract;
|
|
function Size: Integer; virtual; abstract;
|
|
{$IFDEF SUPPORTS_FOR_IN}
|
|
function GetEnumerator: IJclAnsistrIterator; virtual; abstract;
|
|
{$ENDIF SUPPORTS_FOR_IN}
|
|
{ IJclAnsiStrFlatContainer }
|
|
procedure LoadFromStrings(Strings: TJclAnsiStrings);
|
|
procedure SaveToStrings(Strings: TJclAnsiStrings);
|
|
procedure AppendToStrings(Strings: TJclAnsiStrings);
|
|
procedure AppendFromStrings(Strings: TJclAnsiStrings);
|
|
function GetAsStrings: TJclAnsiStrings;
|
|
function GetAsDelimited(const Separator: AnsiString = AnsiLineBreak): AnsiString;
|
|
procedure AppendDelimited(const AString: AnsiString; const Separator: AnsiString = AnsiLineBreak);
|
|
procedure LoadDelimited(const AString: AnsiString; const Separator: AnsiString = AnsiLineBreak);
|
|
end;
|
|
|
|
TJclWideStrAbstractCollection = class(TJclWideStrAbstractContainer,
|
|
{$IFDEF THREADSAFE}IJclLockable,{$ENDIF THREADSAFE} IJclCloneable, IJclIntfCloneable, IJclContainer,
|
|
IJclStrContainer, IJclWideStrContainer, IJclWideStrFlatContainer, IJclWideStrCollection,
|
|
IJclWideStrEqualityComparer, IJclWideStrComparer)
|
|
public
|
|
{ IJclWideStrCollection }
|
|
function Add(const AString: WideString): Boolean; virtual; abstract;
|
|
function AddAll(const ACollection: IJclWideStrCollection): Boolean; virtual; abstract;
|
|
procedure Clear; virtual; abstract;
|
|
function Contains(const AString: WideString): Boolean; virtual; abstract;
|
|
function ContainsAll(const ACollection: IJclWideStrCollection): Boolean; virtual; abstract;
|
|
function CollectionEquals(const ACollection: IJclWideStrCollection): Boolean; virtual; abstract;
|
|
function Extract(const AString: WideString): Boolean; virtual; abstract;
|
|
function ExtractAll(const ACollection: IJclWideStrCollection): Boolean; virtual; abstract;
|
|
function First: IJclWideStrIterator; virtual; abstract;
|
|
function IsEmpty: Boolean; virtual; abstract;
|
|
function Last: IJclWideStrIterator; virtual; abstract;
|
|
function Remove(const AString: WideString): Boolean; virtual; abstract;
|
|
function RemoveAll(const ACollection: IJclWideStrCollection): Boolean; virtual; abstract;
|
|
function RetainAll(const ACollection: IJclWideStrCollection): Boolean; virtual; abstract;
|
|
function Size: Integer; virtual; abstract;
|
|
{$IFDEF SUPPORTS_FOR_IN}
|
|
function GetEnumerator: IJclWideStrIterator; virtual; abstract;
|
|
{$ENDIF SUPPORTS_FOR_IN}
|
|
{ IJclWideStrFlatContainer }
|
|
procedure LoadFromStrings(Strings: TJclWideStrings);
|
|
procedure SaveToStrings(Strings: TJclWideStrings);
|
|
procedure AppendToStrings(Strings: TJclWideStrings);
|
|
procedure AppendFromStrings(Strings: TJclWideStrings);
|
|
function GetAsStrings: TJclWideStrings;
|
|
function GetAsDelimited(const Separator: WideString = WideLineBreak): WideString;
|
|
procedure AppendDelimited(const AString: WideString; const Separator: WideString = WideLineBreak);
|
|
procedure LoadDelimited(const AString: WideString; const Separator: WideString = WideLineBreak);
|
|
end;
|
|
|
|
{$IFDEF SUPPORTS_UNICODE_STRING}
|
|
TJclUnicodeStrAbstractCollection = class(TJclUnicodeStrAbstractContainer,
|
|
{$IFDEF THREADSAFE}IJclLockable,{$ENDIF THREADSAFE} IJclCloneable, IJclIntfCloneable, IJclContainer,
|
|
IJclStrContainer, IJclUnicodeStrContainer, IJclUnicodeStrFlatContainer, IJclUnicodeStrCollection,
|
|
IJclUnicodeStrEqualityComparer, IJclUnicodeStrComparer)
|
|
public
|
|
{ IJclUnicodeStrCollection }
|
|
function Add(const AString: UnicodeString): Boolean; virtual; abstract;
|
|
function AddAll(const ACollection: IJclUnicodeStrCollection): Boolean; virtual; abstract;
|
|
procedure Clear; virtual; abstract;
|
|
function Contains(const AString: UnicodeString): Boolean; virtual; abstract;
|
|
function ContainsAll(const ACollection: IJclUnicodeStrCollection): Boolean; virtual; abstract;
|
|
function CollectionEquals(const ACollection: IJclUnicodeStrCollection): Boolean; virtual; abstract;
|
|
function Extract(const AString: UnicodeString): Boolean; virtual; abstract;
|
|
function ExtractAll(const ACollection: IJclUnicodeStrCollection): Boolean; virtual; abstract;
|
|
function First: IJclUnicodeStrIterator; virtual; abstract;
|
|
function IsEmpty: Boolean; virtual; abstract;
|
|
function Last: IJclUnicodeStrIterator; virtual; abstract;
|
|
function Remove(const AString: UnicodeString): Boolean; virtual; abstract;
|
|
function RemoveAll(const ACollection: IJclUnicodeStrCollection): Boolean; virtual; abstract;
|
|
function RetainAll(const ACollection: IJclUnicodeStrCollection): Boolean; virtual; abstract;
|
|
function Size: Integer; virtual; abstract;
|
|
{$IFDEF SUPPORTS_FOR_IN}
|
|
function GetEnumerator: IJclUnicodeStrIterator; virtual; abstract;
|
|
{$ENDIF SUPPORTS_FOR_IN}
|
|
{ IJclUnicodeStrFlatContainer }
|
|
procedure LoadFromStrings(Strings: TJclUnicodeStrings);
|
|
procedure SaveToStrings(Strings: TJclUnicodeStrings);
|
|
procedure AppendToStrings(Strings: TJclUnicodeStrings);
|
|
procedure AppendFromStrings(Strings: TJclUnicodeStrings);
|
|
function GetAsStrings: TJclUnicodeStrings;
|
|
function GetAsDelimited(const Separator: UnicodeString = WideLineBreak): UnicodeString;
|
|
procedure AppendDelimited(const AString: UnicodeString; const Separator: UnicodeString = WideLineBreak);
|
|
procedure LoadDelimited(const AString: UnicodeString; const Separator: UnicodeString = WideLineBreak);
|
|
end;
|
|
{$ENDIF SUPPORTS_UNICODE_STRING}
|
|
|
|
const
|
|
// table of byte permutations without inner loop
|
|
BytePermTable: array [Byte] of Byte =
|
|
( 22, 133, 0, 244, 194, 193, 4, 164, 69, 211, 166, 235, 75, 110, 9, 140,
|
|
125, 84, 64, 209, 57, 47, 197, 76, 237, 48, 189, 87, 221, 254, 20, 132,
|
|
25, 162, 203, 225, 186, 165, 72, 228, 61, 208, 158, 185, 114, 173, 1, 66,
|
|
202, 46, 198, 214, 27, 161, 178, 238, 8, 68, 97, 17, 199, 210, 96, 196,
|
|
85, 240, 233, 71, 232, 142, 148, 70, 184, 152, 90, 206, 139, 182, 34, 101,
|
|
104, 12, 143, 227, 24, 247, 175, 150, 39, 31, 36, 123, 62, 119, 236, 28,
|
|
117, 100, 230, 223, 30, 154, 18, 153, 127, 192, 176, 19, 174, 134, 2, 216,
|
|
218, 91, 45, 7, 128, 138, 126, 40, 16, 54, 207, 181, 11, 137, 60, 191,
|
|
51, 231, 121, 213, 86, 111, 141, 172, 98, 226, 179, 249, 136, 58, 88, 93,
|
|
201, 195, 118, 144, 146, 113, 212, 32, 21, 131, 177, 33, 151, 130, 205, 171,
|
|
92, 251, 168, 29, 156, 124, 224, 200, 3, 187, 105, 52, 239, 147, 82, 94,
|
|
26, 102, 243, 242, 145, 163, 49, 135, 43, 78, 112, 83, 63, 35, 170, 167,
|
|
250, 159, 73, 37, 6, 79, 106, 215, 129, 74, 109, 42, 41, 120, 23, 160,
|
|
107, 180, 103, 77, 53, 169, 89, 149, 44, 38, 81, 246, 188, 67, 15, 80,
|
|
155, 99, 95, 5, 229, 108, 13, 255, 59, 241, 252, 245, 222, 248, 115, 55,
|
|
217, 56, 65, 219, 204, 190, 10, 50, 253, 183, 234, 116, 122, 220, 14, 157);
|
|
|
|
{$IFDEF UNITVERSIONING}
|
|
const
|
|
UnitVersioning: TUnitVersionInfo = (
|
|
RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-2.1-Build3536/jcl/source/common/JclAbstractContainers.pas $';
|
|
Revision: '$Revision: 2993 $';
|
|
Date: '$Date: 2009-09-12 12:57:33 +0200 (sam., 12 sept. 2009) $';
|
|
LogPath: 'JCL\source\common';
|
|
Extra: '';
|
|
Data: nil
|
|
);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
implementation
|
|
|
|
uses
|
|
{$IFDEF HAS_UNIT_ANSISTRINGS}
|
|
AnsiStrings,
|
|
{$ENDIF HAS_UNIT_ANSISTRINGS}
|
|
JclStringConversions, JclUnicode,
|
|
SysUtils;
|
|
|
|
//=== { TJclAbstractLockable } ===============================================
|
|
|
|
{$IFDEF THREADSAFE}
|
|
|
|
constructor TJclAbstractLockable.Create;
|
|
begin
|
|
inherited Create;
|
|
FThreadSafe := True;
|
|
FSyncReaderWriter := TJclMultiReadExclusiveWrite.Create(mpReaders);
|
|
end;
|
|
|
|
destructor TJclAbstractLockable.Destroy;
|
|
begin
|
|
FSyncReaderWriter.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TJclAbstractLockable.ReadLock;
|
|
begin
|
|
if FThreadSafe then
|
|
SyncReaderWriter.BeginRead;
|
|
end;
|
|
|
|
procedure TJclAbstractLockable.ReadUnlock;
|
|
begin
|
|
if FThreadSafe then
|
|
SyncReaderWriter.EndRead;
|
|
end;
|
|
|
|
procedure TJclAbstractLockable.WriteLock;
|
|
begin
|
|
if FThreadSafe then
|
|
SyncReaderWriter.BeginWrite;
|
|
end;
|
|
|
|
procedure TJclAbstractLockable.WriteUnlock;
|
|
begin
|
|
if FThreadSafe then
|
|
SyncReaderWriter.EndWrite;
|
|
end;
|
|
{$ENDIF THREADSAFE}
|
|
|
|
//=== { TJclAbstractContainerBase } ==========================================
|
|
|
|
constructor TJclAbstractContainerBase.Create;
|
|
begin
|
|
inherited Create;
|
|
|
|
FAllowDefaultElements := True;
|
|
FDuplicates := dupAccept;
|
|
FRemoveSingleElement := True;
|
|
FReturnDefaultElements := True;
|
|
FAutoGrowStrategy := agsProportional;
|
|
FAutoGrowParameter := 4;
|
|
FAutoPackStrategy := apsDisabled;
|
|
FAutoPackParameter := 4;
|
|
end;
|
|
|
|
procedure TJclAbstractContainerBase.Assign(const Source: IJclContainer);
|
|
begin
|
|
Source.AssignTo(Self);
|
|
end;
|
|
|
|
procedure TJclAbstractContainerBase.AssignDataTo(Dest: TJclAbstractContainerBase);
|
|
begin
|
|
// override to customize
|
|
if Dest.ReadOnly then
|
|
raise EJclReadOnlyError.Create;
|
|
end;
|
|
|
|
procedure TJclAbstractContainerBase.AssignPropertiesTo(Dest: TJclAbstractContainerBase);
|
|
begin
|
|
// override to customize
|
|
Dest.AllowDefaultElements := AllowDefaultElements;
|
|
Dest.Duplicates := Duplicates;
|
|
Dest.RemoveSingleElement := RemoveSingleElement;
|
|
Dest.ReturnDefaultElements := ReturnDefaultElements;
|
|
Dest.AutoGrowParameter := AutoGrowParameter;
|
|
Dest.AutoGrowStrategy := AutoGrowStrategy;
|
|
Dest.AutoPackParameter := AutoPackParameter;
|
|
Dest.AutoPackStrategy := AutoPackStrategy;
|
|
end;
|
|
|
|
procedure TJclAbstractContainerBase.AssignTo(const Dest: IJclContainer);
|
|
var
|
|
DestObject: TObject;
|
|
begin
|
|
DestObject := Dest.GetContainerReference;
|
|
if DestObject is TJclAbstractContainerBase then
|
|
begin
|
|
AssignPropertiesTo(TJclAbstractContainerBase(DestObject));
|
|
AssignDataTo(TJclAbstractContainerBase(DestObject));
|
|
end
|
|
else
|
|
raise EJclAssignError.Create;
|
|
end;
|
|
|
|
procedure TJclAbstractContainerBase.AutoGrow;
|
|
begin
|
|
SetCapacity(CalcGrowCapacity(FCapacity, FSize));
|
|
end;
|
|
|
|
procedure TJclAbstractContainerBase.AutoPack;
|
|
begin
|
|
SetCapacity(CalcPackCapacity(FCapacity, FSize));
|
|
end;
|
|
|
|
function TJclAbstractContainerBase.CalcGrowCapacity(ACapacity, ASize: Integer): Integer;
|
|
var
|
|
Increment: Integer;
|
|
begin
|
|
Result := ACapacity;
|
|
if ASize = ACapacity then
|
|
begin
|
|
case FAutoGrowStrategy of
|
|
agsDisabled: ;
|
|
agsAgressive:
|
|
Result := ACapacity + 1;
|
|
agsProportional:
|
|
begin
|
|
Increment := ACapacity div FAutoGrowParameter;
|
|
if Increment = 0 then
|
|
Increment := 1;
|
|
Result := ACapacity + Increment;
|
|
end;
|
|
agsIncremental:
|
|
Result := ACapacity + FAutoGrowParameter;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TJclAbstractContainerBase.CalcPackCapacity(ACapacity, ASize: Integer): Integer;
|
|
var
|
|
Decrement: Integer;
|
|
begin
|
|
Result := ACapacity;
|
|
if ASize < ACapacity then
|
|
begin
|
|
case FAutoPackStrategy of
|
|
apsDisabled:
|
|
Decrement := 0;
|
|
apsAgressive:
|
|
Decrement := 1;
|
|
apsProportional:
|
|
Decrement := ACapacity div FAutoPackParameter;
|
|
apsIncremental:
|
|
Decrement := FAutoPackParameter;
|
|
else
|
|
Decrement := 0;
|
|
end;
|
|
if (Decrement > 0) and ((ASize + Decrement) <= ACapacity) then
|
|
Result := ASize;
|
|
end;
|
|
end;
|
|
|
|
function TJclAbstractContainerBase.CheckDuplicate: Boolean;
|
|
begin
|
|
case FDuplicates of
|
|
dupIgnore:
|
|
Result := False;
|
|
dupAccept:
|
|
Result := True;
|
|
//dupError: ;
|
|
else
|
|
raise EJclDuplicateElementError.Create;
|
|
end;
|
|
end;
|
|
|
|
function TJclAbstractContainerBase.ObjectClone: TObject;
|
|
var
|
|
NewContainer: TJclAbstractContainerBase;
|
|
begin
|
|
{$IFDEF THREADSAFE}
|
|
ReadLock;
|
|
try
|
|
{$ENDIF THREADSAFE}
|
|
NewContainer := CreateEmptyContainer;
|
|
AssignDataTo(NewContainer);
|
|
Result := NewContainer;
|
|
{$IFDEF THREADSAFE}
|
|
finally
|
|
ReadUnlock;
|
|
end;
|
|
{$ENDIF THREADSAFE}
|
|
end;
|
|
|
|
function TJclAbstractContainerBase.GetAllowDefaultElements: Boolean;
|
|
begin
|
|
Result := FAllowDefaultElements;
|
|
end;
|
|
|
|
function TJclAbstractContainerBase.GetAutoGrowParameter: Integer;
|
|
begin
|
|
Result := FAutoGrowParameter;
|
|
end;
|
|
|
|
function TJclAbstractContainerBase.GetAutoGrowStrategy: TJclAutoGrowStrategy;
|
|
begin
|
|
Result := FAutoGrowStrategy;
|
|
end;
|
|
|
|
function TJclAbstractContainerBase.GetAutoPackParameter: Integer;
|
|
begin
|
|
Result := FAutoPackParameter;
|
|
end;
|
|
|
|
function TJclAbstractContainerBase.GetAutoPackStrategy: TJclAutoPackStrategy;
|
|
begin
|
|
Result := FAutoPackStrategy;
|
|
end;
|
|
|
|
function TJclAbstractContainerBase.GetCapacity: Integer;
|
|
begin
|
|
Result := FCapacity;
|
|
end;
|
|
|
|
function TJclAbstractContainerBase.GetContainerReference: TObject;
|
|
begin
|
|
Result := Self;
|
|
end;
|
|
|
|
function TJclAbstractContainerBase.GetDuplicates: TDuplicates;
|
|
begin
|
|
Result := FDuplicates;
|
|
end;
|
|
|
|
function TJclAbstractContainerBase.GetReadOnly: Boolean;
|
|
begin
|
|
Result := FReadOnly;
|
|
end;
|
|
|
|
function TJclAbstractContainerBase.GetRemoveSingleElement: Boolean;
|
|
begin
|
|
Result := FRemoveSingleElement;
|
|
end;
|
|
|
|
function TJclAbstractContainerBase.GetReturnDefaultElements: Boolean;
|
|
begin
|
|
Result := FReturnDefaultElements;
|
|
end;
|
|
|
|
function TJclAbstractContainerBase.GetThreadSafe: Boolean;
|
|
begin
|
|
{$IFDEF THREADSAFE}
|
|
Result := FThreadSafe;
|
|
{$ELSE ~THREADSAFE}
|
|
Result := False;
|
|
{$ENDIF ~THREADSAFE}
|
|
end;
|
|
|
|
procedure TJclAbstractContainerBase.Grow;
|
|
begin
|
|
// override to customize
|
|
SetCapacity(CalcGrowCapacity(FCapacity, FSize));
|
|
end;
|
|
|
|
function TJclAbstractContainerBase.IntfClone: IInterface;
|
|
var
|
|
NewContainer: TJclAbstractContainerBase;
|
|
begin
|
|
{$IFDEF THREADSAFE}
|
|
ReadLock;
|
|
try
|
|
{$ENDIF THREADSAFE}
|
|
NewContainer := CreateEmptyContainer;
|
|
AssignDataTo(NewContainer);
|
|
Result := NewContainer;
|
|
{$IFDEF THREADSAFE}
|
|
finally
|
|
ReadUnlock;
|
|
end;
|
|
{$ENDIF THREADSAFE}
|
|
end;
|
|
|
|
procedure TJclAbstractContainerBase.Pack;
|
|
begin
|
|
// override to customize
|
|
SetCapacity(CalcPackCapacity(FCapacity, FSize));
|
|
end;
|
|
|
|
procedure TJclAbstractContainerBase.SetAllowDefaultElements(Value: Boolean);
|
|
begin
|
|
FAllowDefaultElements := Value;
|
|
end;
|
|
|
|
procedure TJclAbstractContainerBase.SetAutoGrowParameter(Value: Integer);
|
|
begin
|
|
FAutoGrowParameter := Value;
|
|
end;
|
|
|
|
procedure TJclAbstractContainerBase.SetAutoGrowStrategy(Value: TJclAutoGrowStrategy);
|
|
begin
|
|
FAutoGrowStrategy := Value;
|
|
end;
|
|
|
|
procedure TJclAbstractContainerBase.SetAutoPackParameter(Value: Integer);
|
|
begin
|
|
FAutoPackParameter := Value;
|
|
end;
|
|
|
|
procedure TJclAbstractContainerBase.SetAutoPackStrategy(Value: TJclAutoPackStrategy);
|
|
begin
|
|
FAutoPackStrategy := Value;
|
|
end;
|
|
|
|
procedure TJclAbstractContainerBase.SetCapacity(Value: Integer);
|
|
begin
|
|
FCapacity := Value;
|
|
end;
|
|
|
|
procedure TJclAbstractContainerBase.SetDuplicates(Value: TDuplicates);
|
|
begin
|
|
FDuplicates := Value;
|
|
end;
|
|
|
|
procedure TJclAbstractContainerBase.SetReadOnly(Value: Boolean);
|
|
begin
|
|
FReadOnly := Value;
|
|
end;
|
|
|
|
procedure TJclAbstractContainerBase.SetRemoveSingleElement(Value: Boolean);
|
|
begin
|
|
FRemoveSingleElement := Value;
|
|
end;
|
|
|
|
procedure TJclAbstractContainerBase.SetReturnDefaultElements(Value: Boolean);
|
|
begin
|
|
FReturnDefaultElements := Value;
|
|
end;
|
|
|
|
procedure TJclAbstractContainerBase.SetThreadSafe(Value: Boolean);
|
|
begin
|
|
{$IFDEF THREADSAFE}
|
|
FThreadSafe := Value;
|
|
{$ELSE ~THREADSAFE}
|
|
if Value then
|
|
raise EJclOperationNotSupportedError.Create;
|
|
{$ENDIF ~THREADSAFE}
|
|
end;
|
|
|
|
//=== { TJclAbstractIterator } ===============================================
|
|
|
|
constructor TJclAbstractIterator.Create(AValid: Boolean);
|
|
begin
|
|
inherited Create;
|
|
FValid := AValid;
|
|
end;
|
|
|
|
procedure TJclAbstractIterator.Assign(const Source: IJclAbstractIterator);
|
|
begin
|
|
Source.AssignTo(Self);
|
|
end;
|
|
|
|
procedure TJclAbstractIterator.AssignPropertiesTo(Dest: TJclAbstractIterator);
|
|
begin
|
|
Dest.FValid := FValid;
|
|
end;
|
|
|
|
procedure TJclAbstractIterator.AssignTo(const Dest: IJclAbstractIterator);
|
|
var
|
|
DestObject: TObject;
|
|
begin
|
|
DestObject := Dest.GetIteratorReference;
|
|
if DestObject is TJclAbstractIterator then
|
|
AssignPropertiesTo(TJclAbstractIterator(DestObject))
|
|
else
|
|
raise EJclAssignError.Create;
|
|
end;
|
|
|
|
procedure TJclAbstractIterator.CheckValid;
|
|
begin
|
|
if not Valid then
|
|
raise EJclIllegalStateOperationError.Create;
|
|
end;
|
|
|
|
function TJclAbstractIterator.ObjectClone: TObject;
|
|
begin
|
|
{$IFDEF THREADSAFE}
|
|
ReadLock;
|
|
try
|
|
{$ENDIF THREADSAFE}
|
|
Result := CreateEmptyIterator;
|
|
{$IFDEF THREADSAFE}
|
|
finally
|
|
ReadUnlock;
|
|
end;
|
|
{$ENDIF THREADSAFE}
|
|
end;
|
|
|
|
function TJclAbstractIterator.GetIteratorReference: TObject;
|
|
begin
|
|
Result := Self;
|
|
end;
|
|
|
|
function TJclAbstractIterator.IntfClone: IInterface;
|
|
begin
|
|
{$IFDEF THREADSAFE}
|
|
ReadLock;
|
|
try
|
|
{$ENDIF THREADSAFE}
|
|
Result := CreateEmptyIterator;
|
|
{$IFDEF THREADSAFE}
|
|
finally
|
|
ReadUnlock;
|
|
end;
|
|
{$ENDIF THREADSAFE}
|
|
end;
|
|
|
|
//=== { TJclIntfAbstractContainer } ==========================================
|
|
|
|
procedure TJclIntfAbstractContainer.AssignPropertiesTo(Dest: TJclAbstractContainerBase);
|
|
var
|
|
ADest: TJclIntfAbstractContainer;
|
|
begin
|
|
inherited AssignPropertiesTo(Dest);
|
|
if Dest is TJclIntfAbstractContainer then
|
|
begin
|
|
ADest := TJclIntfAbstractContainer(Dest);
|
|
ADest.EqualityCompare := EqualityCompare;
|
|
ADest.Compare := Compare;
|
|
ADest.HashConvert := HashConvert;
|
|
end;
|
|
end;
|
|
|
|
function TJclIntfAbstractContainer.FreeObject(var AInterface: IInterface): IInterface;
|
|
begin
|
|
Result := AInterface;
|
|
AInterface := nil;
|
|
end;
|
|
|
|
function TJclIntfAbstractContainer.GetCompare: TIntfCompare;
|
|
begin
|
|
Result := FCompare;
|
|
end;
|
|
|
|
function TJclIntfAbstractContainer.GetEqualityCompare: TIntfEqualityCompare;
|
|
begin
|
|
Result := FEqualityCompare;
|
|
end;
|
|
|
|
function TJclIntfAbstractContainer.GetHashConvert: TIntfHashConvert;
|
|
begin
|
|
Result := FHashConvert;
|
|
end;
|
|
|
|
function TJclIntfAbstractContainer.Hash(const AInterface: IInterface): Integer;
|
|
begin
|
|
if Assigned(FHashConvert) then
|
|
Result := FHashConvert(AInterface)
|
|
else
|
|
Result := Integer(AInterface);
|
|
end;
|
|
|
|
function TJclIntfAbstractContainer.ItemsCompare(const A, B: IInterface): Integer;
|
|
begin
|
|
if Assigned(FCompare) then
|
|
Result := FCompare(A, B)
|
|
else
|
|
if Integer(A) > Integer(B) then
|
|
Result := 1
|
|
else
|
|
if Integer(A) < Integer(B) then
|
|
Result := -1
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TJclIntfAbstractContainer.ItemsEqual(const A, B: IInterface): Boolean;
|
|
begin
|
|
if Assigned(FEqualityCompare) then
|
|
Result := FEqualityCompare(A, B)
|
|
else
|
|
if Assigned(FCompare) then
|
|
Result := FCompare(A, B) = 0
|
|
else
|
|
Result := Integer(A) = Integer(B);
|
|
end;
|
|
|
|
procedure TJclIntfAbstractContainer.SetCompare(Value: TIntfCompare);
|
|
begin
|
|
FCompare := Value;
|
|
end;
|
|
|
|
procedure TJclIntfAbstractContainer.SetEqualityCompare(Value: TIntfEqualityCompare);
|
|
begin
|
|
FEqualityCompare := Value;
|
|
end;
|
|
|
|
procedure TJclIntfAbstractContainer.SetHashConvert(Value: TIntfHashConvert);
|
|
begin
|
|
FHashConvert := Value;
|
|
end;
|
|
|
|
//=== { TJclStrAbstractContainer } ===========================================
|
|
|
|
procedure TJclStrAbstractContainer.AssignPropertiesTo(Dest: TJclAbstractContainerBase);
|
|
begin
|
|
inherited AssignPropertiesTo(Dest);
|
|
if Dest is TJclStrAbstractContainer then
|
|
TJclStrAbstractContainer(Dest).SetCaseSensitive(GetCaseSensitive);
|
|
end;
|
|
|
|
function TJclStrAbstractContainer.GetCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
procedure TJclStrAbstractContainer.SetCaseSensitive(Value: Boolean);
|
|
begin
|
|
FCaseSensitive := Value;
|
|
end;
|
|
|
|
//=== { TJclAnsiStrAbstractContainer } =======================================
|
|
|
|
procedure TJclAnsiStrAbstractContainer.AssignPropertiesTo(Dest: TJclAbstractContainerBase);
|
|
var
|
|
ADest: TJclAnsiStrAbstractContainer;
|
|
begin
|
|
inherited AssignPropertiesTo(Dest);
|
|
if Dest is TJclAnsiStrAbstractContainer then
|
|
begin
|
|
ADest := TJclAnsiStrAbstractContainer(Dest);
|
|
ADest.Encoding := Encoding;
|
|
ADest.EqualityCompare := EqualityCompare;
|
|
ADest.Compare := Compare;
|
|
ADest.HashConvert := HashConvert;
|
|
end;
|
|
end;
|
|
|
|
function TJclAnsiStrAbstractContainer.FreeString(var AString: AnsiString): AnsiString;
|
|
begin
|
|
Result := AString;
|
|
AString := '';
|
|
end;
|
|
|
|
function TJclAnsiStrAbstractContainer.GetCompare: TAnsiStrCompare;
|
|
begin
|
|
Result := FCompare;
|
|
end;
|
|
|
|
function TJclAnsiStrAbstractContainer.GetEncoding: TJclAnsiStrEncoding;
|
|
begin
|
|
Result := FEncoding;
|
|
end;
|
|
|
|
function TJclAnsiStrAbstractContainer.GetEqualityCompare: TAnsiStrEqualityCompare;
|
|
begin
|
|
Result := FEqualityCompare;
|
|
end;
|
|
|
|
function TJclAnsiStrAbstractContainer.GetHashConvert: TAnsiStrHashConvert;
|
|
begin
|
|
Result := FHashConvert;
|
|
end;
|
|
|
|
function TJclAnsiStrAbstractContainer.Hash(const AString: AnsiString): Integer;
|
|
// from "Fast Hashing of Variable-Length Text Strings", Peter K. Pearson, 1990
|
|
// http://portal.acm.org/citation.cfm?id=78978
|
|
type
|
|
TIntegerHash = packed record
|
|
case Byte of
|
|
0: (H1, H2, H3, H4: Byte);
|
|
1: (H: Integer);
|
|
2: (C: UCS4);
|
|
end;
|
|
var
|
|
I, J: Integer;
|
|
C1: Byte;
|
|
C2, IntegerHash: TIntegerHash;
|
|
CA: TUCS4Array;
|
|
begin
|
|
if Assigned(FHashConvert) then
|
|
Result := FHashConvert(AString)
|
|
else
|
|
begin
|
|
IntegerHash.H1 := 0;
|
|
IntegerHash.H2 := 1;
|
|
IntegerHash.H3 := 2;
|
|
IntegerHash.H4 := 3;
|
|
case FEncoding of
|
|
seISO:
|
|
begin
|
|
if FCaseSensitive then
|
|
begin
|
|
for I := 1 to Length(AString) do
|
|
begin
|
|
C1 := Ord(AString[I]);
|
|
IntegerHash.H1 := BytePermTable[IntegerHash.H1 xor C1];
|
|
IntegerHash.H2 := BytePermTable[IntegerHash.H2 xor C1];
|
|
IntegerHash.H3 := BytePermTable[IntegerHash.H3 xor C1];
|
|
IntegerHash.H4 := BytePermTable[IntegerHash.H4 xor C1];
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
// case insensitive
|
|
for I := 1 to Length(AString) - 1 do
|
|
begin
|
|
C1 := Ord(JclAnsiStrings.CharUpper(AString[I]));
|
|
IntegerHash.H1 := BytePermTable[IntegerHash.H1 xor C1];
|
|
IntegerHash.H2 := BytePermTable[IntegerHash.H2 xor C1];
|
|
IntegerHash.H3 := BytePermTable[IntegerHash.H3 xor C1];
|
|
IntegerHash.H4 := BytePermTable[IntegerHash.H4 xor C1];
|
|
end;
|
|
end;
|
|
end;
|
|
seUTF8:
|
|
begin
|
|
if FCaseSensitive then
|
|
begin
|
|
I := 1;
|
|
while I < Length(AString) do
|
|
begin
|
|
C2.C := UTF8GetNextChar(AString, I);
|
|
if I = -1 then
|
|
raise EJclUnexpectedEOSequenceError.Create;
|
|
IntegerHash.H1 := BytePermTable[IntegerHash.H1 xor C2.H1];
|
|
IntegerHash.H2 := BytePermTable[IntegerHash.H2 xor C2.H2];
|
|
IntegerHash.H3 := BytePermTable[IntegerHash.H3 xor C2.H3];
|
|
IntegerHash.H4 := BytePermTable[IntegerHash.H4 xor C2.H4];
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
// case insensitive
|
|
I := 1;
|
|
SetLength(CA, 0);
|
|
while I < Length(AString) do
|
|
begin
|
|
C2.C := UTF8GetNextChar(AString, I);
|
|
CA := UnicodeCaseFold(C2.C);
|
|
for J := Low(CA) to High(CA) do
|
|
begin
|
|
C2.C := CA[J];
|
|
if I = -1 then
|
|
raise EJclUnexpectedEOSequenceError.Create;
|
|
IntegerHash.H1 := BytePermTable[IntegerHash.H1 xor C2.H1];
|
|
IntegerHash.H2 := BytePermTable[IntegerHash.H2 xor C2.H2];
|
|
IntegerHash.H3 := BytePermTable[IntegerHash.H3 xor C2.H3];
|
|
IntegerHash.H4 := BytePermTable[IntegerHash.H4 xor C2.H4];
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
else
|
|
raise EJclOperationNotSupportedError.Create;
|
|
end;
|
|
Result := IntegerHash.H;
|
|
end;
|
|
end;
|
|
|
|
function TJclAnsiStrAbstractContainer.ItemsCompare(const A, B: AnsiString): Integer;
|
|
begin
|
|
if Assigned(FCompare) then
|
|
Result := FCompare(A, B)
|
|
else
|
|
begin
|
|
case FEncoding of
|
|
seISO:
|
|
if FCaseSensitive then
|
|
Result := CompareStr(A, B)
|
|
else
|
|
Result := CompareText(A, B);
|
|
//seUTF8:
|
|
else
|
|
raise EJclOperationNotSupportedError.Create;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TJclAnsiStrAbstractContainer.ItemsEqual(const A, B: AnsiString): Boolean;
|
|
begin
|
|
if Assigned(FEqualityCompare) then
|
|
Result := FEqualityCompare(A, B)
|
|
else
|
|
if Assigned(FCompare) then
|
|
Result := FCompare(A, B) = 0
|
|
else
|
|
begin
|
|
case FEncoding of
|
|
seISO:
|
|
if FCaseSensitive then
|
|
Result := CompareStr(A, B) = 0
|
|
else
|
|
Result := CompareText(A, B) = 0;
|
|
//seUTF8:
|
|
else
|
|
raise EJclOperationNotSupportedError.Create;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJclAnsiStrAbstractContainer.SetCompare(Value: TAnsiStrCompare);
|
|
begin
|
|
FCompare := Value;
|
|
end;
|
|
|
|
procedure TJclAnsiStrAbstractContainer.SetEncoding(Value: TJclAnsiStrEncoding);
|
|
begin
|
|
FEncoding := Value;
|
|
end;
|
|
|
|
procedure TJclAnsiStrAbstractContainer.SetEqualityCompare(Value: TAnsiStrEqualityCompare);
|
|
begin
|
|
FEqualityCompare := Value;
|
|
end;
|
|
|
|
procedure TJclAnsiStrAbstractContainer.SetHashConvert(Value: TAnsiStrHashConvert);
|
|
begin
|
|
FHashConvert := Value;
|
|
end;
|
|
|
|
//=== { TJclWideStrContainer } ===============================================
|
|
|
|
procedure TJclWideStrAbstractContainer.AssignPropertiesTo(Dest: TJclAbstractContainerBase);
|
|
var
|
|
ADest: TJclWideStrAbstractContainer;
|
|
begin
|
|
inherited AssignPropertiesTo(Dest);
|
|
if Dest is TJclWideStrAbstractContainer then
|
|
begin
|
|
ADest := TJclWideStrAbstractContainer(Dest);
|
|
ADest.Encoding := Encoding;
|
|
ADest.EqualityCompare := EqualityCompare;
|
|
ADest.Compare := Compare;
|
|
ADest.HashConvert := HashConvert;
|
|
end;
|
|
end;
|
|
|
|
function TJclWideStrAbstractContainer.FreeString(var AString: WideString): WideString;
|
|
begin
|
|
Result := AString;
|
|
AString := '';
|
|
end;
|
|
|
|
function TJclWideStrAbstractContainer.GetCompare: TWideStrCompare;
|
|
begin
|
|
Result := FCompare;
|
|
end;
|
|
|
|
function TJclWideStrAbstractContainer.GetEncoding: TJclWideStrEncoding;
|
|
begin
|
|
Result := FEncoding;
|
|
end;
|
|
|
|
function TJclWideStrAbstractContainer.GetEqualityCompare: TWideStrEqualityCompare;
|
|
begin
|
|
Result := FEqualityCompare;
|
|
end;
|
|
|
|
function TJclWideStrAbstractContainer.GetHashConvert: TWideStrHashConvert;
|
|
begin
|
|
Result := FHashConvert;
|
|
end;
|
|
|
|
function TJclWideStrAbstractContainer.Hash(const AString: WideString): Integer;
|
|
// from "Fast Hashing of Variable-Length Text Strings", Peter K. Pearson, 1990
|
|
// http://portal.acm.org/citation.cfm?id=78978
|
|
type
|
|
TIntegerHash = packed record
|
|
case Byte of
|
|
0: (H1, H2, H3, H4: Byte);
|
|
1: (H: Integer);
|
|
2: (C: UCS4);
|
|
end;
|
|
var
|
|
I, J: Integer;
|
|
C2, IntegerHash: TIntegerHash;
|
|
CA: TUCS4Array;
|
|
begin
|
|
if Assigned(FHashConvert) then
|
|
Result := FHashConvert(AString)
|
|
else
|
|
begin
|
|
IntegerHash.H1 := 0;
|
|
IntegerHash.H2 := 1;
|
|
IntegerHash.H3 := 2;
|
|
IntegerHash.H4 := 3;
|
|
case FEncoding of
|
|
seUTF16:
|
|
begin
|
|
SetLength(CA, 0);
|
|
if FCaseSensitive then
|
|
begin
|
|
I := 1;
|
|
while I < Length(AString) do
|
|
begin
|
|
C2.C := UTF16GetNextChar(AString, I);
|
|
if I = -1 then
|
|
raise EJclUnexpectedEOSequenceError.Create;
|
|
IntegerHash.H1 := BytePermTable[IntegerHash.H1 xor C2.H1];
|
|
IntegerHash.H2 := BytePermTable[IntegerHash.H2 xor C2.H2];
|
|
IntegerHash.H3 := BytePermTable[IntegerHash.H3 xor C2.H3];
|
|
IntegerHash.H4 := BytePermTable[IntegerHash.H4 xor C2.H4];
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
// case insensitive
|
|
I := 1;
|
|
while I < Length(AString) do
|
|
begin
|
|
C2.C := UTF16GetNextChar(AString, I);
|
|
CA := UnicodeCaseFold(C2.C);
|
|
for J := Low(CA) to High(CA) do
|
|
begin
|
|
C2.C := CA[J];
|
|
if I = -1 then
|
|
raise EJclUnexpectedEOSequenceError.Create;
|
|
IntegerHash.H1 := BytePermTable[IntegerHash.H1 xor C2.H1];
|
|
IntegerHash.H2 := BytePermTable[IntegerHash.H2 xor C2.H2];
|
|
IntegerHash.H3 := BytePermTable[IntegerHash.H3 xor C2.H3];
|
|
IntegerHash.H4 := BytePermTable[IntegerHash.H4 xor C2.H4];
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
else
|
|
raise EJclOperationNotSupportedError.Create;
|
|
end;
|
|
Result := IntegerHash.H;
|
|
end;
|
|
end;
|
|
|
|
function TJclWideStrAbstractContainer.ItemsCompare(const A, B: WideString): Integer;
|
|
begin
|
|
if Assigned(FCompare) then
|
|
Result := FCompare(A, B)
|
|
else
|
|
begin
|
|
case FEncoding of
|
|
seUTF16:
|
|
if FCaseSensitive then
|
|
Result := JclWideStrings.WideCompareStr(A, B)
|
|
else
|
|
Result := JclWideStrings.WideCompareText(A, B);
|
|
else
|
|
raise EJclOperationNotSupportedError.Create;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TJclWideStrAbstractContainer.ItemsEqual(const A, B: WideString): Boolean;
|
|
begin
|
|
if Assigned(FEqualityCompare) then
|
|
Result := FEqualityCompare(A, B)
|
|
else
|
|
if Assigned(FCompare) then
|
|
Result := FCompare(A, B) = 0
|
|
else
|
|
begin
|
|
case FEncoding of
|
|
seUTF16:
|
|
if FCaseSensitive then
|
|
Result := JclWideStrings.WideCompareStr(A, B) = 0
|
|
else
|
|
Result := JclWideStrings.WideCompareText(A, B) = 0;
|
|
else
|
|
raise EJclOperationNotSupportedError.Create;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJclWideStrAbstractContainer.SetCompare(Value: TWideStrCompare);
|
|
begin
|
|
FCompare := Value;
|
|
end;
|
|
|
|
procedure TJclWideStrAbstractContainer.SetEncoding(Value: TJclWideStrEncoding);
|
|
begin
|
|
FEncoding := Value;
|
|
end;
|
|
|
|
procedure TJclWideStrAbstractContainer.SetEqualityCompare(Value: TWideStrEqualityCompare);
|
|
begin
|
|
FEqualityCompare := Value;
|
|
end;
|
|
|
|
procedure TJclWideStrAbstractContainer.SetHashConvert(Value: TWideStrHashConvert);
|
|
begin
|
|
FHashConvert := Value;
|
|
end;
|
|
|
|
{$IFDEF SUPPORTS_UNICODE_STRING}
|
|
//=== { TJclUnicodeStrContainer } ===============================================
|
|
|
|
procedure TJclUnicodeStrAbstractContainer.AssignPropertiesTo(Dest: TJclAbstractContainerBase);
|
|
var
|
|
ADest: TJclUnicodeStrAbstractContainer;
|
|
begin
|
|
inherited AssignPropertiesTo(Dest);
|
|
if Dest is TJclUnicodeStrAbstractContainer then
|
|
begin
|
|
ADest := TJclUnicodeStrAbstractContainer(Dest);
|
|
ADest.EqualityCompare := EqualityCompare;
|
|
ADest.Compare := Compare;
|
|
ADest.HashConvert := HashConvert;
|
|
end;
|
|
end;
|
|
|
|
function TJclUnicodeStrAbstractContainer.FreeString(var AString: UnicodeString): UnicodeString;
|
|
begin
|
|
Result := AString;
|
|
AString := '';
|
|
end;
|
|
|
|
function TJclUnicodeStrAbstractContainer.GetCompare: TUnicodeStrCompare;
|
|
begin
|
|
Result := FCompare;
|
|
end;
|
|
|
|
function TJclUnicodeStrAbstractContainer.GetEqualityCompare: TUnicodeStrEqualityCompare;
|
|
begin
|
|
Result := FEqualityCompare;
|
|
end;
|
|
|
|
function TJclUnicodeStrAbstractContainer.GetHashConvert: TUnicodeStrHashConvert;
|
|
begin
|
|
Result := FHashConvert;
|
|
end;
|
|
|
|
function TJclUnicodeStrAbstractContainer.Hash(const AString: UnicodeString): Integer;
|
|
// from "Fast Hashing of Variable-Length Text Strings", Peter K. Pearson, 1990
|
|
// http://portal.acm.org/citation.cfm?id=78978
|
|
type
|
|
TIntegerHash = packed record
|
|
case Byte of
|
|
0: (H1, H2, H3, H4: Byte);
|
|
1: (H: Integer);
|
|
2: (C: UCS4);
|
|
end;
|
|
var
|
|
I, J: Integer;
|
|
C2, IntegerHash: TIntegerHash;
|
|
CA: TUCS4Array;
|
|
begin
|
|
if Assigned(FHashConvert) then
|
|
Result := FHashConvert(AString)
|
|
else
|
|
begin
|
|
IntegerHash.H1 := 0;
|
|
IntegerHash.H2 := 1;
|
|
IntegerHash.H3 := 2;
|
|
IntegerHash.H4 := 3;
|
|
SetLength(CA, 0);
|
|
if FCaseSensitive then
|
|
begin
|
|
I := 1;
|
|
while I < Length(AString) do
|
|
begin
|
|
C2.C := UTF16GetNextChar(AString, I);
|
|
if I = -1 then
|
|
raise EJclUnexpectedEOSequenceError.Create;
|
|
IntegerHash.H1 := BytePermTable[IntegerHash.H1 xor C2.H1];
|
|
IntegerHash.H2 := BytePermTable[IntegerHash.H2 xor C2.H2];
|
|
IntegerHash.H3 := BytePermTable[IntegerHash.H3 xor C2.H3];
|
|
IntegerHash.H4 := BytePermTable[IntegerHash.H4 xor C2.H4];
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
// case insensitive
|
|
I := 1;
|
|
while I < Length(AString) do
|
|
begin
|
|
C2.C := UTF16GetNextChar(AString, I);
|
|
CA := UnicodeCaseFold(C2.C);
|
|
for J := Low(CA) to High(CA) do
|
|
begin
|
|
C2.C := CA[J];
|
|
if I = -1 then
|
|
raise EJclUnexpectedEOSequenceError.Create;
|
|
IntegerHash.H1 := BytePermTable[IntegerHash.H1 xor C2.H1];
|
|
IntegerHash.H2 := BytePermTable[IntegerHash.H2 xor C2.H2];
|
|
IntegerHash.H3 := BytePermTable[IntegerHash.H3 xor C2.H3];
|
|
IntegerHash.H4 := BytePermTable[IntegerHash.H4 xor C2.H4];
|
|
end;
|
|
end;
|
|
end;
|
|
Result := IntegerHash.H;
|
|
end;
|
|
end;
|
|
|
|
|
|
function TJclUnicodeStrAbstractContainer.ItemsCompare(const A, B: UnicodeString): Integer;
|
|
begin
|
|
if Assigned(FCompare) then
|
|
Result := FCompare(A, B)
|
|
else
|
|
if FCaseSensitive then
|
|
Result := CompareStr(A, B)
|
|
else
|
|
Result := CompareText(A, B);
|
|
end;
|
|
|
|
function TJclUnicodeStrAbstractContainer.ItemsEqual(const A, B: UnicodeString): Boolean;
|
|
begin
|
|
if Assigned(FEqualityCompare) then
|
|
Result := FEqualityCompare(A, B)
|
|
else
|
|
if Assigned(FCompare) then
|
|
Result := FCompare(A, B) = 0
|
|
else
|
|
if FCaseSensitive then
|
|
Result := CompareStr(A, B) = 0
|
|
else
|
|
Result := CompareText(A, B) = 0;
|
|
end;
|
|
|
|
procedure TJclUnicodeStrAbstractContainer.SetCompare(Value: TUnicodeStrCompare);
|
|
begin
|
|
FCompare := Value;
|
|
end;
|
|
|
|
procedure TJclUnicodeStrAbstractContainer.SetEqualityCompare(Value: TUnicodeStrEqualityCompare);
|
|
begin
|
|
FEqualityCompare := Value;
|
|
end;
|
|
|
|
procedure TJclUnicodeStrAbstractContainer.SetHashConvert(Value: TUnicodeStrHashConvert);
|
|
begin
|
|
FHashConvert := Value;
|
|
end;
|
|
{$ENDIF SUPPORTS_UNICODE_STRING}
|
|
|
|
//=== { TJclSingleAbstractContainer } ========================================
|
|
|
|
procedure TJclSingleAbstractContainer.AssignPropertiesTo(Dest: TJclAbstractContainerBase);
|
|
var
|
|
ADest: TJclSingleAbstractContainer;
|
|
begin
|
|
inherited AssignPropertiesTo(Dest);
|
|
if Dest is TJclSingleAbstractContainer then
|
|
begin
|
|
ADest := TJclSingleAbstractContainer(Dest);
|
|
ADest.Precision := Precision;
|
|
ADest.EqualityCompare := EqualityCompare;
|
|
ADest.Compare := Compare;
|
|
ADest.HashConvert := HashConvert;
|
|
end;
|
|
end;
|
|
|
|
function TJclSingleAbstractContainer.FreeSingle(var AValue: Single): Single;
|
|
begin
|
|
Result := AValue;
|
|
AValue := 0.0;
|
|
end;
|
|
|
|
function TJclSingleAbstractContainer.GetCompare: TSingleCompare;
|
|
begin
|
|
Result := FCompare;
|
|
end;
|
|
|
|
function TJclSingleAbstractContainer.GetEqualityCompare: TSingleEqualityCompare;
|
|
begin
|
|
Result := FEqualityCompare;
|
|
end;
|
|
|
|
function TJclSingleAbstractContainer.GetHashConvert: TSingleHashConvert;
|
|
begin
|
|
Result := FHashConvert;
|
|
end;
|
|
|
|
function TJclSingleAbstractContainer.GetPrecision: Single;
|
|
begin
|
|
Result := FPrecision;
|
|
end;
|
|
|
|
function TJclSingleAbstractContainer.Hash(const AValue: Single): Integer;
|
|
const
|
|
A = 0.6180339887; // (sqrt(5) - 1) / 2
|
|
begin
|
|
if Assigned(FHashConvert) then
|
|
Result := FHashConvert(AValue)
|
|
else
|
|
Result := Round(MaxInt * Frac(AValue * A));
|
|
end;
|
|
|
|
function TJclSingleAbstractContainer.ItemsCompare(const A, B: Single): Integer;
|
|
begin
|
|
if Assigned(FCompare) then
|
|
Result := FCompare(A, B)
|
|
else
|
|
if Abs(A - B) <= FPrecision then
|
|
Result := 0
|
|
else
|
|
if A > B then
|
|
Result := 1
|
|
else
|
|
Result := -1;
|
|
end;
|
|
|
|
function TJclSingleAbstractContainer.ItemsEqual(const A, B: Single): Boolean;
|
|
begin
|
|
if Assigned(FEqualityCompare) then
|
|
Result := FEqualityCompare(A, B)
|
|
else
|
|
if Assigned(FCompare) then
|
|
Result := FCompare(A, B) = 0
|
|
else
|
|
Result := Abs(A - B) <= FPrecision;
|
|
end;
|
|
|
|
procedure TJclSingleAbstractContainer.SetCompare(Value: TSingleCompare);
|
|
begin
|
|
FCompare := Value;
|
|
end;
|
|
|
|
procedure TJclSingleAbstractContainer.SetEqualityCompare(Value: TSingleEqualityCompare);
|
|
begin
|
|
FEqualityCompare := Value;
|
|
end;
|
|
|
|
procedure TJclSingleAbstractContainer.SetHashConvert(Value: TSingleHashConvert);
|
|
begin
|
|
FHashConvert := Value;
|
|
end;
|
|
|
|
procedure TJclSingleAbstractContainer.SetPrecision(const Value: Single);
|
|
begin
|
|
FPrecision := Value;
|
|
end;
|
|
|
|
//=== { TJclDoubleAbstractContainer } ========================================
|
|
|
|
procedure TJclDoubleAbstractContainer.AssignPropertiesTo(Dest: TJclAbstractContainerBase);
|
|
var
|
|
ADest: TJclDoubleAbstractContainer;
|
|
begin
|
|
inherited AssignPropertiesTo(Dest);
|
|
if Dest is TJclDoubleAbstractContainer then
|
|
begin
|
|
ADest := TJclDoubleAbstractContainer(Dest);
|
|
ADest.Precision := Precision;
|
|
ADest.Compare := Compare;
|
|
ADest.EqualityCompare := EqualityCompare;
|
|
ADest.HashConvert := HashConvert;
|
|
end;
|
|
end;
|
|
|
|
function TJclDoubleAbstractContainer.FreeDouble(var AValue: Double): Double;
|
|
begin
|
|
Result := AValue;
|
|
AValue := 0.0;
|
|
end;
|
|
|
|
function TJclDoubleAbstractContainer.GetCompare: TDoubleCompare;
|
|
begin
|
|
Result := FCompare;
|
|
end;
|
|
|
|
function TJclDoubleAbstractContainer.GetEqualityCompare: TDoubleEqualityCompare;
|
|
begin
|
|
Result := FEqualityCompare;
|
|
end;
|
|
|
|
function TJclDoubleAbstractContainer.GetHashConvert: TDoubleHashConvert;
|
|
begin
|
|
Result := FHashConvert;
|
|
end;
|
|
|
|
function TJclDoubleAbstractContainer.GetPrecision: Double;
|
|
begin
|
|
Result := FPrecision;
|
|
end;
|
|
|
|
function TJclDoubleAbstractContainer.Hash(const AValue: Double): Integer;
|
|
const
|
|
A = 0.6180339887; // (sqrt(5) - 1) / 2
|
|
begin
|
|
if Assigned(FHashConvert) then
|
|
Result := FHashConvert(AValue)
|
|
else
|
|
Result := Round(MaxInt * Frac(AValue * A));
|
|
end;
|
|
|
|
function TJclDoubleAbstractContainer.ItemsCompare(const A, B: Double): Integer;
|
|
begin
|
|
if Assigned(FCompare) then
|
|
Result := FCompare(A, B)
|
|
else
|
|
if Abs(A - B) <= FPrecision then
|
|
Result := 0
|
|
else
|
|
if A > B then
|
|
Result := 1
|
|
else
|
|
Result := -1;
|
|
end;
|
|
|
|
function TJclDoubleAbstractContainer.ItemsEqual(const A, B: Double): Boolean;
|
|
begin
|
|
if Assigned(FEqualityCompare) then
|
|
Result := FEqualityCompare(A, B)
|
|
else
|
|
if Assigned(FCompare) then
|
|
Result := FCompare(A, B) = 0
|
|
else
|
|
Result := Abs(A - B) <= FPrecision;
|
|
end;
|
|
|
|
procedure TJclDoubleAbstractContainer.SetCompare(Value: TDoubleCompare);
|
|
begin
|
|
FCompare := Value;
|
|
end;
|
|
|
|
procedure TJclDoubleAbstractContainer.SetEqualityCompare(Value: TDoubleEqualityCompare);
|
|
begin
|
|
FEqualityCompare := Value;
|
|
end;
|
|
|
|
procedure TJclDoubleAbstractContainer.SetHashConvert(Value: TDoubleHashConvert);
|
|
begin
|
|
FHashConvert := Value;
|
|
end;
|
|
|
|
procedure TJclDoubleAbstractContainer.SetPrecision(const Value: Double);
|
|
begin
|
|
FPrecision := Value;
|
|
end;
|
|
|
|
//=== { TJclExtendedAbstractContainer } ======================================
|
|
|
|
procedure TJclExtendedAbstractContainer.AssignPropertiesTo(Dest: TJclAbstractContainerBase);
|
|
var
|
|
ADest: TJclExtendedAbstractContainer;
|
|
begin
|
|
inherited AssignPropertiesTo(Dest);
|
|
if Dest is TJclExtendedAbstractContainer then
|
|
begin
|
|
ADest := TJclExtendedAbstractContainer(Dest);
|
|
ADest.Precision := Precision;
|
|
ADest.EqualityCompare := EqualityCompare;
|
|
ADest.Compare := Compare;
|
|
ADest.HashConvert := HashConvert;
|
|
end;
|
|
end;
|
|
|
|
function TJclExtendedAbstractContainer.FreeExtended(var AValue: Extended): Extended;
|
|
begin
|
|
Result := AValue;
|
|
AValue := 0.0;
|
|
end;
|
|
|
|
function TJclExtendedAbstractContainer.GetCompare: TExtendedCompare;
|
|
begin
|
|
Result := FCompare;
|
|
end;
|
|
|
|
function TJclExtendedAbstractContainer.GetEqualityCompare: TExtendedEqualityCompare;
|
|
begin
|
|
Result := FEqualityCompare;
|
|
end;
|
|
|
|
function TJclExtendedAbstractContainer.GetHashConvert: TExtendedHashConvert;
|
|
begin
|
|
Result := FHashConvert;
|
|
end;
|
|
|
|
function TJclExtendedAbstractContainer.GetPrecision: Extended;
|
|
begin
|
|
Result := FPrecision;
|
|
end;
|
|
|
|
function TJclExtendedAbstractContainer.Hash(const AValue: Extended): Integer;
|
|
const
|
|
A = 0.6180339887; // (sqrt(5) - 1) / 2
|
|
begin
|
|
if Assigned(FHashConvert) then
|
|
Result := FHashConvert(AValue)
|
|
else
|
|
Result := Round(MaxInt * Frac(AValue * A));
|
|
end;
|
|
|
|
function TJclExtendedAbstractContainer.ItemsCompare(const A, B: Extended): Integer;
|
|
begin
|
|
if Assigned(FCompare) then
|
|
Result := FCompare(A, B)
|
|
else
|
|
if Abs(A - B) <= FPrecision then
|
|
Result := 0
|
|
else
|
|
if A > B then
|
|
Result := 1
|
|
else
|
|
Result := -1;
|
|
end;
|
|
|
|
function TJclExtendedAbstractContainer.ItemsEqual(const A, B: Extended): Boolean;
|
|
begin
|
|
if Assigned(FEqualityCompare) then
|
|
Result := FEqualityCompare(A, B)
|
|
else
|
|
if Assigned(FCompare) then
|
|
Result := FCompare(A, B) = 0
|
|
else
|
|
Result := Abs(A - B) <= FPrecision;
|
|
end;
|
|
|
|
procedure TJclExtendedAbstractContainer.SetCompare(Value: TExtendedCompare);
|
|
begin
|
|
FCompare := Value;
|
|
end;
|
|
|
|
procedure TJclExtendedAbstractContainer.SetEqualityCompare(Value: TExtendedEqualityCompare);
|
|
begin
|
|
FEqualityCompare := Value;
|
|
end;
|
|
|
|
procedure TJclExtendedAbstractContainer.SetHashConvert(Value: TExtendedHashConvert);
|
|
begin
|
|
FHashConvert := Value;
|
|
end;
|
|
|
|
procedure TJclExtendedAbstractContainer.SetPrecision(const Value: Extended);
|
|
begin
|
|
FPrecision := Value;
|
|
end;
|
|
|
|
//=== { TJclIntegerAbstractContainer } =======================================
|
|
|
|
procedure TJclIntegerAbstractContainer.AssignPropertiesTo(Dest: TJclAbstractContainerBase);
|
|
var
|
|
ADest: TJclIntegerAbstractContainer;
|
|
begin
|
|
inherited AssignPropertiesTo(Dest);
|
|
if Dest is TJclIntegerAbstractContainer then
|
|
begin
|
|
ADest := TJclIntegerAbstractContainer(Dest);
|
|
ADest.EqualityCompare := EqualityCompare;
|
|
ADest.Compare := Compare;
|
|
ADest.HashConvert := HashConvert;
|
|
end;
|
|
end;
|
|
|
|
function TJclIntegerAbstractContainer.FreeInteger(var AValue: Integer): Integer;
|
|
begin
|
|
Result := AValue;
|
|
AValue := 0;
|
|
end;
|
|
|
|
function TJclIntegerAbstractContainer.GetCompare: TIntegerCompare;
|
|
begin
|
|
Result := FCompare;
|
|
end;
|
|
|
|
function TJclIntegerAbstractContainer.GetEqualityCompare: TIntegerEqualityCompare;
|
|
begin
|
|
Result := FEqualityCompare;
|
|
end;
|
|
|
|
function TJclIntegerAbstractContainer.GetHashConvert: TIntegerHashConvert;
|
|
begin
|
|
Result := FHashConvert;
|
|
end;
|
|
|
|
function TJclIntegerAbstractContainer.Hash(AValue: Integer): Integer;
|
|
begin
|
|
if Assigned(FHashConvert) then
|
|
Result := FHashConvert(AValue)
|
|
else
|
|
Result := AValue;
|
|
end;
|
|
|
|
function TJclIntegerAbstractContainer.ItemsCompare(A, B: Integer): Integer;
|
|
begin
|
|
if Assigned(FCompare) then
|
|
Result := FCompare(A, B)
|
|
else
|
|
if A > B then
|
|
Result := 1
|
|
else
|
|
if A < B then
|
|
Result := -1
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TJclIntegerAbstractContainer.ItemsEqual(A, B: Integer): Boolean;
|
|
begin
|
|
if Assigned(FEqualityCompare) then
|
|
Result := FEqualityCompare(A, B)
|
|
else
|
|
if Assigned(FCompare) then
|
|
Result := FCompare(A, B) = 0
|
|
else
|
|
Result := A = B;
|
|
end;
|
|
|
|
procedure TJclIntegerAbstractContainer.SetCompare(Value: TIntegerCompare);
|
|
begin
|
|
FCompare := Value;
|
|
end;
|
|
|
|
procedure TJclIntegerAbstractContainer.SetEqualityCompare(Value: TIntegerEqualityCompare);
|
|
begin
|
|
FEqualityCompare := Value;
|
|
end;
|
|
|
|
procedure TJclIntegerAbstractContainer.SetHashConvert(Value: TIntegerHashConvert);
|
|
begin
|
|
FHashConvert := Value;
|
|
end;
|
|
|
|
//=== { TJclCardinalAbstractContainer } ======================================
|
|
|
|
procedure TJclCardinalAbstractContainer.AssignPropertiesTo(Dest: TJclAbstractContainerBase);
|
|
var
|
|
ADest: TJclCardinalAbstractContainer;
|
|
begin
|
|
inherited AssignPropertiesTo(Dest);
|
|
if Dest is TJclCardinalAbstractContainer then
|
|
begin
|
|
ADest := TJclCardinalAbstractContainer(Dest);
|
|
ADest.EqualityCompare := EqualityCompare;
|
|
ADest.Compare := Compare;
|
|
ADest.HashConvert := HashConvert;
|
|
end;
|
|
end;
|
|
|
|
function TJclCardinalAbstractContainer.FreeCardinal(var AValue: Cardinal): Cardinal;
|
|
begin
|
|
Result := AValue;
|
|
AValue := 0;
|
|
end;
|
|
|
|
function TJclCardinalAbstractContainer.GetCompare: TCardinalCompare;
|
|
begin
|
|
Result := FCompare;
|
|
end;
|
|
|
|
function TJclCardinalAbstractContainer.GetEqualityCompare: TCardinalEqualityCompare;
|
|
begin
|
|
Result := FEqualityCompare;
|
|
end;
|
|
|
|
function TJclCardinalAbstractContainer.GetHashConvert: TCardinalHashConvert;
|
|
begin
|
|
Result := FHashConvert;
|
|
end;
|
|
|
|
function TJclCardinalAbstractContainer.Hash(AValue: Cardinal): Integer;
|
|
begin
|
|
if Assigned(FHashConvert) then
|
|
Result := FHashConvert(AValue)
|
|
else
|
|
Result := AValue and MaxInt;
|
|
end;
|
|
|
|
function TJclCardinalAbstractContainer.ItemsCompare(A, B: Cardinal): Integer;
|
|
begin
|
|
if Assigned(FCompare) then
|
|
Result := FCompare(A, B)
|
|
else
|
|
if A > B then
|
|
Result := 1
|
|
else
|
|
if A < B then
|
|
Result := -1
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TJclCardinalAbstractContainer.ItemsEqual(A, B: Cardinal): Boolean;
|
|
begin
|
|
if Assigned(FEqualityCompare) then
|
|
Result := FEqualityCompare(A, B)
|
|
else
|
|
if Assigned(FCompare) then
|
|
Result := FCompare(A, B) = 0
|
|
else
|
|
Result := A = B;
|
|
end;
|
|
|
|
procedure TJclCardinalAbstractContainer.SetCompare(Value: TCardinalCompare);
|
|
begin
|
|
FCompare := Value;
|
|
end;
|
|
|
|
procedure TJclCardinalAbstractContainer.SetEqualityCompare(Value: TCardinalEqualityCompare);
|
|
begin
|
|
FEqualityCompare := Value;
|
|
end;
|
|
|
|
procedure TJclCardinalAbstractContainer.SetHashConvert(Value: TCardinalHashConvert);
|
|
begin
|
|
FHashConvert := Value;
|
|
end;
|
|
|
|
//=== { TJclInt64AbstractContainer } =========================================
|
|
|
|
procedure TJclInt64AbstractContainer.AssignPropertiesTo(Dest: TJclAbstractContainerBase);
|
|
var
|
|
ADest: TJclInt64AbstractContainer;
|
|
begin
|
|
inherited AssignPropertiesTo(Dest);
|
|
if Dest is TJclInt64AbstractContainer then
|
|
begin
|
|
ADest := TJclInt64AbstractContainer(Dest);
|
|
ADest.EqualityCompare := EqualityCompare;
|
|
ADest.Compare := Compare;
|
|
ADest.HashConvert := HashConvert;
|
|
end;
|
|
end;
|
|
|
|
function TJclInt64AbstractContainer.FreeInt64(var AValue: Int64): Int64;
|
|
begin
|
|
Result := AValue;
|
|
AValue := 0;
|
|
end;
|
|
|
|
function TJclInt64AbstractContainer.GetCompare: TInt64Compare;
|
|
begin
|
|
Result := FCompare;
|
|
end;
|
|
|
|
function TJclInt64AbstractContainer.GetEqualityCompare: TInt64EqualityCompare;
|
|
begin
|
|
Result := FEqualityCompare;
|
|
end;
|
|
|
|
function TJclInt64AbstractContainer.GetHashConvert: TInt64HashConvert;
|
|
begin
|
|
Result := FHashConvert;
|
|
end;
|
|
|
|
function TJclInt64AbstractContainer.Hash(const AValue: Int64): Integer;
|
|
begin
|
|
if Assigned(FHashConvert) then
|
|
Result := FHashConvert(AValue)
|
|
else
|
|
Result := AValue and MaxInt;
|
|
end;
|
|
|
|
function TJclInt64AbstractContainer.ItemsCompare(const A, B: Int64): Integer;
|
|
begin
|
|
if Assigned(FCompare) then
|
|
Result := FCompare(A, B)
|
|
else
|
|
if A > B then
|
|
Result := 1
|
|
else
|
|
if A < B then
|
|
Result := -1
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TJclInt64AbstractContainer.ItemsEqual(const A, B: Int64): Boolean;
|
|
begin
|
|
if Assigned(FEqualityCompare) then
|
|
Result := FEqualityCompare(A, B)
|
|
else
|
|
if Assigned(FCompare) then
|
|
Result := FCompare(A, B) = 0
|
|
else
|
|
Result := A = B;
|
|
end;
|
|
|
|
procedure TJclInt64AbstractContainer.SetCompare(Value: TInt64Compare);
|
|
begin
|
|
FCompare := Value;
|
|
end;
|
|
|
|
procedure TJclInt64AbstractContainer.SetEqualityCompare(Value: TInt64EqualityCompare);
|
|
begin
|
|
FEqualityCompare := Value;
|
|
end;
|
|
|
|
procedure TJclInt64AbstractContainer.SetHashConvert(Value: TInt64HashConvert);
|
|
begin
|
|
FHashConvert := Value;
|
|
end;
|
|
|
|
//=== { TJclPtrAbstractContainer } ===========================================
|
|
|
|
procedure TJclPtrAbstractContainer.AssignPropertiesTo(Dest: TJclAbstractContainerBase);
|
|
var
|
|
ADest: TJclPtrAbstractContainer;
|
|
begin
|
|
inherited AssignPropertiesTo(Dest);
|
|
if Dest is TJclPtrAbstractContainer then
|
|
begin
|
|
ADest := TJclPtrAbstractContainer(Dest);
|
|
ADest.EqualityCompare := EqualityCompare;
|
|
ADest.Compare := Compare;
|
|
ADest.HashConvert := HashConvert;
|
|
end;
|
|
end;
|
|
|
|
function TJclPtrAbstractContainer.FreePointer(var APtr: Pointer): Pointer;
|
|
begin
|
|
Result := APtr;
|
|
APtr := nil;
|
|
end;
|
|
|
|
function TJclPtrAbstractContainer.GetCompare: TPtrCompare;
|
|
begin
|
|
Result := FCompare;
|
|
end;
|
|
|
|
function TJclPtrAbstractContainer.GetEqualityCompare: TPtrEqualityCompare;
|
|
begin
|
|
Result := FEqualityCompare;
|
|
end;
|
|
|
|
function TJclPtrAbstractContainer.GetHashConvert: TPtrHashConvert;
|
|
begin
|
|
Result := FHashConvert;
|
|
end;
|
|
|
|
function TJclPtrAbstractContainer.Hash(APtr: Pointer): Integer;
|
|
begin
|
|
if Assigned(FHashConvert) then
|
|
Result := FHashConvert(APtr)
|
|
else
|
|
Result := Integer(APtr) and MaxInt;
|
|
end;
|
|
|
|
function TJclPtrAbstractContainer.ItemsCompare(A, B: Pointer): Integer;
|
|
begin
|
|
if Assigned(FCompare) then
|
|
Result := FCompare(A, B)
|
|
else
|
|
if Integer(A) > Integer(B) then
|
|
Result := 1
|
|
else
|
|
if Integer(A) < Integer(B) then
|
|
Result := -1
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TJclPtrAbstractContainer.ItemsEqual(A, B: Pointer): Boolean;
|
|
begin
|
|
if Assigned(FEqualityCompare) then
|
|
Result := FEqualityCompare(A, B)
|
|
else
|
|
if Assigned(FCompare) then
|
|
Result := FCompare(A, B) = 0
|
|
else
|
|
Result := Integer(A) = Integer(B);
|
|
end;
|
|
procedure TJclPtrAbstractContainer.SetCompare(Value: TPtrCompare);
|
|
begin
|
|
FCompare := Value;
|
|
end;
|
|
|
|
procedure TJclPtrAbstractContainer.SetEqualityCompare(Value: TPtrEqualityCompare);
|
|
begin
|
|
FEqualityCompare := Value;
|
|
end;
|
|
|
|
procedure TJclPtrAbstractContainer.SetHashConvert(Value: TPtrHashConvert);
|
|
begin
|
|
FHashConvert := Value;
|
|
end;
|
|
|
|
//=== { TJclAbstractContainer } ==============================================
|
|
|
|
constructor TJclAbstractContainer.Create(AOwnsObjects: Boolean);
|
|
begin
|
|
inherited Create;
|
|
FOwnsObjects := AOwnsObjects;
|
|
end;
|
|
|
|
procedure TJclAbstractContainer.AssignPropertiesTo(Dest: TJclAbstractContainerBase);
|
|
var
|
|
ADest: TJclAbstractContainer;
|
|
begin
|
|
inherited AssignPropertiesTo(Dest);
|
|
if Dest is TJclAbstractContainer then
|
|
begin
|
|
ADest := TJclAbstractContainer(Dest);
|
|
ADest.EqualityCompare := EqualityCompare;
|
|
ADest.Compare := Compare;
|
|
ADest.HashConvert := HashConvert;
|
|
end;
|
|
end;
|
|
|
|
function TJclAbstractContainer.FreeObject(var AObject: TObject): TObject;
|
|
begin
|
|
if FOwnsObjects then
|
|
begin
|
|
Result := nil;
|
|
FreeAndNil(AObject);
|
|
end
|
|
else
|
|
begin
|
|
Result := AObject;
|
|
AObject := nil;
|
|
end;
|
|
end;
|
|
|
|
function TJclAbstractContainer.GetCompare: TCompare;
|
|
begin
|
|
Result := FCompare;
|
|
end;
|
|
|
|
function TJclAbstractContainer.GetEqualityCompare: TEqualityCompare;
|
|
begin
|
|
Result := FEqualityCompare;
|
|
end;
|
|
|
|
function TJclAbstractContainer.GetHashConvert: THashConvert;
|
|
begin
|
|
Result := FHashConvert;
|
|
end;
|
|
|
|
function TJclAbstractContainer.GetOwnsObjects: Boolean;
|
|
begin
|
|
Result := FOwnsObjects;
|
|
end;
|
|
|
|
function TJclAbstractContainer.Hash(AObject: TObject): Integer;
|
|
begin
|
|
if Assigned(FHashConvert) then
|
|
Result := FHashConvert(AObject)
|
|
else
|
|
Result := Integer(AObject);
|
|
end;
|
|
|
|
function TJclAbstractContainer.ItemsCompare(A, B: TObject): Integer;
|
|
begin
|
|
if Assigned(FCompare) then
|
|
Result := FCompare(A, B)
|
|
else
|
|
if Integer(A) > Integer(B) then
|
|
Result := 1
|
|
else
|
|
if Integer(A) < Integer(B) then
|
|
Result := -1
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TJclAbstractContainer.ItemsEqual(A, B: TObject): Boolean;
|
|
begin
|
|
if Assigned(FEqualityCompare) then
|
|
Result := FEqualityCompare(A, B)
|
|
else
|
|
if Assigned(FCompare) then
|
|
Result := FCompare(A, B) = 0
|
|
else
|
|
Result := Integer(A) = Integer(B);
|
|
end;
|
|
|
|
procedure TJclAbstractContainer.SetCompare(Value: TCompare);
|
|
begin
|
|
FCompare := Value;
|
|
end;
|
|
|
|
procedure TJclAbstractContainer.SetEqualityCompare(Value: TEqualityCompare);
|
|
begin
|
|
FEqualityCompare := Value;
|
|
end;
|
|
|
|
procedure TJclAbstractContainer.SetHashConvert(Value: THashConvert);
|
|
begin
|
|
FHashConvert := Value;
|
|
end;
|
|
|
|
{$IFDEF SUPPORTS_GENERICS}
|
|
//=== { TJclAbstractContainer<T> } ===========================================
|
|
|
|
constructor TJclAbstractContainer<T>.Create(AOwnsItems: Boolean);
|
|
begin
|
|
inherited Create;
|
|
FOwnsItems := AOwnsItems;
|
|
end;
|
|
|
|
procedure TJclAbstractContainer<T>.AssignPropertiesTo(Dest: TJclAbstractContainerBase);
|
|
var
|
|
ADest: TJclAbstractContainer<T>;
|
|
begin
|
|
inherited AssignPropertiesTo(Dest);
|
|
if Dest is TJclAbstractContainer<T> then
|
|
begin
|
|
ADest := TJclAbstractContainer<T>(Dest);
|
|
ADest.EqualityCompare := EqualityCompare;
|
|
ADest.Compare := Compare;
|
|
ADest.HashConvert := HashConvert;
|
|
end;
|
|
end;
|
|
|
|
function TJclAbstractContainer<T>.FreeItem(var AItem: T): T;
|
|
begin
|
|
if FOwnsItems then
|
|
begin
|
|
Result := Default(T);
|
|
FreeAndNil(AItem);
|
|
end
|
|
else
|
|
begin
|
|
Result := AItem;
|
|
AItem := Default(T);
|
|
end;
|
|
end;
|
|
|
|
function TJclAbstractContainer<T>.GetCompare: TCompare<T>;
|
|
begin
|
|
Result := FCompare;
|
|
end;
|
|
|
|
function TJclAbstractContainer<T>.GetEqualityCompare: TEqualityCompare<T>;
|
|
begin
|
|
Result := FEqualityCompare;
|
|
end;
|
|
|
|
function TJclAbstractContainer<T>.GetHashConvert: THashConvert<T>;
|
|
begin
|
|
Result := FHashConvert;
|
|
end;
|
|
|
|
function TJclAbstractContainer<T>.GetOwnsItems: Boolean;
|
|
begin
|
|
Result := FOwnsItems;
|
|
end;
|
|
|
|
function TJclAbstractContainer<T>.Hash(const AItem: T): Integer;
|
|
begin
|
|
if Assigned(FHashConvert) then
|
|
Result := FHashConvert(AItem)
|
|
else
|
|
raise EJclOperationNotSupportedError.Create;
|
|
end;
|
|
|
|
function TJclAbstractContainer<T>.ItemsCompare(const A, B: T): Integer;
|
|
begin
|
|
if Assigned(FCompare) then
|
|
Result := FCompare(A, B)
|
|
else
|
|
raise EJclOperationNotSupportedError.Create;
|
|
end;
|
|
|
|
function TJclAbstractContainer<T>.ItemsEqual(const A, B: T): Boolean;
|
|
begin
|
|
if Assigned(FEqualityCompare) then
|
|
Result := FEqualityCompare(A, B)
|
|
else
|
|
if Assigned(FCompare) then
|
|
Result := FCompare(A, B) = 0
|
|
else
|
|
raise EJclOperationNotSupportedError.Create;
|
|
end;
|
|
|
|
procedure TJclAbstractContainer<T>.SetCompare(Value: TCompare<T>);
|
|
begin
|
|
FCompare := Value;
|
|
end;
|
|
|
|
procedure TJclAbstractContainer<T>.SetEqualityCompare(Value: TEqualityCompare<T>);
|
|
begin
|
|
FEqualityCompare := Value;
|
|
end;
|
|
|
|
procedure TJclAbstractContainer<T>.SetHashConvert(Value: THashConvert<T>);
|
|
begin
|
|
FHashConvert := Value;
|
|
end;
|
|
|
|
{$ENDIF SUPPORTS_GENERICS}
|
|
|
|
//=== { TJclAnsiStrAbstractCollection } ======================================
|
|
|
|
// TODO: common implementation, need a function to search for a string starting from
|
|
// a predefined index
|
|
procedure TJclAnsiStrAbstractCollection.AppendDelimited(const AString, Separator: AnsiString);
|
|
var
|
|
Item: AnsiString;
|
|
SepLen: Integer;
|
|
PString, PSep, PPos: PAnsiChar;
|
|
begin
|
|
PString := PAnsiChar(AString);
|
|
PSep := PAnsiChar(Separator);
|
|
PPos := StrPos(PString, PSep);
|
|
if PPos <> nil then
|
|
begin
|
|
SepLen := StrLen(PSep);
|
|
repeat
|
|
//SetLength(Item, PPos - PString + 1);
|
|
SetLength(Item, PPos - PString);
|
|
Move(PString^, Item[1], (PPos - PString) * SizeOf(AnsiChar));
|
|
//Item[PPos - PString + 1] := #0;
|
|
Add(Item);
|
|
PString := PPos + SepLen;
|
|
PPos := StrPos(PString, PSep);
|
|
until PPos = nil;
|
|
if StrLen(PString) > 0 then //ex. hello#world
|
|
Add(PString);
|
|
end
|
|
else //There isnt a Separator in AString
|
|
Add(AString);
|
|
end;
|
|
|
|
procedure TJclAnsiStrAbstractCollection.AppendFromStrings(Strings: TJclAnsiStrings);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to Strings.Count - 1 do
|
|
Add(Strings[I]);
|
|
end;
|
|
|
|
procedure TJclAnsiStrAbstractCollection.AppendToStrings(Strings: TJclAnsiStrings);
|
|
var
|
|
It: IJclAnsiStrIterator;
|
|
begin
|
|
It := First;
|
|
Strings.BeginUpdate;
|
|
try
|
|
while It.HasNext do
|
|
Strings.Add(It.Next);
|
|
finally
|
|
Strings.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
function TJclAnsiStrAbstractCollection.GetAsDelimited(const Separator: AnsiString): AnsiString;
|
|
var
|
|
It: IJclAnsiStrIterator;
|
|
begin
|
|
It := First;
|
|
Result := '';
|
|
if It.HasNext then
|
|
Result := It.Next;
|
|
while It.HasNext do
|
|
Result := Result + Separator + It.Next;
|
|
end;
|
|
|
|
function TJclAnsiStrAbstractCollection.GetAsStrings: TJclAnsiStrings;
|
|
begin
|
|
Result := TJclAnsiStringList.Create;
|
|
try
|
|
AppendToStrings(Result);
|
|
except
|
|
Result.Free;
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
procedure TJclAnsiStrAbstractCollection.LoadDelimited(const AString, Separator: AnsiString);
|
|
begin
|
|
Clear;
|
|
AppendDelimited(AString, Separator);
|
|
end;
|
|
|
|
procedure TJclAnsiStrAbstractCollection.LoadFromStrings(Strings: TJclAnsiStrings);
|
|
begin
|
|
Clear;
|
|
AppendFromStrings(Strings);
|
|
end;
|
|
|
|
procedure TJclAnsiStrAbstractCollection.SaveToStrings(Strings: TJclAnsiStrings);
|
|
begin
|
|
Strings.Clear;
|
|
AppendToStrings(Strings);
|
|
end;
|
|
|
|
//=== { TJclWideStrAbstractCollection } ======================================
|
|
|
|
// TODO: common implementation, need a function to search for a string starting from
|
|
// a predefined index
|
|
procedure TJclWideStrAbstractCollection.AppendDelimited(const AString, Separator: WideString);
|
|
var
|
|
Item: WideString;
|
|
SepLen: Integer;
|
|
PString, PSep, PPos: PWideChar;
|
|
begin
|
|
PString := PWideChar(AString);
|
|
PSep := PWideChar(Separator);
|
|
PPos := StrPosW(PString, PSep);
|
|
if PPos <> nil then
|
|
begin
|
|
SepLen := StrLenW(PSep);
|
|
repeat
|
|
//SetLength(Item, PPos - PString + 1);
|
|
SetLength(Item, PPos - PString);
|
|
Move(PString^, Item[1], (PPos - PString) * SizeOf(WideChar));
|
|
//Item[PPos - PString + 1] := #0;
|
|
Add(Item);
|
|
PString := PPos + SepLen;
|
|
PPos := StrPosW(PString, PSep);
|
|
until PPos = nil;
|
|
if StrLenW(PString) > 0 then //ex. hello#world
|
|
Add(PString);
|
|
end
|
|
else //There isnt a Separator in AString
|
|
Add(AString);
|
|
end;
|
|
|
|
procedure TJclWideStrAbstractCollection.AppendFromStrings(Strings: TJclWideStrings);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to Strings.Count - 1 do
|
|
Add(Strings[I]);
|
|
end;
|
|
|
|
procedure TJclWideStrAbstractCollection.AppendToStrings(Strings: TJclWideStrings);
|
|
var
|
|
It: IJclWideStrIterator;
|
|
begin
|
|
It := First;
|
|
Strings.BeginUpdate;
|
|
try
|
|
while It.HasNext do
|
|
Strings.Add(It.Next);
|
|
finally
|
|
Strings.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
function TJclWideStrAbstractCollection.GetAsDelimited(const Separator: WideString): WideString;
|
|
var
|
|
It: IJclWideStrIterator;
|
|
begin
|
|
It := First;
|
|
Result := '';
|
|
if It.HasNext then
|
|
Result := It.Next;
|
|
while It.HasNext do
|
|
Result := Result + Separator + It.Next;
|
|
end;
|
|
|
|
function TJclWideStrAbstractCollection.GetAsStrings: TJclWideStrings;
|
|
begin
|
|
Result := TJclWideStringList.Create;
|
|
try
|
|
AppendToStrings(Result);
|
|
except
|
|
Result.Free;
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
procedure TJclWideStrAbstractCollection.LoadDelimited(const AString, Separator: WideString);
|
|
begin
|
|
Clear;
|
|
AppendDelimited(AString, Separator);
|
|
end;
|
|
|
|
procedure TJclWideStrAbstractCollection.LoadFromStrings(Strings: TJclWideStrings);
|
|
begin
|
|
Clear;
|
|
AppendFromStrings(Strings);
|
|
end;
|
|
|
|
procedure TJclWideStrAbstractCollection.SaveToStrings(Strings: TJclWideStrings);
|
|
begin
|
|
Strings.Clear;
|
|
AppendToStrings(Strings);
|
|
end;
|
|
|
|
{$IFDEF SUPPORTS_UNICODE_STRING}
|
|
//=== { TJclUnicodeStrAbstractCollection } ===================================
|
|
|
|
// TODO: common implementation, need a function to search for a string starting from
|
|
// a predefined index
|
|
procedure TJclUnicodeStrAbstractCollection.AppendDelimited(const AString, Separator: UnicodeString);
|
|
var
|
|
Item: UnicodeString;
|
|
SepLen: Integer;
|
|
PString, PSep, PPos: PWideChar;
|
|
begin
|
|
PString := PWideChar(AString);
|
|
PSep := PWideChar(Separator);
|
|
PPos := StrPos(PString, PSep);
|
|
if PPos <> nil then
|
|
begin
|
|
SepLen := StrLen(PSep);
|
|
repeat
|
|
//SetLength(Item, PPos - PString + 1);
|
|
SetLength(Item, PPos - PString);
|
|
Move(PString^, Item[1], (PPos - PString) * SizeOf(WideChar));
|
|
//Item[PPos - PString + 1] := #0;
|
|
Add(Item);
|
|
PString := PPos + SepLen;
|
|
PPos := StrPos(PString, PSep);
|
|
until PPos = nil;
|
|
if StrLen(PString) > 0 then //ex. hello#world
|
|
Add(PString);
|
|
end
|
|
else //There isnt a Separator in AString
|
|
Add(AString);
|
|
end;
|
|
|
|
procedure TJclUnicodeStrAbstractCollection.AppendFromStrings(Strings: TJclUnicodeStrings);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to Strings.Count - 1 do
|
|
Add(Strings[I]);
|
|
end;
|
|
|
|
procedure TJclUnicodeStrAbstractCollection.AppendToStrings(Strings: TJclUnicodeStrings);
|
|
var
|
|
It: IJclUnicodeStrIterator;
|
|
begin
|
|
It := First;
|
|
Strings.BeginUpdate;
|
|
try
|
|
while It.HasNext do
|
|
Strings.Add(It.Next);
|
|
finally
|
|
Strings.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
function TJclUnicodeStrAbstractCollection.GetAsDelimited(const Separator: UnicodeString): UnicodeString;
|
|
var
|
|
It: IJclUnicodeStrIterator;
|
|
begin
|
|
It := First;
|
|
Result := '';
|
|
if It.HasNext then
|
|
Result := It.Next;
|
|
while It.HasNext do
|
|
Result := Result + Separator + It.Next;
|
|
end;
|
|
|
|
function TJclUnicodeStrAbstractCollection.GetAsStrings: TJclUnicodeStrings;
|
|
begin
|
|
Result := TJclUnicodeStringList.Create;
|
|
try
|
|
AppendToStrings(Result);
|
|
except
|
|
Result.Free;
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
procedure TJclUnicodeStrAbstractCollection.LoadDelimited(const AString, Separator: UnicodeString);
|
|
begin
|
|
Clear;
|
|
AppendDelimited(AString, Separator);
|
|
end;
|
|
|
|
procedure TJclUnicodeStrAbstractCollection.LoadFromStrings(Strings: TJclUnicodeStrings);
|
|
begin
|
|
Clear;
|
|
AppendFromStrings(Strings);
|
|
end;
|
|
|
|
procedure TJclUnicodeStrAbstractCollection.SaveToStrings(Strings: TJclUnicodeStrings);
|
|
begin
|
|
Strings.Clear;
|
|
AppendToStrings(Strings);
|
|
end;
|
|
{$ENDIF SUPPORTS_UNICODE_STRING}
|
|
|
|
{$IFDEF UNITVERSIONING}
|
|
initialization
|
|
RegisterUnitVersion(HInstance, UnitVersioning);
|
|
|
|
finalization
|
|
UnregisterUnitVersion(HInstance);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
end.
|
|
|