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
|
interface
|
||||||
uses
|
uses
|
||||||
TestFramework,
|
TestFramework,
|
||||||
X2UtHashes;
|
X2UtHashes,
|
||||||
|
X2UtHashesVariants;
|
||||||
|
|
||||||
type
|
type
|
||||||
THashesTest = class(TTestCase)
|
THashesTest = class(TTestCase)
|
||||||
@ -52,6 +53,21 @@ type
|
|||||||
procedure testIterate(); override;
|
procedure testIterate(); override;
|
||||||
end;
|
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
|
implementation
|
||||||
uses
|
uses
|
||||||
SysUtils;
|
SysUtils;
|
||||||
@ -210,8 +226,76 @@ begin
|
|||||||
Result := TX2POHash(FHash);
|
Result := TX2POHash(FHash);
|
||||||
end;
|
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
|
initialization
|
||||||
RegisterTest('Hashes', THashesSITest.Suite);
|
RegisterTest('Hashes', THashesSITest.Suite);
|
||||||
RegisterTest('Hashes', THashesPOTest.Suite);
|
RegisterTest('Hashes', THashesPOTest.Suite);
|
||||||
|
RegisterTest('Hashes', THashesVariantTest.Suite);
|
||||||
|
|
||||||
end.
|
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+
|
-$O+
|
||||||
-$P+
|
-$P+
|
||||||
-$Q-
|
-$Q-
|
||||||
-$R+
|
-$R-
|
||||||
-$S-
|
-$S-
|
||||||
-$T-
|
-$T-
|
||||||
-$U-
|
-$U-
|
||||||
-$V+
|
-$V+
|
||||||
-$W-
|
-$W+
|
||||||
-$X+
|
-$X+
|
||||||
-$YD
|
-$YD
|
||||||
-$Z1
|
-$Z1
|
||||||
|
|||||||
@ -18,12 +18,12 @@ N=1
|
|||||||
O=1
|
O=1
|
||||||
P=1
|
P=1
|
||||||
Q=0
|
Q=0
|
||||||
R=1
|
R=0
|
||||||
S=0
|
S=0
|
||||||
T=0
|
T=0
|
||||||
U=0
|
U=0
|
||||||
V=1
|
V=1
|
||||||
W=0
|
W=1
|
||||||
X=1
|
X=1
|
||||||
Y=1
|
Y=1
|
||||||
Z=1
|
Z=1
|
||||||
@ -130,3 +130,6 @@ OriginalFilename=
|
|||||||
ProductName=
|
ProductName=
|
||||||
ProductVersion=1.0.0.0
|
ProductVersion=1.0.0.0
|
||||||
Comments=
|
Comments=
|
||||||
|
[HistoryLists\hlUnitAliases]
|
||||||
|
Count=1
|
||||||
|
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
|
||||||
|
|||||||
@ -4,8 +4,11 @@ uses
|
|||||||
MemCheck,
|
MemCheck,
|
||||||
TestFramework,
|
TestFramework,
|
||||||
GUITestRunner,
|
GUITestRunner,
|
||||||
|
Variants,
|
||||||
BitsTest in 'Units\BitsTest.pas',
|
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
|
begin
|
||||||
MemChk();
|
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;
|
function BlendColors(const ABackground, AForeground: TColor;
|
||||||
const AAlpha: Byte): 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
|
implementation
|
||||||
uses
|
uses
|
||||||
@ -74,7 +84,7 @@ type
|
|||||||
THackControl = class(TControl);
|
THackControl = class(TControl);
|
||||||
|
|
||||||
|
|
||||||
procedure AAFont;
|
procedure AAFont(const AFont: TFont);
|
||||||
var
|
var
|
||||||
pFont: TLogFont;
|
pFont: TLogFont;
|
||||||
hAAFont: HFONT;
|
hAAFont: HFONT;
|
||||||
@ -114,7 +124,7 @@ begin
|
|||||||
AFont.Handle := hAAFont;
|
AFont.Handle := hAAFont;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure AAControl;
|
procedure AAControl(const AControl: TControl);
|
||||||
var
|
var
|
||||||
pControl: THackControl;
|
pControl: THackControl;
|
||||||
|
|
||||||
@ -123,7 +133,8 @@ begin
|
|||||||
AAFont(pControl.Font);
|
AAFont(pControl.Font);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure AAChildren;
|
procedure AAChildren(const AParent: TWinControl;
|
||||||
|
const ARecursive: Boolean = False);
|
||||||
var
|
var
|
||||||
iControl: Integer;
|
iControl: Integer;
|
||||||
|
|
||||||
@ -137,7 +148,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure AAOwned;
|
procedure AAOwned(const AOwner: TComponent);
|
||||||
var
|
var
|
||||||
iControl: Integer;
|
iControl: Integer;
|
||||||
|
|
||||||
@ -148,7 +159,8 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function BlendColors;
|
function BlendColors(const ABackground, AForeground: TColor;
|
||||||
|
const AAlpha: Byte): TColor;
|
||||||
var
|
var
|
||||||
cBack: Cardinal;
|
cBack: Cardinal;
|
||||||
cFore: Cardinal;
|
cFore: Cardinal;
|
||||||
@ -167,4 +179,53 @@ begin
|
|||||||
(GetBValue(cFore) * AAlpha)) shr 8);
|
(GetBValue(cFore) * AAlpha)) shr 8);
|
||||||
end;
|
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.
|
end.
|
||||||
|
|||||||
@ -169,7 +169,7 @@ type
|
|||||||
procedure InvalidateCursor();
|
procedure InvalidateCursor();
|
||||||
|
|
||||||
function Hash(const AKey: Pointer; const ASize: Cardinal): Cardinal; virtual;
|
function Hash(const AKey: Pointer; const ASize: Cardinal): Cardinal; virtual;
|
||||||
procedure CursorRequired();
|
function CursorRequired(const ARaiseException: Boolean = True): Boolean;
|
||||||
|
|
||||||
function InternalFind(const ABucket: PX2HashBucket;
|
function InternalFind(const ABucket: PX2HashBucket;
|
||||||
const AHash: Cardinal; const AKey: Pointer;
|
const AHash: Cardinal; const AKey: Pointer;
|
||||||
@ -257,7 +257,7 @@ type
|
|||||||
:$ Base hash implementation for string keys.
|
:$ Base hash implementation for string keys.
|
||||||
}
|
}
|
||||||
TX2CustomStringHash = class(TX2CustomHash)
|
TX2CustomStringHash = class(TX2CustomHash)
|
||||||
private
|
protected
|
||||||
function GetCurrentKey(): String;
|
function GetCurrentKey(): String;
|
||||||
protected
|
protected
|
||||||
function CreateKeyManager(): TX2CustomHashManager; override;
|
function CreateKeyManager(): TX2CustomHashManager; override;
|
||||||
@ -275,7 +275,7 @@ type
|
|||||||
:$ Pointer-to-Pointer hash.
|
:$ Pointer-to-Pointer hash.
|
||||||
}
|
}
|
||||||
TX2PPHash = class(TX2CustomPointerHash)
|
TX2PPHash = class(TX2CustomPointerHash)
|
||||||
private
|
protected
|
||||||
function GetCurrentValue(): Pointer;
|
function GetCurrentValue(): Pointer;
|
||||||
function GetValue(Key: Pointer): Pointer;
|
function GetValue(Key: Pointer): Pointer;
|
||||||
procedure SetValue(Key: Pointer; const Value: Pointer);
|
procedure SetValue(Key: Pointer; const Value: Pointer);
|
||||||
@ -290,7 +290,7 @@ type
|
|||||||
:$ Pointer-to-Integer hash.
|
:$ Pointer-to-Integer hash.
|
||||||
}
|
}
|
||||||
TX2PIHash = class(TX2CustomPointerHash)
|
TX2PIHash = class(TX2CustomPointerHash)
|
||||||
private
|
protected
|
||||||
function GetCurrentValue(): Integer;
|
function GetCurrentValue(): Integer;
|
||||||
function GetValue(Key: Pointer): Integer;
|
function GetValue(Key: Pointer): Integer;
|
||||||
procedure SetValue(Key: Pointer; const Value: Integer);
|
procedure SetValue(Key: Pointer; const Value: Integer);
|
||||||
@ -305,7 +305,7 @@ type
|
|||||||
:$ Pointer-to-Object hash.
|
:$ Pointer-to-Object hash.
|
||||||
}
|
}
|
||||||
TX2POHash = class(TX2CustomPointerHash)
|
TX2POHash = class(TX2CustomPointerHash)
|
||||||
private
|
protected
|
||||||
function GetCurrentValue(): TObject;
|
function GetCurrentValue(): TObject;
|
||||||
function GetOwnsObjects(): Boolean;
|
function GetOwnsObjects(): Boolean;
|
||||||
procedure SetOwnsObjects(const Value: Boolean);
|
procedure SetOwnsObjects(const Value: Boolean);
|
||||||
@ -325,7 +325,7 @@ type
|
|||||||
:$ Pointer-to-String hash.
|
:$ Pointer-to-String hash.
|
||||||
}
|
}
|
||||||
TX2PSHash = class(TX2CustomPointerHash)
|
TX2PSHash = class(TX2CustomPointerHash)
|
||||||
private
|
protected
|
||||||
function GetCurrentValue(): String;
|
function GetCurrentValue(): String;
|
||||||
function GetValue(Key: Pointer): String;
|
function GetValue(Key: Pointer): String;
|
||||||
procedure SetValue(Key: Pointer; const Value: String);
|
procedure SetValue(Key: Pointer; const Value: String);
|
||||||
@ -340,7 +340,7 @@ type
|
|||||||
:$ Integer-to-Pointer hash.
|
:$ Integer-to-Pointer hash.
|
||||||
}
|
}
|
||||||
TX2IPHash = class(TX2CustomIntegerHash)
|
TX2IPHash = class(TX2CustomIntegerHash)
|
||||||
private
|
protected
|
||||||
function GetCurrentValue(): Pointer;
|
function GetCurrentValue(): Pointer;
|
||||||
function GetValue(Key: Integer): Pointer;
|
function GetValue(Key: Integer): Pointer;
|
||||||
procedure SetValue(Key: Integer; const Value: Pointer);
|
procedure SetValue(Key: Integer; const Value: Pointer);
|
||||||
@ -355,7 +355,7 @@ type
|
|||||||
:$ Integer-to-Integer hash.
|
:$ Integer-to-Integer hash.
|
||||||
}
|
}
|
||||||
TX2IIHash = class(TX2CustomIntegerHash)
|
TX2IIHash = class(TX2CustomIntegerHash)
|
||||||
private
|
protected
|
||||||
function GetCurrentValue(): Integer;
|
function GetCurrentValue(): Integer;
|
||||||
function GetValue(Key: Integer): Integer;
|
function GetValue(Key: Integer): Integer;
|
||||||
procedure SetValue(Key: Integer; const Value: Integer);
|
procedure SetValue(Key: Integer; const Value: Integer);
|
||||||
@ -370,7 +370,7 @@ type
|
|||||||
:$ Integer-to-Object hash.
|
:$ Integer-to-Object hash.
|
||||||
}
|
}
|
||||||
TX2IOHash = class(TX2CustomIntegerHash)
|
TX2IOHash = class(TX2CustomIntegerHash)
|
||||||
private
|
protected
|
||||||
function GetCurrentValue(): TObject;
|
function GetCurrentValue(): TObject;
|
||||||
function GetOwnsObjects(): Boolean;
|
function GetOwnsObjects(): Boolean;
|
||||||
procedure SetOwnsObjects(const Value: Boolean);
|
procedure SetOwnsObjects(const Value: Boolean);
|
||||||
@ -390,7 +390,7 @@ type
|
|||||||
:$ Integer-to-String hash.
|
:$ Integer-to-String hash.
|
||||||
}
|
}
|
||||||
TX2ISHash = class(TX2CustomIntegerHash)
|
TX2ISHash = class(TX2CustomIntegerHash)
|
||||||
private
|
protected
|
||||||
function GetCurrentValue(): String;
|
function GetCurrentValue(): String;
|
||||||
function GetValue(Key: Integer): String;
|
function GetValue(Key: Integer): String;
|
||||||
procedure SetValue(Key: Integer; const Value: String);
|
procedure SetValue(Key: Integer; const Value: String);
|
||||||
@ -405,7 +405,7 @@ type
|
|||||||
:$ Object-to-Pointer hash.
|
:$ Object-to-Pointer hash.
|
||||||
}
|
}
|
||||||
TX2OPHash = class(TX2CustomObjectHash)
|
TX2OPHash = class(TX2CustomObjectHash)
|
||||||
private
|
protected
|
||||||
function GetCurrentValue(): Pointer;
|
function GetCurrentValue(): Pointer;
|
||||||
function GetValue(Key: TObject): Pointer;
|
function GetValue(Key: TObject): Pointer;
|
||||||
procedure SetValue(Key: TObject; const Value: Pointer);
|
procedure SetValue(Key: TObject; const Value: Pointer);
|
||||||
@ -420,7 +420,7 @@ type
|
|||||||
:$ Object-to-Integer hash.
|
:$ Object-to-Integer hash.
|
||||||
}
|
}
|
||||||
TX2OIHash = class(TX2CustomObjectHash)
|
TX2OIHash = class(TX2CustomObjectHash)
|
||||||
private
|
protected
|
||||||
function GetCurrentValue(): Integer;
|
function GetCurrentValue(): Integer;
|
||||||
function GetValue(Key: TObject): Integer;
|
function GetValue(Key: TObject): Integer;
|
||||||
procedure SetValue(Key: TObject; const Value: Integer);
|
procedure SetValue(Key: TObject; const Value: Integer);
|
||||||
@ -435,7 +435,7 @@ type
|
|||||||
:$ Object-to-Object hash.
|
:$ Object-to-Object hash.
|
||||||
}
|
}
|
||||||
TX2OOHash = class(TX2CustomObjectHash)
|
TX2OOHash = class(TX2CustomObjectHash)
|
||||||
private
|
protected
|
||||||
function GetCurrentValue(): TObject;
|
function GetCurrentValue(): TObject;
|
||||||
function GetOwnsObjects(): Boolean;
|
function GetOwnsObjects(): Boolean;
|
||||||
procedure SetOwnsObjects(const Value: Boolean);
|
procedure SetOwnsObjects(const Value: Boolean);
|
||||||
@ -455,7 +455,7 @@ type
|
|||||||
:$ Object-to-String hash.
|
:$ Object-to-String hash.
|
||||||
}
|
}
|
||||||
TX2OSHash = class(TX2CustomObjectHash)
|
TX2OSHash = class(TX2CustomObjectHash)
|
||||||
private
|
protected
|
||||||
function GetCurrentValue(): String;
|
function GetCurrentValue(): String;
|
||||||
function GetValue(Key: TObject): String;
|
function GetValue(Key: TObject): String;
|
||||||
procedure SetValue(Key: TObject; const Value: String);
|
procedure SetValue(Key: TObject; const Value: String);
|
||||||
@ -470,7 +470,7 @@ type
|
|||||||
:$ String-to-Pointer hash.
|
:$ String-to-Pointer hash.
|
||||||
}
|
}
|
||||||
TX2SPHash = class(TX2CustomStringHash)
|
TX2SPHash = class(TX2CustomStringHash)
|
||||||
private
|
protected
|
||||||
function GetCurrentValue(): Pointer;
|
function GetCurrentValue(): Pointer;
|
||||||
function GetValue(Key: String): Pointer;
|
function GetValue(Key: String): Pointer;
|
||||||
procedure SetValue(Key: String; const Value: Pointer);
|
procedure SetValue(Key: String; const Value: Pointer);
|
||||||
@ -485,7 +485,7 @@ type
|
|||||||
:$ String-to-Integer hash.
|
:$ String-to-Integer hash.
|
||||||
}
|
}
|
||||||
TX2SIHash = class(TX2CustomStringHash)
|
TX2SIHash = class(TX2CustomStringHash)
|
||||||
private
|
protected
|
||||||
function GetCurrentValue(): Integer;
|
function GetCurrentValue(): Integer;
|
||||||
function GetValue(Key: String): Integer;
|
function GetValue(Key: String): Integer;
|
||||||
procedure SetValue(Key: String; const Value: Integer);
|
procedure SetValue(Key: String; const Value: Integer);
|
||||||
@ -500,7 +500,7 @@ type
|
|||||||
:$ String-to-Object hash.
|
:$ String-to-Object hash.
|
||||||
}
|
}
|
||||||
TX2SOHash = class(TX2CustomStringHash)
|
TX2SOHash = class(TX2CustomStringHash)
|
||||||
private
|
protected
|
||||||
function GetCurrentValue(): TObject;
|
function GetCurrentValue(): TObject;
|
||||||
function GetOwnsObjects(): Boolean;
|
function GetOwnsObjects(): Boolean;
|
||||||
procedure SetOwnsObjects(const Value: Boolean);
|
procedure SetOwnsObjects(const Value: Boolean);
|
||||||
@ -520,7 +520,7 @@ type
|
|||||||
:$ String-to-String hash.
|
:$ String-to-String hash.
|
||||||
}
|
}
|
||||||
TX2SSHash = class(TX2CustomStringHash)
|
TX2SSHash = class(TX2CustomStringHash)
|
||||||
private
|
protected
|
||||||
function GetCurrentValue(): String;
|
function GetCurrentValue(): String;
|
||||||
function GetValue(Key: String): String;
|
function GetValue(Key: String): String;
|
||||||
procedure SetValue(Key: String; const Value: String);
|
procedure SetValue(Key: String; const Value: String);
|
||||||
@ -908,13 +908,18 @@ begin
|
|||||||
Result := CRC32(AKey, ASize);
|
Result := CRC32(AKey, ASize);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TX2CustomHash.CursorRequired();
|
function TX2CustomHash.CursorRequired(const ARaiseException: Boolean): Boolean;
|
||||||
begin
|
begin
|
||||||
|
Result := True;
|
||||||
if not Assigned(FCursor) then
|
if not Assigned(FCursor) then
|
||||||
if Assigned(FRoot) then
|
if Assigned(FRoot) then
|
||||||
FCursor := CreateCursor()
|
FCursor := CreateCursor()
|
||||||
else
|
else
|
||||||
raise EX2HashNoCursor.Create('Cursor not available!');
|
begin
|
||||||
|
Result := False;
|
||||||
|
if ARaiseException then
|
||||||
|
raise EX2HashNoCursor.Create('Cursor not available!');
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -1173,13 +1178,18 @@ end;
|
|||||||
|
|
||||||
procedure TX2CustomHash.First();
|
procedure TX2CustomHash.First();
|
||||||
begin
|
begin
|
||||||
CursorRequired();
|
if not CursorRequired(False) then
|
||||||
|
exit;
|
||||||
|
|
||||||
Cursor.First();
|
Cursor.First();
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TX2CustomHash.Next(): Boolean;
|
function TX2CustomHash.Next(): Boolean;
|
||||||
begin
|
begin
|
||||||
CursorRequired();
|
Result := False;
|
||||||
|
if not CursorRequired(False) then
|
||||||
|
exit;
|
||||||
|
|
||||||
Result := Cursor.Next();
|
Result := Cursor.Next();
|
||||||
end;
|
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
|
:: Include one of the extensions (X2UtSettingsINI, X2UtSettingsRegistry) for
|
||||||
:: an implementation.
|
:: an implementation.
|
||||||
::
|
::
|
||||||
|
:: X2UtSettings is deprecated, and replaced by X2UtConfig.
|
||||||
|
::
|
||||||
:: Last changed: $Date$
|
:: Last changed: $Date$
|
||||||
:: Revision: $Rev$
|
:: Revision: $Rev$
|
||||||
:: Author: $Author$
|
:: Author: $Author$
|
||||||
@ -153,7 +155,7 @@ type
|
|||||||
//:$ Validates the specified value using the defined callback method
|
//:$ Validates the specified value using the defined callback method
|
||||||
//:$ if present.
|
//:$ if present.
|
||||||
function ValidateValue(const AName: String; const AValue: Variant): Variant;
|
function ValidateValue(const AName: String; const AValue: Variant): Variant;
|
||||||
end;
|
end deprecated;
|
||||||
|
|
||||||
{
|
{
|
||||||
:$ Settings factory.
|
:$ Settings factory.
|
||||||
@ -184,7 +186,7 @@ type
|
|||||||
//:: callback method to perform centralized checks.
|
//:: callback method to perform centralized checks.
|
||||||
procedure Define(const ASection, AName: String; const AValue: Variant;
|
procedure Define(const ASection, AName: String; const AValue: Variant;
|
||||||
const ACallback: TX2SettingsCallback = nil);
|
const ACallback: TX2SettingsCallback = nil);
|
||||||
end;
|
end deprecated;
|
||||||
|
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user