paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-02 02:52:54 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fix for #7418 from forest

Browse Source 
git-svn-id: trunk@4721 -
This commit is contained in:
florian 2006-09-24 19:28:32 +00:00
parent 2639b104cc
commit 9bc1960e93
3 changed files with 30 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
fcl/inc/registry.pp
View File

@ -305,7 +305,7 @@ function TRegistry.ReadDate(const Name: string): TDateTime;
begin begin
ReadBinaryData(Name, Result, SizeOf(TDateTime)); ReadBinaryData(Name, Result, SizeOf(TDateTime));
Result:=Round(Result); Result:=Trunc(Result);
end; end;
function TRegistry.ReadDateTime(const Name: string): TDateTime; function TRegistry.ReadDateTime(const Name: string): TDateTime;

36
fcl/inc/xmlreg.pp
View File

@ -26,6 +26,8 @@ Type
end; end;
{ TXmlRegistry }
TXmlRegistry = Class(TObject) TXmlRegistry = Class(TObject)
Private Private
FAutoFlush, FAutoFlush,
@ -52,6 +54,7 @@ Type
Property Dirty : Boolean Read FDirty write FDirty; Property Dirty : Boolean Read FDirty write FDirty;
Public Public
Constructor Create(AFileName : String); Constructor Create(AFileName : String);
Destructor Destroy;override;
Function SetKey(KeyPath : String; AllowCreate : Boolean) : Boolean ; Function SetKey(KeyPath : String; AllowCreate : Boolean) : Boolean ;
Procedure SetRootKey(Value : String); Procedure SetRootKey(Value : String);
Function DeleteKey(KeyPath : String) : Boolean; Function DeleteKey(KeyPath : String) : Boolean;
@ -99,6 +102,12 @@ begin
CreateEmptyDoc; CreateEmptyDoc;
end; end;
destructor TXmlRegistry.Destroy;
begin
if Assigned(FDocument) then FDocument.Free;
inherited Destroy;
end;
Procedure TXmlRegistry.SetFileName(Value : String); Procedure TXmlRegistry.SetFileName(Value : String);
begin begin
@ -139,6 +148,8 @@ begin
L:=Length(Result); L:=Length(Result);
If (L>0) and (Result[L]<>'/') then If (L>0) and (Result[L]<>'/') then
Result:=Result+'/'; Result:=Result+'/';
If (L>0) and (Result[1]<>'/') then
Result:='/' + Result;
end; end;
Function TXmlRegistry.SetKey(KeyPath : String; AllowCreate : Boolean) : boolean; Function TXmlRegistry.SetKey(KeyPath : String; AllowCreate : Boolean) : boolean;
@ -153,8 +164,9 @@ begin
If Not Result then If Not Result then
Exit; Exit;
KeyPath:=NormalizeKey(KeyPath); KeyPath:=NormalizeKey(KeyPath);
If (KeyPath[1]<>'/') then If (FCurrentElement<>nil) then
begin begin
Delete(Keypath,1,1);
Node:=FCurrentElement; Node:=FCurrentElement;
Resultkey:=FCurrentKey; Resultkey:=FCurrentKey;
end end
@ -237,8 +249,11 @@ begin
If Not Result then If Not Result then
Exit; Exit;
KeyPath:=NormalizeKey(KeyPath); KeyPath:=NormalizeKey(KeyPath);
If (KeyPath[1]<>'/') then If (FCurrentElement<>nil) then
Node:=FCurrentElement begin
Delete(Keypath,1,1);
Node:=FCurrentElement;
end
else else
begin begin
Delete(Keypath,1,1); Delete(Keypath,1,1);
@ -383,7 +398,8 @@ Function TXmlRegistry.CreateSubKey (S : String; N : TDomElement) : TDomElement;
begin begin
Result:=FDocument.CreateElement(SKey); Result:=FDocument.CreateElement(SKey);
Result[SName]:=S; Result[SName]:=S;
N.AppendChild(Result); if N<>nil then
N.AppendChild(Result);
FDirty:=True; FDirty:=True;
end; end;
@ -448,6 +464,7 @@ begin
end; end;
end; end;
Procedure TXmlRegistry.Load; Procedure TXmlRegistry.Load;
Var Var
@ -478,9 +495,7 @@ begin
ReadXMLFile(FDocument,S); ReadXMLFile(FDocument,S);
if (FDocument=Nil) then if (FDocument=Nil) then
CreateEmptyDoc; CreateEmptyDoc;
FCurrentElement:=Nil; SetRootKey('HKEY_CURRENT_USER');
FCurrentKey:='';
FRootKey:='';
FDirty:=False; FDirty:=False;
end; end;
@ -716,8 +731,11 @@ begin
If (Length(S)=0) then If (Length(S)=0) then
Exit; Exit;
S:=NormalizeKey(S); S:=NormalizeKey(S);
If (S[1]<>'/') then If (FCurrentElement<>nil) then
Node:=FCurrentElement begin
Delete(S,1,1);
Node:=FCurrentElement;
end
else else
begin begin
Delete(S,1,1); Delete(S,1,1);

3
fcl/inc/xregreg.inc
View File

@ -20,7 +20,7 @@ Procedure TRegistry.SysRegFree;
begin begin
TXMLRegistry(FSysData).Flush; TXMLRegistry(FSysData).Flush;
FSysData:=TXMLRegistry.Create(XFileName); TXMLRegistry(FSysData).Free;
end; end;
function TRegistry.SysCreateKey(const Key: String): Boolean; function TRegistry.SysCreateKey(const Key: String): Boolean;
@ -237,4 +237,5 @@ procedure TRegistry.CloseKey;
begin begin
TXMLRegistry(FSysData).Flush; TXMLRegistry(FSysData).Flush;
TXMLRegistry(FSysData).SetRootKey(TXMLRegistry(FSysData).RootKey);
end; end;