1. private with Interfaces.C; 
  2. private with System; 
  3.  
  4. private package Support.Win is 
  5.  
  6.     -- Returns the path of the directory where system-wide application-specific 
  7.     -- data files can be read and written on a Windows system. 
  8.     function App_Data_Directory return String; 
  9.  
  10.     -- Returns the file extension of executables on Windows without a leading 
  11.     -- dot character. 
  12.     function Executable_Extension return String; 
  13.     pragma Postcondition( Executable_Extension'Result'Length > 0 ); 
  14.  
  15.     -- Returns the path of the application's executable file. 
  16.     function Executable_Path return String; 
  17.     pragma Postcondition( Executable_Path'Result'Length > 0 ); 
  18.  
  19.     -- Returns the path of the user's home directory. 
  20.     function Home_Directory return String; 
  21.     pragma Postcondition( Home_Directory'Result'Length > 0 ); 
  22.  
  23.     -- Opens an Explorer window at the directory specified by 'path'. If 'path' 
  24.     -- is a file, the file will be selected in the window. 
  25.     procedure Reveal_Path( path : String ); 
  26.  
  27.     -- Returns the path of the Windows font directory. 
  28.     function System_Font_Directory return String; 
  29.  
  30. private 
  31.  
  32.     use Interfaces.C; 
  33.     use System; 
  34.  
  35.     type CSIDL is new Unsigned_32; 
  36.  
  37.     CSIDL_DESKTOP              : constant CSIDL := 16#0000#; 
  38.     CSIDL_INTERNET             : constant CSIDL := 16#0001#; 
  39.     CSIDL_PROGRAMS             : constant CSIDL := 16#0002#; 
  40.     CSIDL_CONTROLS             : constant CSIDL := 16#0003#; 
  41.     CSIDL_PRINTERS             : constant CSIDL := 16#0004#; 
  42.     CSIDL_PERSONAL             : constant CSIDL := 16#0005#; 
  43.     CSIDL_FAVORITES            : constant CSIDL := 16#0006#; 
  44.     CSIDL_STARTUP              : constant CSIDL := 16#0007#; 
  45.     CSIDL_RECENT               : constant CSIDL := 16#0008#; 
  46.     CSIDL_SENDTO               : constant CSIDL := 16#0009#; 
  47.     CSIDL_DESKTOPDIRECTORY     : constant CSIDL := 16#0010#; 
  48.     CSIDL_BITBUCKET            : constant CSIDL := 16#000a#; 
  49.     CSIDL_STARTMENU            : constant CSIDL := 16#000b#; 
  50.     CSIDL_MYDOCUMENTS          : constant CSIDL := 16#000c#; 
  51.     CSIDL_MYMUSIC              : constant CSIDL := 16#000d#; 
  52.     CSIDL_MYVIDEO              : constant CSIDL := 16#000e#; 
  53.     CSIDL_LOCAL_APPDATA        : constant CSIDL := 16#001c#; 
  54.     CSIDL_COMMON_APPDATA       : constant CSIDL := 16#0023#; 
  55.     CSIDL_PROGRAM_FILES        : constant CSIDL := 16#0026#; 
  56.     CSIDL_PROGRAM_FILES_COMMON : constant CSIDL := 16#002b#; 
  57.  
  58.     MAX_PATH : constant := 260; 
  59.  
  60.     type    VOID      is null record; 
  61.     subtype PVOID     is System.Address; 
  62.     subtype HANDLE    is PVOID; 
  63.     subtype HINSTANCE is HANDLE; 
  64.     subtype HWND      is HANDLE; 
  65.     subtype CHAR      is Interfaces.C.char; 
  66.     type    PCHAR     is access all CHAR; 
  67.     subtype LPSTR     is PCHAR; 
  68.         pragma No_Strict_Aliasing( LPSTR ); 
  69.     subtype ULONG     is Interfaces.C.unsigned_long; 
  70.     subtype DWORD     is ULONG; 
  71.     subtype INT       is Interfaces.C.int; 
  72.  
  73.     type SHGFP is (SHGFP_TYPE_CURRENT, SHGFP_TYPE_DEFAULT); 
  74.     for SHGFP'Size use 32; 
  75.  
  76.     function GetModuleFileNameA( hModule    : HINSTANCE; 
  77.                                  lpFilename : LPSTR; 
  78.                                  nSize      : DWORD 
  79.                                ) return DWORD; 
  80.     pragma Import (Stdcall, GetModuleFileNameA, "GetModuleFileNameA"); 
  81.  
  82.     function SHGetFolderPathA( hwndOwner : HWND; 
  83.                                nFolder   : CSIDL; 
  84.                                hToken    : PVOID; 
  85.                                dwFlags   : SHGFP; 
  86.                                lpszPath  : access String ) return INT; 
  87.     pragma Import( Stdcall, SHGetFolderPathA, "SHGetFolderPathA" ); 
  88.  
  89. end Support.Win;