paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-08 05:07:30 +01:00
Code Issues Packages Projects Releases Wiki Activity

* Make TRegIniFile Delphi compatible.

Browse Source 
* Fix completely broken TRegistryIniFile.
+ Tests.

git-svn-id: trunk@22654 -
This commit is contained in:
yury 2012-10-15 12:43:14 +00:00
parent 9a3225f1af
commit 25602c7cbd
4 changed files with 227 additions and 321 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

87
packages/fcl-registry/src/regini.inc
View File

@ -5,57 +5,50 @@
constructor TRegIniFile.Create(const FN: String); constructor TRegIniFile.Create(const FN: String);
begin begin
inherited Create; Create(FN, KEY_ALL_ACCESS);
fFileName := FN;
if fFileName<>'' then
fPath := fFileName + '\'
else
fPath := '';
end; end;
constructor TRegIniFile.Create(const FN: String;aaccess:longword); constructor TRegIniFile.Create(const FN: String;aaccess:longword);
begin begin
inherited Create(aaccess); inherited Create(aaccess);
fFileName := FN; fFileName := FN;
if fFileName<>'' then if fFileName<>'' then begin
fPath := fFileName + '\' fPath := fFileName + '\';
OpenKey(fFileName, aaccess <> KEY_READ);
end
else else
fPath := ''; fPath := '';
fPreferStringValues:=True; // Delphi compatibility
end; end;
procedure TRegIniFile.DeleteKey(const Section, Ident: String); procedure TRegIniFile.DeleteKey(const Section, Ident: String);
begin begin
if not OpenKey(fPath+Section,true) then Exit; if OpenSection(Section) then
try try
DeleteValue(Ident); DeleteValue(Ident);
finally finally
CloseKey; CloseSection;
end; end;
end; end;
procedure TRegIniFile.EraseSection(const Section: string); procedure TRegIniFile.EraseSection(const Section: string);
begin begin
inherited DeleteKey(fPath+Section); inherited DeleteKey(Section);
end; end;
procedure TRegIniFile.ReadSection(const Section: string; Strings: TStrings); procedure TRegIniFile.ReadSection(const Section: string; Strings: TStrings);
begin begin
if not OpenKey(fPath+Section,false) then Exit; if OpenSection(Section) then
try try
GetValueNames(Strings); GetValueNames(Strings);
finally finally
CloseKey; CloseSection;
end; end;
end; end;
procedure TRegIniFile.ReadSections(Strings: TStrings); procedure TRegIniFile.ReadSections(Strings: TStrings);
begin begin
if not OpenKey(fFileName,false) then Exit;
try
GetKeyNames(Strings); GetKeyNames(Strings);
finally
CloseKey;
end;
end; end;
procedure TRegIniFile.ReadSectionValues(const Section: string; Strings: TStrings); procedure TRegIniFile.ReadSectionValues(const Section: string; Strings: TStrings);
@ -64,7 +57,8 @@ var
V : String; V : String;
i : Integer; i : Integer;
begin begin
if not OpenKey(fPath+Section,false) then Exit; if OpenSection(Section) then
try
ValList := TStringList.Create; ValList := TStringList.Create;
try try
GetValueNames(ValList); GetValueNames(ValList);
@ -75,13 +69,15 @@ begin
end; end;
finally finally
ValList.Free; ValList.Free;
CloseKey; end;
finally
CloseSection;
end; end;
end; end;
procedure TRegIniFile.WriteBool(const Section, Ident: string; Value: Boolean); procedure TRegIniFile.WriteBool(const Section, Ident: string; Value: Boolean);
begin begin
if not OpenKey(fPath+Section,true) then Exit; if OpenSection(Section) then
try try
if not fPreferStringValues then if not fPreferStringValues then
inherited WriteBool(Ident,Value) inherited WriteBool(Ident,Value)
@ -92,13 +88,13 @@ begin
inherited WriteString(Ident,BoolToStr(Value)); inherited WriteString(Ident,BoolToStr(Value));
end; end;
finally finally
CloseKey; CloseSection;
end; end;
end; end;
procedure TRegIniFile.WriteInteger(const Section, Ident: string; Value: LongInt); procedure TRegIniFile.WriteInteger(const Section, Ident: string; Value: LongInt);
begin begin
if not OpenKey(fPath+Section,true) then Exit; if OpenSection(Section) then
try try
if not fPreferStringValues then if not fPreferStringValues then
inherited WriteInteger(Ident,Value) inherited WriteInteger(Ident,Value)
@ -109,24 +105,24 @@ begin
inherited WriteString(Ident,IntToStr(Value)); inherited WriteString(Ident,IntToStr(Value));
end; end;
finally finally
CloseKey; CloseSection;
end; end;
end; end;
procedure TRegIniFile.WriteString(const Section, Ident, Value: String); procedure TRegIniFile.WriteString(const Section, Ident, Value: String);
begin begin
if not OpenKey(fPath+Section,true) then Exit; if OpenSection(Section) then
try try
inherited WriteString(Ident,Value); inherited WriteString(Ident,Value);
finally finally
CloseKey; CloseSection;
end; end;
end; end;
function TRegIniFile.ReadBool(const Section, Ident: string; Default: Boolean): Boolean; function TRegIniFile.ReadBool(const Section, Ident: string; Default: Boolean): Boolean;
begin begin
Result := Default; Result := Default;
if not OpenKey(fPath+Section,false) then Exit; if OpenSection(Section) then
try try
if ValueExists(Ident) then if ValueExists(Ident) then
if (not fPreferStringValues) or (GetDataType(Ident)=rdInteger) then if (not fPreferStringValues) or (GetDataType(Ident)=rdInteger) then
@ -134,14 +130,14 @@ begin
else else
Result := StrToBool(inherited ReadString(Ident)); Result := StrToBool(inherited ReadString(Ident));
finally finally
CloseKey; CloseSection;
end; end;
end; end;
function TRegIniFile.ReadInteger(const Section, Ident: string; Default: LongInt): LongInt; function TRegIniFile.ReadInteger(const Section, Ident: string; Default: LongInt): LongInt;
begin begin
Result := Default; Result := Default;
if not OpenKey(fPath+Section,false) then Exit; if OpenSection(Section) then
try try
if ValueExists(Ident) then if ValueExists(Ident) then
if (not fPreferStringValues) or (GetDataType(Ident)=rdInteger) then if (not fPreferStringValues) or (GetDataType(Ident)=rdInteger) then
@ -149,18 +145,45 @@ begin
else else
Result := StrToInt(inherited ReadString(Ident)); Result := StrToInt(inherited ReadString(Ident));
finally finally
CloseKey; CloseSection;
end; end;
end; end;
function TRegIniFile.ReadString(const Section, Ident, Default: String): String; function TRegIniFile.ReadString(const Section, Ident, Default: String): String;
begin begin
Result := Default; Result := Default;
if not OpenKey(fPath+Section,false) then Exit; if OpenSection(Section) then
try try
if ValueExists(Ident) then if ValueExists(Ident) then
Result := inherited ReadString(Ident); Result := inherited ReadString(Ident);
finally finally
CloseKey; CloseSection;
end; end;
end; end;
function TRegIniFile.OpenSection(const Section: string): boolean;
var
k: HKEY;
begin
ASSERT(fOldCurKey = 0);
if Section <> '' then begin
k:=GetKey(Section);
if k = 0 then begin
Result:=False;
exit;
end;
fOldCurKey:=CurrentKey;
SetCurrentKey(k);
end;
Result:=True;
end;
procedure TRegIniFile.CloseSection;
begin
if fOldCurKey <> 0 then begin
CloseKey(CurrentKey);
SetCurrentKey(fOldCurKey);
fOldCurKey:=0;
end;
end;

294
packages/fcl-registry/src/registry.pp
View File

@ -135,6 +135,10 @@ type
fFileName : String; fFileName : String;
fPath : String; fPath : String;
fPreferStringValues: Boolean; fPreferStringValues: Boolean;
fOldCurKey : HKEY;
function OpenSection(const Section: string): boolean;
procedure CloseSection;
public public
constructor Create(const FN: string); overload; constructor Create(const FN: string); overload;
constructor Create(const FN: string;aaccess:longword); overload; constructor Create(const FN: string;aaccess:longword); overload;
@ -188,6 +192,7 @@ type
procedure EraseSection(const Section: string); override; procedure EraseSection(const Section: string); override;
procedure DeleteKey(const Section, Name: String); override; procedure DeleteKey(const Section, Name: String); override;
procedure UpdateFile; override; procedure UpdateFile; override;
function ValueExists(const Section, Ident: string): Boolean; override;
property RegIniFile: TRegIniFile read FRegIniFile; property RegIniFile: TRegIniFile read FRegIniFile;
end; end;
@ -490,122 +495,53 @@ end;
function TRegistryIniFile.ReadDate(const Section, Name: string; function TRegistryIniFile.ReadDate(const Section, Name: string;
Default: TDateTime): TDateTime; Default: TDateTime): TDateTime;
var sectkey,curkey : HKey;
begin begin
Result:=Default;
with FRegInifile do with FRegInifile do
begin if OpenSection(Section) then
sectkey:=getkey(Section); try
if sectkey<>0 then if ValueExists(Name) then
begin Result:=FRegInifile.ReadDate(Name);
try // allocation ok
curkey:=FRegIniFile.CurrentKey;
SetCurrentKey(sectKey);
try // save current key
if ValueExists(Name) THen
result:=FRegIniFile.ReadDate(Name)
else
result:=default;
finally finally
SetCurrentKey(CurKey); CloseSection;
end;
finally
closekey(sectkey);
end;
end
else
result:=default;
end; end;
end; end;
function TRegistryIniFile.ReadDateTime(const Section, Name: string; function TRegistryIniFile.ReadDateTime(const Section, Name: string;
Default: TDateTime): TDateTime; Default: TDateTime): TDateTime;
var sectkey,curkey : HKey;
begin begin
Result:=Default;
with FRegInifile do with FRegInifile do
begin if OpenSection(Section) then
sectkey:=getkey(Section); try
if sectkey<>0 then if ValueExists(Name) then
begin Result:=FRegInifile.ReadDateTime(Name);
try // allocation ok
curkey:=FRegIniFile.CurrentKey;
SetCurrentKey(sectKey);
try // save current key
if ValueExists(Name) THen
result:=FRegIniFile.ReadDateTime(Name)
else
result:=default;
finally finally
SetCurrentKey(CurKey); CloseSection;
end;
finally
closekey(sectkey);
end;
end
else
result:=default;
end; end;
end; end;
function TRegistryIniFile.ReadFloat(const Section, Name: string; function TRegistryIniFile.ReadFloat(const Section, Name: string;
Default: Double): Double; Default: Double): Double;
var sectkey,curkey : HKey;
begin begin
Result:=Default;
with FRegInifile do with FRegInifile do
begin if OpenSection(Section) then
sectkey:=getkey(Section); try
if sectkey<>0 then if ValueExists(Name) then
begin Result:=FRegInifile.ReadFloat(Name);
try // allocation ok
curkey:=FRegIniFile.CurrentKey;
SetCurrentKey(sectKey);
try // save current key
if ValueExists(Name) THen
result:=FRegIniFile.ReadFloat(Name)
else
result:=default;
finally finally
SetCurrentKey(CurKey); CloseSection;
end;
finally
closekey(sectkey);
end;
end
else
result:=default;
end; end;
end; end;
function TRegistryIniFile.ReadInteger(const Section, Name: string; function TRegistryIniFile.ReadInteger(const Section, Name: string;
Default: Integer): Longint; Default: Integer): Longint;
var sectkey,curkey : HKey;
begin begin
with FRegInifile do Result:=FRegInifile.ReadInteger(Section, Name, Default);
begin
sectkey:=getkey(Section);
if sectkey<>0 then
begin
try // allocation ok
curkey:=FRegIniFile.CurrentKey;
SetCurrentKey(sectKey);
try // save current key
if ValueExists(Name) THen
result:=FRegIniFile.ReadInteger(section,Name,default)
else
result:=default;
finally
SetCurrentKey(CurKey);
end;
finally
closekey(sectkey);
end;
end
else
result:=default;
end;
end; end;
procedure TRegistryIniFile.ReadSection(const Section: string; procedure TRegistryIniFile.ReadSection(const Section: string; Strings: TStrings);
Strings: TStrings);
begin begin
FRegIniFile.ReadSection(Section,strings); FRegIniFile.ReadSection(Section,strings);
end; end;
@ -623,59 +559,21 @@ end;
function TRegistryIniFile.ReadString(const Section, Name, function TRegistryIniFile.ReadString(const Section, Name,
Default: string): string; Default: string): string;
var sectkey,curkey : HKey;
begin begin
with FRegInifile do Result:=FRegInifile.ReadString(Section, Name, Default);
begin
sectkey:=getkey(Section);
if sectkey<>0 then
begin
try // allocation ok
curkey:=FRegIniFile.CurrentKey;
SetCurrentKey(sectKey);
try // save current key
if ValueExists(Name) THen
result:=FRegIniFile.ReadString(section,Name,default)
else
result:=default;
finally
SetCurrentKey(CurKey);
end;
finally
closekey(sectkey);
end;
end
else
result:=default;
end;
end; end;
function TRegistryIniFile.ReadTime(const Section, Name: string; function TRegistryIniFile.ReadTime(const Section, Name: string;
Default: TDateTime): TDateTime; Default: TDateTime): TDateTime;
var sectkey,curkey : HKey;
begin begin
Result:=Default;
with FRegInifile do with FRegInifile do
begin if OpenSection(Section) then
sectkey:=getkey(Section); try
if sectkey<>0 then if ValueExists(Name) then
begin Result:=FRegInifile.ReadTime(Name);
try // allocation ok
curkey:=FRegIniFile.CurrentKey;
SetCurrentKey(sectKey);
try // save current key
if ValueExists(Name) THen
result:=FRegIniFile.ReadTime(Name)
else
result:=default;
finally finally
SetCurrentKey(CurKey); CloseSection;
end;
finally
closekey(sectkey);
end;
end
else
result:=default;
end; end;
end; end;
@ -692,145 +590,71 @@ end;
procedure TRegistryIniFile.WriteDate(const Section, Name: string; procedure TRegistryIniFile.WriteDate(const Section, Name: string;
Value: TDateTime); Value: TDateTime);
var sectkey,curkey : HKey;
begin begin
with FRegInifile do with FRegInifile do
begin if OpenSection(Section) then
sectkey:=getkey(Section); try
if sectkey<>0 then FRegInifile.WriteDate(Name, Value);
begin
try // allocation ok
curkey:=FRegIniFile.CurrentKey;
SetCurrentKey(sectKey);
try // save current key
FRegIniFile.WriteDate(name,value)
finally finally
SetCurrentKey(CurKey); CloseSection;
end;
finally
closekey(sectkey);
end;
end
end; end;
end; end;
procedure TRegistryIniFile.WriteDateTime(const Section, Name: string; procedure TRegistryIniFile.WriteDateTime(const Section, Name: string;
Value: TDateTime); Value: TDateTime);
var sectkey,curkey : HKey;
begin begin
with FRegInifile do with FRegInifile do
begin if OpenSection(Section) then
sectkey:=getkey(Section); try
if sectkey<>0 then FRegInifile.WriteDateTime(Name, Value);
begin
try // allocation ok
curkey:=FRegIniFile.CurrentKey;
SetCurrentKey(sectKey);
try // save current key
FRegIniFile.WriteDateTime(Name,value)
finally finally
SetCurrentKey(CurKey); CloseSection;
end;
finally
closekey(sectkey);
end;
end
end; end;
end; end;
procedure TRegistryIniFile.WriteFloat(const Section, Name: string; procedure TRegistryIniFile.WriteFloat(const Section, Name: string;
Value: Double); Value: Double);
var sectkey,curkey : HKey;
begin begin
with FRegInifile do with FRegInifile do
begin if OpenSection(Section) then
sectkey:=getkey(Section); try
if sectkey<>0 then FRegInifile.WriteFloat(Name, Value);
begin
try // allocation ok
curkey:=FRegIniFile.CurrentKey;
SetCurrentKey(sectKey);
try // save current key
FRegIniFile.WriteFloat(Name,value)
finally finally
SetCurrentKey(CurKey); CloseSection;
end;
finally
closekey(sectkey);
end;
end
end; end;
end; end;
procedure TRegistryIniFile.WriteInteger(const Section, Name: string; procedure TRegistryIniFile.WriteInteger(const Section, Name: string;
Value: Integer); Value: Integer);
var sectkey,curkey : HKey;
begin begin
with FRegInifile do FRegInifile.WriteInteger(Section, Name, Value);
begin
sectkey:=getkey(Section);
if sectkey<>0 then
begin
try // allocation ok
curkey:=FRegIniFile.CurrentKey;
SetCurrentKey(sectKey);
try // save current key
FRegIniFile.WriteInteger(section,Name,value)
finally
SetCurrentKey(CurKey);
end;
finally
closekey(sectkey);
end;
end
end;
end; end;
procedure TRegistryIniFile.WriteString(const Section, Name, Value: String); procedure TRegistryIniFile.WriteString(const Section, Name, Value: String);
var sectkey,curkey : HKey;
begin begin
with FRegInifile do FRegInifile.WriteString(Section, Name, Value);
begin
sectkey:=getkey(Section);
if sectkey<>0 then
begin
try // allocation ok
curkey:=FRegIniFile.CurrentKey;
SetCurrentKey(sectKey);
try // save current key
FRegIniFile.WriteString(section,Name,value)
finally
SetCurrentKey(CurKey);
end;
finally
closekey(sectkey);
end;
end
end;
end; end;
procedure TRegistryIniFile.WriteTime(const Section, Name: string; procedure TRegistryIniFile.WriteTime(const Section, Name: string;
Value: TDateTime); Value: TDateTime);
var sectkey,curkey : HKey;
begin begin
with FRegInifile do with FRegInifile do
begin if OpenSection(Section) then
sectkey:=getkey(Section); try
if sectkey<>0 then FRegInifile.WriteTime(Name, Value);
begin
try // allocation ok
curkey:=FRegIniFile.CurrentKey;
SetCurrentKey(sectKey);
try // save current key
FRegIniFile.WriteTime(Name,value)
finally finally
SetCurrentKey(CurKey); CloseSection;
end; end;
end;
function TRegistryIniFile.ValueExists(const Section, Ident: string): Boolean;
begin
with FRegInifile do
if OpenSection(Section) then
try
Result:=FRegInifile.ValueExists(Ident);
finally finally
closekey(sectkey); CloseSection;
end;
end
end; end;
end; end;

2
packages/fcl-registry/src/winreg.inc
View File

@ -266,7 +266,7 @@ end;
procedure TRegistry.CloseKey(key:HKEY); procedure TRegistry.CloseKey(key:HKEY);
begin begin
RegCloseKey(CurrentKey) RegCloseKey(key);
end; end;
procedure TRegistry.ChangeKey(Value: HKey; const Path: String); procedure TRegistry.ChangeKey(Value: HKey; const Path: String);

105
packages/fcl-registry/tests/tregistry2.pp
View File

@ -7,7 +7,7 @@ procedure DoRegTest2;
implementation implementation
uses Windows, SysUtils, registry; uses Windows, SysUtils, Classes, registry;
const const
STestRegPath = 'Software\FPC-RegTest'; STestRegPath = 'Software\FPC-RegTest';
@ -17,29 +17,8 @@ begin
raise Exception.Create('Test FAILED. Error code: ' + IntToStr(ErrCode)); raise Exception.Create('Test FAILED. Error code: ' + IntToStr(ErrCode));
end; end;
procedure DoRegTest2; procedure ClearReg;
var
reg: TRegistry;
k: HKEY;
begin begin
reg:=TRegistry.Create;
try
if not reg.OpenKey(STestRegPath, True) then
TestFailed(1);
if reg.CurrentPath <> STestRegPath then
TestFailed(2);
k:=reg.CurrentKey;
if not reg.OpenKey('\' + STestRegPath + '\1', True) then
TestFailed(3);
if RegCloseKey(k) = 0 then
TestFailed(4);
if reg.CurrentPath <> STestRegPath + '\1' then
TestFailed(5);
reg.CloseKey;
if reg.CurrentPath <> '' then
TestFailed(6);
finally
reg.Free;
with TRegistry.Create do with TRegistry.Create do
try try
DeleteKey(STestRegPath + '\1'); DeleteKey(STestRegPath + '\1');
@ -48,6 +27,86 @@ begin
Free; Free;
end; end;
end; end;
procedure DoRegTest2;
var
reg: TRegistry;
ri: TRegIniFile;
rini: TRegistryIniFile;
sl: TStringList;
begin
ClearReg;
reg:=TRegistry.Create;
try
if not reg.OpenKey(STestRegPath, True) then
TestFailed(1);
if reg.CurrentPath <> STestRegPath then
TestFailed(2);
reg.WriteString('Item1', '1');
if not reg.OpenKey('\' + STestRegPath + '\1', True) then
TestFailed(3);
reg.WriteString('Item2', '2');
if reg.CurrentPath <> STestRegPath + '\1' then
TestFailed(5);
reg.CloseKey;
if reg.CurrentPath <> '' then
TestFailed(6);
ri:=TRegIniFile.Create(STestRegPath);
with ri do
try
if ReadString('', 'Item1', '') <> '1' then
TestFailed(10);
if ReadString('1', 'Item2', '') <> '2' then
TestFailed(11);
if ReadString('', 'Item1', '') <> '1' then
TestFailed(12);
if not ValueExists('Item1') then
TestFailed(13);
WriteInteger('1', 'Item3', 3);
sl:=TStringList.Create;
try
ReadSectionValues('1', sl);
if sl.Count <> 2 then
TestFailed(14);
if sl.Values['Item2'] <> '2' then
TestFailed(15);
if sl.Values['Item3'] <> '3' then
TestFailed(16);
finally
sl.Free;
end;
WriteInteger('', 'Item4', 4);
if GetDataType('Item4') <> rdString then
TestFailed(17);
finally
Free;
end;
rini:=TRegistryIniFile.Create(STestRegPath);
with rini do
try
if ReadString('', 'Item1', '') <> '1' then
TestFailed(20);
if ReadString('1', 'Item2', '') <> '2' then
TestFailed(21);
if ReadString('', 'Item1', '') <> '1' then
TestFailed(22);
if not ValueExists('', 'Item4') then
TestFailed(23);
if not ValueExists('1', 'Item2') then
TestFailed(24);
finally
Free;
end;
finally
reg.Free;
ClearReg;
end;
end; end;
end. end.