388 lines
13 KiB
ObjectPascal
388 lines
13 KiB
ObjectPascal
{
|
|
:: X2UtSettings provides a generic access mechanism for application settings.
|
|
:: Include one of the extensions (X2UtSettingsINI, X2UtSettingsRegistry) for
|
|
:: an implementation.
|
|
::
|
|
:: Last changed: $Date$
|
|
:: Revision: $Rev$
|
|
:: Author: $Author$
|
|
}
|
|
unit X2UtSettings;
|
|
|
|
interface
|
|
uses
|
|
Classes,
|
|
SysUtils,
|
|
Variants,
|
|
X2UtHashes;
|
|
|
|
type
|
|
//:$ Raised when an unregistered setting is requested without providing a
|
|
//:$ default value.
|
|
EX2SettingsUndefined = class(Exception);
|
|
|
|
//:$ Raised when trying to read a registered setting as a different type than
|
|
//:$ it was registered with.
|
|
EX2SettingsType = class(Exception);
|
|
|
|
//:$ Raised when the specified range is invalid.
|
|
EX2SettingsRange = class(Exception);
|
|
|
|
//:$ Raised when the specified define already exists
|
|
EX2SettingsExists = class(Exception);
|
|
|
|
//:$ Callback method for defines
|
|
TX2SettingsCallback = procedure(const ASection, AName: String;
|
|
var AValue: Variant) of object;
|
|
|
|
{
|
|
:$ Internal representation of a persistent setting
|
|
}
|
|
TX2SettingsRanges = array of array[0..1] of Variant;
|
|
|
|
TX2SettingsDefine = class(TObject)
|
|
private
|
|
FCallback: TX2SettingsCallback;
|
|
FRanges: TX2SettingsRanges;
|
|
FValue: Variant;
|
|
public
|
|
constructor Create(const AValue: Variant;
|
|
const ARanges: array of const;
|
|
const ACallback: TX2SettingsCallback);
|
|
|
|
property Callback: TX2SettingsCallback read FCallback;
|
|
property Ranges: TX2SettingsRanges read FRanges;
|
|
property Value: Variant read FValue;
|
|
end;
|
|
|
|
|
|
// Forward declaration
|
|
TX2SettingsFactory = class;
|
|
|
|
{
|
|
:$ Abstract settings object.
|
|
|
|
:: Provides access to the settings regardless of the storage backend.
|
|
}
|
|
TX2Settings = class(TObject)
|
|
private
|
|
FFactory: TX2SettingsFactory;
|
|
FSection: String;
|
|
protected
|
|
function InternalReadBool(const AName: String; out AValue: Boolean): Boolean; virtual; abstract;
|
|
function InternalReadFloat(const AName: String; out AValue: Double): Boolean; virtual; abstract;
|
|
function InternalReadInteger(const AName: String; out AValue: Integer): Boolean; virtual; abstract;
|
|
function InternalReadString(const AName: String; out AValue: String): Boolean; virtual; abstract;
|
|
|
|
property Factory: TX2SettingsFactory read FFactory;
|
|
property Section: String read FSection;
|
|
public
|
|
constructor Create(const AFactory: TX2SettingsFactory;
|
|
const ASection: String); virtual;
|
|
|
|
//:$ Reads a boolean value from the settings.
|
|
//:: If the ADefault parameter is used, that value will be returned if the
|
|
//:: setting could not be found. Otherwise the setting must have been
|
|
//:: registered with the factory's Register() method.
|
|
function ReadBool(const AName: String): Boolean; overload; virtual;
|
|
function ReadBool(const AName: String; const ADefault: Boolean): Boolean; overload; virtual;
|
|
|
|
//:$ Reads a floating point value from the settings.
|
|
//:: If the ADefault parameter is used, that value will be returned if the
|
|
//:: setting could not be found. Otherwise the setting must have been
|
|
//:: registered with the factory's Register() method.
|
|
function ReadFloat(const AName: String): Double; overload; virtual;
|
|
function ReadFloat(const AName: String; const ADefault: Double): Double; overload; virtual;
|
|
|
|
//:$ Reads an integer value from the settings.
|
|
//:: If the ADefault parameter is used, that value will be returned if the
|
|
//:: setting could not be found. Otherwise the setting must have been
|
|
//:: registered with the factory's Register() method.
|
|
function ReadInteger(const AName: String): Integer; overload; virtual;
|
|
function ReadInteger(const AName: String; const ADefault: Integer): Integer; overload; virtual;
|
|
|
|
//:$ Reads a string value from the settings.
|
|
//:: If the ADefault parameter is used, that value will be returned if the
|
|
//:: setting could not be found. Otherwise the setting must have been
|
|
//:: registered with the factory's Register() method.
|
|
function ReadString(const AName: String): String; overload; virtual;
|
|
function ReadString(const AName, ADefault: String): String; overload; virtual;
|
|
|
|
//:$ Writes a boolean value to the settings.
|
|
procedure WriteBool(const AName: String; AValue: Boolean); virtual; abstract;
|
|
|
|
//:$ Writes a floating point value to the settings.
|
|
procedure WriteFloat(const AName: String; AValue: Double); virtual; abstract;
|
|
|
|
//:$ Writes an integer value to the settings.
|
|
procedure WriteInteger(const AName: String; AValue: Integer); virtual; abstract;
|
|
|
|
//:$ Writes a string value to the settings.
|
|
procedure WriteString(const AName, AValue: String); virtual; abstract;
|
|
|
|
//:$ Checks if the specified setting exists.
|
|
function ValueExists(const AName: String): Boolean; virtual; abstract;
|
|
|
|
//:$ Retrieves the list of sub-sections for this section.
|
|
procedure GetSectionNames(const ADest: TStrings); virtual; abstract;
|
|
|
|
//:$ Retrieves the list of values for this section.
|
|
procedure GetValueNames(const ADest: TStrings); virtual; abstract;
|
|
|
|
//:$ Deletes this section.
|
|
procedure DeleteSection(); virtual; abstract;
|
|
|
|
//:$ Deletes the specified value.
|
|
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)
|
|
private
|
|
FDefines: TX2ObjectHash;
|
|
protected
|
|
function GetSection(const ASection: String): TX2Settings; virtual; abstract;
|
|
public
|
|
constructor Create();
|
|
destructor Destroy(); override;
|
|
|
|
//:$ Loads 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;
|
|
|
|
//:$ Defines a persistent setting
|
|
//:: Persistent settings are a way for the application to register it's
|
|
//:: configuration settings on startup with a default value and a range.
|
|
//:: When reading a setting it will be checked against the specified range
|
|
//:: (if supplied), or if not found, the registered default value will be
|
|
//:: returned. This allows the setting to be read in many places without
|
|
//:: having to do all the checks every time. In addition you may provide
|
|
//:: a callback method to handle more advanced checks.
|
|
//:: /n/n
|
|
//:: Ranges must be specified as an array where each pair of values
|
|
//:: specifies the minimum and maximum value of that range. The type
|
|
//:: of the values in the ranges must be the same as the type of the
|
|
//:: value, and is used later on for type checking. The only exception
|
|
//:: to this rule is that you are allowed to specify integer ranges for
|
|
//:: a floating value.
|
|
procedure Define(const ASection, AName: String; const AValue: Variant;
|
|
const ARanges: array of const;
|
|
const ACallback: TX2SettingsCallback = nil);
|
|
end;
|
|
|
|
|
|
implementation
|
|
resourcestring
|
|
RSInvalidRange = 'Invalid range!';
|
|
RSInvalidType = 'Invalid type!';
|
|
RSUndefined = 'Undefined setting: %s!';
|
|
RSDefineExists = 'Define already exists!';
|
|
|
|
|
|
{============================ TX2Settings
|
|
Initialization
|
|
========================================}
|
|
constructor TX2Settings.Create;
|
|
begin
|
|
inherited Create();
|
|
|
|
FFactory := AFactory;
|
|
FSection := ASection;
|
|
end;
|
|
|
|
|
|
{============================ TX2Settings
|
|
Read
|
|
========================================}
|
|
function TX2Settings.ReadBool(const AName: String): Boolean;
|
|
begin
|
|
if not InternalReadBool(AName, Result) then
|
|
raise EX2SettingsUndefined.CreateFmt(RSUndefined, [AName]);
|
|
end;
|
|
|
|
function TX2Settings.ReadBool(const AName: String;
|
|
const ADefault: Boolean): Boolean;
|
|
begin
|
|
if not InternalReadBool(AName, Result) then
|
|
Result := ADefault;
|
|
end;
|
|
|
|
function TX2Settings.ReadFloat(const AName: String): Double;
|
|
begin
|
|
if not InternalReadFloat(AName, Result) then
|
|
raise EX2SettingsUndefined.CreateFmt(RSUndefined, [AName]);
|
|
end;
|
|
|
|
function TX2Settings.ReadFloat(const AName: String;
|
|
const ADefault: Double): Double;
|
|
begin
|
|
if not InternalReadFloat(AName, Result) then
|
|
Result := ADefault;
|
|
end;
|
|
|
|
function TX2Settings.ReadInteger(const AName: String): Integer;
|
|
begin
|
|
if not InternalReadInteger(AName, Result) then
|
|
raise EX2SettingsUndefined.CreateFmt(RSUndefined, [AName]);
|
|
end;
|
|
|
|
function TX2Settings.ReadInteger(const AName: String;
|
|
const ADefault: Integer): Integer;
|
|
begin
|
|
if not InternalReadInteger(AName, Result) then
|
|
Result := ADefault;
|
|
end;
|
|
|
|
function TX2Settings.ReadString(const AName: String): String;
|
|
begin
|
|
if not InternalReadString(AName, Result) then
|
|
raise EX2SettingsUndefined.CreateFmt(RSUndefined, [AName]);
|
|
end;
|
|
|
|
function TX2Settings.ReadString(const AName, ADefault: String): String;
|
|
begin
|
|
if not InternalReadString(AName, Result) then
|
|
Result := ADefault;
|
|
end;
|
|
|
|
|
|
{===================== TX2SettingsFactory
|
|
Defines
|
|
========================================}
|
|
constructor TX2SettingsFactory.Create;
|
|
begin
|
|
inherited;
|
|
|
|
FDefines := TX2ObjectHash.Create();
|
|
end;
|
|
|
|
destructor TX2SettingsFactory.Destroy;
|
|
begin
|
|
FreeAndNil(FDefines);
|
|
|
|
inherited;
|
|
end;
|
|
|
|
|
|
procedure TX2SettingsFactory.Define;
|
|
function CheckVarType(const AValue: Variant): TVarType;
|
|
begin
|
|
case VarType(AValue) of
|
|
varBoolean: break;
|
|
varByte,
|
|
varSmallint,
|
|
varInteger,
|
|
varWord,
|
|
varLongWord: Result := varInteger;
|
|
varSingle,
|
|
varDouble,
|
|
varDate: Result := varDouble;
|
|
varOleStr,
|
|
varStrArg,
|
|
varString: Result := varString;
|
|
else
|
|
raise EX2SettingsType.Create(RSInvalidType);
|
|
end;
|
|
end;
|
|
|
|
var
|
|
iIndex: Integer;
|
|
sHash: String;
|
|
vtValue: TVarType;
|
|
|
|
begin
|
|
sHash := ASection + #0 + AName;
|
|
if FDefines.Exists(sHash) then
|
|
raise EX2SettingsExists.Create(RSDefineExists);
|
|
|
|
// Validate type
|
|
vtValue := CheckVarType(AValue);
|
|
|
|
// Validate ranges
|
|
if High(ARanges) mod 2 <> 0 then
|
|
raise EX2SettingsRange.Create(RSInvalidRange);
|
|
|
|
for iIndex := 0 to High(ARanges) do
|
|
case ARanges[iIndex].VType of
|
|
vtBoolean:
|
|
if vtValue <> varBoolean then
|
|
raise EX2SettingsType.Create(RSInvalidType);
|
|
vtInteger:
|
|
if not (vtValue in [varInteger, varDouble]) then
|
|
raise EX2SettingsType.Create(RSInvalidType);
|
|
vtExtended:
|
|
if vtValue <> varDouble then
|
|
raise EX2SettingsType.Create(RSInvalidType);
|
|
vtString,
|
|
vtPChar,
|
|
vtChar,
|
|
vtWideChar,
|
|
vtPWideChar,
|
|
vtWideString,
|
|
vtAnsiString:
|
|
if vtValue <> varString then
|
|
raise EX2SettingsType.Create(RSInvalidType);
|
|
vtVariant:
|
|
if vtValue <> CheckVarType(ARanges[iIndex].VVariant^) then
|
|
raise EX2SettingsType.Create(RSInvalidType);
|
|
end;
|
|
|
|
FDefines[sHash] := TX2SettingsDefine.Create(VarAsType(AValue, vtValue),
|
|
ARanges, ACallback);
|
|
end;
|
|
|
|
|
|
{====================== TX2SettingsDefine
|
|
Initialization
|
|
========================================}
|
|
constructor TX2SettingsDefine.Create;
|
|
function VarRecToVariant(const AVarRec: TVarRec): Variant;
|
|
begin
|
|
case AVarRec.VType of
|
|
vtBoolean: Result := AVarRec.VBoolean;
|
|
vtInteger: Result := AVarRec.VInteger;
|
|
vtExtended: Result := VarAsType(AVarRec.VExtended^, varDouble);
|
|
vtString: Result := AVarRec.VString^;
|
|
vtPChar: Result := String(AVarRec.VPChar);
|
|
vtPWideChar: Result := String(AVarRec.VPWideChar^);
|
|
vtWideChar: Result := String(AVarRec.VWideChar);
|
|
vtWideString: Result := String(AVarRec.VWideString^);
|
|
vtAnsiString: Result := String(AVarRec.VAnsiString^);
|
|
vtVariant: Result := AVarRec.VVariant^;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
iCount: Integer;
|
|
iIndex: Integer;
|
|
iRange: Integer;
|
|
|
|
begin
|
|
FValue := AValue;
|
|
FCallback := ACallback;
|
|
|
|
// Copy ranges
|
|
iCount := (High(ARanges) + 1) div 2;
|
|
iIndex := 0;
|
|
|
|
SetLength(FRanges, iCount);
|
|
|
|
for iRange := 0 to iCount - 1 do
|
|
begin
|
|
FRanges[iRange][0] := VarRecToVariant(ARanges[iIndex]);
|
|
FRanges[iRange][1] := VarRecToVariant(ARanges[iIndex + 1]);
|
|
|
|
Inc(iIndex, 2);
|
|
end;
|
|
end;
|
|
|
|
end.
|