diff --git a/Test/X2UtilsSettingsTest.cfg b/Test/X2UtilsSettingsTest.cfg new file mode 100644 index 0000000..17482c8 --- /dev/null +++ b/Test/X2UtilsSettingsTest.cfg @@ -0,0 +1,37 @@ +-$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 +-GD +-cg +-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +-H+ +-W+ +-M +-$M16384,1048576 +-K$00400000 +-LE"c:\program files\borland\delphi6\Projects\Bpl" +-LN"c:\program files\borland\delphi6\Projects\Bpl" +-DmadExcept diff --git a/Test/X2UtilsSettingsTest.dof b/Test/X2UtilsSettingsTest.dof new file mode 100644 index 0000000..541cf39 --- /dev/null +++ b/Test/X2UtilsSettingsTest.dof @@ -0,0 +1,160 @@ +[FileVersion] +Version=6.0 +[Compiler] +A=8 +B=0 +C=1 +D=1 +E=0 +F=0 +G=1 +H=1 +I=1 +J=0 +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=0 +X=1 +Y=1 +Z=1 +ShowHints=1 +ShowWarnings=1 +UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +[Linker] +MapFile=3 +OutputObjs=0 +ConsoleApp=1 +DebugInfo=0 +RemoteSymbols=0 +MinStackSize=16384 +MaxStackSize=1048576 +ImageBase=4194304 +ExeDescription= +[Directories] +OutputDir= +UnitOutputDir= +PackageDLLOutputDir= +PackageDCPOutputDir= +SearchPath= +Packages=vcl;rtl;vclx;Indy60;madBasic_;madDisAsm_;dsnap;dbrtl;xmlrtl;inet;soaprtl +Conditionals=madExcept +DebugSourceDirs= +UsePackages=0 +[Parameters] +RunParams= +HostApplication= +Launcher= +UseLauncher=0 +DebugCWD= +[Version Info] +IncludeVerInfo=0 +AutoIncBuild=1 +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= +Comments= +[Excluded Packages] +c:\program files\borland\delphi6\Projects\Bpl\VirtualTreesD6D.bpl=Virtual Treeview +C:\PROGRA~1\Borland\Delphi6\Projects\Bpl\ThemeManager6.bpl=Windows XP Theme Manager +c:\program files\borland\delphi6\Projects\Bpl\JVCL200_D60.bpl=JEDI-VCL Components +c:\program files\borland\delphi6\Projects\Bpl\dclIndy60.bpl=Internet Direct (Indy) for D6 Property and Component Editors +c:\program files\borland\delphi6\Projects\Bpl\BalloonD6.bpl=Balloon 2.0 +c:\program files\borland\delphi6\Projects\Bpl\asqlite.bpl=Aducom Software -- SQLite Design Time Components +C:\PROGRA~1\Borland\Delphi6\Projects\Bpl\aSQLitepkg.bpl=Aducom Software -- SQLite RunTime Components +C:\PROGRA~1\Borland\Delphi6\Projects\Bpl\GR32_D6.bpl=Graphics32 +c:\program files\borland\delphi6\Projects\Bpl\GR32_DSGN_D6.bpl=Graphics32 Design Time Package +c:\program files\borland\delphi6\Projects\Bpl\PNGImage_D6.bpl=PNGImage +c:\program files\borland\delphi6\Projects\Bpl\BMSpinEditD6.bpl=BMSpinEdit +C:\PROGRA~1\Borland\Delphi6\Projects\Bpl\tbx_d6.bpl=Toolbar2000 -- TBX Extensions (Alex Denisov) +C:\PROGRA~1\Borland\Delphi6\Projects\Bpl\tb2k_d6.bpl=Toolbar2000 Components (Jordan Russell) +c:\program files\borland\delphi6\Projects\Bpl\tbxdsgn_d6.bpl=Toolbar2000 -- TBX Extensions Design Package (Alex Denisov) +C:\PROGRA~1\Borland\Delphi6\Projects\Bpl\tb2kdsgn_d6.bpl=Toolbar2000 Design Package (Jordan Russell) +c:\program files\borland\delphi6\Projects\Bpl\SynEdit_D6.bpl=SynEdit component suite +c:\program files\borland\delphi6\Projects\Bpl\DelphiX_for5.bpl=DelphiX - DirectX components for Delphi +c:\program files\borland\delphi6\Projects\Bpl\GLScene6.bpl=GLScene - OpenGL 3D library +c:\program files\borland\delphi6\Projects\Bpl\NLDMBD6D.bpl=NLDMessageBox +c:\program files\borland\delphi6\Projects\Bpl\TntUnicodeVcl_D60.bpl=Tnt Unicode Controls +c:\program files\borland\delphi6\Projects\Bpl\PageControlExD6.bpl=PageControlEx +c:\program files\borland\delphi6\Bin\dclsmp60.bpl=Borland Sample Components +c:\program files\borland\delphi6\Bin\dcl31w60.bpl=Delphi 1.0 Compatibility Components +c:\program files\borland\delphi6\Projects\Bpl\NLDTrayIconD6.bpl=NLDTrayIcon donated by SVG_1986 +c:\program files\borland\delphi6\Projects\Bpl\ServerListD6D.bpl=SOF2Manager - Server List Designtime +C:\WINDOWS\System32\ibevnt60.bpl=Borland Interbase Event Alerter Component +F:\Delphi\Components\madCollection\madBasic\Delphi 6\madHelp_.bpl=madHelp 1.1 · www.madshi.net +F:\Delphi\Components\madCollection\madRemote\Delphi 6\madRemote_.bpl=madRemote 1.1a · www.madshi.net +F:\Delphi\Components\madCollection\madKernel\Delphi 6\madKernel_.bpl=madKernel 1.2z · www.madshi.net +F:\Delphi\Components\madCollection\madCodeHook\Delphi 6\madCodeHook_.bpl=madCodeHook 2.0a · www.madshi.net +F:\Delphi\Components\madCollection\madSecurity\Delphi 6\madSecurity_.bpl=madSecurity 1.1n · www.madshi.net +F:\Delphi\Components\madCollection\madShell\Delphi 6\madShell_.bpl=madShell 1.3i · www.madshi.net +c:\program files\borland\delphi6\Projects\Bpl\X2MultiMon_D6D.bpl=X2MultiMon Designtime Package +c:\program files\borland\delphi6\Projects\Bpl\ff2_d60.bpl=TurboPower FlashFiler Designtime Package - VCL60 +F:\Delphi\Components\ZipForge\Lib\Delphi 6\dclZipForged6.bpl=ZipForge Package +c:\program files\borland\delphi6\Bin\dclado60.bpl=Borland ADO DB Components +c:\program files\borland\delphi6\Bin\dclbde60.bpl=Borland BDE DB Components +C:\Program Files\Borland\Delphi6\Bin\dbx60.bpl=Borland SQL Explorer UI Package +c:\program files\borland\delphi6\Bin\DCLIB60.bpl=InterBase Data Access Components +c:\program files\borland\delphi6\Bin\dclcds60.bpl=Borland Base Cached ClientDataset Component +C:\Program Files\Borland\Delphi6\Bin\dclmid60.bpl=Borland MyBase DataAccess Components +c:\program files\borland\delphi6\Bin\dclbdecds60.bpl=Borland Local BDE ClientDataset Components +c:\program files\borland\delphi6\Bin\dclqrt60.bpl=QuickReport Components +c:\program files\borland\delphi6\Bin\dcltee60.bpl=TeeChart Components +c:\program files\borland\delphi6\Bin\dcldss60.bpl=Borland Decision Cube Components +c:\program files\borland\delphi6\Bin\dcltqr60.bpl=TeeChart for QuickReport Components +c:\program files\borland\delphi6\Bin\dclclxdb60.bpl=Borland CLX Database Components +C:\Program Files\Borland\Delphi6\Bin\dclclxstd60.bpl=Borland CLX Standard Components +c:\program files\borland\delphi6\Bin\dclmcn60.bpl=Borland DataSnap Connection Components +c:\program files\borland\delphi6\Bin\applet60.bpl=Borland Control Panel Applet Package +c:\program files\borland\delphi6\Bin\dclemacsedit60.bpl=Borland Editor Emacs Enhancements +c:\program files\borland\delphi6\Bin\dclshlctrls60.bpl=Shell Control Property and Component Editors +c:\program files\borland\delphi6\Bin\DBWEBXPRT.BPL=Borland Web Wizard Package +c:\program files\borland\delphi6\Bin\DCLNMF60.bpl=NetMasters Fastnet Tools +c:\program files\borland\delphi6\Bin\dclwbm60.bpl=Borland InternetExpress Components +c:\program files\borland\delphi6\Bin\dclie60.bpl=Internet Explorer Components +c:\program files\borland\delphi6\Bin\dclwebsnap60.bpl=Borland WebSnap Components +c:\program files\borland\delphi6\Bin\dclite60.bpl=Borland Integrated Translation Environment +c:\program files\borland\delphi6\Bin\dcldbx60.bpl=Borland dbExpress Components +c:\program files\borland\delphi6\Bin\dcldbxcds60.bpl=Borland Local DBX ClientDataset Components +[Included Packages] +C:\Program Files\Borland\Delphi6\Bin\dclstd60.bpl=Borland Standard Components +c:\program files\borland\delphi6\Bin\dclsmpedit60.bpl=Borland Editor Script Enhancements +F:\Delphi\Components\madCollection\madBasic\Delphi 6\madBasic_.bpl=madBasic 1.1f · www.madshi.net +F:\Delphi\Components\madCollection\madDisAsm\Delphi 6\madDisAsm_.bpl=madDisAsm 2.0a · www.madshi.net +F:\Delphi\Components\madCollection\madExcept\Delphi 6\madExcept_.bpl=madExcept 2.6a · www.madshi.net +F:\Delphi\Components\madCollection\madExcept\Delphi 6\madExceptIde_.bpl=madExceptIde 1.0b · www.madshi.net +F:\Delphi\Components\madCollection\madExcept\Delphi 6\madExceptWizard_.bpl=madExceptWizard 2.6 · www.madshi.net +C:\Program Files\Borland\Delphi6\Bin\dcldb60.bpl=Borland Database Components +c:\program files\borland\delphi6\Bin\dclnet60.bpl=Borland Internet Components +c:\program files\borland\delphi6\Bin\dclsoap60.bpl=Borland SOAP Components +c:\program files\borland\delphi6\Projects\Bpl\ColorPickerButtonD6.bpl=ColorPickerButton +C:\Program Files\Borland\Delphi6\Bin\dclact60.bpl=Borland ActionBar Components +c:\program files\borland\delphi6\Projects\Bpl\SysILS.bpl=(untitled) +c:\program files\borland\delphi6\Projects\Bpl\videocap5.bpl=(untitled) +c:\program files\borland\delphi6\Projects\Bpl\DragDropD6.bpl=Drag and Drop Component Suite diff --git a/Test/X2UtilsSettingsTest.dpr b/Test/X2UtilsSettingsTest.dpr new file mode 100644 index 0000000..98de5a8 --- /dev/null +++ b/Test/X2UtilsSettingsTest.dpr @@ -0,0 +1,130 @@ +program X2UtilsSettingsTest; + +{$APPTYPE CONSOLE} + +uses + madExcept, + madLinkDisAsm, + Classes, + SysUtils, + Windows, + X2UtApp in '..\X2UtApp.pas', + X2UtSettings in '..\X2UtSettings.pas', + X2UtSettingsINI in '..\X2UtSettingsINI.pas', + X2UtSettingsRegistry in '..\X2UtSettingsRegistry.pas'; + +procedure TraverseSection(const ASettings: TX2SettingsFactory; + const ASection: String = ''; + const AIndent: Integer = 0); +var + sIndent: String; + slSections: TStringList; + iSection: Integer; + slValues: TStringList; + iValue: Integer; + sSection: String; + +begin + sIndent := StringOfChar(' ', AIndent * 2); + slSections := TStringList.Create(); + try + with ASettings[ASection] do + try + GetSectionNames(slSections); + + for iSection := 0 to slSections.Count - 1 do begin + WriteLn(sIndent, '[', slSections[iSection], ']'); + + sSection := ASection; + if Length(sSection) > 0 then + sSection := sSection + '.'; + + sSection := sSection + slSections[iSection]; + + slValues := TStringList.Create(); + try + with ASettings[sSection] do + try + GetValueNames(slValues); + + for iValue := 0 to slValues.Count - 1 do + WriteLn(sIndent, slValues[iValue], '=', ReadString(slValues[iValue])); + finally + Free(); + end; + finally + FreeAndNil(slValues); + end; + + TraverseSection(ASettings, sSection, AIndent + 1); + end; + finally + Free(); + end; + finally + FreeAndNil(slSections); + end; +end; + + +var + Settings: TX2SettingsFactory; + +begin + // INI settings + WriteLn('INI data:'); + Settings := TX2INISettingsFactory.Create(); + try + with TX2INISettingsFactory(Settings) do + Filename := App.Path + 'settings.ini'; + + { + // Deletes one section + with Settings['Test.Section'] do + try + DeleteSection(); + finally + Free(); + end; + } + + { + // Deletes everything + with Settings[''] do + try + DeleteSection(); + finally + Free(); + end; + } + + TraverseSection(Settings, '', 1); + WriteLn; + finally + FreeAndNil(Settings); + end; + ReadLn; + + { + // Registry settings + WriteLn('Registry data:'); + Settings := TX2RegistrySettingsFactory.Create(); + try + with TX2RegistrySettingsFactory(Settings) do begin + Root := HKEY_CURRENT_USER; + Key := '\Software\X2Software\X2FileShare\'; + end; + + // Note: you WILL get exceptions here due to the fact that not all + // values are strings yet they are treated as such here. Perhaps in the + // future type conversion will be done on-the-fly, but for now just press + // F5 when debugging (you won't get exceptions when running the EXE as + // standalone) and the default value will be returned. Perhaps the best + // solution... + TraverseSection(Settings, '', 1); + ReadLn; + finally + FreeAndNil(Settings); + end; + } +end. diff --git a/Test/settings.ini b/Test/settings.ini new file mode 100644 index 0000000..5546584 --- /dev/null +++ b/Test/settings.ini @@ -0,0 +1,8 @@ +[Test.Section.1] +TestSection1=Success + +[Test.Section.2] +TestSection2=Success + +[Test.Test] +TestTest=Success \ No newline at end of file diff --git a/X2UtSettings.pas b/X2UtSettings.pas new file mode 100644 index 0000000..2ce9b34 --- /dev/null +++ b/X2UtSettings.pas @@ -0,0 +1,91 @@ +{ + :: X2UtSettings provides a generic access mechanism for application settings. + :: Include one of the extensions (X2UtSettingsINI, X2UtSettingsRegistry) for + :: an implementation. + :: + :: Subversion repository available at: + :: $URL$ + :: + :: Last changed: $Date$ + :: Revision: $Rev$ + :: Author: $Author$ + + :$ + :$ + :$ X2Utils is released under the zlib/libpng OSI-approved license. + :$ For more information: http://www.opensource.org/ + :$ /n/n + :$ /n/n + :$ Copyright (c) 2003 X2Software + :$ /n/n + :$ This software is provided 'as-is', without any express or implied warranty. + :$ In no event will the authors be held liable for any damages arising from + :$ the use of this software. + :$ /n/n + :$ Permission is granted to anyone to use this software for any purpose, + :$ including commercial applications, and to alter it and redistribute it + :$ freely, subject to the following restrictions: + :$ /n/n + :$ 1. The origin of this software must not be misrepresented; you must not + :$ claim that you wrote the original software. If you use this software in a + :$ product, an acknowledgment in the product documentation would be + :$ appreciated but is not required. + :$ /n/n + :$ 2. Altered source versions must be plainly marked as such, and must not be + :$ misrepresented as being the original software. + :$ /n/n + :$ 3. This notice may not be removed or altered from any source distribution. +} +unit X2UtSettings; + +interface +uses + Classes; + +type + { + :$ Abstract settings object + + :: Provides access to the settings regardless of the storage backend. + } + TX2Settings = class(TObject) + public + function ReadBool(const AName: String; const ADefault: Boolean = False): Boolean; virtual; abstract; + function ReadFloat(const AName: String; const ADefault: Double = 0.0): Double; virtual; abstract; + function ReadInteger(const AName: String; const ADefault: Integer = 0): Integer; virtual; abstract; + function ReadString(const AName: String; const ADefault: String = ''): String; virtual; abstract; + + procedure WriteBool(const AName: String; AValue: Boolean); virtual; abstract; + procedure WriteFloat(const AName: String; AValue: Double); virtual; abstract; + procedure WriteInteger(const AName: String; AValue: Integer); virtual; abstract; + procedure WriteString(const AName, AValue: String); virtual; abstract; + + procedure GetSectionNames(const ADest: TStrings); virtual; abstract; + procedure GetValueNames(const ADest: TStrings); virtual; abstract; + + procedure DeleteSection(); virtual; abstract; + procedure DeleteValue(const AName: String); virtual; abstract; + end; + + { + :$ Settings factory + + :: Extensions must implement a factory descendant which an application can + :: create to provide application-wide access to the same settings. + } + TX2SettingsFactory = class(TObject) + protected + function GetSection(const ASection: String): TX2Settings; virtual; abstract; + public + //:$ Load a section from the settings + //:: Sub-sections are indicated by seperating the sections with a dot ('.') + //:: characters, ex: Sub.Section. The underlying extension will translate + //:: this into a compatible section. + //:! The application is responsible for freeing the returned class. + property Sections[const ASection: String]: TX2Settings read GetSection; default; + end; + + +implementation + +end. diff --git a/X2UtSettingsINI.pas b/X2UtSettingsINI.pas new file mode 100644 index 0000000..d6c2dbb --- /dev/null +++ b/X2UtSettingsINI.pas @@ -0,0 +1,272 @@ +{ + :: X2UtSettingsINI extends X2UtSettings with INI reading/writing. + :: + :: Subversion repository available at: + :: $URL$ + :: + :: Last changed: $Date$ + :: Revision: $Rev$ + :: Author: $Author$ + + :$ + :$ + :$ X2Utils is released under the zlib/libpng OSI-approved license. + :$ For more information: http://www.opensource.org/ + :$ /n/n + :$ /n/n + :$ Copyright (c) 2003 X2Software + :$ /n/n + :$ This software is provided 'as-is', without any express or implied warranty. + :$ In no event will the authors be held liable for any damages arising from + :$ the use of this software. + :$ /n/n + :$ Permission is granted to anyone to use this software for any purpose, + :$ including commercial applications, and to alter it and redistribute it + :$ freely, subject to the following restrictions: + :$ /n/n + :$ 1. The origin of this software must not be misrepresented; you must not + :$ claim that you wrote the original software. If you use this software in a + :$ product, an acknowledgment in the product documentation would be + :$ appreciated but is not required. + :$ /n/n + :$ 2. Altered source versions must be plainly marked as such, and must not be + :$ misrepresented as being the original software. + :$ /n/n + :$ 3. This notice may not be removed or altered from any source distribution. +} +unit X2UtSettingsINI; + +interface +uses + Classes, + IniFiles, + X2UtSettings; + +type + { + :$ INI-based settings implementation + + :: It is highly recommended to create instances using TX2INISettingsFactory + :: instead of directly. + } + TX2INISettings = class(TX2Settings) + private + FData: TMemIniFile; + FSection: String; + public + // IX2Settings implementation + function ReadBool(const AName: String; const ADefault: Boolean = False): Boolean; override; + function ReadFloat(const AName: String; const ADefault: Double = 0.0): Double; override; + function ReadInteger(const AName: String; const ADefault: Integer = 0): Integer; override; + function ReadString(const AName: String; const ADefault: String = ''): String; override; + + procedure WriteBool(const AName: String; AValue: Boolean); override; + procedure WriteFloat(const AName: String; AValue: Double); override; + procedure WriteInteger(const AName: String; AValue: Integer); override; + procedure WriteString(const AName, AValue: String); override; + + procedure GetSectionNames(const ADest: TStrings); override; + procedure GetValueNames(const ADest: TStrings); override; + + procedure DeleteSection(); override; + procedure DeleteValue(const AName: String); override; + public + constructor Create(const AFilename, ASection: String); + destructor Destroy(); override; + end; + + { + :$ Factory for INI-based settings + + :: Before use, assign Filename with a valid path. + } + TX2INISettingsFactory = class(TX2SettingsFactory) + private + FFilename: String; + protected + function GetSection(const ASection: String): TX2Settings; override; + public + //:$ Specifies the filename of the INI + property Filename: String read FFilename write FFilename; + end; + +implementation +uses + SysUtils; + +{================== TX2INISettingsFactory + Section +========================================} +function TX2INISettingsFactory.GetSection; +begin + Result := TX2INISettings.Create(FFilename, ASection); +end; + + +{========================= TX2INISettings + Initialization +========================================} +constructor TX2INISettings.Create; +begin + inherited Create(); + + FData := TMemIniFile.Create(AFilename); + FSection := ASection; +end; + +destructor TX2INISettings.Destroy; +begin + FData.UpdateFile(); + FreeAndNil(FData); + + inherited; +end; + + +{========================= TX2INISettings + Read +========================================} +function TX2INISettings.ReadBool; +begin + Result := FData.ReadBool(FSection, AName, ADefault); +end; + +function TX2INISettings.ReadFloat; +begin + Result := FData.ReadFloat(FSection, AName, ADefault); +end; + +function TX2INISettings.ReadInteger; +begin + Result := FData.ReadInteger(FSection, AName, ADefault); +end; + +function TX2INISettings.ReadString; +begin + Result := FData.ReadString(FSection, AName, ADefault); +end; + + +{========================= TX2INISettings + Write +========================================} +procedure TX2INISettings.WriteBool; +begin + FData.WriteBool(FSection, AName, AValue); +end; + +procedure TX2INISettings.WriteFloat; +begin + FData.WriteFloat(FSection, AName, AValue); +end; + +procedure TX2INISettings.WriteInteger; +begin + FData.WriteInteger(FSection, AName, AValue); +end; + +procedure TX2INISettings.WriteString; +begin + FData.WriteString(FSection, AName, AValue); +end; + + +{========================= TX2INISettings + Enumeration +========================================} +procedure TX2INISettings.GetSectionNames; +var + slSections: TStringList; + slFound: TStringList; + iSection: Integer; + sCompare: String; + iCompareLen: Integer; + sSection: String; + iPos: Integer; + +begin + sCompare := FSection; + iCompareLen := Length(sCompare); + + if iCompareLen > 0 then begin + sCompare := sCompare + '.'; + Inc(iCompareLen); + end; + + slSections := TStringList.Create(); + slFound := TStringList.Create(); + try + slFound.Sorted := True; + slFound.Duplicates := dupIgnore; + FData.ReadSections(slSections); + + // Filter out non-subsections + for iSection := slSections.Count - 1 downto 0 do + if (iCompareLen = 0) or + (SameText(sCompare, Copy(slSections[iSection], 1, iCompareLen))) then begin + sSection := slSections[iSection]; + + Delete(sSection, 1, iCompareLen); + iPos := AnsiPos('.', sSection); + + if iPos > 0 then + SetLength(sSection, iPos - 1); + + slFound.Add(sSection); + end; + + ADest.AddStrings(slFound); + finally + FreeAndNil(slFound); + FreeAndNil(slSections); + end; +end; + +procedure TX2INISettings.GetValueNames; +begin + FData.ReadSection(FSection, ADest); +end; + + +{========================= TX2INISettings + Delete +========================================} +procedure TX2INISettings.DeleteSection; +var + slSections: TStringList; + iSection: Integer; + sCompare: String; + iCompareLen: Integer; + +begin + sCompare := FSection; + iCompareLen := Length(sCompare); + + if iCompareLen > 0 then begin + sCompare := sCompare + '.'; + Inc(iCompareLen); + end; + + slSections := TStringList.Create(); + try + // At first thought, parsing the sections again seems redundant, but it + // eliminates the need for recursive calls, any section that matches the + // start is automatically a sub-(sub-etc-)section of the current section. + FData.ReadSections(slSections); + + for iSection := slSections.Count - 1 downto 0 do + if (iCompareLen = 0) or + (SameText(sCompare, Copy(slSections[iSection], 1, iCompareLen))) then + FData.EraseSection(slSections[iSection]); + finally + FreeAndNil(slSections); + end; + FData.EraseSection(FSection); +end; + +procedure TX2INISettings.DeleteValue; +begin + FData.DeleteKey(FSection, AName); +end; + +end. diff --git a/X2UtSettingsRegistry.pas b/X2UtSettingsRegistry.pas new file mode 100644 index 0000000..5893082 --- /dev/null +++ b/X2UtSettingsRegistry.pas @@ -0,0 +1,275 @@ +{ + :: X2UtSettingsRegistry extends X2UtSettings with registry reading/writing. + :: + :: Subversion repository available at: + :: $URL$ + :: + :: Last changed: $Date$ + :: Revision: $Rev$ + :: Author: $Author$ + + :$ + :$ + :$ X2Utils is released under the zlib/libpng OSI-approved license. + :$ For more information: http://www.opensource.org/ + :$ /n/n + :$ /n/n + :$ Copyright (c) 2003 X2Software + :$ /n/n + :$ This software is provided 'as-is', without any express or implied warranty. + :$ In no event will the authors be held liable for any damages arising from + :$ the use of this software. + :$ /n/n + :$ Permission is granted to anyone to use this software for any purpose, + :$ including commercial applications, and to alter it and redistribute it + :$ freely, subject to the following restrictions: + :$ /n/n + :$ 1. The origin of this software must not be misrepresented; you must not + :$ claim that you wrote the original software. If you use this software in a + :$ product, an acknowledgment in the product documentation would be + :$ appreciated but is not required. + :$ /n/n + :$ 2. Altered source versions must be plainly marked as such, and must not be + :$ misrepresented as being the original software. + :$ /n/n + :$ 3. This notice may not be removed or altered from any source distribution. +} +unit X2UtSettingsRegistry; + +interface +uses + Classes, + Registry, + Windows, + X2UtSettings; + +type + { + :$ Registry-based settings implementation + + :: It is highly recommended to create instances using + :: TX2RegistrySettingsFactory instead of directly. + } + TX2RegistrySettings = class(TX2Settings) + private + FData: TRegistry; + FKey: String; + FOpen: Boolean; + FReadOnly: Boolean; + + function OpenRead(): Boolean; + function OpenWrite(): Boolean; + public + // IX2Settings implementation + function ReadBool(const AName: String; const ADefault: Boolean = False): Boolean; override; + function ReadFloat(const AName: String; const ADefault: Double = 0.0): Double; override; + function ReadInteger(const AName: String; const ADefault: Integer = 0): Integer; override; + function ReadString(const AName: String; const ADefault: String = ''): String; override; + + procedure WriteBool(const AName: String; AValue: Boolean); override; + procedure WriteFloat(const AName: String; AValue: Double); override; + procedure WriteInteger(const AName: String; AValue: Integer); override; + procedure WriteString(const AName, AValue: String); override; + + procedure GetSectionNames(const ADest: TStrings); override; + procedure GetValueNames(const ADest: TStrings); override; + + procedure DeleteSection(); override; + procedure DeleteValue(const AName: String); override; + public + constructor Create(const ARoot: Cardinal; const AKey: String); + destructor Destroy(); override; + end; + + { + :$ Factory for Registry-based settings + + :: Before use, assign Root and Key to valid values. + } + TX2RegistrySettingsFactory = class(TX2SettingsFactory) + private + FKey: String; + FRoot: HKEY; + protected + function GetSection(const ASection: String): TX2Settings; override; + public + //:$ Specifies the base registry key + property Key: String read FKey write FKey; + + //:$ Specifies the root key + property Root: HKEY read FRoot write FRoot; + end; + +implementation +uses + SysUtils; + +{============= TX2RegistrySettingsFactory + Section +========================================} +function TX2RegistrySettingsFactory.GetSection; +var + sKey: String; + +begin + sKey := IncludeTrailingPathDelimiter(FKey) + + StringReplace(ASection, '.', '\', [rfReplaceAll]); + Result := TX2RegistrySettings.Create(FRoot, sKey); +end; + + +{==================== TX2RegistrySettings + Initialization +========================================} +constructor TX2RegistrySettings.Create; +begin + inherited Create(); + + FData := TRegistry.Create(); + FData.RootKey := ARoot; + FKey := AKey; +end; + +destructor TX2RegistrySettings.Destroy; +begin + FreeAndNil(FData); + + inherited; +end; + + +function TX2RegistrySettings.OpenRead; +begin + if not FOpen then begin + FReadOnly := True; + FOpen := FData.OpenKey(FKey, False); + end; + + Result := FOpen; +end; + +function TX2RegistrySettings.OpenWrite; +begin + if (FOpen) and (FReadOnly) then begin + FData.CloseKey(); + FOpen := False; + end; + + if not FOpen then begin + FReadOnly := False; + FOpen := FData.OpenKey(FKey, True); + end; + + Result := FOpen; +end; + + +{==================== TX2RegistrySettings + Read +========================================} +function TX2RegistrySettings.ReadBool; +begin + if OpenRead() then + try + Result := FData.ReadBool(AName) + except + Result := ADefault; + end; +end; + +function TX2RegistrySettings.ReadFloat; +begin + if OpenRead() then + try + Result := FData.ReadFloat(AName) + except + Result := ADefault; + end; +end; + +function TX2RegistrySettings.ReadInteger; +begin + if OpenRead() then + try + Result := FData.ReadInteger(AName) + except + Result := ADefault; + end; +end; + +function TX2RegistrySettings.ReadString; +begin + if OpenRead() then + try + Result := FData.ReadString(AName) + except + Result := ADefault; + end; +end; + + +{==================== TX2RegistrySettings + Write +========================================} +procedure TX2RegistrySettings.WriteBool; +begin + if OpenWrite() then + FData.WriteBool(AName, AValue); +end; + +procedure TX2RegistrySettings.WriteFloat; +begin + if OpenWrite() then + FData.WriteFloat(AName, AValue); +end; + +procedure TX2RegistrySettings.WriteInteger; +begin + if OpenWrite() then + FData.WriteInteger(AName, AValue); +end; + +procedure TX2RegistrySettings.WriteString; +begin + if OpenWrite() then + FData.WriteString(AName, AValue); +end; + + +{==================== TX2RegistrySettings + Enumeration +========================================} +procedure TX2RegistrySettings.GetSectionNames; +begin + if OpenRead() then + FData.GetKeyNames(ADest); +end; + +procedure TX2RegistrySettings.GetValueNames; +begin + if OpenRead() then + FData.GetValueNames(ADest); +end; + + +{==================== TX2RegistrySettings + Delete +========================================} +procedure TX2RegistrySettings.DeleteSection; +begin + // On Delphi 6 at least DeleteKey recursively calls itself for subkeys, + // eliminating issues with WinNT based systems. Might need to verify + // for Delphi 5 or lower if it's ever used. + FData.CloseKey(); + FData.DeleteKey(FKey); + FOpen := False; +end; + +procedure TX2RegistrySettings.DeleteValue; +begin + if OpenRead() then + if FData.ValueExists(AName) then + FData.DeleteValue(AName); +end; + +end.