View Issue Details

IDProjectCategoryView StatusLast Update
0034875FPCFCLpublic2019-02-09 14:58
ReporterCCRDudeAssigned ToMarco van de Voort 
PrioritynormalSeverityminorReproducibilityalways
Status resolvedResolutionfixed 
PlatformIntel PCOSWindowsOS Version10 (1709)
Product Version3.3.1Product Build 
Target VersionFixed in Version3.3.1 
Summary0034875: fcl-registry is missing rdInt64 (REG_QWORD) support
DescriptionTRegistry supports most registry data types, but is missing the last one, REG_QWORD, in the form of a custom data type e.g. like rdInt64.

FreePascal already has more data types than Delphi, so there's no conflict in keeping it exactly the same here.

The required steps are quite simple, while the workaround of using the Windows API to manipulate REG_QWORD currently produces a lot of code overhead.

Attached is a patch listing what should be sufficient to support rdInt64/REG_QWORD.
Additional Information1. Registry.pas needs rdInt64 to be added to the TRegDataType enum.
2. winreg.inc needs REG_QWORD added to the RegDataWords array.
3. Registry.pas needs a ReadInt64 method (copy of ReadInteger, just SizeOf() parameter and RegDataType compare needs to be changed).
4. Registry.pas needs a WriteInt64 method (copy of WritedInteger, just SizeOf() parameter and rdInteger -> rdInt64 needs to be changed).
TagsNo tags attached.
Fixed in Revision41267
FPCOldBugId
FPCTarget
Attached Files
  • reg-rdint64.patch (2,936 bytes)
    Index: packages/fcl-registry/src/registry.pp
    ===================================================================
    --- packages/fcl-registry/src/registry.pp	(revision 40536)
    +++ packages/fcl-registry/src/registry.pp	(working copy)
    @@ -32,7 +32,7 @@
       end;
     
       TRegDataType = (rdUnknown, rdString, rdExpandString, rdBinary, rdInteger, rdIntegerBigEndian,
    -                  rdLink, rdMultiString, rdResourceList, rdFullResourceDescriptor,  rdResourceRequirementList);
    +                  rdLink, rdMultiString, rdResourceList, rdFullResourceDescriptor,  rdResourceRequirementList, rdInt64);
     
       TRegDataInfo = record
         RegData: TRegDataType;
    @@ -95,6 +95,7 @@
         function ReadDateTime(const Name: string): TDateTime;
         function ReadFloat(const Name: string): Double;
         function ReadInteger(const Name: string): Integer;
    +    function ReadInt64(const Name: string): Int64;
         function ReadString(const Name: string): string;
         procedure ReadStringList(const Name: string; AList: TStrings);
         function ReadTime(const Name: string): TDateTime;
    @@ -118,6 +119,7 @@
         procedure WriteDateTime(const Name: string; Value: TDateTime);
         procedure WriteFloat(const Name: string; Value: Double);
         procedure WriteInteger(const Name: string; Value: Integer);
    +    procedure WriteInt64(const Name: string; Value: Int64);
         procedure WriteString(const Name, Value: string);
         procedure WriteExpandString(const Name, Value: string);
         procedure WriteStringList(const Name: string; List: TStrings);
    @@ -346,6 +348,17 @@
         Raise ERegistryException.CreateFmt(SInvalidRegType, [Name]);
     end;
     
    +function TRegistry.ReadInt64(const Name: string): Int64;
    +
    +Var
    +  RegDataType: TRegDataType;
    +
    +begin
    +  GetData(Name, @Result, SizeOf(Int64), RegDataType);
    +  If RegDataType<>rdInt64 Then
    +    Raise ERegistryException.CreateFmt(SInvalidRegType, [Name]);
    +end;
    +
     function TRegistry.ReadBool(const Name: string): Boolean;
     
     begin
    @@ -515,6 +528,11 @@
       PutData(Name, @Value, SizeOf(Integer), rdInteger);
     end;
     
    +procedure TRegistry.WriteInt64(const Name: string; Value: Int64);
    +begin
    +  PutData(Name, @Value, SizeOf(Int64), rdInt64);
    +end;
    +
     procedure TRegistry.WriteString(const Name, Value: string);
     var
       u: UnicodeString;
    Index: packages/fcl-registry/src/winreg.inc
    ===================================================================
    --- packages/fcl-registry/src/winreg.inc	(revision 40536)
    +++ packages/fcl-registry/src/winreg.inc	(working copy)
    @@ -1,7 +1,7 @@
     Const
       RegDataWords : Array [TRegDataType] of DWORD
                    = (REG_NONE,REG_SZ,REG_EXPAND_SZ,REG_BINARY,REG_DWORD,REG_DWORD_BIG_ENDIAN,
    -                  REG_LINK,REG_MULTI_SZ,REG_RESOURCE_LIST,REG_FULL_RESOURCE_DESCRIPTOR,REG_RESOURCE_REQUIREMENTS_LIST);
    +                  REG_LINK,REG_MULTI_SZ,REG_RESOURCE_LIST,REG_FULL_RESOURCE_DESCRIPTOR,REG_RESOURCE_REQUIREMENTS_LIST,REG_QWORD);
     
     type
       TWinRegData = record
    
    reg-rdint64.patch (2,936 bytes)

Activities

CCRDude

2019-01-15 12:10

reporter  

reg-rdint64.patch (2,936 bytes)
Index: packages/fcl-registry/src/registry.pp
===================================================================
--- packages/fcl-registry/src/registry.pp	(revision 40536)
+++ packages/fcl-registry/src/registry.pp	(working copy)
@@ -32,7 +32,7 @@
   end;
 
   TRegDataType = (rdUnknown, rdString, rdExpandString, rdBinary, rdInteger, rdIntegerBigEndian,
-                  rdLink, rdMultiString, rdResourceList, rdFullResourceDescriptor,  rdResourceRequirementList);
+                  rdLink, rdMultiString, rdResourceList, rdFullResourceDescriptor,  rdResourceRequirementList, rdInt64);
 
   TRegDataInfo = record
     RegData: TRegDataType;
@@ -95,6 +95,7 @@
     function ReadDateTime(const Name: string): TDateTime;
     function ReadFloat(const Name: string): Double;
     function ReadInteger(const Name: string): Integer;
+    function ReadInt64(const Name: string): Int64;
     function ReadString(const Name: string): string;
     procedure ReadStringList(const Name: string; AList: TStrings);
     function ReadTime(const Name: string): TDateTime;
@@ -118,6 +119,7 @@
     procedure WriteDateTime(const Name: string; Value: TDateTime);
     procedure WriteFloat(const Name: string; Value: Double);
     procedure WriteInteger(const Name: string; Value: Integer);
+    procedure WriteInt64(const Name: string; Value: Int64);
     procedure WriteString(const Name, Value: string);
     procedure WriteExpandString(const Name, Value: string);
     procedure WriteStringList(const Name: string; List: TStrings);
@@ -346,6 +348,17 @@
     Raise ERegistryException.CreateFmt(SInvalidRegType, [Name]);
 end;
 
+function TRegistry.ReadInt64(const Name: string): Int64;
+
+Var
+  RegDataType: TRegDataType;
+
+begin
+  GetData(Name, @Result, SizeOf(Int64), RegDataType);
+  If RegDataType<>rdInt64 Then
+    Raise ERegistryException.CreateFmt(SInvalidRegType, [Name]);
+end;
+
 function TRegistry.ReadBool(const Name: string): Boolean;
 
 begin
@@ -515,6 +528,11 @@
   PutData(Name, @Value, SizeOf(Integer), rdInteger);
 end;
 
+procedure TRegistry.WriteInt64(const Name: string; Value: Int64);
+begin
+  PutData(Name, @Value, SizeOf(Int64), rdInt64);
+end;
+
 procedure TRegistry.WriteString(const Name, Value: string);
 var
   u: UnicodeString;
Index: packages/fcl-registry/src/winreg.inc
===================================================================
--- packages/fcl-registry/src/winreg.inc	(revision 40536)
+++ packages/fcl-registry/src/winreg.inc	(working copy)
@@ -1,7 +1,7 @@
 Const
   RegDataWords : Array [TRegDataType] of DWORD
                = (REG_NONE,REG_SZ,REG_EXPAND_SZ,REG_BINARY,REG_DWORD,REG_DWORD_BIG_ENDIAN,
-                  REG_LINK,REG_MULTI_SZ,REG_RESOURCE_LIST,REG_FULL_RESOURCE_DESCRIPTOR,REG_RESOURCE_REQUIREMENTS_LIST);
+                  REG_LINK,REG_MULTI_SZ,REG_RESOURCE_LIST,REG_FULL_RESOURCE_DESCRIPTOR,REG_RESOURCE_REQUIREMENTS_LIST,REG_QWORD);
 
 type
   TWinRegData = record
reg-rdint64.patch (2,936 bytes)

Marco van de Voort

2019-02-09 14:58

manager   ~0113983

Committed. It is a bit weird with the signed vs unsigned stuff, but for dword it is the same.

Issue History

Date Modified Username Field Change
2019-01-15 12:10 CCRDude New Issue
2019-01-15 12:10 CCRDude File Added: reg-rdint64.patch
2019-02-09 14:58 Marco van de Voort Fixed in Revision => 41267
2019-02-09 14:58 Marco van de Voort Note Added: 0113983
2019-02-09 14:58 Marco van de Voort Status new => resolved
2019-02-09 14:58 Marco van de Voort Fixed in Version => 3.3.1
2019-02-09 14:58 Marco van de Voort Resolution open => fixed
2019-02-09 14:58 Marco van de Voort Assigned To => Marco van de Voort