Initial implementation of registry

fcl/inc/regdef.inc

@@ -0,0 +1,63 @@
+
+Const
+  HKEY_CLASSES_ROOT     = $80000000;
+  HKEY_CURRENT_USER     = $80000001;
+  HKEY_LOCAL_MACHINE    = $80000002;
+  HKEY_USERS            = $80000003;
+  HKEY_PERFORMANCE_DATA = $80000004;
+  HKEY_CURRENT_CONFIG   = $80000005;
+  HKEY_DYN_DATA         = $80000006;
+
+  KEY_ALL_ACCESS         = $F003F;
+  KEY_CREATE_LINK        = 32;
+  KEY_CREATE_SUB_KEY     = 4;
+  KEY_ENUMERATE_SUB_KEYS = 8;
+  KEY_EXECUTE            = $20019;
+  KEY_NOTIFY             = 16;
+  KEY_QUERY_VALUE        = 1;
+  KEY_READ               = $20019;
+  KEY_SET_VALUE          = 2;
+  KEY_WRITE              = $20006;
+
+  REG_BINARY                     = 3;
+  REG_DWORD                      = 4;
+  REG_DWORD_LITTLE_ENDIAN        = 4;
+  REG_DWORD_BIG_ENDIAN           = 5;
+  REG_EXPAND_SZ                  = 2;
+  REG_FULL_RESOURCE_DESCRIPTOR   = 9;
+  REG_LINK                       = 6;
+  REG_MULTI_SZ                   = 7;
+  REG_NONE                       = 0;
+  REG_RESOURCE_LIST              = 8;
+  REG_RESOURCE_REQUIREMENTS_LIST = 10;
+  REG_SZ                         = 1;
+
+  REG_OPTION_VOLATILE            = 1;
+  REG_OPTION_NON_VOLATILE        = 0;
+  REG_CREATED_NEW_KEY            = 1;
+  REG_OPENED_EXISTING_KEY        = 2;
+
+  ERROR_SUCCESS = 0;
+
+Type
+  LPDWORD = ^DWord;
+  LPVOID  = Pointer;
+  WINBOOL = LongBool;
+  LPCSTR  = PChar;
+  LPSTR   = Pchar;
+  LONG    = LongInt;
+  LPBYTE  = ^Byte;
+
+  ACCESS_MASK = DWORD;
+       REGSAM = ACCESS_MASK;
+
+  SECURITY_ATTRIBUTES = record
+    nLength : DWORD;
+    lpSecurityDescriptor : LPVOID;
+    bInheritHandle : WINBOOL;
+  end;
+  LPSECURITY_ATTRIBUTES = ^SECURITY_ATTRIBUTES;
+
+
+  HKEY = Integer;
+  PHKEY = ^HKEY;

fcl/inc/regini.inc

@@ -0,0 +1,65 @@
+
+{******************************************************************************
+                                TRegIniFile
+ ******************************************************************************}
+ 
+constructor TRegIniFile.Create(const FN: String);
+begin
+  inherited Create;
+  fFileName := FN;
+end;
+
+procedure TRegIniFile.DeleteKey(const Section, Ident: String);
+begin
+
+end;
+
+procedure TRegIniFile.EraseSection(const Section: string);
+begin
+
+end;
+
+procedure TRegIniFile.ReadSection(const Section: string; Strings: TStrings);
+begin
+
+end;
+
+procedure TRegIniFile.ReadSections(Strings: TStrings);
+begin
+
+end;
+
+procedure TRegIniFile.ReadSectionValues(const Section: string; Strings: TStrings);
+begin
+
+end;
+
+procedure TRegIniFile.WriteBool(const Section, Ident: string; Value: Boolean);
+begin
+
+end;
+
+procedure TRegIniFile.WriteInteger(const Section, Ident: string; Value: LongInt);
+begin
+
+end;
+
+procedure TRegIniFile.WriteString(const Section, Ident, Value: String);
+begin
+
+end;
+
+function TRegIniFile.ReadBool(const Section, Ident: string; Default: Boolean): Boolean;
+begin
+  Result := Default;
+end;
+
+function TRegIniFile.ReadInteger(const Section, Ident: string; Default: LongInt): LongInt;
+begin
+  Result := Default;
+end;
+
+function TRegIniFile.ReadString(const Section, Ident, Default: String): String;
+begin
+  Result := Default;
+end;

fcl/inc/registry.pp

@@ -0,0 +1,409 @@
+Unit registry;
+
+{$mode objfpc} 
+{$H+}
+
+interface
+
+{$ifndef win32}
+{$define XMLREG}
+{$endif}
+
+Uses
+  {$ifndef XMLREG}
+    Windows,
+  {$endif XMLREG}
+    Classes, 
+    SysUtils;
+
+  {$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, rdInteger, rdBinary);
+
+  TRegDataInfo = record
+    RegData: TRegDataType;
+    DataSize: Integer;
+  end;
+
+{ ---------------------------------------------------------------------
+    TRegistry
+  ---------------------------------------------------------------------}
+
+  TRegistry = class(TObject)
+  private
+    FStringSizeIncludesNull : Boolean;
+    FSysData : Pointer;
+    fAccess: LongWord;
+    fCurrentKey: HKEY;
+    fRootKey: HKEY;
+    fLazyWrite: Boolean;
+    fCurrentPath: string;
+    procedure SetRootKey(Value: HKEY);
+    Procedure SysRegCreate;
+    Procedure SysRegFree;
+    Function  SysGetData(const Name: String; Buffer: Pointer; BufSize: Integer; var RegData: TRegDataType): Integer;
+    Function  SysPutData(const Name: string; Buffer: Pointer; BufSize: Integer; RegData: TRegDataType) : Boolean;
+    Function  SysCreateKey(const Key: String): Boolean;
+  protected
+    function GetBaseKey(Relative: Boolean): HKey;
+    function GetData(const Name: string; Buffer: Pointer;
+                  BufSize: Integer; var RegData: TRegDataType): Integer;
+    function GetKey(const Key: string): HKEY;
+    procedure ChangeKey(Value: HKey; const Path: string);
+    procedure PutData(const Name: string; Buffer: Pointer;
+                  BufSize: Integer; RegData: TRegDataType);
+    procedure SetCurrentKey(Value: HKEY);
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    function CreateKey(const Key: string): Boolean;
+    function DeleteKey(const Key: string): Boolean;
+    function DeleteValue(const Name: string): Boolean;
+    function GetDataInfo(const ValueName: string; var Value: TRegDataInfo): Boolean;
+    function GetDataSize(const ValueName: string): Integer;
+    function GetDataType(const ValueName: string): TRegDataType;
+    function GetKeyInfo(var Value: TRegKeyInfo): Boolean;
+    function HasSubKeys: Boolean;
+    function KeyExists(const Key: string): Boolean;
+    function LoadKey(const Key, FileName: string): Boolean;
+    function OpenKey(const Key: string; CanCreate: Boolean): Boolean;
+    function OpenKeyReadOnly(const Key: string): Boolean;
+    function ReadCurrency(const Name: string): Currency;
+    function ReadBinaryData(const Name: string; var Buffer; BufSize: Integer): Integer;
+    function ReadBool(const Name: string): Boolean;
+    function ReadDate(const Name: string): TDateTime;
+    function ReadDateTime(const Name: string): TDateTime;
+    function ReadFloat(const Name: string): Double;
+    function ReadInteger(const Name: string): Integer;
+    function ReadString(const Name: string): string;
+    function ReadTime(const Name: string): TDateTime;
+    function RegistryConnect(const UNCName: string): Boolean;
+    function ReplaceKey(const Key, FileName, BackUpFileName: string): Boolean;
+    function RestoreKey(const Key, FileName: string): Boolean;
+    function SaveKey(const Key, FileName: string): Boolean;
+    function UnLoadKey(const Key: string): Boolean;
+    function ValueExists(const Name: string): Boolean;
+
+    procedure CloseKey;
+    procedure GetKeyNames(Strings: TStrings);
+    procedure GetValueNames(Strings: TStrings);
+    procedure MoveKey(const OldName, NewName: string; Delete: Boolean);
+    procedure RenameValue(const OldName, NewName: string);
+    procedure WriteCurrency(const Name: string; Value: Currency);
+    procedure WriteBinaryData(const Name: string; var Buffer; BufSize: Integer);
+    procedure WriteBool(const Name: string; Value: Boolean);
+    procedure WriteDate(const Name: string; Value: TDateTime);
+    procedure WriteDateTime(const Name: string; Value: TDateTime);
+    procedure WriteFloat(const Name: string; Value: Double);
+    procedure WriteInteger(const Name: string; Value: Integer);
+    procedure WriteString(const Name, Value: string);
+    procedure WriteExpandString(const Name, Value: string);
+    procedure WriteTime(const Name: string; Value: TDateTime);
+
+    property Access: LongWord read fAccess write fAccess;
+    property CurrentKey: HKEY read fCurrentKey;
+    property CurrentPath: string read fCurrentPath;
+    property LazyWrite: Boolean read fLazyWrite write fLazyWrite;
+    property RootKey: HKEY read fRootKey write SetRootKey;
+    Property StringSizeIncludesNull : Boolean read FStringSizeIncludesNull;
+  end;
+
+{ ---------------------------------------------------------------------
+    TRegIniFile
+  ---------------------------------------------------------------------}
+  TRegIniFile = class(TRegistry)
+  private
+    fFileName: String;
+  public
+    constructor Create(const FN: string);
+    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;
+
+    procedure WriteString(const Section, Ident, Value: String);
+    procedure WriteInteger(const Section, Ident: string; Value: Longint);
+    procedure WriteBool(const Section, Ident: string; Value: Boolean);
+    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;
+  end;
+
+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"';
+
+implementation
+
+{ ---------------------------------------------------------------------
+    Include implementation-dependent code
+  ---------------------------------------------------------------------}
+  
+
+{$ifdef XMLREG}
+{$i xregreg.inc}
+{$else}
+{$i winreg.inc}
+{$endif}
+
+{ ---------------------------------------------------------------------
+    Generic, implementation-independent code.
+  ---------------------------------------------------------------------}
+ 
+
+Constructor TRegistry.Create;
+
+begin
+  inherited Create;
+  FAccess     := KEY_ALL_ACCESS;
+  FRootKey    := HKEY_CURRENT_USER;
+  FLazyWrite  := True;
+  FCurrentKey := 0;
+  SysRegCreate;
+end;
+
+Destructor TRegistry.Destroy;
+begin
+  CloseKey;
+  SysRegFree;
+  inherited Destroy;
+end;
+
+function TRegistry.CreateKey(const Key: String): Boolean;
+
+begin
+  Result:=SysCreateKey(Key);
+  If Not Result Then 
+    Raise ERegistryException.CreateFmt(SRegCreateFailed, [Key]);
+end;
+
+function TRegistry.GetBaseKey(Relative: Boolean): HKey;
+begin
+  If Relative Then
+    Result := CurrentKey 
+  else
+    Result := RootKey;
+end;
+
+function TRegistry.GetData(const Name: String; Buffer: Pointer;
+          BufSize: Integer; var RegData: TRegDataType): Integer;
+begin
+  Result:=SysGetData(Name,Buffer,BufSize,RegData);
+  If (Result=-1) then
+    Raise ERegistryException.CreateFmt(SRegGetDataFailed, [Name]);
+end;
+
+procedure TRegistry.PutData(const Name: string; Buffer: Pointer;
+  BufSize: Integer; RegData: TRegDataType);
+
+begin
+  If Not SysPutData(Name,Buffer,BufSize,RegData) then
+    Raise ERegistryException.CreateFmt(SRegSetDataFailed, [Name]);
+end;
+
+
+function TRegistry.GetDataSize(const ValueName: String): Integer;
+
+Var
+  Info: TRegDataInfo;
+
+begin
+  If GetDataInfo(ValueName,Info) Then
+    Result := Info.DataSize 
+  else
+    Result := -1;
+end;
+
+function TRegistry.GetDataType(const ValueName: string): TRegDataType;
+
+Var
+  Info: TRegDataInfo;
+
+begin
+  GetDataInfo(ValueName, Info);
+  Result:=Info.RegData;
+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: string; var Buffer; BufSize: Integer): Integer;
+
+Var
+  RegDataType: TRegDataType;
+
+begin
+  Result := GetData(Name, @Buffer, BufSize, RegDataType);
+  If (RegDataType<>rdBinary) Then
+    Raise ERegistryException.CreateFmt(SInvalidRegType, [Name]);
+end;
+
+function TRegistry.ReadInteger(const Name: string): Integer;
+
+Var
+  RegDataType: TRegDataType;
+
+begin
+  GetData(Name, @Result, SizeOf(Integer), RegDataType);
+  If RegDataType<>rdInteger Then
+    Raise ERegistryException.CreateFmt(SInvalidRegType, [Name]);
+end;
+
+function TRegistry.ReadBool(const Name: string): Boolean;
+
+begin
+  Result:=ReadInteger(Name)<>0;
+end;
+
+function TRegistry.ReadCurrency(const Name: string): Currency;
+
+Var
+  RegDataType: TRegDataType;
+
+begin
+  ReadBinaryData(Name, Result, SizeOf(Currency));
+end;
+
+function TRegistry.ReadDate(const Name: string): TDateTime;
+
+begin
+  ReadBinaryData(Name, Result, SizeOf(TDateTime));
+  Result:=Round(Result);
+end;
+
+function TRegistry.ReadDateTime(const Name: string): TDateTime;
+Var
+  RegDataType: TRegDataType;
+
+begin
+  ReadBinaryData(Name, Result, SizeOf(TDateTime));
+end;
+
+function TRegistry.ReadFloat(const Name: string): Double;
+
+begin
+  ReadBinaryData(Name,Result,SizeOf(Double));
+end;
+
+function TRegistry.ReadString(const Name: string): string;
+
+Var
+  Info : TRegDataInfo;
+
+begin
+  GetDataInfo(Name,Info);
+  If Not (Info.RegData in [rdString,rdExpandString]) then
+    Raise ERegistryException.CreateFmt(SInvalidRegType, [Name]);
+  SetLength(Result,Info.DataSize);
+  If Info.DataSize>0 then
+    begin
+    If StringSizeIncludesNull then
+      SetLength(Result, Info.DataSize-1)
+    else  
+      SetLength(Result, Info.DataSize);
+    GetData(Name,@Result[1],Info.DataSize,Info.RegData);
+    end;
+end;
+
+function TRegistry.ReadTime(const Name: string): TDateTime;
+
+begin
+  ReadBinaryData(Name, Result, SizeOf(TDateTime));
+  Result:=Frac(Result);
+end;
+
+procedure TRegistry.WriteBinaryData(const Name: string; var Buffer; BufSize: Integer);
+begin
+  PutData(Name, @Buffer, BufSize, rdBinary);
+end;
+
+procedure TRegistry.WriteBool(const Name: string; Value: Boolean);
+
+begin
+  WriteInteger(Name,Ord(Value));
+end;
+
+procedure TRegistry.WriteCurrency(const Name: string; Value: Currency);
+begin
+  WriteBinaryData(Name, Value, SizeOf(Currency));
+end;
+
+procedure TRegistry.WriteDate(const Name: string; Value: TDateTime);
+begin
+  WriteBinarydata(Name, Value, SizeOf(TDateTime));
+end;
+
+procedure TRegistry.WriteTime(const Name: string; Value: TDateTime);
+begin
+  WriteBinaryData(Name, Value, SizeOf(TDateTime));
+end;
+
+procedure TRegistry.WriteDateTime(const Name: string; Value: TDateTime);
+begin
+  WriteBinaryData(Name, Value, SizeOf(TDateTime));
+end;
+
+procedure TRegistry.WriteExpandString(const Name, Value: string);
+
+begin
+  PutData(Name, @Value[1], Length(Value),rdExpandString);
+end;
+
+procedure TRegistry.WriteFloat(const Name: string; Value: Double);
+begin
+  WriteBinaryData(Name, Value, SizeOf(Double));
+end;
+
+procedure TRegistry.WriteInteger(const Name: string; Value: Integer);
+begin
+  PutData(Name, @Value, SizeOf(Integer), rdInteger);
+end;
+
+procedure TRegistry.WriteString(const Name, Value: string);
+
+begin
+  PutData(Name, @Value[1], Length(Value), rdString);
+end;
+
+procedure TRegistry.MoveKey(const OldName, NewName: string; Delete: Boolean);
+begin
+
+end;
+
+
+{ ---------------------------------------------------------------------
+    Include TRegIniFile implementation
+  ---------------------------------------------------------------------}
+  
+
+{$i regini.inc}
+  
+end.

fcl/inc/xmlreg.pp

@@ -0,0 +1,745 @@
+{$mode objfpc}
+{$h+}
+
+unit xmlreg;
+
+Interface
+
+uses
+  sysutils,classes,dom,xmlread,xmlwrite;
+  
+Type
+
+  TDataType = (dtUnknown,dtDWORD,dtString,dtBinary);
+  TDataInfo = record
+    DataType : TDataType;
+    DataSize : Integer;
+  end;
+  
+  TKeyInfo = record
+    SubKeys,
+    SubKeyLen,
+    Values,
+    ValueLen,
+    DataLen   : Integer;
+    FTime     : TDateTime;
+  end;
+                            
+
+  TXmlRegistry = Class(TObject)
+  Private
+    FAutoFlush,
+    FDirty : Boolean;
+    FFileName : String;
+    FRootKey : String;
+    FDocument : TXMLDocument;
+    FCurrentElement : TDomElement;
+    FCurrentKey : String;
+    Procedure SetFileName(Value : String);
+  Protected
+    Procedure LoadFromStream(S : TStream);
+    Function  NormalizeKey(KeyPath : String) : String;
+    Procedure CreateEmptyDoc;
+    Function  FindKey (S : String) : TDomElement;
+    Function  FindSubKey (S : String; N : TDomElement) : TDomElement;
+    Function  CreateSubKey (S : String; N : TDomElement) : TDomElement;
+    Function  FindValueKey (S : String) : TDomElement;
+    Function  CreateValueKey (S : String) : TDomElement;
+    Function  BufToHex(Const Buf; Len : Integer) : String;
+    Function  hexToBuf(Const Str : String; Var Buf; Var Len : Integer ) : Integer;
+    Procedure MaybeFlush;
+    Property  Document : TXMLDocument Read FDocument;  
+    Property  Dirty : Boolean Read FDirty write FDirty;
+  Public
+    Constructor Create(AFileName : String);
+    Function  SetKey(KeyPath : String; AllowCreate : Boolean) : Boolean ;
+    Procedure SetRootKey(Value : String);
+    Function  DeleteKey(KeyPath : String) : Boolean;
+    Function  CreateKey(KeyPath : String) : Boolean;
+    Function  GetValueSize(Name : String) : Integer;
+    Function  GetValueType(Name : String) : TDataType;
+    Function  GetValueInfo(Name : String; Var Info : TDataInfo) : Boolean;
+    Function  GetKeyInfo(Var Info : TKeyInfo) : Boolean;
+    Function  EnumSubKeys(List : TStrings) : Integer;
+    Function  EnumValues(List : TStrings) : Integer;
+    Function  KeyExists(KeyPath : String) : Boolean;
+    Function  ValueExists(ValueName : String) : Boolean;
+    Function  RenameValue(Const OldName,NewName : String) : Boolean;
+    Function  DeleteValue(S : String) : Boolean;
+    Procedure Flush;
+    Procedure Load;
+    Function GetValueData(Name : String; Var DataType : TDataType; Var Data; Var DataSize : Integer) : Boolean;
+    Function SetValueData(Name : String; DataType : TDataType; Const Data; DataSize : Integer) : Boolean;
+    Property FileName : String Read FFileName Write SetFileName;    
+    Property RootKey : String Read FRootKey Write SetRootkey;
+    Property AutoFlush : Boolean Read FAutoFlush Write FAutoFlush;
+  end;  
+
+// used Key types
+  
+Const
+  SXmlReg = 'XMLReg';
+  SKey    = 'Key';
+  SValue  = 'Value';
+  SName   = 'Name';
+  SType   = 'Type';
+  SData   = 'Data'; 
+
+Implementation
+
+
+Constructor TXmlRegistry.Create(AFileName : String);
+
+begin
+  FFileName:=AFileName;
+  FautoFlush:=True;
+  If (AFileName<>'') then
+    Load
+  else
+    CreateEmptyDoc;  
+end;
+
+Procedure TXmlRegistry.SetFileName(Value : String);
+
+begin
+  If Value<>FFileName then
+    begin
+    FFilename:=Value;
+    Flush;
+    end;
+end;
+
+Procedure TXmlRegistry.CreateEmptyDoc;
+
+Const
+  template = '<?xml version="1.0" encoding="ISO8859-1"?>'+LineEnding+
+             '<'+SXMLReg+'>'+LineEnding+
+             '</'+SXMLReg+'>'+LineEnding;
+                            
+Var
+  S : TStream;
+ 
+begin
+  S:=TStringStream.Create(Template);
+  S.Seek(0,soFromBeginning);
+  Try
+    LoadFromStream(S);
+  Finally
+    S.Free;
+  end;  
+end;
+ 
+Function TXmlRegistry.NormalizeKey(KeyPath : String) : String;
+
+Var
+  L : Integer;
+
+begin
+  Result:=StringReplace(KeyPath,'\','/',[rfReplaceAll]);
+  L:=Length(Result);
+  If (L>0) and (Result[L]<>'/') then
+    Result:=Result+'/';
+end;
+ 
+Function TXmlRegistry.SetKey(KeyPath : String; AllowCreate : Boolean) : boolean;
+
+Var
+  SubKey,ResultKey : String;
+  P : Integer;
+  Node,Node2 : TDomElement;
+  
+begin
+  Result:=(Length(KeyPath)>0);
+  If Not Result then
+    Exit;
+  KeyPath:=NormalizeKey(KeyPath);  
+  If (KeyPath[1]<>'/') then
+    begin
+    Node:=FCurrentElement;
+    Resultkey:=FCurrentKey;
+    end
+  else
+    begin
+    Delete(Keypath,1,1);
+    Node:=FDocument.DocumentElement;
+    If (FRootKey<>'') then
+      KeyPath:=FRootKey+KeyPath;
+    ResultKey:='';  
+    end;
+  Result:=True;   
+  repeat
+    P:=Pos('/',KeyPath);
+    If (P<>0) then
+      begin
+      SubKey:=Copy(KeyPath,1,P-1);
+      Delete(KeyPath,1,P);
+      Node2:=FindSubKey(SubKey,Node);
+      Result:=(Node2<>Nil);
+      If Result then
+        Node:=Node2
+      else
+        begin
+        If AllowCreate then
+          Begin
+          Node2:=CreateSubKey(SubKey,Node);
+          Result:=Node2<>Nil;
+          If Result Then
+            Node:=Node2;
+          end;
+        end;  
+      If Result then
+        ResultKey:=ResultKey+SubKey+'/';
+      end;
+  Until (Not Result) or (Length(KeyPath)=0);
+  If Result then
+    begin
+    FCurrentkey:=ResultKey;
+    FCurrentElement:=Node;
+    end;
+  MaybeFlush;  
+end;
+ 
+Procedure TXmlRegistry.SetRootKey(Value : String);
+
+begin
+  FRootKey:=NormalizeKey(Value);
+  If (Length(FRootKey)>1) and (FRootKey[1]='/') then
+    Delete(FRootKey,1,1);
+  FCurrentKey:='';
+  FCurrentElement:=Nil;
+end;
+ 
+Function TXmlRegistry.DeleteKey(KeyPath : String) : Boolean;
+
+Var
+  N : TDomElement;
+  
+begin
+ N:=FindKey(KeyPath);
+ Result:=(N<>Nil);
+ If Result then
+   begin
+   (N.ParentNode as TDomElement).RemoveChild(N);
+   FDirty:=True;
+   MaybeFlush;
+   end;
+end;
+ 
+Function TXmlRegistry.CreateKey(KeyPath : String) : Boolean;
+
+Var
+  SubKey : String;
+  P : Integer;
+  Node,Node2 : TDomElement;
+  
+begin
+  Result:=(Length(KeyPath)>0);
+  If Not Result then
+    Exit;
+  KeyPath:=NormalizeKey(KeyPath);  
+  If (KeyPath[1]<>'/') then
+    Node:=FCurrentElement
+  else
+    begin
+    Delete(Keypath,1,1);
+    Node:=FDocument.DocumentElement;
+    If (FRootKey<>'') then
+      KeyPath:=FRootKey+KeyPath;
+    end;
+  Result:=True;   
+  repeat
+    P:=Pos('/',KeyPath);
+    If (P<>0) then
+      begin
+      SubKey:=Copy(KeyPath,1,P-1);
+      Delete(KeyPath,1,P);
+      Node2:=FindSubKey(SubKey,Node);
+      Result:=(Node2<>Nil);
+      If Result then
+        Node:=Node2
+      else
+        begin
+        Node2:=CreateSubKey(SubKey,Node);
+        Result:=Node2<>Nil;
+        Node:=Node2
+        end;  
+      end;
+  Until (Not Result) or (Length(KeyPath)=0);
+  MaybeFlush;  
+end;
+ 
+Function TXmlRegistry.GetValueData(Name : String; Var DataType : TDataType; Var Data; Var DataSize : Integer) : Boolean;
+
+Type
+  PCardinal = ^Cardinal;
+
+Var
+  Node  : TDomElement;
+  DataNode : TDomNode;
+  ND : Integer;
+  Dt : TDataType;
+  
+begin
+  Node:=FindValueKey(Name);
+  Result:=Node<>Nil;
+  If Result then
+    begin
+    DataNode:=Node.FirstChild;
+    Result:=(DataNode<>Nil) and (DataNode is TDomText);
+    If Result then
+      begin
+      ND:=StrToIntDef(Node[Stype],0);
+      Result:=ND<=Ord(High(TDataType));
+      If Result then
+        begin
+        DataType:=TDataType(StrToIntDef(Node[Stype],0));
+        Case DataType of
+          dtDWORD : begin
+                    PCardinal(@Data)^:=StrToIntDef(DataNode.NodeValue,0);
+                    DataSize:=SizeOf(Cardinal);
+                    end;
+          dtString : begin
+                     DataSize:=Length(DataNode.NodeValue);
+                     If (DataSize>0) then
+                       Move(DataNode.NodeValue[1],Data,DataSize);
+                     end;  
+          dtBinary : begin
+                     DataSize:=Length(DataNode.NodeValue);
+                     If (DataSize>0) then
+                       HexToBuf(DataNode.NodeValue,Data,DataSize);
+                     end;
+        end;
+        end;  
+      end;  
+    end;
+end;
+ 
+Function TXmlRegistry.SetValueData(Name : String; DataType : TDataType; Const Data; DataSize : Integer) : Boolean;
+
+Type
+  PCardinal = ^Cardinal;
+
+Var
+  Node  : TDomElement;
+  DataNode : TDomNode;
+  ND : Integer;
+  Dt : TDataType;
+  S : String;
+  
+begin
+  Node:=FindValueKey(Name);
+  If Node=Nil then
+    Node:=CreateValueKey(Name);
+  Result:=(Node<>Nil);
+  If Result then
+    begin
+    Node[SType]:=IntToStr(Ord(DataType));
+    DataNode:=Node.FirstChild;
+    Case DataType of
+      dtDWORD : DataNode.NodeValue:=IntToStr(PCardinal(@Data)^);
+      dtString : begin
+                 SetLength(S,DataSize);
+                 If (DataSize>0) then
+                   Move(Data,S[1],DataSize);
+                 DataNode.NodeValue:=S;
+                 end;
+      dtBinary : begin
+                 S:=BufToHex(Data,DataSize);
+                 DataNode.NodeValue:=S;
+                 end;           
+    end;
+    end;
+  If Result then
+    begin
+    FDirty:=True;  
+    MaybeFlush;
+    end;
+end;
+ 
+Function TXmlRegistry.FindSubKey (S : String; N : TDomElement) : TDomElement;
+
+Var
+  Node : TDOMNode;
+
+begin
+  Result:=Nil;
+  If N<>Nil then
+    begin
+    Node:=N.FirstChild;
+    While (Result=Nil) and (Assigned(Node)) do
+      begin
+      If (Node.NodeType=ELEMENT_NODE) and (Node.NodeName=SKey) then
+        If CompareText(TDomElement(Node)[SName],S)=0 then
+          Result:=TDomElement(Node);
+      Node:=Node.NextSibling;
+      end;    
+    end;  
+end;
+
+Function TXmlRegistry.CreateSubKey (S : String; N : TDomElement) : TDomElement;
+
+begin
+  Result:=FDocument.CreateElement(SKey);
+  Result[SName]:=S;
+  N.AppendChild(Result);
+  FDirty:=True;
+end;
+
+Function  TXmlRegistry.FindValueKey (S : String) : TDomElement;
+
+Var
+  Node : TDOMNode;
+
+begin
+  If FCurrentElement<>Nil then
+    begin
+    Node:=FCurrentElement.FirstChild;
+    Result:=Nil;
+    While (Result=Nil) and (Assigned(Node)) do
+      begin
+      If (Node.NodeType=ELEMENT_NODE) and (Node.NodeName=SValue) then
+        If CompareText(TDomElement(Node)[SName],S)=0 then
+          Result:=TDomElement(Node);
+      Node:=Node.NextSibling;
+      end;    
+    end;  
+end;
+
+Function  TXmlRegistry.CreateValueKey (S : String) : TDomElement;
+
+begin
+  If Assigned(FCurrentElement) then
+    begin
+    Result:=FDocument.CreateElement(SValue);
+    Result[SName]:=S;
+    // textnode to hold the value;
+    Result.AppendChild(FDocument.CreateTextNode(''));
+    FCurrentElement.AppendChild(Result);
+    FDirty:=True;
+    end
+  else
+    Result:=Nil;  
+end;
+ 
+Procedure TXMLregistry.MaybeFlush;
+ 
+begin
+  If FAutoFlush then
+    Flush;
+end; 
+ 
+Procedure TXmlRegistry.Flush;
+
+Var 
+  S : TStream;
+
+begin
+  If FDirty then
+    begin
+    S:=TFileStream.Create(FFileName,fmCreate);
+    Try
+      WriteXMLFile(FDocument,S);
+      FDirty:=False;
+    finally
+      S.Free;
+    end;  
+    end;
+end;
+
+Procedure TXmlRegistry.Load;
+
+Var
+  S : TStream;
+ 
+begin
+  If Not FileExists(FFileName) then
+    CreateEmptyDoc
+  else
+    begin   
+    S:=TFileStream.Create(FFileName,fmOpenReadWrite);
+    try
+      LoadFromStream(S);
+    finally
+      S.Free;
+    end;
+    end;
+end;
+
+Procedure TXmlRegistry.LoadFromStream(S : TStream);
+
+begin
+  If Assigned(FDocument) then 
+    begin
+    FDocument.Free;
+    FDocument:=Nil;
+    end;
+  ReadXMLFile(FDocument,S);
+  if (FDocument=Nil) then 
+    CreateEmptyDoc;
+  FCurrentElement:=Nil;
+  FCurrentKey:='';
+  FRootKey:='';
+  FDirty:=False;
+end;
+
+Function TXmlRegistry.BufToHex(Const Buf; Len : Integer) : String;
+
+Var
+  P : PByte;
+  S : String;
+  I : Integer;
+    
+begin
+  SetLength(Result,Len*2);
+  P:=@Buf;
+  For I:=0 to Len-1 do
+    begin
+    S:=HexStr(P[I],2);
+    Move(S[1],Result[I*2+1],2);
+    end;
+end;
+
+Function TXMLRegistry.hexToBuf(Const Str : String; Var Buf; Var Len : Integer ) : Integer;
+
+Var
+  I : Integer;
+  P : PByte;
+  S : String;
+  B : Byte;
+  Code : Integer;
+  
+begin
+  P:=@Buf;
+  Len:= Length(Str) div 2;
+  For I:=0 to Len-1 do
+    begin
+    S:='$'+Copy(Str,(I*2)+1,2);
+    Val(S,B,Code);
+    If Code<>0 then
+      begin
+      Inc(Result);
+      B:=0;
+      end;
+    P[I]:=B;  
+    end;
+end;
+
+Function TXMLRegistry.DeleteValue(S : String) : Boolean;
+
+Var 
+  N : TDomElement;
+
+begin
+  N:=FindValueKey(S);
+  Result:=(N<>Nil);
+  If Result then
+    begin
+    FCurrentElement.RemoveChild(N);
+    FDirty:=True;
+    MaybeFlush;
+    end;
+end;
+
+Function TXMLRegistry.GetValueSize(Name : String) : Integer;
+
+Var
+  Info : TDataInfo;
+
+begin
+  If GetValueInfo(Name,Info) then
+    Result:=Info.DataSize
+  else
+    Result:=-1;
+end;
+
+Function TXMLRegistry.GetValueType(Name : String) : TDataType;
+
+Var
+  Info : TDataInfo;
+
+begin
+  If GetValueInfo(Name,Info) then
+    Result:=Info.DataType
+  else
+    Result:=dtUnknown;
+end;
+
+Function TXMLRegistry.GetValueInfo(Name : String; Var Info : TDataInfo) : Boolean;
+
+Var 
+  N  : TDomElement;
+  DN : TDomNode;
+begin
+  N:=FindValueKey(Name);
+  Result:=(N<>Nil);
+  If Result then
+    begin
+    DN:=N.FirstChild;
+    Result:=DN<>Nil;
+    If Result then
+    With Info do
+      begin
+      DataType:=TDataType(StrToIntDef(N[SType],0));
+      Case DataType of
+        dtUnknown : DataSize:=0;
+        dtDword   : Datasize:=SizeOf(Cardinal);
+        dtString  : DataSize:=Length(DN.NodeValue);
+        dtBinary  : DataSize:=Length(DN.NodeValue) div 2;
+      end;
+      end;
+    end;  
+end;
+
+Function  TXMLRegistry.GetKeyInfo(Var Info : TKeyInfo) : Boolean;
+
+Var
+  Node,DataNode : TDOMNode;
+  L    : Integer;
+  
+begin
+  FillChar(Info,SizeOf(Info),0);
+  Result:=FCurrentElement<>Nil;
+  If Result then
+    With Info do
+      begin
+      If (FFileName<>'') Then
+        FTime:=FileAge(FFileName);
+      Node:=FCurrentElement.FirstChild;
+      While Assigned(Node) do
+        begin
+        If (Node.NodeType=ELEMENT_NODE) then
+          If (Node.NodeName=SKey) then
+            begin
+            Inc(SubKeys);
+            L:=Length(TDomElement(Node)[SName]);
+            If (L>SubKeyLen) then
+              SubKeyLen:=L;
+            end
+          else if (Node.NodeName=SValue) then
+            begin
+            Inc(Values);
+            L:=Length(TDomElement(Node)[SName]);
+            If (L>ValueLen) then
+              ValueLen:=L;
+            DataNode:=TDomElement(Node).FirstChild;
+            If (DataNode<>Nil) and (DataNode is TDomText) then
+              Case TDataType(StrToIntDef(TDomElement(Node)[SType],0)) of
+                dtUnknown : L:=0;
+                dtDWord   : L:=4;
+                DtString  : L:=Length(DataNode.NodeValue);
+                dtBinary  : L:=Length(DataNode.NodeValue) div 2;
+              end
+            else
+              L:=0;  
+            If (L>DataLen) Then
+              DataLen:=L;  
+            end;
+        Node:=Node.NextSibling;
+        end;
+      end;  
+end;
+
+Function TXMLRegistry.EnumSubKeys(List : TStrings) : Integer;
+
+Var
+  Node : TDOMNode;
+
+begin
+  List.Clear;
+  Result:=0;
+  If FCurrentElement<>Nil then
+    begin
+    Node:=FCurrentElement.FirstChild;
+    While Assigned(Node) do
+      begin
+      If (Node.NodeType=ELEMENT_NODE) and (Node.NodeName=SKey) then
+        List.Add(TDomElement(Node)[SName]);
+      Node:=Node.NextSibling;
+      end;
+    Result:=List.Count;
+    end;  
+end;
+
+Function TXMLRegistry.EnumValues(List : TStrings) : Integer;
+
+Var
+  Node : TDOMNode;
+
+begin
+  List.Clear;
+  Result:=0;
+  If FCurrentElement<>Nil then
+    begin
+    Node:=FCurrentElement.FirstChild;
+    While Assigned(Node) do
+      begin
+      If (Node.NodeType=ELEMENT_NODE) and (Node.NodeName=SValue) then
+        List.Add(TDomElement(Node)[SName]);
+      Node:=Node.NextSibling;
+      end;
+    Result:=List.Count;
+    end;  
+end;
+
+Function TXMLRegistry.KeyExists(KeyPath : String) : Boolean;
+
+begin
+  Result:=FindKey(KeyPath)<>Nil;
+end;
+
+Function TXMLRegistry.RenameValue(Const OldName,NewName : String) : Boolean;
+
+Var 
+  N : TDomElement;
+
+begin
+  N:=FindValueKey(OldName);
+  If (N<>Nil) then
+    begin
+    N[SName]:=NewName;
+    FDirty:=True;
+    MaybeFlush;
+    end;
+end;
+
+Function TXMLRegistry.FindKey (S : String) : TDomElement;
+
+Var
+  SubKey : String;
+  P : Integer;
+  Node : TDomElement;
+  
+begin
+  Result:=Nil;
+  If (Length(S)=0) then
+    Exit;
+  S:=NormalizeKey(S);  
+  If (S[1]<>'/') then
+    Node:=FCurrentElement
+  else
+    begin
+    Delete(S,1,1);
+    Node:=FDocument.DocumentElement;
+    If (FRootKey<>'') then
+      S:=FRootKey+S;
+    end;
+  repeat
+    P:=Pos('/',S);
+    If (P<>0) then
+      begin
+      SubKey:=Copy(S,1,P-1);
+      Delete(S,1,P);
+      Result:=FindSubKey(SubKey,Node);
+      Node:=Result;
+      end;
+  Until (Result=Nil) or (Length(S)=0);
+end;
+
+Function  TXmlRegistry.ValueExists(ValueName : String) : Boolean;
+
+begin
+  Result:=FindValueKey(ValueName)<>Nil;
+end;
+
+
+end.

fcl/win32/winreg.inc

@@ -0,0 +1,257 @@
+{******************************************************************************
+                                  TRegistry
+ ******************************************************************************}
+
+Procedure TRegistry.SysRegCreate;
+begin
+  FStringSizeIncludesNull:=True;
+end;
+
+Procedure TRegistry.SysRegfree;
+
+begin
+end;
+
+Function PrepKey(Const S : String) : pChar;
+
+begin
+  If (S[1]<>'\') then
+    Result:=@S[1]
+  else
+    Result:=@S[2];
+end;
+
+Function RelativeKey(Const S : String) : Boolean;
+
+begin
+  Result:=(S[1]<>'\')
+end;
+
+
+function TRegistry.sysCreateKey(const Key: String): Boolean;
+Var
+  P: PChar;
+  Disposition: LPDWord;
+  Handle: HKEY;
+  SecurityAttributes: Pointer; //LPSECURITY_ATTRIBUTES;
+
+begin
+  SecurityAttributes := Nil;
+  P:=PrepKey(Key);
+  Result:=RegCreateKeyEx(GetBaseKey(RelativeKey(Key)),
+                         P,
+                         0,
+                         '',
+                         REG_OPTION_NON_VOLATILE,
+                         KEY_ALL_ACCESS,
+                         SecurityAttributes,
+                         Handle,
+                         Disposition) = ERROR_SUCCESS;
+  RegCloseKey(Handle);
+end;
+
+function TRegistry.DeleteKey(const Key: String): Boolean;
+
+Var
+  P: PChar;
+
+begin
+  P:=PRepKey(Key);
+  Result:=RegDeleteKey(GetBaseKey(RelativeKey(Key)),P)=ERROR_SUCCESS;
+end;
+
+function TRegistry.DeleteValue(const Name: String): Boolean;
+begin
+  Result := RegDeleteValue(fCurrentKey, @Name[1]) = ERROR_SUCCESS;
+end;
+
+function TRegistry.SysGetData(const Name: String; Buffer: Pointer;
+          BufSize: Integer; var RegData: TRegDataType): Integer;
+Var
+  P: PChar;
+  RD : DWord;
+  
+begin
+  P := @Name[1];
+  If RegQueryValueEx(fCurrentKey,P,Nil,
+                     @RD,Buffer,@BufSize)<>ERROR_SUCCESS Then
+    Result:=-1
+  else                  
+    begin
+    If (RD=REG_SZ) then
+      RegData:=rdString
+    else if (RD=REG_EXPAND_SZ) then
+      Regdata:=rdExpandString
+    else if (RD=REG_DWORD) then
+      RegData:=rdInteger
+    else if (RD=REG_BINARY) then
+      RegData:=rdBinary
+    else
+      RegData:=rdUnknown;  
+    Result:=BufSize;
+    end;
+end;
+
+function TRegistry.GetDataInfo(const ValueName: String; var Value: TRegDataInfo): Boolean;
+
+Var
+  P: PChar;
+
+begin
+  P:=@ValueName[1];
+  With Value do
+    Result:=RegQueryValueEx(fCurrentKey,P,Nil,@RegData,Nil,@DataSize)=ERROR_SUCCESS;
+  If Not Result Then
+    begin
+    Value.RegData := rdUnknown;
+    Value.DataSize := 0
+    end
+end;
+
+function TRegistry.GetKey(const Key: String): HKEY;
+begin
+  Result := 0;
+end;
+
+function TRegistry.GetKeyInfo(var Value: TRegKeyInfo): Boolean;
+begin
+  Result := True;
+end;
+
+function TRegistry.KeyExists(const Key: string): Boolean;
+begin
+  Result := True;
+end;
+
+function TRegistry.LoadKey(const Key, FileName: string): Boolean;
+begin
+  Result := True;
+end;
+
+function TRegistry.OpenKey(const Key: string; CanCreate: Boolean): Boolean;
+
+Var
+  P: PChar;
+  Handle: HKEY;
+  Disposition: LPDWord;
+  SecurityAttributes: Pointer; //LPSECURITY_ATTRIBUTES;
+
+begin
+  SecurityAttributes := Nil;
+  P:=PrepKey(Key);
+  If CanCreate then
+    Result:=RegCreateKeyEx(GetBaseKey(RelativeKey(Key)),P,0,'',
+                           REG_OPTION_NON_VOLATILE,
+                           fAccess,SecurityAttributes,Handle,
+                           Disposition)=ERROR_SUCCESS 
+  else
+    Result:=RegOpenKeyEx(GetBaseKey(RelativeKey(Key)),
+                         P,0,fAccess,Handle)=ERROR_SUCCESS;
+  If Result then 
+    fCurrentKey:=Handle;
+end;
+
+function TRegistry.OpenKeyReadOnly(const Key: string): Boolean;
+
+Var
+  P: PChar;
+  Handle: HKEY;
+
+begin
+  P:=PrepKey(Key);
+  Result := RegOpenKeyEx(GetBaseKey(RelativeKey(Key)),P,0,KEY_READ,Handle) = 0;
+  If Result Then 
+    fCurrentKey := Handle;
+end;
+
+function TRegistry.RegistryConnect(const UNCName: string): Boolean;
+begin
+  Result := True;
+end;
+
+function TRegistry.ReplaceKey(const Key, FileName, BackUpFileName: string): Boolean;
+begin
+  Result := True;
+end;
+
+function TRegistry.RestoreKey(const Key, FileName: string): Boolean;
+begin
+  Result := True;
+end;
+
+function TRegistry.SaveKey(const Key, FileName: string): Boolean;
+begin
+  Result := True;
+end;
+
+function TRegistry.UnLoadKey(const Key: string): Boolean;
+begin
+  Result := True;
+end;
+
+function TRegistry.ValueExists(const Name: string): Boolean;
+begin
+  Result := True;
+end;
+
+procedure TRegistry.CloseKey;
+begin
+  If (CurrentKey<>0) then
+    begin
+    if LazyWrite then
+      RegCloseKey(CurrentKey) 
+    else
+      RegFlushKey(CurrentKey);
+    fCurrentKey:=0;
+    end
+end;
+
+procedure TRegistry.ChangeKey(Value: HKey; const Path: String);
+begin
+
+end;
+
+procedure TRegistry.GetKeyNames(Strings: TStrings);
+begin
+
+end;
+
+procedure TRegistry.GetValueNames(Strings: TStrings);
+begin
+
+end;
+
+Function TRegistry.SysPutData(const Name: string; Buffer: Pointer;
+  BufSize: Integer; RegData: TRegDataType) : Boolean;
+
+Var
+  P: PChar;
+  RegDataType: DWORD;
+
+begin
+  Case RegData of
+    rdUnknown      : RegDataType:=REG_NONE;
+    rdString       : RegDataType:=REG_SZ;
+    rdExpandString : RegDataType:=REG_EXPAND_SZ;
+    rdInteger      : RegDataType:=REG_DWORD;
+    rdBinary       : RegDataType:=REG_BINARY;
+  end;
+  P:=@Name[1];
+  Result:=RegSetValueEx(fCurrentKey,P,0,RegDataType,Buffer,BufSize)=ERROR_SUCCESS;
+end;
+
+procedure TRegistry.RenameValue(const OldName, NewName: string);
+begin
+
+end;
+
+procedure TRegistry.SetCurrentKey(Value: HKEY);
+begin
+  fCurrentKey := Value;
+end;
+
+procedure TRegistry.SetRootKey(Value: HKEY);
+begin
+  fRootKey := Value;
+end;
+