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