diff --git a/Packages/D7/X2Utils.cfg b/Packages/D7/X2Utils.cfg new file mode 100644 index 0000000..44403d1 --- /dev/null +++ b/Packages/D7/X2Utils.cfg @@ -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 diff --git a/Packages/D7/X2Utils.dof b/Packages/D7/X2Utils.dof new file mode 100644 index 0000000..9ce9f66 --- /dev/null +++ b/Packages/D7/X2Utils.dof @@ -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 diff --git a/Packages/D7/X2Utils.dpk b/Packages/D7/X2Utils.dpk new file mode 100644 index 0000000..7e58deb --- /dev/null +++ b/Packages/D7/X2Utils.dpk @@ -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. diff --git a/Packages/D7/X2Utils.res b/Packages/D7/X2Utils.res new file mode 100644 index 0000000..3826071 Binary files /dev/null and b/Packages/D7/X2Utils.res differ diff --git a/UnitTests/Units/HashesTest.pas b/UnitTests/Units/HashesTest.pas index 402416d..fecaa26 100644 --- a/UnitTests/Units/HashesTest.pas +++ b/UnitTests/Units/HashesTest.pas @@ -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. diff --git a/UnitTests/Units/IniParserTest.pas b/UnitTests/Units/IniParserTest.pas new file mode 100644 index 0000000..313cb19 --- /dev/null +++ b/UnitTests/Units/IniParserTest.pas @@ -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. diff --git a/UnitTests/Units/SettingsTest.pas b/UnitTests/Units/SettingsTest.pas new file mode 100644 index 0000000..fba8a6c --- /dev/null +++ b/UnitTests/Units/SettingsTest.pas @@ -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. diff --git a/UnitTests/X2UtUnitTests.cfg b/UnitTests/X2UtUnitTests.cfg index 556e9fb..44403d1 100644 --- a/UnitTests/X2UtUnitTests.cfg +++ b/UnitTests/X2UtUnitTests.cfg @@ -15,12 +15,12 @@ -$O+ -$P+ -$Q- --$R+ +-$R- -$S- -$T- -$U- -$V+ --$W- +-$W+ -$X+ -$YD -$Z1 diff --git a/UnitTests/X2UtUnitTests.dof b/UnitTests/X2UtUnitTests.dof index 74999f0..cdafc69 100644 --- a/UnitTests/X2UtUnitTests.dof +++ b/UnitTests/X2UtUnitTests.dof @@ -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; diff --git a/UnitTests/X2UtUnitTests.dpr b/UnitTests/X2UtUnitTests.dpr index 3ebf588..390acab 100644 --- a/UnitTests/X2UtUnitTests.dpr +++ b/UnitTests/X2UtUnitTests.dpr @@ -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(); diff --git a/X2UtConfig.pas b/X2UtConfig.pas new file mode 100644 index 0000000..22d2346 --- /dev/null +++ b/X2UtConfig.pas @@ -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. diff --git a/X2UtConfigIni.pas b/X2UtConfigIni.pas new file mode 100644 index 0000000..969f78a --- /dev/null +++ b/X2UtConfigIni.pas @@ -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. + \ No newline at end of file diff --git a/X2UtGraphics.pas b/X2UtGraphics.pas index d323868..adf9edd 100644 --- a/X2UtGraphics.pas +++ b/X2UtGraphics.pas @@ -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. diff --git a/X2UtHashes.pas b/X2UtHashes.pas index 117e0f4..cbcf373 100644 --- a/X2UtHashes.pas +++ b/X2UtHashes.pas @@ -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 - raise EX2HashNoCursor.Create('Cursor not available!'); + 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; diff --git a/X2UtHashesVariants.pas b/X2UtHashesVariants.pas new file mode 100644 index 0000000..83a9232 --- /dev/null +++ b/X2UtHashesVariants.pas @@ -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. diff --git a/X2UtIniParser.pas b/X2UtIniParser.pas new file mode 100644 index 0000000..7787aea --- /dev/null +++ b/X2UtIniParser.pas @@ -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. + \ No newline at end of file diff --git a/X2UtSettings.pas b/X2UtSettings.pas index d2fcd3e..f5ff1fc 100644 --- a/X2UtSettings.pas +++ b/X2UtSettings.pas @@ -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