Skip to content

R
riscv-gcc-1
Commit 1fdc61b5 by Vasiliy Fofanov Committed by Arnaud Charlet
Options

g-regist.ads, [...] (Set_Value): new parameter Expand... 

2007-12-06  Vasiliy Fofanov  <fofanov@adacore.com>

	* g-regist.ads, g-regist.adb (Set_Value): new parameter Expand; when
	set to True this procedure will create the value of type REG_EXPAND_SZ.
	It was only possible to create REG_SZ values before.

From-SVN: r130842
parent 422ba273
Showing with 79 additions and 62 deletions
gcc/ada/g-regist.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2005, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2007, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -154,7 +154,6 @@ package body GNAT.Registry is
procedure Check_Result (Result : LONG; Message : String) is
use type LONG;
begin
if Result /= ERROR_SUCCESS then
Exceptions.Raise_Exception
......@@ -169,7 +168,6 @@ package body GNAT.Registry is
procedure Close_Key (Key : HKEY) is
Result : LONG;
begin
Result := RegCloseKey (Key);
Check_Result (Result, "Close_Key");
......@@ -198,16 +196,17 @@ package body GNAT.Registry is
Dispos : aliased DWORD;
begin
Result := RegCreateKeyEx
(From_Key,
C_Sub_Key (C_Sub_Key'First)'Address,
0,
C_Class (C_Class'First)'Address,
REG_OPTION_NON_VOLATILE,
C_Mode,
Null_Address,
New_Key'Unchecked_Access,
Dispos'Unchecked_Access);
Result :=
RegCreateKeyEx
(From_Key,
C_Sub_Key (C_Sub_Key'First)'Address,
0,
C_Class (C_Class'First)'Address,
REG_OPTION_NON_VOLATILE,
C_Mode,
Null_Address,
New_Key'Unchecked_Access,
Dispos'Unchecked_Access);
Check_Result (Result, "Create_Key " & Sub_Key);
return New_Key;
......@@ -220,7 +219,6 @@ package body GNAT.Registry is
procedure Delete_Key (From_Key : HKEY; Sub_Key : String) is
C_Sub_Key : constant String := Sub_Key & ASCII.Nul;
Result : LONG;
begin
Result := RegDeleteKey (From_Key, C_Sub_Key (C_Sub_Key'First)'Address);
Check_Result (Result, "Delete_Key " & Sub_Key);
......@@ -233,7 +231,6 @@ package body GNAT.Registry is
procedure Delete_Value (From_Key : HKEY; Sub_Key : String) is
C_Sub_Key : constant String := Sub_Key & ASCII.Nul;
Result : LONG;
begin
Result := RegDeleteValue (From_Key, C_Sub_Key (C_Sub_Key'First)'Address);
Check_Result (Result, "Delete_Value " & Sub_Key);
......@@ -271,32 +268,35 @@ package body GNAT.Registry is
Size_Sub_Key := Sub_Key'Length;
Size_Value := Value'Length;
Result := RegEnumValue
(From_Key, Index,
Sub_Key (1)'Address,
Size_Sub_Key'Unchecked_Access,
null,
Type_Sub_Key'Unchecked_Access,
Value (1)'Address,
Size_Value'Unchecked_Access);
Result :=
RegEnumValue
(From_Key, Index,
Sub_Key (1)'Address,
Size_Sub_Key'Unchecked_Access,
null,
Type_Sub_Key'Unchecked_Access,
Value (1)'Address,
Size_Value'Unchecked_Access);
exit when not (Result = ERROR_SUCCESS);
Quit := False;
if Type_Sub_Key = REG_EXPAND_SZ and then Expand then
Action (Natural (Index) + 1,
Sub_Key (1 .. Integer (Size_Sub_Key)),
Directory_Operations.Expand_Path
(Value (1 .. Integer (Size_Value) - 1),
Directory_Operations.DOS),
Quit);
Action
(Natural (Index) + 1,
Sub_Key (1 .. Integer (Size_Sub_Key)),
Directory_Operations.Expand_Path
(Value (1 .. Integer (Size_Value) - 1),
Directory_Operations.DOS),
Quit);
elsif Type_Sub_Key = REG_SZ or else Type_Sub_Key = REG_EXPAND_SZ then
Action (Natural (Index) + 1,
Sub_Key (1 .. Integer (Size_Sub_Key)),
Value (1 .. Integer (Size_Value) - 1),
Quit);
Action
(Natural (Index) + 1,
Sub_Key (1 .. Integer (Size_Sub_Key)),
Value (1 .. Integer (Size_Value) - 1),
Quit);
end if;
exit when Quit;
......@@ -345,16 +345,17 @@ package body GNAT.Registry is
C_Sub_Key : constant String := Sub_Key & ASCII.Nul;
C_Mode : constant REGSAM := To_C_Mode (Mode);
New_Key : aliased HKEY;
Result : LONG;
New_Key : aliased HKEY;
Result : LONG;
begin
Result := RegOpenKeyEx
(From_Key,
C_Sub_Key (C_Sub_Key'First)'Address,
0,
C_Mode,
New_Key'Unchecked_Access);
Result :=
RegOpenKeyEx
(From_Key,
C_Sub_Key (C_Sub_Key'First)'Address,
0,
C_Mode,
New_Key'Unchecked_Access);
Check_Result (Result, "Open_Key " & Sub_Key);
return New_Key;
......@@ -385,13 +386,14 @@ package body GNAT.Registry is
begin
Size_Value := Value'Length;
Result := RegQueryValueEx
(From_Key,
C_Sub_Key (C_Sub_Key'First)'Address,
null,
Type_Value'Unchecked_Access,
Value (Value'First)'Address,
Size_Value'Unchecked_Access);
Result :=
RegQueryValueEx
(From_Key,
C_Sub_Key (C_Sub_Key'First)'Address,
null,
Type_Value'Unchecked_Access,
Value (Value'First)'Address,
Size_Value'Unchecked_Access);
Check_Result (Result, "Query_Value " & Sub_Key & " key");
......@@ -408,23 +410,32 @@ package body GNAT.Registry is
---------------
procedure Set_Value
(From_Key : HKEY;
Sub_Key : String;
Value : String)
(From_Key : HKEY;
Sub_Key : String;
Value : String;
Expand : Boolean := False)
is
C_Sub_Key : constant String := Sub_Key & ASCII.Nul;
C_Value : constant String := Value & ASCII.Nul;
Result : LONG;
Value_Type : DWORD;
Result : LONG;
begin
Result := RegSetValueEx
(From_Key,
C_Sub_Key (C_Sub_Key'First)'Address,
0,
REG_SZ,
C_Value (C_Value'First)'Address,
C_Value'Length);
if Expand then
Value_Type := REG_EXPAND_SZ;
else
Value_Type := REG_SZ;
end if;
Result :=
RegSetValueEx
(From_Key,
C_Sub_Key (C_Sub_Key'First)'Address,
0,
Value_Type,
C_Value (C_Value'First)'Address,
C_Value'Length);
Check_Result (Result, "Set_Value " & Sub_Key & " key");
end Set_Value;
......
gcc/ada/g-regist.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2005, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2007, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -95,8 +95,14 @@ package GNAT.Registry is
-- REG_EXPAND_SZ the returned value will have the %name% variables
-- replaced by the corresponding environment variable value.
procedure Set_Value (From_Key : HKEY; Sub_Key : String; Value : String);
-- Add the pair (Sub_Key, Value) into From_Key registry key
procedure Set_Value
(From_Key : HKEY;
Sub_Key : String;
Value : String;
Expand : Boolean := False);
-- Add the pair (Sub_Key, Value) into From_Key registry key.
-- By default the value created is of type REG_SZ, unless
-- Expand is True in which case it is of type REG_EXPAND_SZ
procedure Delete_Key (From_Key : HKEY; Sub_Key : String);
-- Remove Sub_Key from the registry key From_Key
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment