
with GWindows.Registry;     use GWindows.Registry;
with GWindows.GStrings;     use GWindows.GStrings;
with Gwindows.Types;        use Gwindows.Types;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with System;
with Interfaces.C;

package body GProfileConfig is

   function Is_Byte_Array_Empty(baData : Byte_Array) return Boolean is
   begin
      return baData'First > baData'Last;
   end Is_Byte_Array_Empty;


   usRegistryKey : GString_Unbounded := Null_GString_Unbounded;
   usProfileName : GString_Unbounded := Null_GString_Unbounded;

   function GetRegistryKey return GString is
   begin
      return To_GString_From_Unbounded(usRegistryKey);
   end GetRegistryKey;

   procedure SetRegistryKey( sRegistryKey : GString ) is
   begin
      usRegistryKey := To_GString_Unbounded(sRegistryKey);
   end SetRegistryKey;

   function GetProfileName return GString is
   begin
      return To_GString_From_Unbounded(usProfileName);
   end GetProfileName;

   procedure SetProfileName( sProfileName : GString ) is
   begin
      usProfileName := To_GString_Unbounded(sProfileName);
   end SetProfileName;


   function RegCloseKey(
                         hKeyPar    : Hkey
                        )
     return Integer;
   pragma Import (
                  StdCall,
                  RegCloseKey,
                  "RegCloseKey"
                 );
   function RegOpenKeyEx(
                         hKeyPar    : Hkey;
                         lpSubKey   : access GChar_C;
                         ulOptions  : Unsigned_32;
                         samDesired : Unsigned_32;
                         phkResult  : access Hkey
                        )
     return Integer;
   pragma Import (
                  StdCall,
                  RegOpenKeyEx,
                  "RegOpenKeyEx" & Character_Mode_Identifier
                 );
   function RegCreateKeyEx(
                           hKeyPar    : Hkey;
                           lpSubKey   : access GChar_C;
                           Reserved   : Integer;
                           lpClass    : access GChar_C;
                           ulOptions  : Unsigned_32;
                           samDesired : Unsigned_32;
                           lpSecurityAttributes : System.Address;
                           phkResult  : access Hkey;
                           lpdwDisposition      : access Unsigned_32
                          )
                           return Integer;
   pragma Import (
                  StdCall,
                  RegCreateKeyEx,
                  "RegCreateKeyEx" & Character_Mode_Identifier
                 );
   function RegQueryValueEx(
                            hKeyPar     : Hkey;
                            lpValueName : access GChar_C;
                            lpReserved  : access Unsigned_32;
                            lpType      : access Unsigned_32;
                            lpData      : System.Address;
                            lpcbData    : access Integer
                           )
                            return Integer;
   pragma Import (
                  StdCall,
                  RegQueryValueEx,
                  "RegQueryValueEx" & Character_Mode_Identifier
                 );
   function RegSetValueEx(
                            hKeyPar     : Hkey;
                            lpValueName : access GChar_C;
                            Reserved    : Unsigned_32;
                            dwType      : Unsigned_32;
                            lpData      : System.Address;
                            cbData      : Integer
                           )
                            return Integer;
   pragma Import (
                  StdCall,
                  RegSetValueEx,
                  "RegSetValueEx" & Character_Mode_Identifier
                 );

   function GetAppRegistryKey (eProfile : enProfile_Type) return Hkey is
      hRootKey      : Hkey;
      nResult       : Integer;
      szSoftName    : GString_C := To_GString_C ("SOFTWARE");
      szRegistryKey : GString_C := To_GString_C (To_GString_From_Unbounded(usRegistryKey));
      szProfileName : GString_C := To_GString_C (To_GString_From_Unbounded(usProfileName));
      hSoftKey      : aliased Hkey;
      hCompanyKey   : aliased Hkey;
      hAppKey       : aliased Hkey;
      dw            : aliased Unsigned_32;
   begin
      pragma Assert(usRegistryKey /= Null_GString_Unbounded And usProfileName /= Null_GString_Unbounded);
      if eProfile = User_Profile then
         hRootKey := HKEY_CURRENT_USER;
      else
         hRootKey := HKEY_LOCAL_MACHINE;
      end if;
      nResult := RegOpenKeyEx(
                              hRootKey,
                              szSoftName(szSoftName'First)'Access,
                              0,
                              KEY_WRITE Or KEY_READ,
                              hSoftKey'Access
                             );
      if nResult /= 0 then
         return Null_Handle;
      end if;
      nResult := RegCreateKeyEx(
                                hSoftKey,
                                szRegistryKey(szRegistryKey'First)'Access,
                                0,
                                null,
                                REG_OPTION_NON_VOLATILE,
                                KEY_WRITE Or KEY_READ,
                                System.Null_Address,
                                hCompanyKey'Access,
                                dw'Access
                               );
      if nResult /= 0 then
         nResult := RegCloseKey(hSoftKey);
         pragma Assert(nResult = 0);
         return Null_Handle;
      end if;
      nResult := RegCreateKeyEx(
                                hCompanyKey,
                                szProfileName(szProfileName'First)'Access,
                                0,
                                null,
                                REG_OPTION_NON_VOLATILE,
                                KEY_WRITE Or KEY_READ,
                                System.Null_Address,
                                hAppKey'Access,
                                dw'Access
                               );
      if nResult /= 0 then
         nResult := RegCloseKey(hCompanyKey);
         pragma Assert(nResult = 0);
         nResult := RegCloseKey(hSoftKey);
         pragma Assert(nResult = 0);
         return Null_Handle;
      end if;
      nResult := RegCloseKey(hCompanyKey);
      pragma Assert(nResult = 0);
      nResult := RegCloseKey(hSoftKey);
      pragma Assert(nResult = 0);
      return hAppKey;
   end GetAppRegistryKey;

   function GetSectionKey(
                          sSection : GString;
                          eProfile : enProfile_Type
                         )
                          return Hkey is
      nResult     : Integer;
      szSection   : GString_C := To_GString_C (sSection);
      hSectionKey : aliased Hkey;
      hAppKey     : Hkey := GetAppRegistryKey(eProfile);
      dw          : aliased Unsigned_32;
   begin
      if hAppKey = Null_Handle then
         return Null_Handle;
      end if;
      nResult := RegCreateKeyEx(
                                hAppKey,
                                szSection(szSection'First)'Access,
                                0,
                                null,
                                REG_OPTION_NON_VOLATILE,
                                KEY_WRITE Or KEY_READ,
                                System.Null_Address,
                                hSectionKey'Access,
                                dw'Access
                               );
      if nResult /= 0 then
         nResult := RegCloseKey(hAppKey);
         pragma Assert(nResult = 0);
         return Null_Handle;
      end if;
      nResult := RegCloseKey(hAppKey);
      pragma Assert(nResult = 0);
      return hSectionKey;
   end GetSectionKey;

   function GetConfigBinary(
                            sSection, sEntry : GString;
                            eProfile : enProfile_Type := User_Profile
                           )
                            return Byte_Array is
      hSecKey : Hkey := GetSectionKey(
                                      sSection,
                                      eProfile
                                     );
      Null_Byte_Array : Byte_Array (1 .. 0);
      szEntry         : GString_C := To_GString_C (sEntry);
      nResult         : Integer;
      dwType          : aliased Unsigned_32;
      nCount          : aliased Integer;
   begin
      if hSecKey = Null_Handle then
         return Null_Byte_Array;
      end if;
      nResult := RegQueryValueEx(
                                 hSecKey,
                                 szEntry(szEntry'First)'Access,
                                 null,
                                 dwType'Access,
                                 System.Null_Address,
                                 nCount'Access
                                );
      if nResult /= 0 then
         nResult := RegCloseKey(hSecKey);
         pragma Assert(nResult = 0);
         return Null_Byte_Array;
      end if;
      pragma Assert(dwType = REG_BINARY);
      declare
         Result_Array : Byte_Array (1 .. nCount);
      begin
         nResult := RegQueryValueEx(
                                    hSecKey,
                                    szEntry(szEntry'First)'Access,
                                    null,
                                    dwType'Access,
                                    Result_Array(Result_Array'First)'Address,
                                    nCount'Access
                                   );
         if nResult /= 0 then
            nResult := RegCloseKey(hSecKey);
            pragma Assert(nResult = 0);
            return Null_Byte_Array;
         end if;
         nResult := RegCloseKey(hSecKey);
         pragma Assert(nResult = 0);
         return Result_Array;
      end;
   end GetConfigBinary;

   procedure WriteConfigBinary(
                               sSection, sEntry : GString;
                               baData : Byte_Array;
                               eProfile : enProfile_Type := User_Profile
                              ) is
      hSecKey : Hkey := GetSectionKey(
                                      sSection,
                                      eProfile
                                     );
      szEntry         : GString_C := To_GString_C (sEntry);
      nResult         : Integer;
   begin
      pragma Assert(hSecKey /= Null_Handle);
      nResult := RegSetValueEx(
                               hSecKey,
                               szEntry(szEntry'First)'Access,
                               0,
                               REG_BINARY,
                               baData(baData'First)'Address,
                               baData'Length
                              );
      pragma Assert(nResult = 0);
   end WriteConfigBinary;

   function GetConfigInt(
                         sSection, sEntry : GString;
                         nDefault : Integer := 0;
                         eProfile : enProfile_Type := User_Profile
                        )
                         return Integer is
      hSecKey : Hkey := GetSectionKey(
                                      sSection,
                                      eProfile
                                     );
      szEntry         : GString_C := To_GString_C (sEntry);
      nResult         : Integer;
      dwType          : aliased Unsigned_32;
      nCount          : aliased Integer;
      nRetValue       : Integer;
   begin
      if hSecKey = Null_Handle then
	 return nDefault;
      end if;
      nCount := 4;
      nResult := RegQueryValueEx(
				 hSecKey,
				 szEntry(szEntry'First)'Access,
				 null,
				 dwType'Access,
				 nRetValue'Address,
				 nCount'Access
				);
      if nResult /= 0 then
	 nResult := RegCloseKey(hSecKey);
	 pragma Assert(nResult = 0);
	 return nDefault;
      end if;
      pragma Assert(dwType = REG_DWORD and nCount = 4);
      nResult := RegCloseKey(hSecKey);
      pragma Assert(nResult = 0);
      return nRetValue;
   end GetConfigInt;

   procedure WriteConfigInt(
			       sSection, sEntry : GString;
			       nValue : Integer;
			       eProfile : enProfile_Type := User_Profile
			      ) is
      hSecKey : Hkey := GetSectionKey(
				      sSection,
				      eProfile
				     );
      szEntry         : GString_C := To_GString_C (sEntry);
      nResult         : Integer;
   begin
      pragma Assert(hSecKey /= Null_Handle);
      nResult := RegSetValueEx(
			       hSecKey,
			       szEntry(szEntry'First)'Access,
			       0,
			       REG_DWORD,
			       nValue'Address,
			       4
			      );
      pragma Assert(nResult = 0);
      nResult := RegCloseKey(hSecKey);
      pragma Assert(nResult = 0);
   end WriteConfigInt;

   function GetConfigInt64(
			   sSection, sEntry : GString;
			   nDefault : Integer_64 := 0;
			   eProfile : enProfile_Type := User_Profile
			  )
			   return Integer_64 is
      hSecKey : Hkey := GetSectionKey(
				      sSection,
				      eProfile
				     );
      szEntry         : GString_C := To_GString_C (sEntry);
      nResult         : Integer;
      dwType          : aliased Unsigned_32;
      nCount          : aliased Integer;
      nRetValue       : Integer_64;
   begin
      if hSecKey = Null_Handle then
	 return nDefault;
      end if;
      nCount := 8;
      nResult := RegQueryValueEx(
				 hSecKey,
				 szEntry(szEntry'First)'Access,
				 null,
				 dwType'Access,
				 nRetValue'Address,
				 nCount'Access
				);
      if nResult /= 0 then
	 nResult := RegCloseKey(hSecKey);
	 pragma Assert(nResult = 0);
	 return nDefault;
      end if;
      pragma Assert(dwType = REG_QWORD and nCount = 8);
      nResult := RegCloseKey(hSecKey);
      pragma Assert(nResult = 0);
      return nRetValue;
   end GetConfigInt64;

   procedure WriteConfigInt64(
			      sSection, sEntry : GString;
			      nValue : Integer_64;
			      eProfile : enProfile_Type := User_Profile
			     ) is
      hSecKey : Hkey := GetSectionKey(
				      sSection,
				      eProfile
				     );
      szEntry         : GString_C := To_GString_C (sEntry);
      nResult         : Integer;
   begin
      pragma Assert(hSecKey /= Null_Handle);
      nResult := RegSetValueEx(
			       hSecKey,
			       szEntry(szEntry'First)'Access,
			       0,
			       REG_QWORD,
			       nValue'Address,
			       8
			      );
      pragma Assert(nResult = 0);
      nResult := RegCloseKey(hSecKey);
      pragma Assert(nResult = 0);
   end WriteConfigInt64;

   function GetConfigString(
			    sSection, sEntry : GString;
			    sDefault : GString := "";
			    eProfile : enProfile_Type := User_Profile
			   )
			    return GString is
      hSecKey : Hkey := GetSectionKey(
				      sSection,
				      eProfile
				     );
      szEntry         : GString_C := To_GString_C (sEntry);
      nResult         : Integer;
      dwType          : aliased Unsigned_32;
      nCount          : aliased Integer;
   begin
      if hSecKey = Null_Handle then
	 return sDefault;
      end if;
      nResult := RegQueryValueEx(
				 hSecKey,
				 szEntry(szEntry'First)'Access,
				 null,
				 dwType'Access,
				 System.Null_Address,
				 nCount'Access
				);
      if nResult /= 0 then
	 nResult := RegCloseKey(hSecKey);
	 pragma Assert(nResult = 0);
	 return sDefault;
      end if;
      pragma Assert(dwType = REG_SZ);
      declare
	 C_Result : GString_C (0 .. Interfaces.C.size_t (nCount));
      begin
	 nResult := RegQueryValueEx(
			     hSecKey,
			     szEntry(szEntry'First)'Access,
			     null,
			     dwType'Access,
			     C_Result (0)'Address,
			     nCount'Access
			    );
	 if nResult /= 0 then
	    nResult := RegCloseKey(hSecKey);
	    pragma Assert(nResult = 0);
	    return sDefault;
	 end if;
	 nResult := RegCloseKey(hSecKey);
	 pragma Assert(nResult = 0);
	 return To_GString_From_C (C_Result);
      end;
   end GetConfigString;

   procedure WriteConfigString(
			       sSection, sEntry : GString;
			       sValue : GString;
			       eProfile : enProfile_Type := User_Profile
			      ) is
      hSecKey : Hkey := GetSectionKey(
				      sSection,
				      eProfile
				     );
      szEntry         : GString_C := To_GString_C (sEntry);
      Value_Data      : GString_C := To_GString_C (sValue);
      nResult         : Integer;
   begin
      pragma Assert(hSecKey /= Null_Handle);
      nResult := RegSetValueEx(
			       hSecKey,
			       szEntry(szEntry'First)'Access,
			       0,
			       REG_SZ,
			       Value_Data (Value_Data'First)'Address,
			       Value_Data'Length * (GCharacter'Size / 8)
			      );
      pragma Assert(nResult = 0);
   end WriteConfigString;

end GProfileConfig;
