Added: initial X2UtConfig implementation
Added: variant hashes Added: Delphi 7 package (note: D6 package is not in sync yet!)
This commit is contained in:
parent
6429b349c3
commit
16ba374f21
40
Packages/D7/X2Utils.cfg
Normal file
40
Packages/D7/X2Utils.cfg
Normal file
@ -0,0 +1,40 @@
|
||||
-$A8
|
||||
-$B-
|
||||
-$C+
|
||||
-$D+
|
||||
-$E-
|
||||
-$F-
|
||||
-$G+
|
||||
-$H+
|
||||
-$I+
|
||||
-$J+
|
||||
-$K-
|
||||
-$L+
|
||||
-$M-
|
||||
-$N+
|
||||
-$O+
|
||||
-$P+
|
||||
-$Q-
|
||||
-$R-
|
||||
-$S-
|
||||
-$T-
|
||||
-$U-
|
||||
-$V+
|
||||
-$W+
|
||||
-$X+
|
||||
-$YD
|
||||
-$Z1
|
||||
-cg
|
||||
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
|
||||
-H+
|
||||
-W+
|
||||
-M
|
||||
-$M16384,1048576
|
||||
-K$00400000
|
||||
-LE"c:\program files\borland\delphi7\Projects\Bpl"
|
||||
-LN"c:\program files\borland\delphi7\Projects\Bpl"
|
||||
-w-SYMBOL_PLATFORM
|
||||
-w-UNIT_PLATFORM
|
||||
-w-UNSAFE_TYPE
|
||||
-w-UNSAFE_CODE
|
||||
-w-UNSAFE_CAST
|
||||
144
Packages/D7/X2Utils.dof
Normal file
144
Packages/D7/X2Utils.dof
Normal file
@ -0,0 +1,144 @@
|
||||
[FileVersion]
|
||||
Version=7.0
|
||||
[Compiler]
|
||||
A=8
|
||||
B=0
|
||||
C=1
|
||||
D=1
|
||||
E=0
|
||||
F=0
|
||||
G=1
|
||||
H=1
|
||||
I=1
|
||||
J=1
|
||||
K=0
|
||||
L=1
|
||||
M=0
|
||||
N=1
|
||||
O=1
|
||||
P=1
|
||||
Q=0
|
||||
R=0
|
||||
S=0
|
||||
T=0
|
||||
U=0
|
||||
V=1
|
||||
W=1
|
||||
X=1
|
||||
Y=1
|
||||
Z=1
|
||||
ShowHints=1
|
||||
ShowWarnings=1
|
||||
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
|
||||
NamespacePrefix=
|
||||
SymbolDeprecated=1
|
||||
SymbolLibrary=1
|
||||
SymbolPlatform=0
|
||||
UnitLibrary=1
|
||||
UnitPlatform=0
|
||||
UnitDeprecated=1
|
||||
HResultCompat=1
|
||||
HidingMember=1
|
||||
HiddenVirtual=1
|
||||
Garbage=1
|
||||
BoundsError=1
|
||||
ZeroNilCompat=1
|
||||
StringConstTruncated=1
|
||||
ForLoopVarVarPar=1
|
||||
TypedConstVarPar=1
|
||||
AsgToTypedConst=1
|
||||
CaseLabelRange=1
|
||||
ForVariable=1
|
||||
ConstructingAbstract=1
|
||||
ComparisonFalse=1
|
||||
ComparisonTrue=1
|
||||
ComparingSignedUnsigned=1
|
||||
CombiningSignedUnsigned=1
|
||||
UnsupportedConstruct=1
|
||||
FileOpen=1
|
||||
FileOpenUnitSrc=1
|
||||
BadGlobalSymbol=1
|
||||
DuplicateConstructorDestructor=1
|
||||
InvalidDirective=1
|
||||
PackageNoLink=1
|
||||
PackageThreadVar=1
|
||||
ImplicitImport=1
|
||||
HPPEMITIgnored=1
|
||||
NoRetVal=1
|
||||
UseBeforeDef=1
|
||||
ForLoopVarUndef=1
|
||||
UnitNameMismatch=1
|
||||
NoCFGFileFound=1
|
||||
MessageDirective=1
|
||||
ImplicitVariants=1
|
||||
UnicodeToLocale=1
|
||||
LocaleToUnicode=1
|
||||
ImagebaseMultiple=1
|
||||
SuspiciousTypecast=1
|
||||
PrivatePropAccessor=1
|
||||
UnsafeType=0
|
||||
UnsafeCode=0
|
||||
UnsafeCast=0
|
||||
[Linker]
|
||||
MapFile=0
|
||||
OutputObjs=0
|
||||
ConsoleApp=1
|
||||
DebugInfo=0
|
||||
RemoteSymbols=0
|
||||
MinStackSize=16384
|
||||
MaxStackSize=1048576
|
||||
ImageBase=4194304
|
||||
ExeDescription=X2Utils
|
||||
[Directories]
|
||||
OutputDir=
|
||||
UnitOutputDir=
|
||||
PackageDLLOutputDir=
|
||||
PackageDCPOutputDir=
|
||||
SearchPath=
|
||||
Packages=vcl;rtl;dbrtl;vcldb;vclx;dss;dsnapcrba;dsnapcon;inetdb;webdsnap;websnap;dbxcds;Irc;parsdpk;hotspotter
|
||||
Conditionals=
|
||||
DebugSourceDirs=
|
||||
UsePackages=0
|
||||
[Parameters]
|
||||
RunParams=ip-to-country.csv countries.csv geo.db
|
||||
HostApplication=
|
||||
Launcher=
|
||||
UseLauncher=0
|
||||
DebugCWD=
|
||||
[Version Info]
|
||||
IncludeVerInfo=1
|
||||
AutoIncBuild=0
|
||||
MajorVer=1
|
||||
MinorVer=0
|
||||
Release=0
|
||||
Build=0
|
||||
Debug=0
|
||||
PreRelease=0
|
||||
Special=0
|
||||
Private=0
|
||||
DLL=0
|
||||
Locale=1043
|
||||
CodePage=1252
|
||||
[Version Info Keys]
|
||||
CompanyName=
|
||||
FileDescription=
|
||||
FileVersion=1.0.0.0
|
||||
InternalName=
|
||||
LegalCopyright=
|
||||
LegalTrademarks=
|
||||
OriginalFilename=
|
||||
ProductName=
|
||||
ProductVersion=1.0.0.0
|
||||
Comments=
|
||||
[HistoryLists\hlUnitAliases]
|
||||
Count=1
|
||||
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
|
||||
[HistoryLists\hlSearchPath]
|
||||
Count=2
|
||||
Item0=..\..
|
||||
Item1=F:\Development\VDarts\Packages
|
||||
[HistoryLists\hlUnitOutputDirectory]
|
||||
Count=3
|
||||
Item0=..\..\Dcu
|
||||
Item1=..\..\..\Dcu
|
||||
Item2=Dcu
|
||||
49
Packages/D7/X2Utils.dpk
Normal file
49
Packages/D7/X2Utils.dpk
Normal file
@ -0,0 +1,49 @@
|
||||
package X2Utils;
|
||||
|
||||
{$R *.res}
|
||||
{$ALIGN 8}
|
||||
{$ASSERTIONS ON}
|
||||
{$BOOLEVAL OFF}
|
||||
{$DEBUGINFO ON}
|
||||
{$EXTENDEDSYNTAX ON}
|
||||
{$IMPORTEDDATA ON}
|
||||
{$IOCHECKS ON}
|
||||
{$LOCALSYMBOLS ON}
|
||||
{$LONGSTRINGS ON}
|
||||
{$OPENSTRINGS ON}
|
||||
{$OPTIMIZATION ON}
|
||||
{$OVERFLOWCHECKS OFF}
|
||||
{$RANGECHECKS OFF}
|
||||
{$REFERENCEINFO ON}
|
||||
{$SAFEDIVIDE OFF}
|
||||
{$STACKFRAMES ON}
|
||||
{$TYPEDADDRESS OFF}
|
||||
{$VARSTRINGCHECKS ON}
|
||||
{$WRITEABLECONST ON}
|
||||
{$MINENUMSIZE 1}
|
||||
{$IMAGEBASE $400000}
|
||||
{$DESCRIPTION 'X2Utils'}
|
||||
{$LIBSUFFIX '70'}
|
||||
{$RUNONLY}
|
||||
{$IMPLICITBUILD ON}
|
||||
|
||||
requires
|
||||
rtl,
|
||||
vcl,
|
||||
VirtualTreesD7,
|
||||
vclx;
|
||||
|
||||
contains
|
||||
X2UtVirtualTree in '..\..\X2UtVirtualTree.pas',
|
||||
X2UtApp in '..\..\X2UtApp.pas',
|
||||
X2UtBits in '..\..\X2UtBits.pas',
|
||||
X2UtGraphics in '..\..\X2UtGraphics.pas',
|
||||
X2UtHandCursor in '..\..\X2UtHandCursor.pas',
|
||||
X2UtHashes in '..\..\X2UtHashes.pas',
|
||||
X2UtHashesVariants in '..\..\X2UtHashesVariants.pas',
|
||||
X2UtMisc in '..\..\X2UtMisc.pas',
|
||||
X2UtOS in '..\..\X2UtOS.pas',
|
||||
X2UtSingleInstance in '..\..\X2UtSingleInstance.pas',
|
||||
X2UtStrings in '..\..\X2UtStrings.pas';
|
||||
|
||||
end.
|
||||
BIN
Packages/D7/X2Utils.res
Normal file
BIN
Packages/D7/X2Utils.res
Normal file
Binary file not shown.
@ -3,7 +3,8 @@ unit HashesTest;
|
||||
interface
|
||||
uses
|
||||
TestFramework,
|
||||
X2UtHashes;
|
||||
X2UtHashes,
|
||||
X2UtHashesVariants;
|
||||
|
||||
type
|
||||
THashesTest = class(TTestCase)
|
||||
@ -52,6 +53,21 @@ type
|
||||
procedure testIterate(); override;
|
||||
end;
|
||||
|
||||
THashesVariantTest = class(THashesTest)
|
||||
private
|
||||
function GetHash(): TX2SVHash;
|
||||
|
||||
property Hash: TX2SVHash read GetHash;
|
||||
protected
|
||||
procedure SetUp(); override;
|
||||
procedure FillTestItems(); override;
|
||||
published
|
||||
procedure testSet(); override;
|
||||
procedure testGet(); override;
|
||||
procedure testDelete(); override;
|
||||
procedure testIterate(); override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
uses
|
||||
SysUtils;
|
||||
@ -210,8 +226,76 @@ begin
|
||||
Result := TX2POHash(FHash);
|
||||
end;
|
||||
|
||||
{ THashesVariantTest }
|
||||
procedure THashesVariantTest.SetUp;
|
||||
begin
|
||||
inherited;
|
||||
|
||||
FHash := TX2SVHash.Create();
|
||||
end;
|
||||
|
||||
function THashesVariantTest.GetHash(): TX2SVHash;
|
||||
begin
|
||||
Result := TX2SVHash(FHash);
|
||||
end;
|
||||
|
||||
procedure THashesVariantTest.FillTestItems;
|
||||
begin
|
||||
Hash['Key1'] := 'String';
|
||||
Hash['Key2'] := 5;
|
||||
Hash['Key3'] := 40.4;
|
||||
end;
|
||||
|
||||
procedure THashesVariantTest.testSet;
|
||||
begin
|
||||
FillTestItems();
|
||||
CheckEquals(3, Hash.Count);
|
||||
end;
|
||||
|
||||
procedure THashesVariantTest.testGet;
|
||||
begin
|
||||
FillTestItems();
|
||||
CheckTrue(Hash['Key1'] = 'String');
|
||||
CheckTrue(Hash['Key2'] = 5);
|
||||
CheckTrue(Hash['Key3'] = 40.4);
|
||||
end;
|
||||
|
||||
procedure THashesVariantTest.testDelete;
|
||||
begin
|
||||
FillTestItems();
|
||||
Hash.Delete('Key2');
|
||||
|
||||
CheckEquals(2, Hash.Count);
|
||||
CheckTrue(Hash.Exists('Key1'), 'Key1 does not exist!');
|
||||
CheckFalse(Hash.Exists('Key2'), 'Key2 still exists!');
|
||||
CheckTrue(Hash.Exists('Key3'), 'Key3 does not exist!');
|
||||
end;
|
||||
|
||||
procedure THashesVariantTest.testIterate;
|
||||
var
|
||||
aPresent: array[0..2] of Boolean;
|
||||
|
||||
begin
|
||||
FillTestItems();
|
||||
FillChar(aPresent, SizeOf(aPresent), #0);
|
||||
Hash.First();
|
||||
while Hash.Next() do
|
||||
if ((Hash.CurrentKey = 'Key1') and (Hash.CurrentValue = 'String')) then
|
||||
aPresent[0] := True
|
||||
else if ((Hash.CurrentKey = 'Key2') and (Hash.CurrentValue = 5)) then
|
||||
aPresent[1] := True
|
||||
else if ((Hash.CurrentKey = 'Key3') and (Hash.CurrentValue = 40.4)) then
|
||||
aPresent[2] := True;
|
||||
|
||||
CheckTrue(aPresent[0], 'Key1 was not in the iteration!');
|
||||
CheckTrue(aPresent[1], 'Key2 was not in the iteration!');
|
||||
CheckTrue(aPresent[2], 'Key3 was not in the iteration!');
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
RegisterTest('Hashes', THashesSITest.Suite);
|
||||
RegisterTest('Hashes', THashesPOTest.Suite);
|
||||
RegisterTest('Hashes', THashesVariantTest.Suite);
|
||||
|
||||
end.
|
||||
|
||||
84
UnitTests/Units/IniParserTest.pas
Normal file
84
UnitTests/Units/IniParserTest.pas
Normal file
@ -0,0 +1,84 @@
|
||||
unit IniParserTest;
|
||||
|
||||
interface
|
||||
uses
|
||||
Classes,
|
||||
|
||||
TestFramework,
|
||||
X2UtIniParser;
|
||||
|
||||
type
|
||||
TIniParserTest = class(TTestCase)
|
||||
private
|
||||
FValue: String;
|
||||
|
||||
procedure IniComment(Sender: TObject; Comment: String);
|
||||
procedure IniSection(Sender: TObject; Section: String);
|
||||
procedure IniValue(Sender: TObject; Name, Value: String);
|
||||
|
||||
procedure Parse(const AStream: TStream);
|
||||
published
|
||||
procedure testSimple();
|
||||
procedure testExtended();
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TIniParserTest }
|
||||
procedure TIniParserTest.IniComment(Sender: TObject; Comment: String);
|
||||
begin
|
||||
FValue := FValue + '|C-' + Comment;
|
||||
end;
|
||||
|
||||
procedure TIniParserTest.IniSection(Sender: TObject; Section: String);
|
||||
begin
|
||||
FValue := FValue + '|S-' + Section;
|
||||
end;
|
||||
|
||||
procedure TIniParserTest.IniValue(Sender: TObject; Name, Value: String);
|
||||
begin
|
||||
FValue := FValue + '|V-' + Name + '=' + Value;
|
||||
end;
|
||||
|
||||
procedure TIniParserTest.Parse(const AStream: TStream);
|
||||
begin
|
||||
with TX2IniParser.Create() do
|
||||
try
|
||||
OnComment := IniComment;
|
||||
OnSection := IniSection;
|
||||
OnValue := IniValue;
|
||||
|
||||
FValue := '';
|
||||
Execute(AStream);
|
||||
finally
|
||||
Free();
|
||||
AStream.Free();
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TIniParserTest.testSimple;
|
||||
begin
|
||||
Parse(TStringStream.Create(';Comment'#13#10 +
|
||||
'[Section]'#13#10 +
|
||||
'Name=Value'));
|
||||
CheckEquals('|C-Comment|S-Section|V-Name=Value', FValue);
|
||||
end;
|
||||
|
||||
procedure TIniParserTest.testExtended;
|
||||
begin
|
||||
Parse(TStringStream.Create(';C1'#13#10 +
|
||||
';C2'#13#10 +
|
||||
'[ Section Two ] ; C3 '#13#10 +
|
||||
'[Section Three;Two;One]'#13#10 +
|
||||
'N=V'#13#10 +
|
||||
'X=Y;C4'));
|
||||
CheckEquals('|C-C1|C-C2|S-Section Two|C-C3|S-Section Three;Two;One' +
|
||||
'|V-N=V|V-X=Y|C-C4', FValue);
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
RegisterTest('IniParser', TIniParserTest.Suite);
|
||||
|
||||
end.
|
||||
79
UnitTests/Units/SettingsTest.pas
Normal file
79
UnitTests/Units/SettingsTest.pas
Normal file
@ -0,0 +1,79 @@
|
||||
unit SettingsTest;
|
||||
|
||||
interface
|
||||
uses
|
||||
TestFramework,
|
||||
X2UtConfig;
|
||||
|
||||
type
|
||||
TSettingsTest = class(TTestCase)
|
||||
protected
|
||||
function CreateSource(): IX2ConfigSource; virtual; abstract;
|
||||
end;
|
||||
|
||||
TSettingsINITest = class(TSettingsTest)
|
||||
protected
|
||||
function CreateSource(): IX2ConfigSource; override;
|
||||
end;
|
||||
|
||||
TSettingsRegistryTest = class(TSettingsTest)
|
||||
protected
|
||||
function CreateSource(): IX2ConfigSource; override;
|
||||
end;
|
||||
|
||||
TSettingsXMLTest = class(TSettingsTest)
|
||||
protected
|
||||
function CreateSource(): IX2ConfigSource; override;
|
||||
end;
|
||||
|
||||
TSettingsNiniXMLTest = class(TSettingsTest)
|
||||
protected
|
||||
function CreateSource(): IX2ConfigSource; override;
|
||||
end;
|
||||
|
||||
TSettingsCmdLineTest = class(TSettingsTest)
|
||||
protected
|
||||
function CreateSource(): IX2ConfigSource; override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TSettingsINITest }
|
||||
function TSettingsINITest.CreateSource(): IX2ConfigSource;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
{ TSettingsRegistryTest }
|
||||
function TSettingsRegistryTest.CreateSource(): IX2ConfigSource;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
{ TSettingsXMLTest }
|
||||
function TSettingsXMLTest.CreateSource(): IX2ConfigSource;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
{ TSettingsNiniXMLTest }
|
||||
function TSettingsNiniXMLTest.CreateSource(): IX2ConfigSource;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
{ TSettingsCmdLineTest }
|
||||
function TSettingsCmdLineTest.CreateSource(): IX2ConfigSource;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
RegisterTest('Settings', TSettingsINITest.Suite);
|
||||
RegisterTest('Settings', TSettingsRegistryTest.Suite);
|
||||
RegisterTest('Settings', TSettingsXMLTest.Suite);
|
||||
RegisterTest('Settings', TSettingsNiniXMLTest.Suite);
|
||||
RegisterTest('Settings', TSettingsCmdLineTest.Suite);
|
||||
|
||||
end.
|
||||
@ -15,12 +15,12 @@
|
||||
-$O+
|
||||
-$P+
|
||||
-$Q-
|
||||
-$R+
|
||||
-$R-
|
||||
-$S-
|
||||
-$T-
|
||||
-$U-
|
||||
-$V+
|
||||
-$W-
|
||||
-$W+
|
||||
-$X+
|
||||
-$YD
|
||||
-$Z1
|
||||
|
||||
@ -18,12 +18,12 @@ N=1
|
||||
O=1
|
||||
P=1
|
||||
Q=0
|
||||
R=1
|
||||
R=0
|
||||
S=0
|
||||
T=0
|
||||
U=0
|
||||
V=1
|
||||
W=0
|
||||
W=1
|
||||
X=1
|
||||
Y=1
|
||||
Z=1
|
||||
@ -130,3 +130,6 @@ OriginalFilename=
|
||||
ProductName=
|
||||
ProductVersion=1.0.0.0
|
||||
Comments=
|
||||
[HistoryLists\hlUnitAliases]
|
||||
Count=1
|
||||
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
|
||||
|
||||
@ -4,8 +4,11 @@ uses
|
||||
MemCheck,
|
||||
TestFramework,
|
||||
GUITestRunner,
|
||||
Variants,
|
||||
BitsTest in 'Units\BitsTest.pas',
|
||||
HashesTest in 'Units\HashesTest.pas';
|
||||
HashesTest in 'Units\HashesTest.pas',
|
||||
SettingsTest in 'Units\SettingsTest.pas',
|
||||
IniParserTest in 'Units\IniParserTest.pas';
|
||||
|
||||
begin
|
||||
MemChk();
|
||||
|
||||
501
X2UtConfig.pas
Normal file
501
X2UtConfig.pas
Normal file
@ -0,0 +1,501 @@
|
||||
{
|
||||
:: X2UtConfig provides a generic access mechanism for application settings.
|
||||
:: Create an instance of one of the TX2xxxConfigSource classes (such as
|
||||
:: TX2IniConfigSource in the X2UtConfigIni.pas unit) to gain access to an
|
||||
:: IX2ConfigSource interface.
|
||||
::
|
||||
:: Though no actual code was ported, credits to Nini for .NET
|
||||
:: (http://nini.sourceforge.net/) for some excellent ideas. In fact,
|
||||
:: X2UtXMLConfigSource is capable of recognizing, reading and writing
|
||||
:: Nini-compatible XML files.
|
||||
::
|
||||
:: Last changed: $Date$
|
||||
:: Revision: $Rev$
|
||||
:: Author: $Author$
|
||||
}
|
||||
unit X2UtConfig;
|
||||
|
||||
interface
|
||||
uses
|
||||
Classes,
|
||||
|
||||
X2UtHashes,
|
||||
X2UtHashesVariants;
|
||||
|
||||
type
|
||||
// Forward declarations
|
||||
IX2Config = interface;
|
||||
IX2ConfigSource = interface;
|
||||
|
||||
{
|
||||
:$ Callback for Iterate method.
|
||||
}
|
||||
TX2ConfigIterateMethod = procedure(Sender: IX2ConfigSource;
|
||||
Config: IX2Config;
|
||||
var Abort: Boolean) of object;
|
||||
|
||||
|
||||
{
|
||||
:$ Interface for configurations.
|
||||
|
||||
:: Implementations are highly recommended to descend from, or simply use,
|
||||
:: TX2BaseConfig.
|
||||
}
|
||||
IX2Config = interface
|
||||
['{25DF95C1-CE09-44A7-816B-A33B8D0D78DC}']
|
||||
function GetName(): String;
|
||||
|
||||
function ReadBool(const AName: String; const ADefault: Boolean = False): Boolean;
|
||||
function ReadFloat(const AName: String; const ADefault: Double = 0): Double;
|
||||
function ReadInteger(const AName: String; const ADefault: Integer = 0): Integer;
|
||||
function ReadString(const AName: String; const ADefault: String = ''): String;
|
||||
|
||||
procedure WriteBool(const AName: String; AValue: Boolean);
|
||||
procedure WriteFloat(const AName: String; AValue: Double);
|
||||
procedure WriteInteger(const AName: String; AValue: Integer);
|
||||
procedure WriteString(const AName, AValue: String);
|
||||
|
||||
procedure Clear();
|
||||
procedure Delete(const AName: String);
|
||||
function Exists(const AName: String): Boolean;
|
||||
|
||||
procedure Save();
|
||||
|
||||
property Name: String read GetName;
|
||||
end;
|
||||
|
||||
{
|
||||
:$ Interface for configuration sources.
|
||||
|
||||
:: For subsections, seperate each section name with a dot (.)
|
||||
::
|
||||
:: Implementations are highly recommended to descend from
|
||||
:: TX2BaseConfigSource.
|
||||
}
|
||||
IX2ConfigSource = interface
|
||||
['{1FF5282B-122F-47D7-95E8-3DB60A8CF765}']
|
||||
function GetAutoSave(): Boolean;
|
||||
procedure SetAutoSave(Value: Boolean);
|
||||
|
||||
function Configs(const AName: String): IX2Config;
|
||||
|
||||
function Add(const AName: String): IX2Config;
|
||||
function Exists(const AName: String): Boolean;
|
||||
procedure Delete(const AName: String);
|
||||
procedure Clear();
|
||||
|
||||
procedure Save();
|
||||
|
||||
procedure List(const AName: String; const ADest: TStrings;
|
||||
const ARecurse: Boolean = False);
|
||||
procedure Iterate(const AName: String;
|
||||
const ACallback: TX2ConfigIterateMethod;
|
||||
const AData: Pointer;
|
||||
const ARecurse: Boolean = False); overload;
|
||||
|
||||
property AutoSave: Boolean read GetAutoSave write SetAutoSave;
|
||||
end;
|
||||
|
||||
// Forward declarations
|
||||
TX2BaseConfig = class;
|
||||
TX2BaseConfigSource = class;
|
||||
|
||||
{
|
||||
:$ Hash for configuration objects.
|
||||
}
|
||||
TX2ConfigHash = class(TX2SOHash)
|
||||
protected
|
||||
function GetCurrentValue(): TX2BaseConfig;
|
||||
function GetValue(Key: String): TX2BaseConfig;
|
||||
procedure SetValue(Key: String; const Value: TX2BaseConfig);
|
||||
public
|
||||
property CurrentValue: TX2BaseConfig read GetCurrentValue;
|
||||
property Values[Key: String]: TX2BaseConfig read GetValue write SetValue; default;
|
||||
end;
|
||||
|
||||
{
|
||||
:$ Default implementation for configurations.
|
||||
}
|
||||
TX2BaseConfig = class(TInterfacedObject, IX2Config)
|
||||
private
|
||||
FConfigItems: TX2ConfigHash;
|
||||
FName: String;
|
||||
FSource: IX2ConfigSource;
|
||||
FValues: TX2SVHash;
|
||||
protected
|
||||
procedure WriteValue(const AName: String; const AValue: Variant);
|
||||
|
||||
property Source: IX2ConfigSource read FSource;
|
||||
property Values: TX2SVHash read FValues;
|
||||
property ConfigItems: TX2ConfigHash read FConfigItems;
|
||||
public
|
||||
constructor Create(const AConfig: String; const ASource: IX2ConfigSource);
|
||||
destructor Destroy(); override;
|
||||
|
||||
// IX2Config
|
||||
function GetName(): String;
|
||||
|
||||
function ReadBool(const AName: String; const ADefault: Boolean = False): Boolean;
|
||||
function ReadFloat(const AName: String; const ADefault: Double = 0): Double;
|
||||
function ReadInteger(const AName: String; const ADefault: Integer = 0): Integer;
|
||||
function ReadString(const AName: String; const ADefault: String = ''): String;
|
||||
|
||||
procedure WriteBool(const AName: String; AValue: Boolean);
|
||||
procedure WriteFloat(const AName: String; AValue: Double);
|
||||
procedure WriteInteger(const AName: String; AValue: Integer);
|
||||
procedure WriteString(const AName, AValue: String);
|
||||
|
||||
procedure Clear();
|
||||
procedure Delete(const AName: String);
|
||||
function Exists(const AName: String): Boolean;
|
||||
|
||||
procedure Save(); virtual;
|
||||
|
||||
property Name: String read GetName;
|
||||
end;
|
||||
|
||||
{
|
||||
:$ Default implementation for configuration sources.
|
||||
}
|
||||
TX2BaseConfigSource = class(TInterfacedObject, IX2ConfigSource)
|
||||
private
|
||||
FAutoSave: Boolean;
|
||||
FConfigItems: TX2ConfigHash;
|
||||
protected
|
||||
function GetConfig(const AName: String;
|
||||
const AAllowCreate: Boolean = True): TX2BaseConfig; virtual;
|
||||
function CreateConfig(const AName: String): TX2BaseConfig; virtual; abstract;
|
||||
function GetItems(const AName: String): TX2ConfigHash; virtual;
|
||||
|
||||
property ConfigItems: TX2ConfigHash read FConfigItems;
|
||||
public
|
||||
constructor Create();
|
||||
destructor Destroy(); override;
|
||||
|
||||
// IX2ConfigSource
|
||||
function GetAutoSave(): Boolean;
|
||||
procedure SetAutoSave(Value: Boolean);
|
||||
|
||||
function Configs(const AName: String): IX2Config; virtual;
|
||||
|
||||
function Add(const AName: String): IX2Config; virtual;
|
||||
function Exists(const AName: String): Boolean; virtual;
|
||||
procedure Delete(const AName: String); virtual;
|
||||
procedure Clear(); virtual;
|
||||
|
||||
procedure Save(); virtual;
|
||||
|
||||
procedure List(const AName: String; const ADest: TStrings;
|
||||
const ARecurse: Boolean = False); virtual;
|
||||
procedure Iterate(const AName: String;
|
||||
const ACallback: TX2ConfigIterateMethod;
|
||||
const AData: Pointer = nil;
|
||||
const ARecurse: Boolean = False); overload; virtual;
|
||||
end;
|
||||
|
||||
{
|
||||
:$ Default implementation for stream-based configuration sources.
|
||||
}
|
||||
TX2StreamConfigSource = class(TX2BaseConfigSource)
|
||||
public
|
||||
constructor Create(const AStream: TStream); overload; virtual; abstract;
|
||||
constructor Create(const AFileName: String); overload; virtual;
|
||||
end;
|
||||
|
||||
|
||||
var
|
||||
SectionSeparator: Char = '.';
|
||||
|
||||
|
||||
implementation
|
||||
uses
|
||||
SysUtils,
|
||||
Variants,
|
||||
|
||||
X2UtStrings;
|
||||
|
||||
{========================================
|
||||
TX2ConfigHash
|
||||
========================================}
|
||||
function TX2ConfigHash.GetCurrentValue(): TX2BaseConfig;
|
||||
begin
|
||||
Result := TX2BaseConfig(inherited GetCurrentValue());
|
||||
end;
|
||||
|
||||
function TX2ConfigHash.GetValue(Key: String): TX2BaseConfig;
|
||||
begin
|
||||
Result := TX2BaseConfig(inherited GetValue(Key));
|
||||
end;
|
||||
|
||||
procedure TX2ConfigHash.SetValue(Key: String; const Value: TX2BaseConfig);
|
||||
begin
|
||||
inherited SetValue(Key, Value);
|
||||
end;
|
||||
|
||||
|
||||
{==================== TX2BaseConfigSource
|
||||
IX2ConfigSource
|
||||
========================================}
|
||||
constructor TX2BaseConfigSource.Create();
|
||||
begin
|
||||
inherited;
|
||||
|
||||
FConfigItems := TX2ConfigHash.Create(True);
|
||||
end;
|
||||
|
||||
destructor TX2BaseConfigSource.Destroy();
|
||||
begin
|
||||
FreeAndNil(FConfigItems);
|
||||
|
||||
inherited;
|
||||
end;
|
||||
|
||||
|
||||
function TX2BaseConfigSource.GetAutoSave(): Boolean;
|
||||
begin
|
||||
Result := FAutoSave;
|
||||
end;
|
||||
|
||||
procedure TX2BaseConfigSource.SetAutoSave(Value: Boolean);
|
||||
begin
|
||||
FAutoSave := Value;
|
||||
end;
|
||||
|
||||
|
||||
function TX2BaseConfigSource.GetConfig(const AName: String;
|
||||
const AAllowCreate: Boolean): TX2BaseConfig;
|
||||
var
|
||||
aSections: TSplitArray;
|
||||
iSection: Integer;
|
||||
pItems: TX2ConfigHash;
|
||||
sSection: String;
|
||||
|
||||
begin
|
||||
Result := nil;
|
||||
|
||||
// Separate subsections
|
||||
Split(AName, SectionSeparator, aSections);
|
||||
|
||||
for iSection := Low(aSections) to High(aSections) do
|
||||
begin
|
||||
sSection := Trim(aSections[iSection]);
|
||||
if Length(sSection) = 0 then
|
||||
continue;
|
||||
|
||||
if Assigned(Result) then
|
||||
pItems := Result.ConfigItems
|
||||
else
|
||||
pItems := FConfigItems;
|
||||
|
||||
Result := pItems[sSection];
|
||||
if not Assigned(Result) then
|
||||
if AAllowCreate then
|
||||
begin
|
||||
Result := CreateConfig(sSection);
|
||||
pItems[sSection] := Result;
|
||||
end else
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TX2BaseConfigSource.GetItems(const AName: String): TX2ConfigHash;
|
||||
var
|
||||
pConfig: TX2BaseConfig;
|
||||
|
||||
begin
|
||||
Result := nil;
|
||||
if Length(Trim(AName)) > 0 then
|
||||
begin
|
||||
pConfig := GetConfig(AName, False);
|
||||
if Assigned(pConfig) then
|
||||
Result := pConfig.ConfigItems;
|
||||
end else
|
||||
Result := FConfigItems;
|
||||
end;
|
||||
|
||||
|
||||
function TX2BaseConfigSource.Configs(const AName: String): IX2Config;
|
||||
begin
|
||||
Result := GetConfig(AName, True);
|
||||
end;
|
||||
|
||||
function TX2BaseConfigSource.Add(const AName: String): IX2Config;
|
||||
begin
|
||||
end;
|
||||
|
||||
function TX2BaseConfigSource.Exists(const AName: String): Boolean;
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TX2BaseConfigSource.Delete(const AName: String);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TX2BaseConfigSource.Clear();
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
procedure TX2BaseConfigSource.Save();
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TX2BaseConfigSource.List(const AName: String; const ADest: TStrings;
|
||||
const ARecurse: Boolean);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TX2BaseConfigSource.Iterate(const AName: String;
|
||||
const ACallback: TX2ConfigIterateMethod;
|
||||
const AData: Pointer;
|
||||
const ARecurse: Boolean);
|
||||
var
|
||||
bAbort: Boolean;
|
||||
pItems: TX2ConfigHash;
|
||||
|
||||
begin
|
||||
pItems := GetItems(AName);
|
||||
if not Assigned(pItems) then
|
||||
exit;
|
||||
|
||||
bAbort := False;
|
||||
pItems.First();
|
||||
while pItems.Next() do
|
||||
begin
|
||||
ACallback(Self, pItems.CurrentValue, bAbort);
|
||||
if bAbort then
|
||||
break;
|
||||
|
||||
if ARecurse then
|
||||
Iterate(AName + SectionSeparator + pItems.CurrentValue.Name, ACallback,
|
||||
AData, ARecurse);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{================== TX2StreamConfigSource
|
||||
Initialization
|
||||
========================================}
|
||||
constructor TX2StreamConfigSource.Create(const AFileName: String);
|
||||
var
|
||||
fsData: TFileStream;
|
||||
|
||||
begin
|
||||
fsData := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
|
||||
try
|
||||
Create(fsData);
|
||||
finally
|
||||
FreeAndNil(fsData);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{========================== TX2BaseConfig
|
||||
IX2Config
|
||||
========================================}
|
||||
constructor TX2BaseConfig.Create(const AConfig: String;
|
||||
const ASource: IX2ConfigSource);
|
||||
begin
|
||||
inherited Create();
|
||||
|
||||
FSource := ASource;
|
||||
FName := AConfig;
|
||||
FConfigItems := TX2ConfigHash.Create(True);
|
||||
end;
|
||||
|
||||
destructor TX2BaseConfig.Destroy();
|
||||
begin
|
||||
FreeAndNil(FConfigItems);
|
||||
|
||||
inherited;
|
||||
end;
|
||||
|
||||
|
||||
function TX2BaseConfig.GetName(): String;
|
||||
begin
|
||||
Result := FName;
|
||||
end;
|
||||
|
||||
|
||||
function TX2BaseConfig.ReadBool(const AName: String;
|
||||
const ADefault: Boolean): Boolean;
|
||||
begin
|
||||
Result := ADefault;
|
||||
if Values.Exists(AName) then
|
||||
Result := VarAsType(Values[AName], vtBoolean);
|
||||
end;
|
||||
|
||||
function TX2BaseConfig.ReadFloat(const AName: String;
|
||||
const ADefault: Double): Double;
|
||||
begin
|
||||
Result := ADefault;
|
||||
if Values.Exists(AName) then
|
||||
Result := VarAsType(Values[AName], vtExtended);
|
||||
end;
|
||||
|
||||
function TX2BaseConfig.ReadInteger(const AName: String;
|
||||
const ADefault: Integer): Integer;
|
||||
begin
|
||||
Result := ADefault;
|
||||
if Values.Exists(AName) then
|
||||
Result := VarAsType(Values[AName], vtInteger);
|
||||
end;
|
||||
|
||||
function TX2BaseConfig.ReadString(const AName, ADefault: String): String;
|
||||
begin
|
||||
Result := ADefault;
|
||||
if Values.Exists(AName) then
|
||||
Result := VarAsType(Values[AName], vtString);
|
||||
end;
|
||||
|
||||
|
||||
procedure TX2BaseConfig.WriteValue(const AName: String; const AValue: Variant);
|
||||
begin
|
||||
Values[AName] := AValue;
|
||||
if Source.AutoSave then
|
||||
Save();
|
||||
end;
|
||||
|
||||
procedure TX2BaseConfig.WriteBool(const AName: String; AValue: Boolean);
|
||||
begin
|
||||
WriteValue(AName, AValue);
|
||||
end;
|
||||
|
||||
procedure TX2BaseConfig.WriteFloat(const AName: String; AValue: Double);
|
||||
begin
|
||||
WriteValue(AName, AValue);
|
||||
end;
|
||||
|
||||
procedure TX2BaseConfig.WriteInteger(const AName: String; AValue: Integer);
|
||||
begin
|
||||
WriteValue(AName, AValue);
|
||||
end;
|
||||
|
||||
procedure TX2BaseConfig.WriteString(const AName, AValue: String);
|
||||
begin
|
||||
WriteValue(AName, AValue);
|
||||
end;
|
||||
|
||||
|
||||
procedure TX2BaseConfig.Clear();
|
||||
begin
|
||||
Values.Clear();
|
||||
end;
|
||||
|
||||
procedure TX2BaseConfig.Delete(const AName: String);
|
||||
begin
|
||||
Values.Delete(AName);
|
||||
end;
|
||||
|
||||
function TX2BaseConfig.Exists(const AName: String): Boolean;
|
||||
begin
|
||||
Result := Values.Exists(AName);
|
||||
end;
|
||||
|
||||
|
||||
procedure TX2BaseConfig.Save();
|
||||
begin
|
||||
Source.Save();
|
||||
end;
|
||||
|
||||
end.
|
||||
47
X2UtConfigIni.pas
Normal file
47
X2UtConfigIni.pas
Normal file
@ -0,0 +1,47 @@
|
||||
{
|
||||
:: Implements the IX2ConfigSource for INI files.
|
||||
::
|
||||
:: Last changed: $Date$
|
||||
:: Revision: $Rev$
|
||||
:: Author: $Author$
|
||||
}
|
||||
unit X2UtConfigIni;
|
||||
|
||||
interface
|
||||
uses
|
||||
X2UtConfig;
|
||||
|
||||
type
|
||||
TX2IniConfigSource = class(TX2StreamConfigSource)
|
||||
protected
|
||||
procedure IniSection(Sender: TObject; Section: String);
|
||||
procedure IniValue(Sender: TObject; Name, Value: String);
|
||||
public
|
||||
constructor Create(const AStream: TStream); override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
uses
|
||||
X2UtIniParser;
|
||||
|
||||
{===================== TX2IniConfigSource
|
||||
Initialization
|
||||
========================================}
|
||||
constructor TX2IniConfigSource.Create(const AStream: TStream);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
|
||||
procedure TX2IniConfigSource.IniSection(Sender: TObject; Section: String);
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
procedure TX2IniConfigSource.IniValue(Sender: TObject; Name, Value: String);
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -57,6 +57,16 @@ uses
|
||||
function BlendColors(const ABackground, AForeground: TColor;
|
||||
const AAlpha: Byte): TColor;
|
||||
|
||||
{
|
||||
:$ Darkens a color with the specified value
|
||||
}
|
||||
function DarkenColor(const AColor: TColor; const AValue: Byte): TColor;
|
||||
|
||||
{
|
||||
:$ Lightens a color with the specified value
|
||||
}
|
||||
function LightenColor(const AColor: TColor; const AValue: Byte): TColor;
|
||||
|
||||
|
||||
implementation
|
||||
uses
|
||||
@ -74,7 +84,7 @@ type
|
||||
THackControl = class(TControl);
|
||||
|
||||
|
||||
procedure AAFont;
|
||||
procedure AAFont(const AFont: TFont);
|
||||
var
|
||||
pFont: TLogFont;
|
||||
hAAFont: HFONT;
|
||||
@ -114,7 +124,7 @@ begin
|
||||
AFont.Handle := hAAFont;
|
||||
end;
|
||||
|
||||
procedure AAControl;
|
||||
procedure AAControl(const AControl: TControl);
|
||||
var
|
||||
pControl: THackControl;
|
||||
|
||||
@ -123,7 +133,8 @@ begin
|
||||
AAFont(pControl.Font);
|
||||
end;
|
||||
|
||||
procedure AAChildren;
|
||||
procedure AAChildren(const AParent: TWinControl;
|
||||
const ARecursive: Boolean = False);
|
||||
var
|
||||
iControl: Integer;
|
||||
|
||||
@ -137,7 +148,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure AAOwned;
|
||||
procedure AAOwned(const AOwner: TComponent);
|
||||
var
|
||||
iControl: Integer;
|
||||
|
||||
@ -148,7 +159,8 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
function BlendColors;
|
||||
function BlendColors(const ABackground, AForeground: TColor;
|
||||
const AAlpha: Byte): TColor;
|
||||
var
|
||||
cBack: Cardinal;
|
||||
cFore: Cardinal;
|
||||
@ -167,4 +179,53 @@ begin
|
||||
(GetBValue(cFore) * AAlpha)) shr 8);
|
||||
end;
|
||||
|
||||
|
||||
function DarkenColor(const AColor: TColor; const AValue: Byte): TColor;
|
||||
var
|
||||
cColor: Cardinal;
|
||||
iRed: Integer;
|
||||
iGreen: Integer;
|
||||
iBlue: Integer;
|
||||
|
||||
begin
|
||||
cColor := ColorToRGB(AColor);
|
||||
iRed := (cColor and $FF0000) shr 16;;
|
||||
iGreen := (cColor and $00FF00) shr 8;
|
||||
iBlue := cColor and $0000FF;
|
||||
|
||||
Dec(iRed, AValue);
|
||||
Dec(iGreen, AValue);
|
||||
Dec(iBlue, AValue);
|
||||
|
||||
if iRed < 0 then iRed := 0;
|
||||
if iGreen < 0 then iGreen := 0;
|
||||
if iBlue < 0 then iBlue := 0;
|
||||
|
||||
Result := (iRed shl 16) + (iGreen shl 8) + iBlue;
|
||||
end;
|
||||
|
||||
function LightenColor(const AColor: TColor; const AValue: Byte): TColor;
|
||||
var
|
||||
cColor: Cardinal;
|
||||
iRed: Integer;
|
||||
iGreen: Integer;
|
||||
iBlue: Integer;
|
||||
|
||||
begin
|
||||
cColor := ColorToRGB(AColor);
|
||||
iRed := (cColor and $FF0000) shr 16;;
|
||||
iGreen := (cColor and $00FF00) shr 8;
|
||||
iBlue := cColor and $0000FF;
|
||||
|
||||
Inc(iRed, AValue);
|
||||
Inc(iGreen, AValue);
|
||||
Inc(iBlue, AValue);
|
||||
|
||||
if iRed > 255 then iRed := 255;
|
||||
if iGreen > 255 then iGreen := 255;
|
||||
if iBlue > 255 then iBlue := 255;
|
||||
|
||||
Result := (iRed shl 16) + (iGreen shl 8) + iBlue;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -169,7 +169,7 @@ type
|
||||
procedure InvalidateCursor();
|
||||
|
||||
function Hash(const AKey: Pointer; const ASize: Cardinal): Cardinal; virtual;
|
||||
procedure CursorRequired();
|
||||
function CursorRequired(const ARaiseException: Boolean = True): Boolean;
|
||||
|
||||
function InternalFind(const ABucket: PX2HashBucket;
|
||||
const AHash: Cardinal; const AKey: Pointer;
|
||||
@ -257,7 +257,7 @@ type
|
||||
:$ Base hash implementation for string keys.
|
||||
}
|
||||
TX2CustomStringHash = class(TX2CustomHash)
|
||||
private
|
||||
protected
|
||||
function GetCurrentKey(): String;
|
||||
protected
|
||||
function CreateKeyManager(): TX2CustomHashManager; override;
|
||||
@ -275,7 +275,7 @@ type
|
||||
:$ Pointer-to-Pointer hash.
|
||||
}
|
||||
TX2PPHash = class(TX2CustomPointerHash)
|
||||
private
|
||||
protected
|
||||
function GetCurrentValue(): Pointer;
|
||||
function GetValue(Key: Pointer): Pointer;
|
||||
procedure SetValue(Key: Pointer; const Value: Pointer);
|
||||
@ -290,7 +290,7 @@ type
|
||||
:$ Pointer-to-Integer hash.
|
||||
}
|
||||
TX2PIHash = class(TX2CustomPointerHash)
|
||||
private
|
||||
protected
|
||||
function GetCurrentValue(): Integer;
|
||||
function GetValue(Key: Pointer): Integer;
|
||||
procedure SetValue(Key: Pointer; const Value: Integer);
|
||||
@ -305,7 +305,7 @@ type
|
||||
:$ Pointer-to-Object hash.
|
||||
}
|
||||
TX2POHash = class(TX2CustomPointerHash)
|
||||
private
|
||||
protected
|
||||
function GetCurrentValue(): TObject;
|
||||
function GetOwnsObjects(): Boolean;
|
||||
procedure SetOwnsObjects(const Value: Boolean);
|
||||
@ -325,7 +325,7 @@ type
|
||||
:$ Pointer-to-String hash.
|
||||
}
|
||||
TX2PSHash = class(TX2CustomPointerHash)
|
||||
private
|
||||
protected
|
||||
function GetCurrentValue(): String;
|
||||
function GetValue(Key: Pointer): String;
|
||||
procedure SetValue(Key: Pointer; const Value: String);
|
||||
@ -340,7 +340,7 @@ type
|
||||
:$ Integer-to-Pointer hash.
|
||||
}
|
||||
TX2IPHash = class(TX2CustomIntegerHash)
|
||||
private
|
||||
protected
|
||||
function GetCurrentValue(): Pointer;
|
||||
function GetValue(Key: Integer): Pointer;
|
||||
procedure SetValue(Key: Integer; const Value: Pointer);
|
||||
@ -355,7 +355,7 @@ type
|
||||
:$ Integer-to-Integer hash.
|
||||
}
|
||||
TX2IIHash = class(TX2CustomIntegerHash)
|
||||
private
|
||||
protected
|
||||
function GetCurrentValue(): Integer;
|
||||
function GetValue(Key: Integer): Integer;
|
||||
procedure SetValue(Key: Integer; const Value: Integer);
|
||||
@ -370,7 +370,7 @@ type
|
||||
:$ Integer-to-Object hash.
|
||||
}
|
||||
TX2IOHash = class(TX2CustomIntegerHash)
|
||||
private
|
||||
protected
|
||||
function GetCurrentValue(): TObject;
|
||||
function GetOwnsObjects(): Boolean;
|
||||
procedure SetOwnsObjects(const Value: Boolean);
|
||||
@ -390,7 +390,7 @@ type
|
||||
:$ Integer-to-String hash.
|
||||
}
|
||||
TX2ISHash = class(TX2CustomIntegerHash)
|
||||
private
|
||||
protected
|
||||
function GetCurrentValue(): String;
|
||||
function GetValue(Key: Integer): String;
|
||||
procedure SetValue(Key: Integer; const Value: String);
|
||||
@ -405,7 +405,7 @@ type
|
||||
:$ Object-to-Pointer hash.
|
||||
}
|
||||
TX2OPHash = class(TX2CustomObjectHash)
|
||||
private
|
||||
protected
|
||||
function GetCurrentValue(): Pointer;
|
||||
function GetValue(Key: TObject): Pointer;
|
||||
procedure SetValue(Key: TObject; const Value: Pointer);
|
||||
@ -420,7 +420,7 @@ type
|
||||
:$ Object-to-Integer hash.
|
||||
}
|
||||
TX2OIHash = class(TX2CustomObjectHash)
|
||||
private
|
||||
protected
|
||||
function GetCurrentValue(): Integer;
|
||||
function GetValue(Key: TObject): Integer;
|
||||
procedure SetValue(Key: TObject; const Value: Integer);
|
||||
@ -435,7 +435,7 @@ type
|
||||
:$ Object-to-Object hash.
|
||||
}
|
||||
TX2OOHash = class(TX2CustomObjectHash)
|
||||
private
|
||||
protected
|
||||
function GetCurrentValue(): TObject;
|
||||
function GetOwnsObjects(): Boolean;
|
||||
procedure SetOwnsObjects(const Value: Boolean);
|
||||
@ -455,7 +455,7 @@ type
|
||||
:$ Object-to-String hash.
|
||||
}
|
||||
TX2OSHash = class(TX2CustomObjectHash)
|
||||
private
|
||||
protected
|
||||
function GetCurrentValue(): String;
|
||||
function GetValue(Key: TObject): String;
|
||||
procedure SetValue(Key: TObject; const Value: String);
|
||||
@ -470,7 +470,7 @@ type
|
||||
:$ String-to-Pointer hash.
|
||||
}
|
||||
TX2SPHash = class(TX2CustomStringHash)
|
||||
private
|
||||
protected
|
||||
function GetCurrentValue(): Pointer;
|
||||
function GetValue(Key: String): Pointer;
|
||||
procedure SetValue(Key: String; const Value: Pointer);
|
||||
@ -485,7 +485,7 @@ type
|
||||
:$ String-to-Integer hash.
|
||||
}
|
||||
TX2SIHash = class(TX2CustomStringHash)
|
||||
private
|
||||
protected
|
||||
function GetCurrentValue(): Integer;
|
||||
function GetValue(Key: String): Integer;
|
||||
procedure SetValue(Key: String; const Value: Integer);
|
||||
@ -500,7 +500,7 @@ type
|
||||
:$ String-to-Object hash.
|
||||
}
|
||||
TX2SOHash = class(TX2CustomStringHash)
|
||||
private
|
||||
protected
|
||||
function GetCurrentValue(): TObject;
|
||||
function GetOwnsObjects(): Boolean;
|
||||
procedure SetOwnsObjects(const Value: Boolean);
|
||||
@ -520,7 +520,7 @@ type
|
||||
:$ String-to-String hash.
|
||||
}
|
||||
TX2SSHash = class(TX2CustomStringHash)
|
||||
private
|
||||
protected
|
||||
function GetCurrentValue(): String;
|
||||
function GetValue(Key: String): String;
|
||||
procedure SetValue(Key: String; const Value: String);
|
||||
@ -908,13 +908,18 @@ begin
|
||||
Result := CRC32(AKey, ASize);
|
||||
end;
|
||||
|
||||
procedure TX2CustomHash.CursorRequired();
|
||||
function TX2CustomHash.CursorRequired(const ARaiseException: Boolean): Boolean;
|
||||
begin
|
||||
Result := True;
|
||||
if not Assigned(FCursor) then
|
||||
if Assigned(FRoot) then
|
||||
FCursor := CreateCursor()
|
||||
else
|
||||
begin
|
||||
Result := False;
|
||||
if ARaiseException then
|
||||
raise EX2HashNoCursor.Create('Cursor not available!');
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -1173,13 +1178,18 @@ end;
|
||||
|
||||
procedure TX2CustomHash.First();
|
||||
begin
|
||||
CursorRequired();
|
||||
if not CursorRequired(False) then
|
||||
exit;
|
||||
|
||||
Cursor.First();
|
||||
end;
|
||||
|
||||
function TX2CustomHash.Next(): Boolean;
|
||||
begin
|
||||
CursorRequired();
|
||||
Result := False;
|
||||
if not CursorRequired(False) then
|
||||
exit;
|
||||
|
||||
Result := Cursor.Next();
|
||||
end;
|
||||
|
||||
|
||||
256
X2UtHashesVariants.pas
Normal file
256
X2UtHashesVariants.pas
Normal file
@ -0,0 +1,256 @@
|
||||
{
|
||||
:: Implements hashes with Variant values.
|
||||
::
|
||||
:: Last changed: $Date$
|
||||
:: Revision: $Rev$
|
||||
:: Author: $Author$
|
||||
}
|
||||
unit X2UtHashesVariants;
|
||||
|
||||
interface
|
||||
uses
|
||||
Variants,
|
||||
|
||||
X2UtHashes;
|
||||
|
||||
type
|
||||
{
|
||||
:$ Variant value class.
|
||||
}
|
||||
TX2HashVariantManager = class(TX2CustomHashManager)
|
||||
public
|
||||
procedure Finalize(var AData: Pointer); override;
|
||||
|
||||
function DataSize(const AData: Pointer): Cardinal; override;
|
||||
|
||||
function ToPointer(const AValue: Variant): Pointer; overload;
|
||||
function ToValue(const AData: Pointer): Variant; overload;
|
||||
|
||||
function Compare(const AData: Pointer; const AValue: Pointer;
|
||||
const ASize: Cardinal): Boolean; override;
|
||||
end;
|
||||
|
||||
{
|
||||
:$ Pointer-to-Variant hash.
|
||||
}
|
||||
TX2PVHash = class(TX2CustomPointerHash)
|
||||
private
|
||||
function GetCurrentValue(): Variant;
|
||||
function GetValue(Key: Pointer): Variant;
|
||||
procedure SetValue(Key: Pointer; const Value: Variant);
|
||||
protected
|
||||
function CreateValueManager(): TX2CustomHashManager; override;
|
||||
public
|
||||
property CurrentValue: Variant read GetCurrentValue;
|
||||
property Values[Key: Pointer]: Variant read GetValue write SetValue; default;
|
||||
end;
|
||||
|
||||
{
|
||||
:$ Integer-to-Variant hash.
|
||||
}
|
||||
TX2IVHash = class(TX2CustomIntegerHash)
|
||||
private
|
||||
function GetCurrentValue(): Variant;
|
||||
function GetValue(Key: Integer): Variant;
|
||||
procedure SetValue(Key: Integer; const Value: Variant);
|
||||
protected
|
||||
function CreateValueManager(): TX2CustomHashManager; override;
|
||||
public
|
||||
property CurrentValue: Variant read GetCurrentValue;
|
||||
property Values[Key: Integer]: Variant read GetValue write SetValue; default;
|
||||
end;
|
||||
|
||||
{
|
||||
:$ Object-to-Variant hash.
|
||||
}
|
||||
TX2OVHash = class(TX2CustomObjectHash)
|
||||
private
|
||||
function GetCurrentValue(): Variant;
|
||||
function GetValue(Key: TObject): Variant;
|
||||
procedure SetValue(Key: TObject; const Value: Variant);
|
||||
protected
|
||||
function CreateValueManager(): TX2CustomHashManager; override;
|
||||
public
|
||||
property CurrentValue: Variant read GetCurrentValue;
|
||||
property Values[Key: TObject]: Variant read GetValue write SetValue; default;
|
||||
end;
|
||||
|
||||
{
|
||||
:$ String-to-Variant hash.
|
||||
}
|
||||
TX2SVHash = class(TX2CustomStringHash)
|
||||
private
|
||||
function GetCurrentValue(): Variant;
|
||||
function GetValue(Key: String): Variant;
|
||||
procedure SetValue(Key: String; const Value: Variant);
|
||||
protected
|
||||
function CreateValueManager(): TX2CustomHashManager; override;
|
||||
public
|
||||
property CurrentValue: Variant read GetCurrentValue;
|
||||
property Values[Key: String]: Variant read GetValue write SetValue; default;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{========================================
|
||||
TX2HashVariantManager
|
||||
========================================}
|
||||
function TX2HashVariantManager.DataSize(const AData: Pointer): Cardinal;
|
||||
begin
|
||||
Result := SizeOf(Variant);
|
||||
end;
|
||||
|
||||
procedure TX2HashVariantManager.Finalize(var AData: Pointer);
|
||||
begin
|
||||
if AData <> nil then
|
||||
Dispose(PVariant(AData));
|
||||
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TX2HashVariantManager.ToPointer(const AValue: Variant): Pointer;
|
||||
begin
|
||||
New(PVariant(Result));
|
||||
PVariant(Result)^ := AValue;
|
||||
end;
|
||||
|
||||
function TX2HashVariantManager.ToValue(const AData: Pointer): Variant;
|
||||
begin
|
||||
Result := PVariant(AData)^;
|
||||
end;
|
||||
|
||||
function TX2HashVariantManager.Compare(const AData, AValue: Pointer;
|
||||
const ASize: Cardinal): Boolean;
|
||||
begin
|
||||
Result := (VarCompareValue(PVariant(AData)^, PVariant(AValue)^) = vrEqual);
|
||||
end;
|
||||
|
||||
|
||||
{========================================
|
||||
TX2PVHash
|
||||
========================================}
|
||||
function TX2PVHash.CreateValueManager(): TX2CustomHashManager;
|
||||
begin
|
||||
Result := TX2HashVariantManager.Create();
|
||||
end;
|
||||
|
||||
function TX2PVHash.GetCurrentValue(): Variant;
|
||||
begin
|
||||
CursorRequired();
|
||||
Result := TX2HashVariantManager(ValueManager).ToValue(Cursor.Current^.Value);
|
||||
end;
|
||||
|
||||
function TX2PVHash.GetValue(Key: Pointer): Variant;
|
||||
var
|
||||
pItem: PX2HashValue;
|
||||
|
||||
begin
|
||||
Result := Unassigned;
|
||||
pItem := Find(Key, False);
|
||||
if Assigned(pItem) then
|
||||
Result := TX2HashVariantManager(ValueManager).ToValue(pItem^.Value);
|
||||
end;
|
||||
|
||||
procedure TX2PVHash.SetValue(Key: Pointer; const Value: Variant);
|
||||
begin
|
||||
inherited SetValue(Find(Key, True),
|
||||
TX2HashVariantManager(ValueManager).ToPointer(Value));
|
||||
end;
|
||||
|
||||
|
||||
{========================================
|
||||
TX2IVHash
|
||||
========================================}
|
||||
function TX2IVHash.CreateValueManager(): TX2CustomHashManager;
|
||||
begin
|
||||
Result := TX2HashVariantManager.Create();
|
||||
end;
|
||||
|
||||
function TX2IVHash.GetCurrentValue(): Variant;
|
||||
begin
|
||||
CursorRequired();
|
||||
Result := TX2HashVariantManager(ValueManager).ToValue(Cursor.Current^.Value);
|
||||
end;
|
||||
|
||||
function TX2IVHash.GetValue(Key: Integer): Variant;
|
||||
var
|
||||
pItem: PX2HashValue;
|
||||
|
||||
begin
|
||||
Result := Unassigned;
|
||||
pItem := Find(Key, False);
|
||||
if Assigned(pItem) then
|
||||
Result := TX2HashVariantManager(ValueManager).ToValue(pItem^.Value);
|
||||
end;
|
||||
|
||||
procedure TX2IVHash.SetValue(Key: Integer; const Value: Variant);
|
||||
begin
|
||||
inherited SetValue(Find(Key, True),
|
||||
TX2HashVariantManager(ValueManager).ToPointer(Value));
|
||||
end;
|
||||
|
||||
|
||||
{========================================
|
||||
TX2OVHash
|
||||
========================================}
|
||||
function TX2OVHash.CreateValueManager(): TX2CustomHashManager;
|
||||
begin
|
||||
Result := TX2HashVariantManager.Create();
|
||||
end;
|
||||
|
||||
function TX2OVHash.GetCurrentValue(): Variant;
|
||||
begin
|
||||
CursorRequired();
|
||||
Result := TX2HashVariantManager(ValueManager).ToValue(Cursor.Current^.Value);
|
||||
end;
|
||||
|
||||
function TX2OVHash.GetValue(Key: TObject): Variant;
|
||||
var
|
||||
pItem: PX2HashValue;
|
||||
|
||||
begin
|
||||
Result := Unassigned;
|
||||
pItem := Find(Key, False);
|
||||
if Assigned(pItem) then
|
||||
Result := TX2HashVariantManager(ValueManager).ToValue(pItem^.Value);
|
||||
end;
|
||||
|
||||
procedure TX2OVHash.SetValue(Key: TObject; const Value: Variant);
|
||||
begin
|
||||
inherited SetValue(Find(Key, True),
|
||||
TX2HashVariantManager(ValueManager).ToPointer(Value));
|
||||
end;
|
||||
|
||||
|
||||
{========================================
|
||||
TX2SVHash
|
||||
========================================}
|
||||
function TX2SVHash.CreateValueManager(): TX2CustomHashManager;
|
||||
begin
|
||||
Result := TX2HashVariantManager.Create();
|
||||
end;
|
||||
|
||||
function TX2SVHash.GetCurrentValue(): Variant;
|
||||
begin
|
||||
CursorRequired();
|
||||
Result := TX2HashVariantManager(ValueManager).ToValue(Cursor.Current^.Value);
|
||||
end;
|
||||
|
||||
function TX2SVHash.GetValue(Key: String): Variant;
|
||||
var
|
||||
pItem: PX2HashValue;
|
||||
|
||||
begin
|
||||
Result := Unassigned;
|
||||
pItem := Find(Key, False);
|
||||
if Assigned(pItem) then
|
||||
Result := TX2HashVariantManager(ValueManager).ToValue(pItem^.Value);
|
||||
end;
|
||||
|
||||
procedure TX2SVHash.SetValue(Key: String; const Value: Variant);
|
||||
begin
|
||||
inherited SetValue(Find(Key, True),
|
||||
TX2HashVariantManager(ValueManager).ToPointer(Value));
|
||||
end;
|
||||
|
||||
end.
|
||||
192
X2UtIniParser.pas
Normal file
192
X2UtIniParser.pas
Normal file
@ -0,0 +1,192 @@
|
||||
{
|
||||
:: Implements a lineair INI parser, used by X2UtConfigIni.
|
||||
::
|
||||
:: Last changed: $Date$
|
||||
:: Revision: $Rev$
|
||||
:: Author: $Author$
|
||||
}
|
||||
unit X2UtIniParser;
|
||||
|
||||
interface
|
||||
uses
|
||||
Classes;
|
||||
|
||||
type
|
||||
TX2CustomIniParser = class(TObject)
|
||||
protected
|
||||
procedure DoComment(const AComment: String); virtual;
|
||||
procedure DoSection(const ASection: String); virtual;
|
||||
procedure DoValue(const AName, AValue: String); virtual;
|
||||
public
|
||||
procedure Execute(const AStrings: TStrings); overload; virtual;
|
||||
procedure Execute(const AStream: TStream); overload;
|
||||
procedure Execute(const AFileName: String); overload;
|
||||
end;
|
||||
|
||||
TX2IniCommentEvent = procedure(Sender: TObject; Comment: String) of object;
|
||||
TX2IniSectionEvent = procedure(Sender: TObject; Section: String) of object;
|
||||
TX2IniValueEvent = procedure(Sender: TObject; Name, Value: String) of object;
|
||||
|
||||
TX2IniParser = class(TX2CustomIniParser)
|
||||
private
|
||||
FOnComment: TX2IniCommentEvent;
|
||||
FOnSection: TX2IniSectionEvent;
|
||||
FOnValue: TX2IniValueEvent;
|
||||
protected
|
||||
procedure DoComment(const AComment: String); override;
|
||||
procedure DoSection(const ASection: String); override;
|
||||
procedure DoValue(const AName, AValue: String); override;
|
||||
public
|
||||
property OnComment: TX2IniCommentEvent read FOnComment write FOnComment;
|
||||
property OnSection: TX2IniSectionEvent read FOnSection write FOnSection;
|
||||
property OnValue: TX2IniValueEvent read FOnValue write FOnValue;
|
||||
end;
|
||||
|
||||
implementation
|
||||
uses
|
||||
SysUtils;
|
||||
|
||||
const
|
||||
Comment = ';';
|
||||
SectionStart = '[';
|
||||
SectionEnd = ']';
|
||||
NameValueSep = '=';
|
||||
|
||||
|
||||
{===================== TX2CustomIniParser
|
||||
Notifications
|
||||
========================================}
|
||||
procedure TX2CustomIniParser.DoComment(const AComment: String);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TX2CustomIniParser.DoSection(const ASection: String);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TX2CustomIniParser.DoValue(const AName, AValue: String);
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
{===================== TX2CustomIniParser
|
||||
Parser
|
||||
========================================}
|
||||
procedure TX2CustomIniParser.Execute(const AStrings: TStrings);
|
||||
var
|
||||
iEnd: Integer;
|
||||
iLine: Integer;
|
||||
sLine: String;
|
||||
sName: String;
|
||||
sSection: String;
|
||||
sValue: String;
|
||||
|
||||
begin
|
||||
for iLine := 0 to Pred(AStrings.Count) do
|
||||
begin
|
||||
sLine := Trim(AStrings[iLine]);
|
||||
if Length(sLine) = 0 then
|
||||
continue;
|
||||
|
||||
case sLine[1] of
|
||||
Comment:
|
||||
begin
|
||||
// Comment line
|
||||
Delete(sLine, 1, 1);
|
||||
DoComment(sLine);
|
||||
sLine := '';
|
||||
end;
|
||||
SectionStart:
|
||||
begin
|
||||
// Section line
|
||||
Delete(sLine, 1, 1);
|
||||
iEnd := AnsiPos(SectionEnd, sLine);
|
||||
|
||||
if iEnd > 0 then
|
||||
begin
|
||||
sSection := sLine;
|
||||
SetLength(sSection, iEnd - 1);
|
||||
Delete(sLine, 1, iEnd);
|
||||
|
||||
DoSection(Trim(sSection));
|
||||
end;
|
||||
end;
|
||||
else
|
||||
// Name-Value line
|
||||
iEnd := AnsiPos(NameValueSep, sLine);
|
||||
if iEnd > 0 then
|
||||
begin
|
||||
sName := sLine;
|
||||
SetLength(sName, iEnd - 1);
|
||||
Delete(sLine, 1, iEnd);
|
||||
|
||||
sValue := sLine;
|
||||
iEnd := AnsiPos(Comment, sValue);
|
||||
if iEnd > 0 then
|
||||
SetLength(sValue, iEnd - 1);
|
||||
|
||||
DoValue(TrimRight(sName), Trim(sValue));
|
||||
end;
|
||||
end;
|
||||
|
||||
// Check for possible comment in the rest of the line
|
||||
iEnd := AnsiPos(Comment, sLine);
|
||||
if iEnd > 0 then
|
||||
begin
|
||||
Delete(sLine, 1, iEnd);
|
||||
DoComment(TrimLeft(sLine));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TX2CustomIniParser.Execute(const AStream: TStream);
|
||||
var
|
||||
slData: TStringList;
|
||||
|
||||
begin
|
||||
slData := TStringList.Create();
|
||||
try
|
||||
slData.LoadFromStream(AStream);
|
||||
Execute(slData);
|
||||
finally
|
||||
FreeAndNil(slData);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TX2CustomIniParser.Execute(const AFileName: String);
|
||||
var
|
||||
fsData: TFileStream;
|
||||
|
||||
begin
|
||||
fsData := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
|
||||
try
|
||||
Execute(fsData);
|
||||
finally
|
||||
FreeAndNil(fsData);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{=========================== TX2IniParser
|
||||
Events
|
||||
========================================}
|
||||
procedure TX2IniParser.DoComment(const AComment: String);
|
||||
begin
|
||||
if Assigned(FOnComment) then
|
||||
FOnComment(Self, AComment);
|
||||
end;
|
||||
|
||||
procedure TX2IniParser.DoSection(const ASection: String);
|
||||
begin
|
||||
if Assigned(FOnSection) then
|
||||
FOnSection(Self, ASection);
|
||||
end;
|
||||
|
||||
procedure TX2IniParser.DoValue(const AName, AValue: String);
|
||||
begin
|
||||
if Assigned(FOnValue) then
|
||||
FOnValue(Self, AName, AValue);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -3,6 +3,8 @@
|
||||
:: Include one of the extensions (X2UtSettingsINI, X2UtSettingsRegistry) for
|
||||
:: an implementation.
|
||||
::
|
||||
:: X2UtSettings is deprecated, and replaced by X2UtConfig.
|
||||
::
|
||||
:: Last changed: $Date$
|
||||
:: Revision: $Rev$
|
||||
:: Author: $Author$
|
||||
@ -153,7 +155,7 @@ type
|
||||
//:$ Validates the specified value using the defined callback method
|
||||
//:$ if present.
|
||||
function ValidateValue(const AName: String; const AValue: Variant): Variant;
|
||||
end;
|
||||
end deprecated;
|
||||
|
||||
{
|
||||
:$ Settings factory.
|
||||
@ -184,7 +186,7 @@ type
|
||||
//:: callback method to perform centralized checks.
|
||||
procedure Define(const ASection, AName: String; const AValue: Variant;
|
||||
const ACallback: TX2SettingsCallback = nil);
|
||||
end;
|
||||
end deprecated;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
Loading…
Reference in New Issue
Block a user