diff options
Diffstat (limited to 'gcc/ada/g-regist.adb')
| -rw-r--r-- | gcc/ada/g-regist.adb | 61 |
1 files changed, 45 insertions, 16 deletions
diff --git a/gcc/ada/g-regist.adb b/gcc/ada/g-regist.adb index b1e963cf6dc..f63a7a97837 100644 --- a/gcc/ada/g-regist.adb +++ b/gcc/ada/g-regist.adb @@ -6,8 +6,7 @@ -- -- -- B o d y -- -- -- --- -- --- Copyright (C) 2001 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2003 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- -- @@ -27,13 +26,14 @@ -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ with Ada.Exceptions; with Interfaces.C; with System; +with GNAT.Directory_Operations; package body GNAT.Registry is @@ -60,7 +60,8 @@ package body GNAT.Registry is ERROR_SUCCESS : constant Error_Code := 0; - REG_SZ : constant := 1; + REG_SZ : constant := 1; + REG_EXPAND_SZ : constant := 2; function RegCloseKey (Key : HKEY) return LONG; pragma Import (Stdcall, RegCloseKey, "RegCloseKey"); @@ -131,6 +132,16 @@ package body GNAT.Registry is return LONG; pragma Import (Stdcall, RegSetValueEx, "RegSetValueExA"); + --------------------- + -- Local Constants -- + --------------------- + + Max_Key_Size : constant := 1_024; + -- Maximum number of characters for a registry key + + Max_Value_Size : constant := 2_048; + -- Maximum number of characters for a key's value + ----------------------- -- Local Subprograms -- ----------------------- @@ -239,17 +250,21 @@ package body GNAT.Registry is -- For_Every_Key_Value -- ------------------------- - procedure For_Every_Key_Value (From_Key : HKEY) is + procedure For_Every_Key_Value + (From_Key : HKEY; + Expand : Boolean := False) + is + use GNAT.Directory_Operations; use type LONG; use type ULONG; Index : ULONG := 0; Result : LONG; - Sub_Key : String (1 .. 100); + Sub_Key : String (1 .. Max_Key_Size); pragma Warnings (Off, Sub_Key); - Value : String (1 .. 100); + Value : String (1 .. Max_Value_Size); pragma Warnings (Off, Value); Size_Sub_Key : aliased ULONG; @@ -274,19 +289,26 @@ package body GNAT.Registry is exit when not (Result = ERROR_SUCCESS); - if Type_Sub_Key = REG_SZ then - Quit := False; + 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); + 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); - - exit when Quit; - - Index := Index + 1; end if; + exit when Quit; + + Index := Index + 1; end loop; end For_Every_Key_Value; @@ -353,13 +375,15 @@ package body GNAT.Registry is function Query_Value (From_Key : HKEY; - Sub_Key : String) + Sub_Key : String; + Expand : Boolean := False) return String is + use GNAT.Directory_Operations; use type LONG; use type ULONG; - Value : String (1 .. 100); + Value : String (1 .. Max_Value_Size); pragma Warnings (Off, Value); Size_Value : aliased ULONG; @@ -381,7 +405,12 @@ package body GNAT.Registry is Check_Result (Result, "Query_Value " & Sub_Key & " key"); - return Value (1 .. Integer (Size_Value - 1)); + if Type_Value = REG_EXPAND_SZ and then Expand then + return Directory_Operations.Expand_Path + (Value (1 .. Integer (Size_Value - 1)), Directory_Operations.DOS); + else + return Value (1 .. Integer (Size_Value - 1)); + end if; end Query_Value; --------------- |