Mega Code Archive
DISConfigEx an Alternative to ini file
<![CDATA[
Title: DISConfigEx an Alternative to ini file
Question: An easy alternative to the ini file, file are defined like the following
var0 := 1.00;
var1 := 1;
var2 := true;
// string
var3 := hello world;
// multiline string
var4 := hello\nworld;
Easy variable declaring, use of comments, can be used as a file, registry, stream ...
Anyhow enjoy
Answer:
unit DISConfigEx;
interface
uses
Windows, Messages, SysUtils, Classes, Registry
{$IFNDEF VER130},Variants{$ENDIF};
type
TDISCustomConfigOption = (coAutoStripComments, coAutoStripBlanks, coAutoCreateVars,
coAutoRemoveDeletedRegistryEntries,
coReadOnly, coDisableDelete, coDisableEdit, coDisableInsert);
TDISCustomConfigOptions = set of TDISCustomConfigOption;
TDISLoadMode = (lmUnknown, lmFile, lmRegistry);
TDISRootKey = (HKeyClassesRoot, HKeyCurrentUser, HKeyLocalMachine, HKeyUsers,
HKeyPerformanceData, HKeyCurrentConfig, HKeyDynData);
TDISCustomConfigEx = class(TComponent)
private
{ Private declarations }
fLoadMode : TDISLoadMode;
fOptions : TDISCustomConfigOptions;
fModified : Boolean;
fVariableList : TStringList;
fDeletedRegValues : TStringList;
fOnLoadError : TNotifyEvent;
fOnSaveError : TNotifyEvent;
function GetVariable(Variable: string ): Variant;
procedure SetVariable(Variable: string; const Value: Variant);
procedure CleanUpConfigFile;
function SetVariableLine(Variable: string; const Value: Variant): string;
procedure SetOptions(const Value: TDISCustomConfigOptions);
protected
{ Protected declarations }
property Options: TDISCustomConfigOptions read fOptions write SetOptions;
property OnLoadError : TNotifyEvent read fOnLoadError write fOnLoadError;
property OnSaveError : TNotifyEvent read fOnSaveError write fOnSaveError;
public
{ Public declarations }
constructor Create ( AOwner : TComponent); override;
destructor Destroy; override;
procedure LoadFromFile ( const Filename : string );
procedure LoadFromStream ( AStream : TStream );
procedure SaveToFile ( const Filename : string );
procedure SaveToStream ( AStream : TStream );
procedure LoadFromRegistry ( RootKey : TDISRootKey; Key : String; ComputerName : String = '' );
procedure SaveToRegistry ( RootKey : TDISRootKey; Key : String; ComputerName : String = '' );
procedure DeleteRegistryKey ( RootKey : TDISRootKey; Key : String; ComputerName : String = '' );
function HasRegistryKey ( RootKey : TDISRootKey; Key : String; ComputerName : String = '' ) : boolean;
procedure Clear;
function HasVariable ( Variable : string ) : boolean;
procedure DeleteVariable ( Variable : string );
function Count : integer;
function VariableCount : integer;
property Modified : boolean read fModified;
property LoadMode : TDISLoadMode read fLoadMode;
property Lines : TStringList read fVariableList;
property Variable[ Variable : string ]: Variant read GetVariable write SetVariable;
published
{ Published declarations }
end;
TDISConfigEx = class(TDISCustomConfigEx)
published
property Options;
property OnLoadError;
property OnSaveError;
end;
implementation
var DISRootKeys : array[TDISRootKey] of HKey =
(HKEY_CLASSES_ROOT,HKEY_CURRENT_USER,HKEY_LOCAL_MACHINE,
HKEY_USERS,HKEY_PERFORMANCE_DATA,HKEY_CURRENT_CONFIG,HKEY_DYN_DATA);
//////////////////////////////////////////////////////////////////////////
// Procedure - ReplaceSubSet
// Author - RB
// Date - 07-Apr-2003
//////////////////////////////////////////////////////////////////////////
function ReplaceSubSet ( Value, Value1, Value2 : String ) : String;
var Ts : String;
i : integer;
begin
Ts := Value;
if pos(AnsiUpperCase(Value1),AnsiUpperCase(Ts)) begin
Result := Value;
exit;
end;
i := pos(AnsiUpperCase(Value1),AnsiUpperCase(Ts));
Delete(Ts,i,length(Value1));
Insert(Value2,Ts,i);
Result := Ts;
end;
{ TDISConfigEx }
{-----------------------------------------------------------------------------
Procedure: TDISCustomConfigEx.Create
Author: ronald
Date: 11-Jul-2002
-----------------------------------------------------------------------------}
constructor TDISCustomConfigEx.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
fVariableList := TStringList.Create;
fDeletedRegValues := TStringList.Create;
fLoadMode := lmUnknown;
fModified := False;
fOptions := [coAutoCreateVars,coAutoRemoveDeletedRegistryEntries];
end;
{-----------------------------------------------------------------------------
Procedure: TDISCustomConfigEx.Destroy
Author: ronald
Date: 11-Jul-2002
-----------------------------------------------------------------------------}
destructor TDISCustomConfigEx.Destroy;
begin
if assigned(fVariableList) then
begin
fVariableList.Clear;
fVariableList.Free;
end;
if assigned(fDeletedRegValues) then
begin
fDeletedRegValues.Clear;
fDeletedRegValues.Free;
end;
inherited;
end;
{-----------------------------------------------------------------------------
Procedure: TDISCustomConfigEx.VariableCount
Author: ronald
Date: 12-Jul-2002
-----------------------------------------------------------------------------}
function TDISCustomConfigEx.VariableCount: integer;
var i : integer;
Ts : String;
begin
Result := 0;
i := 0;
while i begin
Ts := fVariableList[i];
if pos(':=',Ts) 0 then
begin
inc(Result);
end;
inc(i);
end;
end;
{-----------------------------------------------------------------------------
Procedure: TDISCustomConfigEx.HasVariable
Author: ronald
Date: 11-Jul-2002
-----------------------------------------------------------------------------}
function TDISCustomConfigEx.HasVariable(Variable: string): boolean;
var i : integer;
Ts : String;
fVariable : String;
begin
Result := False;
i := 0;
while i begin
Ts := fVariableList[i];
fVariable := '';
if pos(':=',Ts) 0 then
begin
fVariable := Trim(copy(Ts,1,pos(':=',Ts)-1));
end;
if ansisametext(Variable,fVariable) then
begin
Result := True;
break;
end
else
inc(i);
end;
end;
{-----------------------------------------------------------------------------
Procedure: TDISCustomConfigEx.DeleteVariable
Author: ronald
Date: 12-Jul-2002
-----------------------------------------------------------------------------}
procedure TDISCustomConfigEx.DeleteVariable(Variable: string);
var i : integer;
Ts : String;
fVariable : String;
begin
if (coDisableDelete in fOptions) then
exit;
i := 0;
while i begin
Ts := fVariableList[i];
fVariable := '';
if pos(':=',Ts) 0 then
begin
fVariable := Trim(copy(Ts,1,pos(':=',Ts)-1));
end;
if ansisametext(Variable,fVariable) then
begin
fVariableList.Delete(i);
if FLoadMode = lmRegistry then
begin
if fDeletedRegValues.IndexOf(Variable) = -1 then
fDeletedRegValues.Add(Variable);
end;
fModified := True;
break;
end
else
inc(i);
end;
end;
{-----------------------------------------------------------------------------
Procedure: TDISCustomConfigEx.GetVariable
Author: ronald
Date: 11-Jul-2002
-----------------------------------------------------------------------------}
function TDISCustomConfigEx.GetVariable(Variable: string): Variant;
var i : integer;
Ts : String;
fVariable : String;
fValue : String;
begin
Result := VarEmpty;
i := 0;
while i begin
Ts := fVariableList[i];
fVariable := '';
if pos(':=',Ts) 0 then
begin
fVariable := Trim(copy(Ts,1,pos(':=',Ts)-1));
System.Delete(Ts,1,pos(':=',Ts)+1);
Ts := Trim(Ts);
if pos(';',Ts) 0 then
Ts := copy(Ts,1,pos(';',Ts)-1);
while pos('\n',Ts) 0 do
Ts := ReplaceSubSet(Ts,'\n',#13#10);
end;
fValue := Ts;
if ansisametext(Variable,fVariable) then
begin
Result := fValue;
break;
end
else
inc(i);
end;
end;
{-----------------------------------------------------------------------------
Procedure: TDISCustomConfigEx.SetVariableLine
Author: ronald
Date: 11-Jul-2002
-----------------------------------------------------------------------------}
function TDISCustomConfigEx.SetVariableLine ( Variable : string; const Value : Variant ) : string;
var Ts : String;
begin
case VarType(Value) of
varDate : Result := Format('%s := %f;',[Variable,VarToDateTime(Value)]);
else
Ts := VarToStr(Value);
while pos(#13#10,Ts) 0 do
Ts := ReplaceSubSet(Ts,#13#10,'\n');
Result := Format('%s := %s;',[Variable,VarToStr(Value)]);
end;
end;
{-----------------------------------------------------------------------------
Procedure: TDISCustomConfigEx.SetVariable
Author: ronald
Date: 11-Jul-2002
When the variable does not exist it will be created.
-----------------------------------------------------------------------------}
procedure TDISCustomConfigEx.SetVariable(Variable: string; const Value: Variant);
var i : integer;
Ts : String;
fVariable : String;
Found : Boolean;
begin
i := 0;
Found := False;
while i begin
Ts := fVariableList[i];
fVariable := '';
if pos(':=',Ts) 0 then
begin
fVariable := Trim(copy(Ts,1,pos(':=',Ts)-1));
end;
if ansisametext(Variable,fVariable) then
begin
if not (coDisableEdit in fOptions) then
begin
Ts := SetVariableLine ( fVariable, Value );
fVariableList[i] := Ts;
fModified := True;
end;
Found := True;
break;
end
else
inc(i);
end;
if not Found then
begin
if not (coDisableInsert in fOptions) and (coAutoCreateVars in fOptions) then
begin
Ts := SetVariableLine ( Variable, Value );
fVariableList.Add(Ts);
fModified := True;
end;
end;
end;
{-----------------------------------------------------------------------------
Procedure: TDISCustomConfigEx.CleanUpConfigFile
Author: ronald
Date: 11-Jul-2002
-----------------------------------------------------------------------------}
procedure TDISCustomConfigEx.CleanUpConfigFile;
var i : integer;
begin
i := 0;
while i begin
fVariableList[i] := Trim(fVariableList[i]);
if (copy(fVariableList[i],1,2) = '//') and (coAutoStripComments in fOptions) then
fVariableList.Delete(i)
else if (fVariableList[i] = '') and (coAutoStripBlanks in fOptions) then
fVariableList.Delete(i)
else
inc(i);
end;
end;
{-----------------------------------------------------------------------------
Procedure: TDISCustomConfigEx.LoadFromFile
Author: ronald
Date: 11-Jul-2002
-----------------------------------------------------------------------------}
procedure TDISCustomConfigEx.LoadFromFile(const Filename: string);
begin
if FileExists(FileName) then
begin
fModified := False;
fVariableList.Clear;
try
fVariableList.LoadFromFile(FileName);
fLoadMode := lmFile;
except
if assigned(fOnLoadError) then
fOnLoadError(Self);
end;
CleanUpConfigFile;
end
else
begin
if assigned(fOnLoadError) then
fOnLoadError(Self);
end;
end;
//////////////////////////////////////////////////////////////////////////
// Procedure - TDISCustomConfigEx.LoadFromStream
// Author - RB
// Date - 16-Oct-2003
//////////////////////////////////////////////////////////////////////////
procedure TDISCustomConfigEx.LoadFromStream(AStream: TStream);
begin
try
fVariableList.LoadFromStream(AStream);
except
if assigned(fOnLoadError) then
fOnLoadError(Self);
end;
end;
//////////////////////////////////////////////////////////////////////////
// Procedure - TDISCustomConfigEx.SaveToStream
// Author - RB
// Date - 16-Oct-2003
//////////////////////////////////////////////////////////////////////////
procedure TDISCustomConfigEx.SaveToStream(AStream: TStream);
begin
try
fVariableList.SaveToStream(AStream);
except
if assigned(fOnSaveError) then
fOnSaveError(Self);
end;
end;
{-----------------------------------------------------------------------------
Procedure: TDISCustomConfigEx.SaveToFile
Author: ronald
Date: 11-Jul-2002
-----------------------------------------------------------------------------}
procedure TDISCustomConfigEx.SaveToFile(const Filename: string);
begin
if (coReadOnly in fOptions) then
exit;
try
fVariableList.SaveToFile(FileName);
except
if assigned(fOnSaveError) then
fOnSaveError(Self);
end;
end;
{-----------------------------------------------------------------------------
Procedure: TDISCustomConfigEx.Clear
Author: ronald
Date: 12-Jul-2002
-----------------------------------------------------------------------------}
procedure TDISCustomConfigEx.Clear;
begin
fVariableList.Clear;
fModified := False;
end;
{-----------------------------------------------------------------------------
Procedure: TDISCustomConfigEx.SetOptions
Author: ronald
Date: 12-Jul-2002
-----------------------------------------------------------------------------}
procedure TDISCustomConfigEx.SetOptions( const Value: TDISCustomConfigOptions);
begin
fOptions := Value;
end;
{-----------------------------------------------------------------------------
Procedure: TDISCustomConfigEx.Count
Author: ronald
Date: 12-Jul-2002
-----------------------------------------------------------------------------}
function TDISCustomConfigEx.Count: integer;
begin
Result := fVariableList.Count;
end;
//////////////////////////////////////////////////////////////////////////
// Procedure - TDISCustomConfigEx.LoadFromRegistry
// Author - RB
// Date - 07-Apr-2003
//////////////////////////////////////////////////////////////////////////
procedure TDISCustomConfigEx.LoadFromRegistry(RootKey: TDISRootKey; Key: String; ComputerName : String = '');
var Reg : TRegistry;
Tl : TStringList;
i,size : integer;
Ts : String;
CV,Ok : Boolean;
begin
fModified := False;
fVariableList.Clear;
fDeletedRegValues.Clear;
Tl := TStringList.Create;
Reg := TRegistry.Create;
Reg.RootKey := DISRootKeys[RootKey];
Ok := True;
if Trim(ComputerName) '' then
begin
Ok := False;
if Reg.RegistryConnect(ComputerName) then
Ok := True
else
begin
if assigned(fOnLoadError) then
fOnLoadError(Self);
end;
end;
if Ok then
begin
if Reg.OpenKeyReadOnly(key) then
begin
fLoadMode := lmRegistry;
Reg.getValueNames(Tl);
for i := 0 to Tl.Count - 1 do
begin
Ts := '';
CV := False;
case Reg.GetDataType(Tl[i]) of
rdUnknown,rdExpandString,rdBinary : ;
rdString :
begin
Ts := Reg.ReadString(Tl[i]);
CV := True;
end;
rdInteger :
begin
Ts := IntToStr(Reg.ReadInteger(Tl[i]));
CV := True;
end;
end;
if CV then
fVariableList.Add(format('%s := %s;',[Tl[i],Ts]));
end;
end
else
begin
if assigned(fOnLoadError) then
fOnLoadError(Self);
end;
end;
Reg.Free;
Tl.Free;
end;
//////////////////////////////////////////////////////////////////////////
// Procedure - TDISCustomConfigEx.SaveToRegistry
// Author - RB
// Date - 07-Apr-2003
//////////////////////////////////////////////////////////////////////////
procedure TDISCustomConfigEx.SaveToRegistry(RootKey: TDISRootKey; Key: String; ComputerName : String = '');
var Reg : TRegistry;
i : integer;
fVariable,Ts : String;
Ok : Boolean;
begin
Reg := TRegistry.Create;
Reg.RootKey := DISRootKeys[RootKey];
Ok := True;
if Trim(ComputerName) '' then
begin
Ok := False;
if Reg.RegistryConnect(ComputerName) then
Ok := True
else
begin
if assigned(fOnSaveError) then
fOnLoadError(Self);
end;
end;
if Ok then
begin
if Reg.OpenKey(key,true) then
begin
if (coAutoRemoveDeletedRegistryEntries in fOptions) then
begin
for i := 0 to fDeletedRegValues.Count - 1 do
Reg.DeleteValue(fDeletedRegValues[i]);
end;
i := 0;
while i begin
Ts := fVariableList[i];
fVariable := '';
if pos(':=',Ts) 0 then
begin
fVariable := Trim(copy(Ts,1,pos(':=',Ts)-1));
System.Delete(Ts,1,pos(':=',Ts)+1);
Ts := Trim(Ts);
if pos(';',Ts) 0 then
Ts := copy(Ts,1,pos(';',Ts)-1);
Ts := Trim(Ts);
try
Reg.WriteString(fVariable,Ts);
except
if assigned(fOnSaveError) then
begin
fOnSaveError(Self);
break;
end;
end;
end;
inc(i);
end;
end
else
begin
if assigned(fOnSaveError) then
fOnSaveError(Self);
end;
end;
Reg.Free;
end;
//////////////////////////////////////////////////////////////////////////
// Procedure - TDISCustomConfigEx.DeleteRegistryKey
// Author - RB
// Date - 07-Apr-2003
//////////////////////////////////////////////////////////////////////////
procedure TDISCustomConfigEx.DeleteRegistryKey(RootKey: TDISRootKey; Key: String; ComputerName : String = '');
var Reg : TRegistry;
Ok : Boolean;
begin
Reg := TRegistry.Create;
Reg.RootKey := DISRootKeys[RootKey];
Ok := True;
if Trim(ComputerName) '' then
begin
Ok := False;
if Reg.RegistryConnect(ComputerName) then
Ok := True
end;
if Ok then
begin
try
Reg.deletekey(key);
except
end;
end;
Reg.Free;
end;
//////////////////////////////////////////////////////////////////////////
// Procedure - TDISCustomConfigEx.HasRegistryKey
// Author - RB
// Date - 07-Apr-2003
//////////////////////////////////////////////////////////////////////////
function TDISCustomConfigEx.HasRegistryKey(RootKey: TDISRootKey; Key: String; ComputerName : String = '') : boolean;
var Reg : TRegistry;
Ok : Boolean;
begin
Result := False;
Reg := TRegistry.Create;
Reg.RootKey := DISRootKeys[RootKey];
Ok := True;
if Trim(ComputerName) '' then
begin
Ok := False;
if Reg.RegistryConnect(ComputerName) then
Ok := True
end;
if Ok then
begin
try
Result := Reg.KeyExists(Key);
except
end;
end;
Reg.Free;
end;
end.
]]>