fpc/tests/webtbs/tw0035022.pp

{ %TARGET=win32,win64,wince }

program tw0035022;

{$apptype console}
{$mode objfpc}{$h+}
{$ASSERTIONS ON}

uses
    registry, sysutils, classes;

const
  ROOT = 'Software';
  subFPCREGINITEST = 'FreePascalRegIniTest';
  subRegIni = 'RegIni';
  subStrings = 'FPCTESTString';
  fqFREEPASCALREGINITEST = Root + '\'+ subFPCREGINITEST;
  fqFPCTESTRegIni = fqFREEPASCALREGINITEST + '\' + subRegIni;
  fqFPCTESTStrings = fqFPCTESTRegIni+'\' + subStrings;
  fqWrongFPCTESTStrings = Root + '\' + subStrings;
  idString1 = 'String1';
  valValue1 = 'Value1';

procedure CheckCreate;
var
  Reg: TRegistry;
  S, SKey: String;
  B: Boolean;
begin
  write('CheckCreate: ');
  Reg := TRegistry.Create(KEY_READ);
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    SKey := fqFPCTESTRegIni;
    B := Reg.OpenKeyReadOnly(SKey);
    Assert(B,format('Error: RegOpenKeyReadOnly(''%s'') failed.',[SKey]));

    SKey := subStrings;
    B := Reg.OpenKeyReadOnly(Skey);
    Assert(B,format('Error: RegOpenKeyReadOnly(''%s'') failed.',[fqFPCTESTStrings]));

    S := Reg.ReadString(idString1);
    Assert(S=valValue1,format('ReadString(''%s''): expected '+'%s, but found: ''%s''',[idString1,valValue1,S]));

    Reg.CloseKey;

    writeln('OK');
  finally
    Reg.Free;
  end;

end;

procedure FindErroneousEntries;
var
  Reg: TRegistry;
  B: Boolean;
begin
  write('FindErroneousEntries: ');
  Reg := TRegistry.Create(KEY_READ);
  try
    B := Reg.OpenKeyReadOnly(fqWrongFPCTESTStrings);
    Reg.CloseKey;
    Assert(not B, format('RegOpenKeyReadOnly found %s, which at this point is unexpected.',[fqWrongFPCTESTStrings]));
    writeln(' no erroneous entries found (OK).');
  finally
    Reg.Free;
  end;
end;

procedure CreateTestEntries;
var
  RegIni: TRegIniFile;
  B: Boolean;
  function TryOpenKey(Key: String; CanCreate: Boolean): Boolean;
  begin
    Result := RegIni.OpenKey(Key, CanCreate);
  end;

  function TryWriteString(Section, Ident, Value: String): Boolean;
  begin
    Result := False;
    try
      RegIni.WriteString(Section, Ident, Value);
      Result := True;
    except
      on E: Exception do
    end;
  end;

begin
  write('CreateTestEntries: ');
  RegIni := TRegIniFile.Create(Root);
  try
    Assert(RegIni.CurrentPath=Root,'Expected: CurrenPath='+Root);
    B := RegIni.CreateKey(subFPCREGINITEST);
    Assert(B,format('Error: CreateKey(''%s'') failed.',[fqFREEPASCALREGINITEST]));

    B := TryOpenKey(subFPCREGINITEST,False);
    Assert(B,format('Error: OpenKey(''%s'') failed.',[fqFREEPASCALREGINITEST]));

    Assert(RegIni.CurrentPath=fqFREEPASCALREGINITEST,'Expected: CurrenPath='+fqFREEPASCALREGINITEST);

    B := TryOpenKey(subRegIni,True);
    Assert(B,format('Error: OpenKey(''%s'') failed.',[fqFPCTESTRegIni]));
    Assert(RegIni.CurrentPath=fqFPCTESTRegIni,'Expected: CurrenPath='+fqFPCTESTRegIni);

    B := TryWriteString(subStrings,idString1,valValue1);
    Assert(B,format('Error: WriteString(''%s'',''%s'',''%s'') failed.',[fqFPCTESTStrings,idString1,valValue1]));

    writeln('OK');
  finally
    RegIni.Free;
  end;

end;

procedure DeleteFPCTESTEntries;
  procedure DeleteStrings;
  var
    Reg: TRegistry;
    B: Boolean;
  begin
    Reg := TRegistry.Create(KEY_ALL_ACCESS);
    try
      Reg.RootKey := HKEY_CURRENT_USER;
      if Reg.KeyExists(fqFPCTESTStrings) then
      begin
        B := Reg.OpenKey(fqFPCTESTStrings, False);
        //writeln('OpenKey: ',B);
        if B then
        begin
          B := not Reg.ValueExists(idString1) or Reg.DeleteValue(idString1);
          Assert(B, format('Error DeleteValue(''%s'') in %s',[idString1,fqFPCTESTStrings]));
        end;
        Reg.CloseKey;
      end;

      if Reg.KeyExists(fqWrongFPCTESTStrings) then
      begin
        B := Reg.OpenKey(fqWrongFPCTESTStrings, False);
        //writeln('OpenKey: ',B);
        if B then
        begin
          B := not Reg.ValueExists(idString1) or Reg.DeleteValue(idString1);
          Assert(B, format('Error DeleteValue(''%s'') in %s',[idString1,fqWrongFPCTESTStrings]));
        end;
        Reg.CloseKey;
      end;
    finally
      Reg.Free;
    end;
  end;

  procedure DeleteEmptyKey(Key: String);
  var
    Reg: TRegistry;
    B: Boolean;
  begin
    Reg := TRegistry.Create(KEY_ALL_ACCESS);
    try
      Reg.RootKey := HKEY_CURRENT_USER;
      if Reg.KeyExists(Key) then
      begin
        B := Reg.DeleteKey(Key);
        Assert(B, format('Error DeleteKey(''%s'')',[Key]));
      end;
    finally
      Reg.Free;
    end;
  end;

begin
  DeleteStrings;
  DeleteEmptyKey(fqFPCTESTStrings);
  DeleteEmptyKey(fqWrongFPCTESTStrings);
  DeleteEmptyKey(fqFPCTESTRegIni);
  DeleteEmptyKey(fqFREEPASCALREGINITEST);
end;

begin
  DeleteFPCTESTEntries;
  CreateTestEntries;
  CheckCreate;
  FindErroneousEntries;
  DeleteFPCTESTEntries;
end.