paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-16 05:59:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Fixed bug ID #22611

Browse Source 
git-svn-id: trunk@26764 -
This commit is contained in:
michael 2014-02-13 16:31:19 +00:00
parent da019b889c
commit 4154f531ff
2 changed files with 158 additions and 80 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

153
packages/fcl-registry/src/regini.inc
View File

@ -119,6 +119,72 @@ begin
end;
end;
procedure TRegIniFile.WriteDate(const Section, Ident: string; Value: TDateTime);
begin
if OpenSection(Section,true) then
try
if not fPreferStringValues then
inherited WriteDate(Ident,Value)
else if ValueExists(Ident) and (GetDataType(Ident)<>rdString) then
inherited WriteDate(Ident,Value)
else
inherited WriteString(Ident,DateToStr(Value));
finally
CloseKey;
end;
end;
procedure TRegIniFile.WriteDateTime(const Section, Ident: string; Value: TDateTime);
begin
if OpenSection(Section,true) then
try
if not fPreferStringValues then
inherited WriteDateTime(Ident,Value)
else if ValueExists(Ident) and (GetDataType(Ident)<>rdString) then
inherited WriteDateTime(Ident,Value)
else
inherited WriteString(Ident,DateTimeToStr(Value));
finally
CloseKey;
end;
end;
procedure TRegIniFile.WriteTime(const Section, Ident: string; Value: TDateTime);
begin
if OpenSection(Section,true) then
try
if not fPreferStringValues then
inherited WriteTime(Ident,Value)
else if ValueExists(Ident) and (GetDataType(Ident)<>rdString) then
inherited WriteTime(Ident,Value)
else
inherited WriteString(Ident,TimeToStr(Value));
finally
CloseKey;
end;
end;
procedure TRegIniFile.WriteFloat(const Section, Ident: string; Value: Double);
begin
if OpenSection(Section,true) then
try
if not fPreferStringValues then
inherited WriteFloat(Ident,Value)
else if ValueExists(Ident) and (GetDataType(Ident)<>rdString) then
inherited WriteFloat(Ident,Value)
else
inherited WriteString(Ident,FloatToStr(Value));
finally
CloseKey;
end;
end;
function TRegIniFile.ReadBool(const Section, Ident: string; Default: Boolean): Boolean;
begin
Result := Default;
@ -161,20 +227,87 @@ begin
end;
end;
function TRegIniFile.ReadDate(const Section, Ident: string; Default: TDateTime):TDateTime;
begin
Result := Default;
if OpenSection(Section) then
try
if ValueExists(Ident) then
if (not fPreferStringValues) or (GetDataType(Ident)<>rdString) then
Result := inherited ReadDate(Ident)
else
Result := StrToDateDef(inherited ReadString(Ident),Result);
finally
CloseSection;
end;
end;
function TRegIniFile.ReadDateTime(const Section, Ident: string; Default: TDateTime):TDateTime;
begin
Result := Default;
if OpenSection(Section) then
try
if ValueExists(Ident) then
if (not fPreferStringValues) or (GetDataType(Ident)<>rdString) then
Result := inherited ReadDateTime(Ident)
else
Result := StrToDateTimeDef(inherited ReadString(Ident),Result);
finally
CloseSection;
end;
end;
function TRegIniFile.ReadTime(const Section, Ident: string; Default: TDateTime):TDateTime;
begin
Result := Default;
if OpenSection(Section) then
try
if ValueExists(Ident) then
if (not fPreferStringValues) or (GetDataType(Ident)<>rdString) then
Result := inherited ReadTime(Ident)
else
Result := StrToTimeDef(inherited ReadString(Ident),Result);
finally
CloseSection;
end;
end;
function TRegIniFile.ReadFloat(const Section, Ident: string; Default: Double): Double;
begin
Result := Default;
if OpenSection(Section) then
try
if ValueExists(Ident) then
if (not fPreferStringValues) or (GetDataType(Ident)<>rdString) then
Result := inherited ReadFloat(Ident)
else
Result := StrToFloatDef(inherited ReadString(Ident),Result);
finally
CloseSection;
end;
end;
function TRegIniFile.OpenSection(const Section: string; CreateSection : Boolean = false): boolean;
var
k: HKEY;
S : String;
begin
S:=Section;
If (S<>'') and (S[1] = '\') then
Delete(S,1,1);
if CreateSection then
CreateKey(Section);
ASSERT(fOldCurKey = 0);
if Section <> '' then begin
k:=GetKey(Section);
if k = 0 then begin
CreateKey('\'+FPath+S);
if Section <> '' then
begin
k:=GetKey('\'+FPath+S);
if k = 0 then
begin
Result:=False;
exit;
end;
fOldCurKey:=CurrentKey;
end;
SetCurrentKey(k);
end;
Result:=True;
@ -182,10 +315,6 @@ end;
procedure TRegIniFile.CloseSection;
begin
if fOldCurKey <> 0 then begin
CloseKey(CurrentKey);
SetCurrentKey(fOldCurKey);
fOldCurKey:=0;
end;
CloseKey(CurrentKey);
end;

85
packages/fcl-registry/src/registry.pp
View File

@ -132,21 +132,26 @@ type
fFileName : String;
fPath : String;
fPreferStringValues: Boolean;
fOldCurKey : HKEY;
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 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);
@ -493,43 +498,19 @@ end;
function TRegistryIniFile.ReadDate(const Section, Name: string;
Default: TDateTime): TDateTime;
begin
Result:=Default;
with FRegInifile do
if OpenSection(Section) then
try
if ValueExists(Name) then
Result:=FRegInifile.ReadDate(Name);
finally
CloseSection;
end;
Result:=FRegInifile.ReadDate(Section,Name,Default);
end;
function TRegistryIniFile.ReadDateTime(const Section, Name: string;
Default: TDateTime): TDateTime;
begin
Result:=Default;
with FRegInifile do
if OpenSection(Section) then
try
if ValueExists(Name) then
Result:=FRegInifile.ReadDateTime(Name);
finally
CloseSection;
end;
Result:=FRegInifile.ReadDateTime(Section,Name,Default);
end;
function TRegistryIniFile.ReadFloat(const Section, Name: string;
Default: Double): Double;
begin
Result:=Default;
with FRegInifile do
if OpenSection(Section) then
try
if ValueExists(Name) then
Result:=FRegInifile.ReadFloat(Name);
finally
CloseSection;
end;
Result:=FRegInifile.ReadFloat(Section,Name,Default);
end;
function TRegistryIniFile.ReadInteger(const Section, Name: string;
@ -563,15 +544,7 @@ end;
function TRegistryIniFile.ReadTime(const Section, Name: string;
Default: TDateTime): TDateTime;
begin
Result:=Default;
with FRegInifile do
if OpenSection(Section) then
try
if ValueExists(Name) then
Result:=FRegInifile.ReadTime(Name);
finally
CloseSection;
end;
Result:=FRegInifile.ReadTime(Section,Name,Default);
end;
procedure TRegistryIniFile.UpdateFile;
@ -588,37 +561,19 @@ end;
procedure TRegistryIniFile.WriteDate(const Section, Name: string;
Value: TDateTime);
begin
with FRegInifile do
if OpenSection(Section) then
try
FRegInifile.WriteDate(Name, Value);
finally
CloseSection;
end;
FRegInifile.WriteDate(Section,Name, Value);
end;
procedure TRegistryIniFile.WriteDateTime(const Section, Name: string;
Value: TDateTime);
begin
with FRegInifile do
if OpenSection(Section) then
try
FRegInifile.WriteDateTime(Name, Value);
finally
CloseSection;
end;
FRegInifile.WriteDateTime(Section,Name, Value);
end;
procedure TRegistryIniFile.WriteFloat(const Section, Name: string;
Value: Double);
begin
with FRegInifile do
if OpenSection(Section) then
try
FRegInifile.WriteFloat(Name, Value);
finally
CloseSection;
end;
FRegInifile.WriteFloat(Section,Name, Value);
end;
procedure TRegistryIniFile.WriteInteger(const Section, Name: string;
@ -635,13 +590,7 @@ end;
procedure TRegistryIniFile.WriteTime(const Section, Name: string;
Value: TDateTime);
begin
with FRegInifile do
if OpenSection(Section) then
try
FRegInifile.WriteTime(Name, Value);
finally
CloseSection;
end;
FRegInifile.WriteTime(Section,Name, Value);
end;
function TRegistryIniFile.ValueExists(const Section, Ident: string): Boolean;