mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-09 22:38:42 +02:00
114 lines
2.4 KiB
ObjectPascal
114 lines
2.4 KiB
ObjectPascal
{$ifdef FPC} {$mode delphi} {$endif}
|
|
unit tregistry2;
|
|
|
|
interface
|
|
|
|
procedure DoRegTest2;
|
|
|
|
implementation
|
|
|
|
uses Windows, SysUtils, Classes, registry;
|
|
|
|
const
|
|
STestRegPath = 'Software\FPC-RegTest';
|
|
|
|
procedure TestFailed(ErrCode: integer);
|
|
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;
|
|
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.
|
|
|