fpc/packages/fcl-registry/tests/tregistry2.pp

{$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.