freepascal.compiler/packages/fcl-registry/src/registry.pp

{
    This file is part of the Free Pascal run time library.
    Copyright (c) 1999-2022 by Michael van Canneyt and other members of the
    Free Pascal development team

    Core registry unit

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}

Unit Registry;

{$mode objfpc}
{$H+}

interface

{$ifndef windows}
{$define XMLREG}
{$endif}

Uses
  {$ifndef XMLREG}
    Windows,
  {$endif XMLREG}
    Classes,
    SysUtils,
    inifiles;

{$I regdef.inc}

type
  ERegistryException = class(Exception);

  TRegKeyInfo = record
    NumSubKeys: Integer;
    MaxSubKeyLen: Integer;
    NumValues: Integer;
    MaxValueLen: Integer;
    MaxDataLen: Integer;
    FileTime: TDateTime;
  end;

  TRegDataType = (rdUnknown, rdString, rdExpandString, rdBinary, rdInteger, rdIntegerBigEndian,
                  rdLink, rdMultiString, rdResourceList, rdFullResourceDescriptor,  rdResourceRequirementList, rdInt64);

  TRegDataInfo = record
    RegData: TRegDataType;
    DataSize: Integer;
  end;

  TUnicodeStringArray = Array of UnicodeString;

{ ---------------------------------------------------------------------
    TRegistry
  ---------------------------------------------------------------------}

  { TRegistry }

  TRegistry = class(TObject)
  private
    FLastError: Longint;
    FStringSizeIncludesNull : Boolean;
    FSysData : Pointer;
    fAccess: LongWord;
    fCurrentKey: HKEY;
    fRootKey: HKEY;
    fLazyWrite: Boolean;
    fCurrentPath: UnicodeString;
    function FixPath(APath: UnicodeString): UnicodeString;
    function GetLastErrorMsg: string;
    function RegMultiSzDataToUnicodeStringArray(U: UnicodeString): TUnicodeStringArray;
    function ListToArray(List: TStrings; IsUtf8: Boolean): TUnicodeStringArray;
    procedure ArrayToList(const Arr: TUnicodeStringArray; List: TStrings; ForceUtf8: Boolean);
    procedure SetRootKey(Value: HKEY);
    Procedure SysRegCreate;
    Procedure SysRegFree;
    Function  SysGetData(const Name: UnicodeString; Buffer: Pointer; BufSize: Integer; Out RegData: TRegDataType): Integer;
    Function  SysPutData(const Name: UnicodeString; Buffer: Pointer; BufSize: Integer; RegData: TRegDataType) : Boolean;
    Function  SysCreateKey(Key: UnicodeString): Boolean;
  protected
    function GetBaseKey(Relative: Boolean): HKey;
    function GetData(const Name: UnicodeString; Buffer: Pointer;
                  BufSize: Integer; Out RegData: TRegDataType): Integer;
    function GetData(const Name: AnsiString; Buffer: Pointer;
                  BufSize: Integer; Out RegData: TRegDataType): Integer;
    function GetKey(Key: UnicodeString): HKEY;
    function GetKey(Key: AnsiString): HKEY;
    procedure ChangeKey(Value: HKey; const Path: UnicodeString);
    procedure ChangeKey(Value: HKey; const Path: AnsiString);
    procedure PutData(const Name: UnicodeString; Buffer: Pointer;
                  BufSize: Integer; RegData: TRegDataType);
    procedure PutData(const Name: AnsiString; Buffer: Pointer;
                  BufSize: Integer; RegData: TRegDataType);
    procedure SetCurrentKey(Value: HKEY);
  public
    constructor Create; overload;
    constructor Create(aaccess:longword); overload;
    destructor Destroy; override;

    function CreateKey(const Key: UnicodeString): Boolean;
    function CreateKey(const Key: AnsiString): Boolean;
    function DeleteKey(const Key: UnicodeString): Boolean;
    function DeleteKey(const Key: AnsiString): Boolean;
    function DeleteValue(const Name: UnicodeString): Boolean;
    function DeleteValue(const Name: AnsiString): Boolean;
    function GetDataInfo(const ValueName: UnicodeString; Out Value: TRegDataInfo): Boolean;
    function GetDataInfo(const ValueName: AnsiString; Out Value: TRegDataInfo): Boolean;
    function GetDataSize(const ValueName: UnicodeString): Integer;
    function GetDataSize(const ValueName: AnsiString): Integer;
    function GetDataType(const ValueName: UnicodeString): TRegDataType;
    function GetDataType(const ValueName: AnsiString): TRegDataType;
    function GetKeyInfo(Out Value: TRegKeyInfo): Boolean;
    function HasSubKeys: Boolean;
    function KeyExists(const Key: UnicodeString): Boolean;
    function KeyExists(const Key: AnsiString): Boolean;
    function LoadKey(const Key, FileName: UnicodeString): Boolean;  unimplemented;
    function LoadKey(const Key, FileName: AnsiString): Boolean;  unimplemented;
    function OpenKey(const Key: UnicodeString; CanCreate: Boolean): Boolean;
    function OpenKey(const Key: AnsiString; CanCreate: Boolean): Boolean;
    function OpenKeyReadOnly(const Key: UnicodeString): Boolean;
    function OpenKeyReadOnly(const Key: AnsiString): Boolean;
    function ReadCurrency(const Name: UnicodeString): Currency;
    function ReadCurrency(const Name: AnsiString): Currency;
    function ReadBinaryData(const Name: UnicodeString; var Buffer; BufSize: Integer): Integer;
    function ReadBinaryData(const Name: AnsiString; var Buffer; BufSize: Integer): Integer;
    function ReadBool(const Name: UnicodeString): Boolean;
    function ReadBool(const Name: AnsiString): Boolean;
    function ReadDate(const Name: UnicodeString): TDateTime;
    function ReadDate(const Name: AnsiString): TDateTime;
    function ReadDateTime(const Name: UnicodeString): TDateTime;
    function ReadDateTime(const Name: AnsiString): TDateTime;
    function ReadFloat(const Name: UnicodeString): Double;
    function ReadFloat(const Name: AnsiString): Double;
    function ReadInteger(const Name: UnicodeString): Integer;
    function ReadInteger(const Name: AnsiString): Integer;
    function ReadInt64(const Name: UnicodeString): Int64;
    function ReadInt64(const Name: AnsiString): Int64;
    function ReadString(const Name: UnicodeString): UnicodeString;
    function ReadString(const Name: AnsiString): string;
    procedure ReadStringList(const Name: UnicodeString; AList: TStrings; ForceUtf8: Boolean=False);
    procedure ReadStringList(const Name: AnsiString; AList: TStrings);
    function ReadStringArray(const Name: UnicodeString): TUnicodeStringArray;
    function ReadStringArray(const Name: AnsiString): TStringArray;
    function ReadTime(const Name: UnicodeString): TDateTime;
    function ReadTime(const Name: AnsiString): TDateTime;
    function RegistryConnect(const UNCName: UnicodeString): Boolean;
    function RegistryConnect(const UNCName: AnsiString): Boolean;
    function ReplaceKey(const Key, FileName, BackUpFileName: UnicodeString): Boolean; unimplemented;
    function ReplaceKey(const Key, FileName, BackUpFileName: AnsiString): Boolean;  unimplemented;
    function RestoreKey(const Key, FileName: UnicodeString): Boolean;  unimplemented;
    function RestoreKey(const Key, FileName: AnsiString): Boolean;  unimplemented;
    function SaveKey(const Key, FileName: UnicodeString): Boolean;
    function SaveKey(const Key, FileName: AnsiString): Boolean;
    function UnLoadKey(const Key: UnicodeString): Boolean;
    function UnLoadKey(const Key: AnsiString): Boolean;
    function ValueExists(const Name: UnicodeString): Boolean;
    function ValueExists(const Name: AnsiString): Boolean;

    procedure CloseKey;
    procedure CloseKey(key:HKEY);
    procedure GetKeyNames(Strings: TStrings);
    function GetKeyNames: TUnicodeStringArray;
    procedure GetValueNames(Strings: TStrings);
    //ToDo
    function GetValueNames: TUnicodeStringArray;
    procedure MoveKey(const OldName, NewName: UnicodeString; Delete: Boolean);  unimplemented;
    procedure MoveKey(const OldName, NewName: AnsiString; Delete: Boolean);  unimplemented;
    procedure RenameValue(const OldName, NewName: UnicodeString);
    procedure RenameValue(const OldName, NewName: AnsiString);
    procedure WriteCurrency(const Name: UnicodeString; Value: Currency);
    procedure WriteCurrency(const Name: AnsiString; Value: Currency);
    procedure WriteBinaryData(const Name: UnicodeString; const Buffer; BufSize: Integer);
    procedure WriteBinaryData(const Name: AnsiString; const Buffer; BufSize: Integer);
    procedure WriteBool(const Name: UnicodeString; Value: Boolean);
    procedure WriteBool(const Name: AnsiString; Value: Boolean);
    procedure WriteDate(const Name: UnicodeString; Value: TDateTime);
    procedure WriteDate(const Name: AnsiString; Value: TDateTime);
    procedure WriteDateTime(const Name: UnicodeString; Value: TDateTime);
    procedure WriteDateTime(const Name: AnsiString; Value: TDateTime);
    procedure WriteFloat(const Name: UnicodeString; Value: Double);
    procedure WriteFloat(const Name: AnsiString; Value: Double);
    procedure WriteInteger(const Name: UnicodeString; Value: Integer);
    procedure WriteInteger(const Name: AnsiString; Value: Integer);
    procedure WriteInt64(const Name: UnicodeString; Value: Int64);
    procedure WriteInt64(const Name: AnsiString; Value: Int64);
    procedure WriteString(const Name, Value: UnicodeString);
    procedure WriteString(const Name, Value: AnsiString);
    procedure WriteExpandString(const Name, Value: UnicodeString);
    procedure WriteExpandString(const Name, Value: AnsiString);
    procedure WriteStringList(const Name: UnicodeString; List: TStrings; IsUtf8: Boolean=False);
    procedure WriteStringArray(const Name: UnicodeString; const Arr: TUnicodeStringArray);
    procedure WriteStringArray(const Name: AnsiString; const Arr: TStringArray);
    procedure WriteTime(const Name: UnicodeString; Value: TDateTime);
    procedure WriteTime(const Name: AnsiString; Value: TDateTime);

    property Access: LongWord read fAccess write fAccess;
    property CurrentKey: HKEY read fCurrentKey;
    property CurrentPath: UnicodeString read fCurrentPath;
    property LazyWrite: Boolean read fLazyWrite write fLazyWrite;
    property RootKey: HKEY read fRootKey write SetRootKey;
    Property StringSizeIncludesNull : Boolean read FStringSizeIncludesNull;
    property LastError: Longint read FLastError; platform;
    property LastErrorMsg: string read GetLastErrorMsg; platform;
  end;

{ ---------------------------------------------------------------------
    TRegIniFile
  ---------------------------------------------------------------------}
  TRegIniFile = class(TRegistry)
  private
    fFileName          : String;
    fPath              : String;
    fPreferStringValues: Boolean;
    fOldCurKey         : HKEY;
    fOldCurPath        : UnicodeString;
    function OpenSection(const Section: string; CreateSection : Boolean = false): boolean;
    procedure CloseSection;
  public
    constructor Create(const FN: string); overload;
    constructor Create(const FN: string;aaccess:longword); overload;
    function ReadString(const Section, Ident, Default: string): string;
    function ReadInteger(const Section, Ident: string; Default: Longint): Longint;
    function ReadBool(const Section, Ident: string; Default: Boolean): Boolean;
    function ReadDate(const Section, Ident: string; Default: TDateTime):TDateTime;
    function ReadDateTime(const Section, Ident: string; Default: TDateTime):TDateTime;
    function ReadTime(const Section, Ident: string; Default: TDateTime):TDateTime;
    function ReadFloat(const Section, Ident: string; Default: Double): Double;

    procedure WriteString(const Section, Ident, Value: String);
    procedure WriteInteger(const Section, Ident: string; Value: Longint);
    procedure WriteBool(const Section, Ident: string; Value: Boolean);
    procedure WriteDate(const Section, Ident: string; Value: TDateTime);
    procedure WriteDateTime(const Section, Ident: string; Value: TDateTime);
    procedure WriteTime(const Section, Ident: string; Value: TDateTime);
    procedure WriteFloat(const Section, Ident: string; Value: Double);
    procedure ReadSection(const Section: string; Strings: TStrings);
    procedure ReadSections(Strings: TStrings);
    procedure ReadSectionValues(const Section: string; Strings: TStrings);
    procedure EraseSection(const Section: string);
    procedure DeleteKey(const Section, Ident: String);

    property FileName: String read fFileName;
    property PreferStringValues: Boolean read fPreferStringValues
                write fPreferStringValues;
  end{$ifdef XMLREG}deprecated 'Use TRegistry instead. Will be removed in 4.0'{$endif} platform; 

{ ---------------------------------------------------------------------
    TRegIniFile
  ---------------------------------------------------------------------}


  TRegistryIniFile = class(TCustomIniFile)
  private
    FRegIniFile: TRegIniFile;
  public
    constructor Create(const AFileName: string); overload;
    constructor Create(const AFileName: string; AAccess: LongWord); overload;
    destructor destroy; override;
    function ReadDate(const Section, Name: string; Default: TDateTime): TDateTime; override;
    function ReadDateTime(const Section, Name: string; Default: TDateTime): TDateTime; override;
    function ReadInteger(const Section, Name: string; Default: Longint): Longint; override;
    function ReadFloat(const Section, Name: string; Default: Double): Double; override;
    function ReadString(const Section, Name, Default: string): string; override;
    function ReadTime(const Section, Name: string; Default: TDateTime): TDateTime; override;
    function ReadBinaryStream(const Section, Name: string; Value: TStream): Integer; override; unimplemented;
    procedure WriteDate(const Section, Name: string; Value: TDateTime); override;
    procedure WriteDateTime(const Section, Name: string; Value: TDateTime); override;
    procedure WriteFloat(const Section, Name: string; Value: Double); override;
    procedure WriteInteger(const Section, Name: string; Value: Longint); override;
    procedure WriteString(const Section, Name, Value: String); override;
    procedure WriteTime(const Section, Name: string; Value: TDateTime); override;
    procedure WriteBinaryStream(const Section, Name: string; Value: TStream); override;
    procedure ReadSection(const Section: string; Strings: TStrings); override;
    procedure ReadSections(Strings: TStrings); override;
    procedure ReadSectionValues(const Section: string; Strings: TStrings); override;
    procedure EraseSection(const Section: string); override;
    procedure DeleteKey(const Section, Name: String); override;
    procedure UpdateFile; override;
    function ValueExists(const Section, Ident: string): Boolean; override;
    function SectionExists(const Section: string): Boolean; override;
    property RegIniFile: TRegIniFile read FRegIniFile;
  end{$ifdef XMLREG}deprecated 'Use TRegistry instead. Will be removed in 4.0'{$endif} platform; 

ResourceString
  SInvalidRegType   = 'Invalid registry data type: "%s"';
  SRegCreateFailed  = 'Failed to create key: "%s"';
  SRegSetDataFailed = 'Failed to set data for value "%s"';
  SRegGetDataFailed = 'Failed to get data for value "%s"';

var
  GlobalXMLFile : Boolean = False;

implementation

{ ---------------------------------------------------------------------
    Include implementation-dependent code
  ---------------------------------------------------------------------}


{$ifdef XMLREG}
{$i xregreg.inc}
{$else}
{$i winreg.inc}
{$endif}

{ ---------------------------------------------------------------------
    Generic, implementation-independent code.
  ---------------------------------------------------------------------}

{$ifdef DebugRegistry}
function DbgS(const S: UnicodeString): String;
var
  C: WideChar;
begin
  Result := '';
  for C in S do Result := Result + IntToHex(Word(C),4) + #32;
  Result := TrimRight(Result);
end;
{$endif}

constructor TRegistry.Create;

begin
  inherited Create;
  FAccess     := KEY_ALL_ACCESS;
  FRootKey    := HKEY_CURRENT_USER;
  FLazyWrite  := True;
  FCurrentKey := 0;
  SysRegCreate;
end;

constructor TRegistry.Create(aaccess: longword);

begin
  Create;
  FAccess     := aaccess;
end;

destructor TRegistry.Destroy;
begin
  CloseKey;
  SysRegFree;
  inherited Destroy;
end;

function TRegistry.CreateKey(const Key: UnicodeString): Boolean;

begin
  Result:=SysCreateKey(Key);
  If Not Result Then
    Raise ERegistryException.CreateFmt(SRegCreateFailed, [Key]);
end;

function TRegistry.CreateKey(const Key: AnsiString): Boolean;
begin
  Result:=CreateKey(UnicodeString(Key));
end;

function TRegistry.DeleteKey(const Key: AnsiString): Boolean;
begin
  Result:=DeleteKey(UnicodeString(Key));
end;

function TRegistry.DeleteValue(const Name: AnsiString): Boolean;
begin
  Result:=DeleteValue(UnicodeString(Name));
end;

function TRegistry.GetDataInfo(const ValueName: AnsiString; out Value: TRegDataInfo
  ): Boolean;
begin
  Result:=GetDataInfo(UnicodeString(ValueName), Value);
end;

function TRegistry.GetBaseKey(Relative: Boolean): HKey;
begin
  If Relative and (CurrentKey<>0) Then
    Result := CurrentKey
  else
    Result := RootKey;
end;

function TRegistry.GetData(const Name: UnicodeString; Buffer: Pointer; BufSize: Integer; out RegData: TRegDataType): Integer;
begin
  Result:=SysGetData(Name,Buffer,BufSize,RegData);
  If (Result=-1) then
    Raise ERegistryException.CreateFmt(SRegGetDataFailed, [Name]);
end;

function TRegistry.GetData(const Name: AnsiString; Buffer: Pointer;
  BufSize: Integer; out RegData: TRegDataType): Integer;
begin
  Result:=GetData(UnicodeString(Name), Buffer, BufSize, RegData);
end;

function TRegistry.GetKey(Key: AnsiString): HKEY;
begin
  Result:=GetKey(UnicodeString(Key));
end;

procedure TRegistry.ChangeKey(Value: HKey; const Path: AnsiString);
begin
  ChangeKey(Value, UnicodeString(Path));
end;


procedure TRegistry.PutData(const Name: UnicodeString; Buffer: Pointer;
  BufSize: Integer; RegData: TRegDataType);

begin
  If Not SysPutData(Name,Buffer,BufSize,RegData) then
    Raise ERegistryException.CreateFmt(SRegSetDataFailed, [Name]);
end;

procedure TRegistry.PutData(const Name: AnsiString; Buffer: Pointer;
  BufSize: Integer; RegData: TRegDataType);
begin
  PutData(UnicodeString(Name), Buffer, BufSize, RegData);
end;


function TRegistry.GetDataSize(const ValueName: UnicodeString): Integer;

Var
  Info: TRegDataInfo;

begin
  If GetDataInfo(ValueName,Info) Then
    Result := Info.DataSize
  else
    Result := -1;
end;

function TRegistry.GetDataSize(const ValueName: AnsiString): Integer;
begin
  Result:=GetDataSize(UnicodeString(ValueName));
end;

function TRegistry.GetDataType(const ValueName: UnicodeString): TRegDataType;

Var
  Info: TRegDataInfo;

begin
  GetDataInfo(ValueName, Info);
  Result:=Info.RegData;
end;

function TRegistry.GetDataType(const ValueName: AnsiString): TRegDataType;
begin
  Result:=GetDataType(UnicodeString(ValueName));
end;


function TRegistry.KeyExists(const Key: AnsiString): Boolean;
begin
  Result:=KeyExists(UnicodeString(Key));
end;

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

function TRegistry.OpenKey(const Key: AnsiString; CanCreate: Boolean): Boolean;
begin
  Result:=OpenKey(UnicodeString(Key), CanCreate);
end;

function TRegistry.OpenKeyReadOnly(const Key: AnsiString): Boolean;
begin
  Result:=OpenKeyReadOnly(UnicodeString(Key));
end;

function TRegistry.HasSubKeys: Boolean;

Var
  Info : TRegKeyInfo;

begin
  Result:=GetKeyInfo(Info);
  If Result then
    Result:=(Info.NumSubKeys>0);
end;

function TRegistry.ReadBinaryData(const Name: UnicodeString; var Buffer; BufSize: Integer): Integer;

Var
  RegDataType: TRegDataType;

begin
  Result := GetData(Name, @Buffer, BufSize, RegDataType);
end;

function TRegistry.ReadBinaryData(const Name: AnsiString; var Buffer;
  BufSize: Integer): Integer;
begin
  Result:=ReadBinaryData(UnicodeString(Name), Buffer, BufSize);
end;

function TRegistry.ReadInteger(const Name: UnicodeString): Integer;

Var
  RegDataType: TRegDataType;

begin
  GetData(Name, @Result, SizeOf(Integer), RegDataType);
  If RegDataType<>rdInteger Then
    Raise ERegistryException.CreateFmt(SInvalidRegType, [Name]);
end;

function TRegistry.ReadInteger(const Name: AnsiString): Integer;
begin
  Result:=ReadInteger(UnicodeString(Name));
end;

function TRegistry.ReadInt64(const Name: UnicodeString): Int64;

Var
  RegDataType: TRegDataType;

begin
  GetData(Name, @Result, SizeOf(Int64), RegDataType);
  If RegDataType<>rdInt64 Then
    Raise ERegistryException.CreateFmt(SInvalidRegType, [Name]);
end;

function TRegistry.ReadInt64(const Name: AnsiString): Int64;
begin
  Result:=ReadInt64(UnicodeString(Name));
end;

function TRegistry.ReadBool(const Name: UnicodeString): Boolean;

begin
  Result:=ReadInteger(Name)<>0;
end;

function TRegistry.ReadBool(const Name: AnsiString): Boolean;
begin
  Result:=ReadBool(UnicodeString(Name));
end;

function TRegistry.ReadCurrency(const Name: UnicodeString): Currency;

begin
  Result:=Default(Currency);
  ReadBinaryData(Name, Result, SizeOf(Currency));
end;

function TRegistry.ReadCurrency(const Name: AnsiString): Currency;
begin
  Result:=ReadCurrency(UnicodeString(Name));
end;

function TRegistry.ReadDate(const Name: UnicodeString): TDateTime;

begin
  Result:=Trunc(ReadDateTime(Name));
end;

function TRegistry.ReadDate(const Name: AnsiString): TDateTime;
begin
  Result:=ReadDate(UnicodeString(Name));
end;

function TRegistry.ReadDateTime(const Name: UnicodeString): TDateTime;

begin
  Result:=Default(TDateTime);
  ReadBinaryData(Name, Result, SizeOf(TDateTime));
end;

function TRegistry.ReadDateTime(const Name: AnsiString): TDateTime;
begin
  Result:=ReadDateTime(UnicodeString(Name));
end;

function TRegistry.ReadFloat(const Name: UnicodeString): Double;

begin
  Result:=Default(Double);
  ReadBinaryData(Name,Result,SizeOf(Double));
end;

function TRegistry.ReadFloat(const Name: AnsiString): Double;
begin
  Result:=ReadFloat(UnicodeString(Name));
end;

function TRegistry.ReadString(const Name: UnicodeString): UnicodeString;

Var
  Info : TRegDataInfo;
  ReadDataSize: Integer;
  u: UnicodeString;

begin
  Result:='';
  GetDataInfo(Name,Info);
  if info.datasize>0 then
  begin
    if Not (Info.RegData in [rdString,rdExpandString]) then
      Raise ERegistryException.CreateFmt(SInvalidRegType, [Name]);
    if Odd(Info.DataSize) then
      SetLength(u,round((Info.DataSize+1)/SizeOf(UnicodeChar)))
    else
      SetLength(u,round(Info.DataSize/SizeOf(UnicodeChar)));
    ReadDataSize := GetData(Name,@u[1],Info.DataSize,Info.RegData);
    if ReadDataSize > 0 then
    begin
      // If the data has the REG_SZ, REG_MULTI_SZ or REG_EXPAND_SZ type,
      // the size includes any terminating null character or characters
      // unless the data was stored without them! (RegQueryValueEx @ MSDN)
      if StringSizeIncludesNull and
         (u[Length(u)] = WideChar(0)) then
        SetLength(u,Length(u)-1);
      Result:=u;
    end;
  end;
end;

function TRegistry.ReadString(const Name: AnsiString): string;
begin
  Result:=ReadString(UnicodeString(Name));
end;


procedure TRegistry.ReadStringList(const Name: UnicodeString; AList: TStrings; ForceUtf8: Boolean=False);

Var
  UArr: TUnicodeStringArray;

begin
  UArr := ReadStringArray(Name);
  ArrayToList(UArr, AList, ForceUtf8);
end;

procedure TRegistry.ReadStringList(const Name: AnsiString; AList: TStrings);
begin
  ReadStringList(UnicodeString(Name), AList);
end;

function TRegistry.FixPath(APath: UnicodeString): UnicodeString;
const
  Delim={$ifdef XMLREG}'/'{$else}'\'{$endif};
begin
  //At this point we know the path is valid, since this is only called after OpenKey succeeded
  //Just sanitize it
  while (Pos(Delim+Delim,APath) > 0) do
    APath := UnicodeStringReplace(APath, Delim+Delim,Delim,[rfReplaceAll]);
  if (Length(APath) > 1) and (APath[Length(APath)] = Delim) then
    System.Delete(APath, Length(APath), 1);
  Result := APath;
end;

function TRegistry.RegMultiSzDataToUnicodeStringArray(U: UnicodeString): TUnicodeStringArray;
var
  Len, i, p: Integer;
  Sub: UnicodeString;
begin
  Result := nil;
  if (U = '') then Exit;
  Len := 1;
  for i := 1 to Length(U) do if (U[i] = #0) then Inc(Len);
  SetLength(Result, Len);
  i := 0;

  while (U <> '') and (i < Length(Result)) do
  begin
    p := Pos(#0, U);
    if (p = 0) then p := Length(U) + 1;
    Sub := Copy(U, 1, p - 1);
    Result[i] := Sub;
    System.Delete(U, 1, p);
    Inc(i);
  end;
end;

function TRegistry.ListToArray(List: TStrings; IsUtf8: Boolean): TUnicodeStringArray;
var
  i, curr, Len: Integer;
  u: UnicodeString;
begin
  Result := nil;
  Len := List.Count;
  SetLength(Result, Len);
  //REG_MULTI_SZ data cannot contain empty strings
  curr := 0;
  for i := 0 to List.Count - 1 do
  begin
    if IsUtf8 then
      u := Utf8Decode(List[i])
    else
      u := List[i];
    if (u>'') then
    begin
      Result[curr] := u;
      inc(curr);
    end
    else
      Dec(Len);
  end;
  if (Len <> List.Count) then SetLength(Result, Len);
end;

procedure TRegistry.ArrayToList(const Arr: TUnicodeStringArray; List: TStrings; ForceUtf8: Boolean);
var
  i: Integer;
begin
  List.Clear;
  for i := Low(Arr) to High(Arr) do
  begin
    if ForceUtf8 then
      List.Add(Utf8Encode(Arr[i]))
    else
      List.Add(String(Arr[i]));
  end;
end;

function TRegistry.ReadStringArray(const Name: UnicodeString): TUnicodeStringArray;
Var
  Info : TRegDataInfo;
  ReadDataSize: Integer;
  Data: UnicodeString;

begin
  Result := nil;
  GetDataInfo(Name,Info);
  //writeln('TRegistry.ReadStringArray: datasize=',info.datasize);
  if info.datasize>0 then
    begin
     If Not (Info.RegData in [rdMultiString]) then
       Raise ERegistryException.CreateFmt(SInvalidRegType, [Name]);
     SetLength(Data,Info.DataSize);
     ReadDataSize := GetData(Name,PWideChar(Data),Info.DataSize,Info.RegData) div SizeOf(WideChar);
     //writeln('TRegistry.ReadStringArray: ReadDataSize=',ReadDataSize);
     if ReadDataSize > 0 then
     begin
       // Windows returns the data with or without trailing zero's, so just strip all trailing null characters
        while (Data[ReadDataSize] = #0) do Dec(ReadDataSize);
       SetLength(Data, ReadDataSize);
       //writeln('Data=',dbgs(data));
       //Data := UnicodeStringReplace(Data, #0, AList.LineBreak, [rfReplaceAll]);
       //AList.Text := Data;
       Result := RegMultiSzDataToUnicodeStringArray(Data);
     end
   end
end;

function TRegistry.ReadStringArray(const Name: AnsiString): TStringArray;
var
  UArr: TUnicodeStringArray;
  i: Integer;
begin
  Result := nil;
  UArr := ReadStringArray(UnicodeString(Name));
  SetLength(Result, Length(UArr));
  for i := Low(UArr) to High(UArr) do Result[i] := UArr[i];
end;

function TRegistry.ReadTime(const Name: UnicodeString): TDateTime;

begin
  Result:=Frac(ReadDateTime(Name));
end;

function TRegistry.ReadTime(const Name: AnsiString): TDateTime;
begin
  Result:=ReadTime(UnicodeString(Name));
end;

function TRegistry.RegistryConnect(const UNCName: AnsiString): Boolean;
begin
  Result:=RegistryConnect(UnicodeString(UNCName));
end;

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

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

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

function TRegistry.UnLoadKey(const Key: AnsiString): Boolean;
begin
  Result:=UnloadKey(UnicodeString(Key));
end;

function TRegistry.ValueExists(const Name: AnsiString): Boolean;
begin
  Result:=ValueExists(UnicodeString(Name));
end;

procedure TRegistry.WriteBinaryData(const Name: UnicodeString; const Buffer; BufSize: Integer);
begin
  PutData(Name, @Buffer, BufSize, rdBinary);
end;

procedure TRegistry.WriteBinaryData(const Name: AnsiString; const Buffer;
  BufSize: Integer);
begin
  WriteBinaryData(UnicodeString(Name), Buffer, BufSize);
end;

procedure TRegistry.WriteBool(const Name: UnicodeString; Value: Boolean);

begin
  WriteInteger(Name,Ord(Value));
end;

procedure TRegistry.WriteBool(const Name: AnsiString; Value: Boolean);
begin
  WriteBool(UnicodeString(Name), Value);
end;

procedure TRegistry.WriteCurrency(const Name: UnicodeString; Value: Currency);
begin
  WriteBinaryData(Name, Value, SizeOf(Currency));
end;

procedure TRegistry.WriteCurrency(const Name: AnsiString; Value: Currency);
begin
  WriteCurrency(UnicodeString(Name), Value);
end;

procedure TRegistry.WriteDate(const Name: UnicodeString; Value: TDateTime);
begin
  WriteBinarydata(Name, Value, SizeOf(TDateTime));
end;

procedure TRegistry.WriteDate(const Name: AnsiString; Value: TDateTime);
begin
  WriteDate(UnicodeString(Name), Value);
end;

procedure TRegistry.WriteTime(const Name: UnicodeString; Value: TDateTime);
begin
  WriteBinaryData(Name, Value, SizeOf(TDateTime));
end;

procedure TRegistry.WriteTime(const Name: AnsiString; Value: TDateTime);
begin
  WriteTime(UnicodeString(Name), Value);
end;

procedure TRegistry.WriteDateTime(const Name: UnicodeString; Value: TDateTime);
begin
  WriteBinaryData(Name, Value, SizeOf(TDateTime));
end;

procedure TRegistry.WriteDateTime(const Name: AnsiString; Value: TDateTime);
begin
  WriteDateTime(UnicodeString(Name), Value);
end;

procedure TRegistry.WriteExpandString(const Name, Value: UnicodeString);
begin
  PutData(Name, PWideChar(Value), ByteLength(Value), rdExpandString);
end;

procedure TRegistry.WriteExpandString(const Name, Value: AnsiString);
begin
  WriteExpandString(UnicodeString(Name), UnicodeString(Value));
end;


procedure TRegistry.WriteStringList(const Name: UnicodeString; List: TStrings; IsUtf8: Boolean=False);

Var
  UArr: TUnicodeStringArray;
begin
  UArr := ListToArray(List, IsUtf8);
  WriteStringArray(Name, UArr);
end;

procedure TRegistry.WriteStringArray(const Name: UnicodeString; const Arr: TUnicodeStringArray);
Var
  Data: UnicodeString;
  u: UnicodeString;
  i: Integer;
begin
  Data := '';
  //REG_MULTI_SZ data cannot contain empty strings
  for i := Low(Arr) to High(Arr) do
  begin
    u := Arr[i];
    if (u>'') then
    begin
      if (Data>'') then
        Data := Data + #0 + u
      else
        Data := Data + u;
    end;
  end;
  if StringSizeIncludesNull then
    Data := Data + #0#0;
  //writeln('Data=',Dbgs(Data));
  PutData(Name, PWideChar(Data), ByteLength(Data), rdMultiString);
end;

procedure TRegistry.WriteStringArray(const Name: AnsiString; const Arr: TStringArray);
var
  UArr: TUnicodeStringArray;
  i: Integer;
begin
  UArr := nil;
  SetLength(UArr, Length(Arr));
  for i := Low(Arr) to High(Arr) do UArr[i] := Arr[i];
  WriteStringArray(UnicodeString(Name), UArr);
end;

procedure TRegistry.WriteFloat(const Name: UnicodeString; Value: Double);
begin
  WriteBinaryData(Name, Value, SizeOf(Double));
end;

procedure TRegistry.WriteFloat(const Name: AnsiString; Value: Double);
begin
  WriteFloat(UnicodeString(Name), Value);
end;

procedure TRegistry.WriteInteger(const Name: UnicodeString; Value: Integer);
begin
  PutData(Name, @Value, SizeOf(Integer), rdInteger);
end;

procedure TRegistry.WriteInteger(const Name: AnsiString; Value: Integer);
begin
  WriteInteger(UnicodeString(Name), Value);
end;

procedure TRegistry.WriteInt64(const Name: UnicodeString; Value: Int64);
begin
  PutData(Name, @Value, SizeOf(Int64), rdInt64);
end;

procedure TRegistry.WriteInt64(const Name: AnsiString; Value: Int64);
begin
  WriteInt64(UnicodeString(Name), Value);
end;

procedure TRegistry.WriteString(const Name, Value: UnicodeString);
begin
  PutData(Name, PWideChar(Value), ByteLength(Value), rdString);
end;

procedure TRegistry.WriteString(const Name, Value: AnsiString);
begin
  WriteString(UnicodeString(Name), UnicodeString(Value));
end;

procedure TRegistry.GetKeyNames(Strings: TStrings);
var
  UArr: TUnicodeStringArray;
begin
  UArr := GetKeyNames;
  ArrayToList(UArr, Strings, True);
end;

procedure TRegistry.GetValueNames(Strings: TStrings);
var
  UArr: TUnicodeStringArray;
begin
  UArr := GetValueNames;
  ArrayToList(UArr, Strings, True);
end;

procedure TRegistry.MoveKey(const OldName, NewName: UnicodeString; Delete: Boolean);
begin

end;

procedure TRegistry.MoveKey(const OldName, NewName: AnsiString; Delete: Boolean);
begin
  MoveKey(UnicodeString(OldName), UnicodeString(NewName), Delete);
end;

procedure TRegistry.RenameValue(const OldName, NewName: AnsiString);
begin
  RenameValue(UnicodeString(OldName), UnicodeString(NewName));
end;

{ ---------------------------------------------------------------------
    Include TRegIniFile implementation
  ---------------------------------------------------------------------}

{$i regini.inc}

{ TRegistryIniFile }

// interface from
// http://www.koders.com/delphi/fid65C1FFAEF89B0CDC4B93FF94C1819686CA6141FC.aspx
constructor TRegistryIniFile.Create(const AFileName: string;
  AAccess: LongWord);
begin
  inherited create(AFilename);
  FRegInifile:=TreginiFile.Create(AFileName,AAccess);
end;

constructor TRegistryIniFile.Create(const AFileName: string);
begin
  Create(AFileName,KEY_ALL_ACCESS);
end;

destructor TRegistryIniFile.destroy;

begin
  FreeAndNil(FRegInifile);
  Inherited;
end;

procedure TRegistryIniFile.DeleteKey(const Section, Name: String);
begin
  FRegIniFile.Deletekey(section,name);
end;

procedure TRegistryIniFile.EraseSection(const Section: string);
begin
  FRegIniFile.EraseSection(section);
end;

function TRegistryIniFile.ReadBinaryStream(const Section, Name: string;
  Value: TStream): Integer;
begin
  result:=-1; // unimplemented
 //
end;

function TRegistryIniFile.ReadDate(const Section, Name: string;
  Default: TDateTime): TDateTime;
begin
  Result:=FRegInifile.ReadDate(Section,Name,Default);
end;

function TRegistryIniFile.ReadDateTime(const Section, Name: string;
  Default: TDateTime): TDateTime;
begin
  Result:=FRegInifile.ReadDateTime(Section,Name,Default);
end;

function TRegistryIniFile.ReadFloat(const Section, Name: string;
  Default: Double): Double;
begin
  Result:=FRegInifile.ReadFloat(Section,Name,Default);
end;

function TRegistryIniFile.ReadInteger(const Section, Name: string;
  Default: Integer): Longint;
begin
  Result:=FRegInifile.ReadInteger(Section, Name, Default);
end;

procedure TRegistryIniFile.ReadSection(const Section: string; Strings: TStrings);
begin
  FRegIniFile.ReadSection(Section,strings);
end;

procedure TRegistryIniFile.ReadSections(Strings: TStrings);
begin
  FRegIniFile.ReadSections(strings);
end;

procedure TRegistryIniFile.ReadSectionValues(const Section: string;
  Strings: TStrings);
begin
  FRegIniFile.ReadSectionValues(Section,strings);
end;

function TRegistryIniFile.ReadString(const Section, Name,
  Default: string): string;
begin
  Result:=FRegInifile.ReadString(Section, Name, Default);
end;

function TRegistryIniFile.ReadTime(const Section, Name: string;
  Default: TDateTime): TDateTime;
begin
  Result:=FRegInifile.ReadTime(Section,Name,Default);
end;

procedure TRegistryIniFile.UpdateFile;
begin
//  FRegIniFile.UpdateFile; ??
end;

procedure TRegistryIniFile.WriteBinaryStream(const Section, Name: string;
  Value: TStream);
begin
 // ??
end;

procedure TRegistryIniFile.WriteDate(const Section, Name: string;
  Value: TDateTime);
begin
  FRegInifile.WriteDate(Section,Name, Value);
end;

procedure TRegistryIniFile.WriteDateTime(const Section, Name: string;
  Value: TDateTime);
begin
  FRegInifile.WriteDateTime(Section,Name, Value);
end;

procedure TRegistryIniFile.WriteFloat(const Section, Name: string;
  Value: Double);
begin
  FRegInifile.WriteFloat(Section,Name, Value);
end;

procedure TRegistryIniFile.WriteInteger(const Section, Name: string;
  Value: Integer);
begin
  FRegInifile.WriteInteger(Section, Name, Value);
end;

procedure TRegistryIniFile.WriteString(const Section, Name, Value: String);
begin
  FRegInifile.WriteString(Section, Name, Value);
end;

procedure TRegistryIniFile.WriteTime(const Section, Name: string;
  Value: TDateTime);
begin
  FRegInifile.WriteTime(Section,Name, Value);
end;

function TRegistryIniFile.ValueExists(const Section, Ident: string): Boolean;
begin
  Result:=FRegInifile.OpenSection(Section);
  if Result then
    try
      Result:=FRegInifile.ValueExists(Ident);
    finally
      FRegInifile.CloseSection;
    end;
end;

function TRegistryIniFile.SectionExists(const Section: string): Boolean;
begin
  Result:=FRegIniFile.KeyExists(Section);
end;

{$ifdef XMLREG}
finalization
  TXMLRegistryInstance.FreeXMLRegistryCache;
{$endif}

end.