* Fix bug ID #32114: more value types for TRegistry

git-svn-id: trunk@36773 -

packages/fcl-registry/src/registry.pp

@@ -31,7 +31,8 @@ type
     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 +96,7 @@ type
     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 +120,7 @@ type
     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;
@@ -410,6 +413,40 @@ begin
   end;
 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
@@ -458,6 +495,16 @@ begin
   PutData(Name, PWideChar(u), ByteLength(u), 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));

packages/fcl-registry/src/winreg.inc

@@ -1,3 +1,8 @@
+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);
+
 type
   TWinRegData = record
     RootKeyOwned: Boolean;
@@ -91,16 +96,9 @@ begin
     Result:=-1
   else
     begin
-    If (RD=REG_SZ) then
-      RegData:=rdString
-    else if (RD=REG_EXPAND_SZ) then
-      Regdata:=rdExpandString
-    else if (RD=REG_DWORD) then
-      RegData:=rdInteger
-    else if (RD=REG_BINARY) then
-      RegData:=rdBinary
-    else
-      RegData:=rdUnknown;
+    RegData:=High(TRegDataType);
+    While (RegData>rdUnknown) and (RD<>RegDataWords[RegData]) do
+      RegData:=Pred(RegData);
     Result:=BufSize;
     end;
 end;
@@ -109,6 +107,7 @@ function TRegistry.GetDataInfo(const ValueName: String; out Value: TRegDataInfo)
 
 Var
   u: UnicodeString;
+  RD : DWord;
 
 begin
   u:=UTF8Decode(ValueName);
@@ -116,6 +115,13 @@ begin
     begin
     FLastError:=RegQueryValueExW(fCurrentKey,PWideChar(u),Nil,lpdword(@RegData),Nil,lpdword(@DataSize));
     Result:=FLastError=ERROR_SUCCESS;
+    if Result then
+      begin
+      RD:=DWord(RegData);
+      RegData:=High(TRegDataType);
+      While (RegData>rdUnknown) and (RD<>RegDataWords[RegData]) do
+         RegData:=Pred(RegData);
+      end;
     end;
   If Not Result Then
     begin
@@ -403,21 +409,19 @@ begin
   end;
 end;
 
+
 Function TRegistry.SysPutData(const Name: string; Buffer: Pointer;
   BufSize: Integer; RegData: TRegDataType) : Boolean;
 
+
 Var
   u: UnicodeString;
   RegDataType: DWORD;
+  B : Pchar;
+  S : String;
 
 begin
-  Case RegData of
-    rdUnknown      : RegDataType:=REG_NONE;
-    rdString       : RegDataType:=REG_SZ;
-    rdExpandString : RegDataType:=REG_EXPAND_SZ;
-    rdInteger      : RegDataType:=REG_DWORD;
-    rdBinary       : RegDataType:=REG_BINARY;
-  end;
+  RegDataType:=RegDataWords[RegData];
   u:=UTF8Decode(Name);
   FLastError:=RegSetValueExW(fCurrentKey,PWideChar(u),0,RegDataType,Buffer,BufSize);
   Result:=FLastError=ERROR_SUCCESS;

packages/fcl-registry/src/xmlreg.pp

@@ -10,7 +10,7 @@ uses
 
 Type
 
-  TDataType = (dtUnknown,dtDWORD,dtString,dtBinary);
+  TDataType = (dtUnknown,dtDWORD,dtString,dtBinary,dtStrings);
   TDataInfo = record
     DataType : TDataType;
     DataSize : Integer;
@@ -345,7 +345,8 @@ begin
                        end
                      end;
 
-        dtBinary : // DataNode is optional
+        dtBinary,
+        dtStrings : // DataNode is optional
                    if HasData then
                      begin
                      BL:=Length(DataNode.NodeValue);
@@ -392,6 +393,7 @@ begin
                    //S:=UTF8Encode(SW);
                  end;
       dtBinary : SW:=BufToHex(Data,DataSize);
+      dtStrings : SW:=BufToHex(Data,DataSize);
     else
       sw:='';
     end;
@@ -682,6 +684,7 @@ begin
         dtUnknown : DataSize:=0;
         dtDword   : Datasize:=SizeOf(Cardinal);
         dtString  : DataSize:=L;
+        dtStrings,
         dtBinary  : DataSize:=L div 2;
       end;
       end;

packages/fcl-registry/src/xregreg.inc

@@ -3,7 +3,39 @@
     System dependent Registry implementation - using XML file.
   ---------------------------------------------------------------------}
 
-uses xmlreg;
+uses typinfo, xmlreg;
+
+Const
+  XFileName = 'reg.xml';
+
+Resourcestring
+  SErrTypeNotSupported = 'Registry data type not supported on this platform: %s';
+
+Function RegDataTypeToXmlDataType(RegData : TRegDataType) : TDataType;
+
+begin
+  Case RegData of
+    rdUnknown               : Result := dtUnknown;
+    rdString,rdExpandString : Result := dtString;
+    rdInteger               : Result := dtDword;
+    rdBinary                : Result := dtBinary;
+    rdMultiString           : Result := dtStrings;
+  else
+    Raise ERegistryException.CreateFmt(SErrTypeNotSupported,[GetEnumName(TypeInfo(TRegDataType),Ord(RegData))]);
+  end;
+end;
+
+Function DataTypeToRegDataType(DataType : TDataType) : TRegDataType;
+
+begin
+  Case DataType of
+    dtUnknown: Result:=rdUnknown;
+    dtDword  : Result:=rdInteger;
+    dtString : Result:=rdString;
+    dtBinary : Result:=rdBinary;
+    dtStrings : Result:=rdMultiString;
+  end;
+end;
 
 type
 
@@ -62,8 +94,6 @@ begin
   FreeAndNil(XMLRegistryCache);
 end;
 
-Const
-  XFileName = 'reg.xml';
 
 { TXMLRegistryInstance }
 
@@ -97,7 +127,7 @@ procedure TRegistry.SysRegFree;
 begin
   if Assigned(FSysData) then
     TXMLRegistry(FSysData).Flush;
-  TXMLRegistryInstance.	FreeXMLRegistry(TXMLRegistry(FSysData));
+  TXMLRegistryInstance.FreeXMLRegistry(TXMLRegistry(FSysData));
 end;
 
 function TRegistry.SysCreateKey(const Key: String): Boolean;
@@ -125,19 +155,11 @@ Var
 begin
   Result:=BufSize;
   If TXmlregistry(FSysData).GetValueDataUnicode(Name,DataType,Buffer^,Result) then
-    begin
-    Case DataType of
-      dtUnknown : RegData:=rdUnknown;
-      dtString  : RegData:=rdString;
-      dtDWord   : RegData:=rdInteger;
-      dtBinary  : RegData:=rdBinary;
-    end;
-    end
+    RegData:=DataTypeToRegDataType(DataType)
   else
     Result:=-1;
 end;
 
-
 function TRegistry.GetDataInfo(const ValueName: string; out Value: TRegDataInfo): Boolean;
 
 Var
@@ -154,12 +176,7 @@ begin
   else
     With Value do
       begin
-      Case Info.DataType of
-        dtUnknown: RegData:=rdUnknown;
-        dtDword  : Regdata:=rdInteger;
-        dtString : RegData:=rdString;
-        dtBinary : RegData:=rdBinary;
-      end;
+      RegData:=DataTypeToRegDataType(Info.DataType);
       DataSize:=Info.DataSize;
       end;
 end;
@@ -264,12 +281,7 @@ Var
   DataType : TDataType;
 
 begin
-  Case RegData of
-    rdUnknown               : DataType := dtUnknown;
-    rdString,rdExpandString : DataType := dtString;
-    rdInteger               : DataType := dtDword;
-    rdBinary                : DataType := dtBinary;
-  end;
+  DataType:=RegDataTypeToXmlDataType(RegData);
   Result:=TXMLRegistry(FSysData).SetValueDataUnicode(Name,DataType,Buffer^,BufSize);
 end;