diff options
Diffstat (limited to 'packages/fcl-registry')
| -rw-r--r-- | packages/fcl-registry/src/regini.inc | 48 | ||||
| -rw-r--r-- | packages/fcl-registry/src/registry.pp | 7 | ||||
| -rw-r--r-- | packages/fcl-registry/src/xmlreg.pp | 34 | ||||
| -rw-r--r-- | packages/fcl-registry/tests/testbasics.pp | 43 |
4 files changed, 96 insertions, 36 deletions
diff --git a/packages/fcl-registry/src/regini.inc b/packages/fcl-registry/src/regini.inc index 78e525cbe5..227405619e 100644 --- a/packages/fcl-registry/src/regini.inc +++ b/packages/fcl-registry/src/regini.inc @@ -83,30 +83,44 @@ procedure TRegIniFile.WriteBool(const Section, Ident: string; Value: Boolean); begin if not OpenKey(fPath+Section,true) then Exit; try - inherited WriteBool(Ident,Value); - finally - CloseKey; + if not fPreferStringValues then + inherited WriteBool(Ident,Value) + else begin + if ValueExists(Ident) and (GetDataType(Ident)=rdInteger) then + inherited WriteBool(Ident,Value) + else + inherited WriteString(Ident,BoolToStr(Value)); + end; + finally + CloseKey; end; end; procedure TRegIniFile.WriteInteger(const Section, Ident: string; Value: LongInt); begin if not OpenKey(fPath+Section,true) then Exit; - try - inherited WriteInteger(Ident,Value); - finally - CloseKey; - end; + try + if not fPreferStringValues then + inherited WriteInteger(Ident,Value) + else begin + if ValueExists(Ident) and (GetDataType(Ident)=rdInteger) then + inherited WriteInteger(Ident,Value) + else + inherited WriteString(Ident,IntToStr(Value)); + end; + finally + CloseKey; + end; end; procedure TRegIniFile.WriteString(const Section, Ident, Value: String); begin - if not OpenKey(fPath+Section,true) then Exit; - try + if not OpenKey(fPath+Section,true) then Exit; + try inherited WriteString(Ident,Value); - finally + finally CloseKey; - end; + end; end; function TRegIniFile.ReadBool(const Section, Ident: string; Default: Boolean): Boolean; @@ -115,7 +129,10 @@ begin if not OpenKey(fPath+Section,false) then Exit; try if ValueExists(Ident) then - Result := inherited ReadBool(Ident); + if (not fPreferStringValues) or (GetDataType(Ident)=rdInteger) then + Result := inherited ReadBool(Ident) + else + Result := StrToBool(inherited ReadString(Ident)); finally CloseKey; end; @@ -127,7 +144,10 @@ begin if not OpenKey(fPath+Section,false) then Exit; try if ValueExists(Ident) then - Result := inherited ReadInteger(Ident); + if (not fPreferStringValues) or (GetDataType(Ident)=rdInteger) then + Result := inherited ReadInteger(Ident) + else + Result := StrToInt(inherited ReadString(Ident)); finally CloseKey; end; diff --git a/packages/fcl-registry/src/registry.pp b/packages/fcl-registry/src/registry.pp index 8a3ea3f6c1..5bce60501c 100644 --- a/packages/fcl-registry/src/registry.pp +++ b/packages/fcl-registry/src/registry.pp @@ -130,8 +130,9 @@ type ---------------------------------------------------------------------} TRegIniFile = class(TRegistry) private - fFileName: String; - fPath : String; + fFileName : String; + fPath : String; + fPreferStringValues: Boolean; public constructor Create(const FN: string); overload; constructor Create(const FN: string;aaccess:longword); overload; @@ -150,6 +151,8 @@ type procedure DeleteKey(const Section, Ident: String); property FileName: String read fFileName; + property PreferStringValues: Boolean read fPreferStringValues + write fPreferStringValues; end; { --------------------------------------------------------------------- diff --git a/packages/fcl-registry/src/xmlreg.pp b/packages/fcl-registry/src/xmlreg.pp index ef0274340b..1fca47aae2 100644 --- a/packages/fcl-registry/src/xmlreg.pp +++ b/packages/fcl-registry/src/xmlreg.pp @@ -352,22 +352,24 @@ begin begin Node[SType]:=IntToStr(Ord(DataType)); DataNode:=Node.FirstChild; - Result:=DataNode<>Nil; // Bug 9879. Create child here? - If Result Then - begin - 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; + // Reading <value></value> results in <value/>, i.e. no subkey exists any more. Create textnode. + if (DataNode=nil) then + begin + DataNode:=FDocument.CreateTextNode(''); + Node.AppendChild(DataNode); + end; + 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 diff --git a/packages/fcl-registry/tests/testbasics.pp b/packages/fcl-registry/tests/testbasics.pp index 9248555ebb..6de7106e84 100644 --- a/packages/fcl-registry/tests/testbasics.pp +++ b/packages/fcl-registry/tests/testbasics.pp @@ -19,6 +19,7 @@ type protected published procedure TestSimpleWinRegistry; + procedure TestDoubleWrite; end; implementation @@ -37,15 +38,49 @@ begin // use a hopefully non existing key AssertFalse(Registry.KeyExists('FPC1234')); - +{$ifdef windows} AssertTrue(Registry.KeyExists('SOFTWARE')); - - // Registry.OpenKey('FPC', False); - // Result:=Registry.ReadString('VALUE1'); +{$endif} Registry.Free; end; +procedure TTestBasics.TestDoubleWrite; + +{$ifndef windows} +Var + FN : String; +{$endif} + +begin +{$ifndef windows} + FN:=includetrailingpathdelimiter(GetAppConfigDir(False))+'reg.xml'; + if FileExists(FN) then + AssertTrue(DeleteFile(FN)); +{$endif} + with TRegistry.Create do + try + OpenKey('test', true); + WriteString('LAYOUT', ''); + CloseKey; + finally + Free; + end; + with TRegistry.Create do + try + OpenKey('test', true); + WriteString('LAYOUT', ''); + CloseKey; + finally + Free; + end; +{$ifndef windows} + FN:=includetrailingpathdelimiter(GetAppConfigDir(False))+'reg.xml'; + if FileExists(FN) then + AssertTrue(DeleteFile(FN)); +{$endif} +end; + initialization RegisterTest(TTestBasics); end. |