path: root/fpcsrc/packages/fcl-registry/src/xregreg.inc

{ ---------------------------------------------------------------------
    System dependent Registry implementation - using XML file.
  ---------------------------------------------------------------------}

uses xmlreg;


Const
  XFileName = 'reg.xml';

Procedure TRegistry.SysRegCreate;
var s : string;
begin
  s:=includetrailingpathdelimiter(GetAppConfigDir(GlobalXMLFile));
  ForceDirectories(s);
  FSysData:=TXMLRegistry.Create(s+XFileName);
  TXmlRegistry(FSysData).AutoFlush:=False;
end;

Procedure TRegistry.SysRegFree;

begin
  if Assigned(FSysData) then
    TXMLRegistry(FSysData).Flush;
  TXMLRegistry(FSysData).Free;
end;

function TRegistry.SysCreateKey(const Key: String): Boolean;

begin
  Result:=TXmlRegistry(FSysData).CreateKey(Key);
end;

function TRegistry.DeleteKey(const Key: String): Boolean;

begin
  Result:=TXMLRegistry(FSysData).DeleteKey(Key);
end;

function TRegistry.DeleteValue(const Name: String): Boolean;
begin
  Result:=TXmlRegistry(FSysData).DeleteValue(Name);
end;

function TRegistry.SysGetData(const Name: String; Buffer: Pointer;
          BufSize: Integer; var RegData: TRegDataType): Integer;

Var
  DataType : TDataType;
begin
  Result:=BufSize;
  If TXmlregistry(FSysData).GetValueData(Name,DataType,Buffer^,Result) then
    begin
    Case DataType of
      dtUnknown : RegData:=rdUnknown;
      dtString  : RegData:=rdString;
      dtDWord   : RegData:=rdInteger;
      dtBinary  : RegData:=rdBinary;
    end;
    end
  else
    Result:=-1;
end;


function TRegistry.GetDataInfo(const ValueName: String; var Value: TRegDataInfo): Boolean;

Var
  Info : TDataInfo;

begin
  Result := TXmlRegistry(FSysData).GetValueInfo(ValueName,Info);
  If Not Result then
    With Value do
      begin
      RegData:=rdunknown;
      DataSize:=0;
      end
  else
    With Value do
      begin
      Case Info.DataType of
        dtUnknown: RegData:=rdUnknown;
        dtDword  : Regdata:=rdInteger;
        dtString : RegData:=rdString;
        dtBinary : RegData:=rdBinary;
      end;
      DataSize:=Info.DataSize;
      end;
end;

function TRegistry.GetKey(const Key: String): HKEY;
begin
  Result := 0;
end;

function TRegistry.GetKeyInfo(var Value: TRegKeyInfo): Boolean;

Var
  Info : TKeyInfo;

begin
  Result:=TXmlRegistry(FSysData).GetKeyInfo(info);
  If Result then
    With Value,Info do
      begin
      NumSubKeys:=SubKeys;
      MaxSubKeyLen:=SubKeyLen;
      NumValues:= Values;
      MaxValueLen:=ValueLen;
      MaxDataLen:=DataLen;
      FileTime:=FTime;
      end;
end;

function TRegistry.KeyExists(const Key: string): Boolean;
begin
  Result:=TXmlRegistry(FSysData).KeyExists(Key);
end;

function TRegistry.LoadKey(const Key, FileName: string): Boolean;
begin
  Result := False;
end;

function TRegistry.OpenKey(const Key: string; CanCreate: Boolean): Boolean;

begin
  Result:=TXmlRegistry(FSysData).SetKey(Key,CanCreate);
  FCurrentKey:=1;
end;

function TRegistry.OpenKeyReadOnly(const Key: string): Boolean;

begin
  Result:=TXmlRegistry(FSysData).SetKey(Key,False);
end;

function TRegistry.RegistryConnect(const UNCName: string): Boolean;
begin
  Result := True;
end;

function TRegistry.ReplaceKey(const Key, FileName, BackUpFileName: string): Boolean;
begin
  Result := False;
end;

function TRegistry.RestoreKey(const Key, FileName: string): Boolean;
begin
  Result := False;
end;

function TRegistry.SaveKey(const Key, FileName: string): Boolean;
begin
  Result := False;
end;

function TRegistry.UnLoadKey(const Key: string): Boolean;
begin
  Result := False;
end;

function TRegistry.ValueExists(const Name: string): Boolean;
begin
  Result := TXmlRegistry(FSysData).ValueExists(Name);
end;

procedure TRegistry.ChangeKey(Value: HKey; const Path: String);
begin

end;

procedure TRegistry.GetKeyNames(Strings: TStrings);
begin
  TXmlRegistry(FSysData).EnumSubKeys(Strings);
end;

procedure TRegistry.GetValueNames(Strings: TStrings);
begin
  TXmlRegistry(FSysData).EnumValues(Strings);
end;


Function TRegistry.SysPutData(const Name: string; Buffer: Pointer;
  BufSize: Integer; RegData: TRegDataType) : Boolean;

Var
  DataType : TDataType;

begin
  Case RegData of
    rdUnknown               : DataType := dtUnknown;
    rdString,rdExpandString : DataType := dtString;
    rdInteger               : DataType := dtDword;
    rdBinary                : DataType := dtBinary;
  end;
  Result:=TXMLRegistry(FSysData).SetValueData(Name,DataType,Buffer^,BufSize);
end;

procedure TRegistry.RenameValue(const OldName, NewName: string);
begin
  TXMLRegistry(FSysData).RenameValue(OldName,NewName);
end;

procedure TRegistry.SetCurrentKey(Value: HKEY);
begin
  fCurrentKey := Value;
end;

procedure TRegistry.SetRootKey(Value: HKEY);

Var
  S: String;

begin
  If (Value=HKEY_CLASSES_ROOT) then
    S:='HKEY_CLASSES_ROOT'
  else if (Value=HKEY_CURRENT_USER) then
    S:='HKEY_CURRENT_USER'
  else if (Value=HKEY_LOCAL_MACHINE) then
    S:='HKEY_LOCAL_MACHINE'
  else if (Value=HKEY_USERS) then
    S:='HKEY_USERS'
  else if Value=HKEY_PERFORMANCE_DATA then
    S:='HKEY_PERFORMANCE_DATA'
  else if (Value=HKEY_CURRENT_CONFIG) then
    S:='HKEY_CURRENT_CONFIG'
  else if (Value=HKEY_DYN_DATA) then
    S:='HKEY_DYN_DATA'
  else
    S:=Format('Key%d',[Value]);
  TXmlRegistry(FSysData).SetRootKey(S);
  fRootKey := Value;
end;

procedure TRegistry.CloseKey;

begin
  // CloseKey is called from destructor, which includes cases of failed construction.
  // FSysData may be unassigned at this point.
  if Assigned(FSysData) then
  begin
    TXMLRegistry(FSysData).Flush;
    TXMLRegistry(FSysData).SetRootKey(TXMLRegistry(FSysData).RootKey);
  end;
end;

procedure TRegistry.CloseKey(key:HKEY);

begin
  if Assigned(FSysData) then
  begin
    TXMLRegistry(FSysData).Flush;
    TXMLRegistry(FSysData).SetRootKey(TXMLRegistry(FSysData).RootKey);
  end;
end;