View Issue Details

IDProjectCategoryView StatusLast Update
0032114FPCRTLpublic2017-07-23 16:29
ReporterCCRDudeAssigned ToMichael Van Canneyt 
PrioritynormalSeverityminorReproducibilitysometimes
Status resolvedResolutionfixed 
PlatformWindowsOSOS Version
Product Version3.0.2Product Build 
Target Version3.2.0Fixed in Version3.1.1 
Summary0032114: Registry unit should support other data types, e.g. REG_MULTI_SZ
DescriptionThe Registry unit is copying Delphi functionality, which supports just a small subset of the data types available on Windows.

The attached patch adds the missing data types, and implements reading and writing of REG_MULTI_SZ entries from/to TStrings objects.
TagsNo tags attached.
Fixed in Revision36773
FPCOldBugId
FPCTarget
Attached Files
  • registry-reg_multi_sz.32114.patch (4,044 bytes)
    Index: packages/fcl-registry/src/registry.pp
    ===================================================================
    --- packages/fcl-registry/src/registry.pp	(revision 36257)
    +++ packages/fcl-registry/src/registry.pp	(working copy)
    @@ -31,7 +31,7 @@
         FileTime: TDateTime;
       end;
     
    -  TRegDataType = (rdUnknown, rdString, rdExpandString, rdBinary, rdInteger);
    +  TRegDataType = (rdUnknown, rdString, rdExpandString, rdBinary, rdInteger, rdIntegerBigEndian, rdLink, rdMultiString, rdResourceList, rdFullResourceDescriptor, rdResourceRequirementList);
     
       TRegDataInfo = record
         RegData: TRegDataType;
    @@ -95,6 +95,7 @@
         function ReadFloat(const Name: string): Double;
         function ReadInteger(const Name: string): Integer;
         function ReadString(const Name: string): string;
    +    procedure ReadStringList(const Name: string; AList: TStrings);
         function ReadTime(const Name: string): TDateTime;
         function RegistryConnect(const UNCName: string): Boolean;
         function ReplaceKey(const Key, FileName, BackUpFileName: string): Boolean;
    @@ -118,6 +119,7 @@
         procedure WriteInteger(const Name: string; Value: Integer);
         procedure WriteString(const Name, Value: string);
         procedure WriteExpandString(const Name, Value: string);
    +    procedure WriteStringList(const Name: string; List: TStrings);
         procedure WriteTime(const Name: string; Value: TDateTime);
     
         property Access: LongWord read fAccess write fAccess;
    @@ -409,6 +411,40 @@
         result:='';
     end;
     
    +procedure TRegistry.ReadStringList(const Name: string; AList: TStrings);
    +
    +Var
    +  Info : TRegDataInfo;
    +  ReadDataSize: Integer;
    +  Data: string;
    +
    +begin
    +  AList.Clear;
    +  GetDataInfo(Name,Info);
    +  if info.datasize>0 then
    +    begin
    +     If Not (Info.RegData in [rdMultiString]) then
    +       Raise ERegistryException.CreateFmt(SInvalidRegType, [Name]);
    +     SetLength(Data,Info.DataSize);
    +     ReadDataSize := GetData(Name,PChar(Data),Info.DataSize,Info.RegData);
    +     if ReadDataSize > 0 then
    +     begin
    +       // If the data has the REG_SZ, REG_MULTI_SZ or REG_EXPAND_SZ type,
    +       // the size includes any terminating null character or characters
    +       // unless the data was stored without them! (RegQueryValueEx @ MSDN)
    +       if StringSizeIncludesNull then begin
    +         if Data[ReadDataSize] = #0 then
    +           Dec(ReadDataSize);
    +         if Data[ReadDataSize] = #0 then
    +           Dec(ReadDataSize);
    +       end;
    +       SetLength(Data, ReadDataSize);
    +       Data := StringReplace(Data, #0, LineEnding, [rfReplaceAll]);
    +       AList.Text := Data;
    +     end
    +   end
    +end;
    +
     function TRegistry.ReadTime(const Name: string): TDateTime;
     
     begin
    @@ -454,6 +490,16 @@
       PutData(Name, PChar(Value), Length(Value),rdExpandString);
     end;
     
    +procedure TRegistry.WriteStringList(const Name: string; List: TStrings);
    +
    +Var
    +  Data: string;
    +
    +begin
    +  Data := StringReplace(List.Text, LineEnding, #0, [rfReplaceAll]) + #0#0;
    +  PutData(Name, PChar(Data), Length(Data),rdMultiString);
    +end;
    +
     procedure TRegistry.WriteFloat(const Name: string; Value: Double);
     begin
       WriteBinaryData(Name, Value, SizeOf(Double));
    Index: packages/fcl-registry/src/winreg.inc
    ===================================================================
    --- packages/fcl-registry/src/winreg.inc	(revision 36257)
    +++ packages/fcl-registry/src/winreg.inc	(working copy)
    @@ -383,6 +383,12 @@
         rdExpandString : RegDataType:=REG_EXPAND_SZ;
         rdInteger      : RegDataType:=REG_DWORD;
         rdBinary       : RegDataType:=REG_BINARY;
    +    rdIntegerBigEndian        : RegDataType:=REG_DWORD_BIG_ENDIAN;
    +    rdLink                    : RegDataType:=REG_LINK;
    +    rdMultiString             : RegDataType:=REG_MULTI_SZ;
    +    rdResourceList            : RegDataType:=REG_RESOURCE_LIST;
    +    rdFullResourceDescriptor  : RegDataType:=REG_FULL_RESOURCE_DESCRIPTOR;
    +    rdResourceRequirementList : RegDataType:=REG_RESOURCE_REQUIREMENTS_LIST;
       end;
       P:=PChar(Name);
       FLastError:=RegSetValueExA(fCurrentKey,P,0,RegDataType,Buffer,BufSize);
    

Activities

CCRDude

2017-07-05 21:24

reporter  

registry-reg_multi_sz.32114.patch (4,044 bytes)
Index: packages/fcl-registry/src/registry.pp
===================================================================
--- packages/fcl-registry/src/registry.pp	(revision 36257)
+++ packages/fcl-registry/src/registry.pp	(working copy)
@@ -31,7 +31,7 @@
     FileTime: TDateTime;
   end;
 
-  TRegDataType = (rdUnknown, rdString, rdExpandString, rdBinary, rdInteger);
+  TRegDataType = (rdUnknown, rdString, rdExpandString, rdBinary, rdInteger, rdIntegerBigEndian, rdLink, rdMultiString, rdResourceList, rdFullResourceDescriptor, rdResourceRequirementList);
 
   TRegDataInfo = record
     RegData: TRegDataType;
@@ -95,6 +95,7 @@
     function ReadFloat(const Name: string): Double;
     function ReadInteger(const Name: string): Integer;
     function ReadString(const Name: string): string;
+    procedure ReadStringList(const Name: string; AList: TStrings);
     function ReadTime(const Name: string): TDateTime;
     function RegistryConnect(const UNCName: string): Boolean;
     function ReplaceKey(const Key, FileName, BackUpFileName: string): Boolean;
@@ -118,6 +119,7 @@
     procedure WriteInteger(const Name: string; Value: Integer);
     procedure WriteString(const Name, Value: string);
     procedure WriteExpandString(const Name, Value: string);
+    procedure WriteStringList(const Name: string; List: TStrings);
     procedure WriteTime(const Name: string; Value: TDateTime);
 
     property Access: LongWord read fAccess write fAccess;
@@ -409,6 +411,40 @@
     result:='';
 end;
 
+procedure TRegistry.ReadStringList(const Name: string; AList: TStrings);
+
+Var
+  Info : TRegDataInfo;
+  ReadDataSize: Integer;
+  Data: string;
+
+begin
+  AList.Clear;
+  GetDataInfo(Name,Info);
+  if info.datasize>0 then
+    begin
+     If Not (Info.RegData in [rdMultiString]) then
+       Raise ERegistryException.CreateFmt(SInvalidRegType, [Name]);
+     SetLength(Data,Info.DataSize);
+     ReadDataSize := GetData(Name,PChar(Data),Info.DataSize,Info.RegData);
+     if ReadDataSize > 0 then
+     begin
+       // If the data has the REG_SZ, REG_MULTI_SZ or REG_EXPAND_SZ type,
+       // the size includes any terminating null character or characters
+       // unless the data was stored without them! (RegQueryValueEx @ MSDN)
+       if StringSizeIncludesNull then begin
+         if Data[ReadDataSize] = #0 then
+           Dec(ReadDataSize);
+         if Data[ReadDataSize] = #0 then
+           Dec(ReadDataSize);
+       end;
+       SetLength(Data, ReadDataSize);
+       Data := StringReplace(Data, #0, LineEnding, [rfReplaceAll]);
+       AList.Text := Data;
+     end
+   end
+end;
+
 function TRegistry.ReadTime(const Name: string): TDateTime;
 
 begin
@@ -454,6 +490,16 @@
   PutData(Name, PChar(Value), Length(Value),rdExpandString);
 end;
 
+procedure TRegistry.WriteStringList(const Name: string; List: TStrings);
+
+Var
+  Data: string;
+
+begin
+  Data := StringReplace(List.Text, LineEnding, #0, [rfReplaceAll]) + #0#0;
+  PutData(Name, PChar(Data), Length(Data),rdMultiString);
+end;
+
 procedure TRegistry.WriteFloat(const Name: string; Value: Double);
 begin
   WriteBinaryData(Name, Value, SizeOf(Double));
Index: packages/fcl-registry/src/winreg.inc
===================================================================
--- packages/fcl-registry/src/winreg.inc	(revision 36257)
+++ packages/fcl-registry/src/winreg.inc	(working copy)
@@ -383,6 +383,12 @@
     rdExpandString : RegDataType:=REG_EXPAND_SZ;
     rdInteger      : RegDataType:=REG_DWORD;
     rdBinary       : RegDataType:=REG_BINARY;
+    rdIntegerBigEndian        : RegDataType:=REG_DWORD_BIG_ENDIAN;
+    rdLink                    : RegDataType:=REG_LINK;
+    rdMultiString             : RegDataType:=REG_MULTI_SZ;
+    rdResourceList            : RegDataType:=REG_RESOURCE_LIST;
+    rdFullResourceDescriptor  : RegDataType:=REG_FULL_RESOURCE_DESCRIPTOR;
+    rdResourceRequirementList : RegDataType:=REG_RESOURCE_REQUIREMENTS_LIST;
   end;
   P:=PChar(Name);
   FLastError:=RegSetValueExA(fCurrentKey,P,0,RegDataType,Buffer,BufSize);

Michael Van Canneyt

2017-07-05 21:49

administrator   ~0101514

Any chance you will implement this for the registry version as well ?
We're trying to be cross-platform, after all.

J. Gareth Moreton

2017-07-06 03:38

developer   ~0101516

Tricky to be cross-platform as the registry is very much a Windows-specific feature. Nevertheless, I believe there are cross-platform wrappers that map onto a basic (and program-specific) configuration file.

CCRDude

2017-07-06 09:48

reporter   ~0101524

Are you referring to the XML version?

That would probably mean moving the $00<->LineEnding conversion to PutData/GetData, to be able to keep LineEnding for the XML version, otherwise we would have to introduce blobs (CDATA) or otherwise encoded text.

From what I've seen in xregreg.inc so far, it should be possible.

Will have to see how to best test this though, I'm not very deep into updating FCL packages yet.

Michael Van Canneyt

2017-07-06 09:56

administrator   ~0101525

@CCRDude:

Yes, typo on my part, I of course meant the XML version.

I think you can store it as
<mykey type="multiline">
<item>Line 0</item>
<item>Line 1</item>
</mykey>

If type="multiline" is not present (in case it is a file produced by external sources), then I would simply assign the node value of the content to the stringlist.text

Michael Van Canneyt

2017-07-23 16:29

administrator   ~0101870

Applied patch, did some corrections, and implemented a version for Unix.

Issue History

Date Modified Username Field Change
2017-07-05 21:23 CCRDude New Issue
2017-07-05 21:24 CCRDude File Added: registry-reg_multi_sz.32114.patch
2017-07-05 21:41 Michael Van Canneyt Assigned To => Michael Van Canneyt
2017-07-05 21:41 Michael Van Canneyt Status new => assigned
2017-07-05 21:49 Michael Van Canneyt Note Added: 0101514
2017-07-06 03:38 J. Gareth Moreton Note Added: 0101516
2017-07-06 09:48 CCRDude Note Added: 0101524
2017-07-06 09:56 Michael Van Canneyt Note Added: 0101525
2017-07-23 16:29 Michael Van Canneyt Fixed in Revision => 36773
2017-07-23 16:29 Michael Van Canneyt Note Added: 0101870
2017-07-23 16:29 Michael Van Canneyt Status assigned => resolved
2017-07-23 16:29 Michael Van Canneyt Fixed in Version => 3.1.1
2017-07-23 16:29 Michael Van Canneyt Resolution open => fixed
2017-07-23 16:29 Michael Van Canneyt Target Version => 3.2.0