paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-04 14:27:11 +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

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

@ -5,57 +5,50 @@
constructor TRegIniFile.Create(const FN: String);
begin
inherited Create;
fFileName := FN;
if fFileName<>'' then
fPath := fFileName + '\'
else
fPath := '';
Create(FN, KEY_ALL_ACCESS);
end;
constructor TRegIniFile.Create(const FN: String;aaccess:longword);
begin
inherited Create(aaccess);
fFileName := FN;
if fFileName<>'' then
fPath := fFileName + '\'
if fFileName<>'' then begin
fPath := fFileName + '\';
OpenKey(fFileName, aaccess <> KEY_READ);
end
else
fPath := '';
fPath := '';
fPreferStringValues:=True; // Delphi compatibility
end;
procedure TRegIniFile.DeleteKey(const Section, Ident: String);
begin
if not OpenKey(fPath+Section,true) then Exit;
try
DeleteValue(Ident);
finally
CloseKey;
end;
if OpenSection(Section) then
try
DeleteValue(Ident);
finally
CloseSection;
end;
end;
procedure TRegIniFile.EraseSection(const Section: string);
begin
inherited DeleteKey(fPath+Section);
inherited DeleteKey(Section);
end;
procedure TRegIniFile.ReadSection(const Section: string; Strings: TStrings);
begin
if not OpenKey(fPath+Section,false) then Exit;
try
GetValueNames(Strings);
finally
CloseKey;
end;
if OpenSection(Section) then
try
GetValueNames(Strings);
finally
CloseSection;
end;
end;
procedure TRegIniFile.ReadSections(Strings: TStrings);
begin
if not OpenKey(fFileName,false) then Exit;
try
GetKeyNames(Strings);
finally
CloseKey;
end;
GetKeyNames(Strings);
end;
procedure TRegIniFile.ReadSectionValues(const Section: string; Strings: TStrings);
@ -64,24 +57,27 @@ var
V : String;
i : Integer;
begin
if not OpenKey(fPath+Section,false) then Exit;
ValList := TStringList.Create;
try
GetValueNames(ValList);
for i:=0 to ValList.Count-1 do
begin
V := inherited ReadString(ValList.Strings[i]);
Strings.Add(ValList.Strings[i] + '=' + V);
end;
finally
ValList.Free;
CloseKey;
end;
if OpenSection(Section) then
try
ValList := TStringList.Create;
try
GetValueNames(ValList);
for i:=0 to ValList.Count-1 do
begin
V := inherited ReadString(ValList.Strings[i]);
Strings.Add(ValList.Strings[i] + '=' + V);
end;
finally
ValList.Free;
end;
finally
CloseSection;
end;
end;
procedure TRegIniFile.WriteBool(const Section, Ident: string; Value: Boolean);
begin
if not OpenKey(fPath+Section,true) then Exit;
if OpenSection(Section) then
try
if not fPreferStringValues then
inherited WriteBool(Ident,Value)
@ -92,13 +88,13 @@ begin
inherited WriteString(Ident,BoolToStr(Value));
end;
finally
CloseKey;
CloseSection;
end;
end;
procedure TRegIniFile.WriteInteger(const Section, Ident: string; Value: LongInt);
begin
if not OpenKey(fPath+Section,true) then Exit;
if OpenSection(Section) then
try
if not fPreferStringValues then
inherited WriteInteger(Ident,Value)
@ -109,24 +105,24 @@ begin
inherited WriteString(Ident,IntToStr(Value));
end;
finally
CloseKey;
CloseSection;
end;
end;
procedure TRegIniFile.WriteString(const Section, Ident, Value: String);
begin
if not OpenKey(fPath+Section,true) then Exit;
if OpenSection(Section) then
try
inherited WriteString(Ident,Value);
inherited WriteString(Ident,Value);
finally
CloseKey;
CloseSection;
end;
end;
function TRegIniFile.ReadBool(const Section, Ident: string; Default: Boolean): Boolean;
begin
Result := Default;
if not OpenKey(fPath+Section,false) then Exit;
if OpenSection(Section) then
try
if ValueExists(Ident) then
if (not fPreferStringValues) or (GetDataType(Ident)=rdInteger) then
@ -134,14 +130,14 @@ begin
else
Result := StrToBool(inherited ReadString(Ident));
finally
CloseKey;
CloseSection;
end;
end;
function TRegIniFile.ReadInteger(const Section, Ident: string; Default: LongInt): LongInt;
begin
Result := Default;
if not OpenKey(fPath+Section,false) then Exit;
if OpenSection(Section) then
try
if ValueExists(Ident) then
if (not fPreferStringValues) or (GetDataType(Ident)=rdInteger) then
@ -149,18 +145,45 @@ begin
else
Result := StrToInt(inherited ReadString(Ident));
finally
CloseKey;
CloseSection;
end;
end;
function TRegIniFile.ReadString(const Section, Ident, Default: String): String;
begin
Result := Default;
if not OpenKey(fPath+Section,false) then Exit;
if OpenSection(Section) then
try
if ValueExists(Ident) then
Result := inherited ReadString(Ident);
finally
CloseKey;
CloseSection;
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;

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

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

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

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

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

@ -7,7 +7,7 @@ procedure DoRegTest2;
implementation
uses Windows, SysUtils, registry;
uses Windows, SysUtils, Classes, registry;
const
STestRegPath = 'Software\FPC-RegTest';
@ -17,36 +17,95 @@ begin
raise Exception.Create('Test FAILED. Error code: ' + IntToStr(ErrCode));
end;
procedure ClearReg;
begin
with TRegistry.Create do
try
DeleteKey(STestRegPath + '\1');
DeleteKey(STestRegPath);
finally
Free;
end;
end;
procedure DoRegTest2;
var
reg: TRegistry;
k: HKEY;
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);
k:=reg.CurrentKey;
reg.WriteString('Item1', '1');
if not reg.OpenKey('\' + STestRegPath + '\1', True) then
TestFailed(3);
if RegCloseKey(k) = 0 then
TestFailed(4);
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;
with TRegistry.Create do
try
DeleteKey(STestRegPath + '\1');
DeleteKey(STestRegPath);
finally
Free;
end;
ClearReg;
end;
end;