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 path of the user's home directory. 
  28.     function Home_Directory return String; 
  29.     pragma Postcondition( Home_Directory'Result'Length > 0 ); 
  30.  
  31.     -- Opens an Explorer window at the directory specified by 'path'. If 'path' 
  32.     -- is a file, the file will be selected in the window. 
  33.     procedure Reveal_Path( path : String ); 
  34.  
  35.     -- Returns the path of the Windows font directory. 
  36.     function System_Font_Directory return String; 
  37.  
  38. private 
  39.  
  40.     use Interfaces.C; 
  41.     use System; 
  42.  
  43.     type CSIDL is new Unsigned_32; 
  44.  
  45.     CSIDL_DESKTOP              : constant CSIDL := 16#0000#; 
  46.     CSIDL_INTERNET             : constant CSIDL := 16#0001#; 
  47.     CSIDL_PROGRAMS             : constant CSIDL := 16#0002#; 
  48.     CSIDL_CONTROLS             : constant CSIDL := 16#0003#; 
  49.     CSIDL_PRINTERS             : constant CSIDL := 16#0004#; 
  50.     CSIDL_PERSONAL             : constant CSIDL := 16#0005#; 
  51.     CSIDL_FAVORITES            : constant CSIDL := 16#0006#; 
  52.     CSIDL_STARTUP              : constant CSIDL := 16#0007#; 
  53.     CSIDL_RECENT               : constant CSIDL := 16#0008#; 
  54.     CSIDL_SENDTO               : constant CSIDL := 16#0009#; 
  55.     CSIDL_DESKTOPDIRECTORY     : constant CSIDL := 16#0010#; 
  56.     CSIDL_BITBUCKET            : constant CSIDL := 16#000a#; 
  57.     CSIDL_STARTMENU            : constant CSIDL := 16#000b#; 
  58.     CSIDL_MYDOCUMENTS          : constant CSIDL := 16#000c#; 
  59.     CSIDL_MYMUSIC              : constant CSIDL := 16#000d#; 
  60.     CSIDL_MYVIDEO              : constant CSIDL := 16#000e#; 
  61.     CSIDL_LOCAL_APPDATA        : constant CSIDL := 16#001c#; 
  62.     CSIDL_COMMON_APPDATA       : constant CSIDL := 16#0023#; 
  63.     CSIDL_PROGRAM_FILES        : constant CSIDL := 16#0026#; 
  64.     CSIDL_PROGRAM_FILES_COMMON : constant CSIDL := 16#002b#; 
  65.  
  66.     MAX_PATH : constant := 260; 
  67.  
  68.     type    VOID      is null record; 
  69.     subtype PVOID     is System.Address; 
  70.     subtype HANDLE    is PVOID; 
  71.     subtype HINSTANCE is HANDLE; 
  72.     subtype HWND      is HANDLE; 
  73.     subtype CHAR      is Interfaces.C.char; 
  74.     type    PCHAR     is access all CHAR; 
  75.     subtype LPSTR     is PCHAR; 
  76.         pragma No_Strict_Aliasing( LPSTR ); 
  77.     subtype ULONG     is Interfaces.C.unsigned_long; 
  78.     subtype DWORD     is ULONG; 
  79.     subtype INT       is Interfaces.C.int; 
  80.  
  81.     type SHGFP is (SHGFP_TYPE_CURRENT, SHGFP_TYPE_DEFAULT); 
  82.     for SHGFP'Size use 32; 
  83.  
  84.     function GetModuleFileNameA( hModule    : HINSTANCE; 
  85.                                  lpFilename : LPSTR; 
  86.                                  nSize      : DWORD 
  87.                                ) return DWORD; 
  88.     pragma Import (Stdcall, GetModuleFileNameA, "GetModuleFileNameA"); 
  89.  
  90.     function SHGetFolderPathA( hwndOwner : HWND; 
  91.                                nFolder   : CSIDL; 
  92.                                hToken    : PVOID; 
  93.                                dwFlags   : SHGFP; 
  94.                                lpszPath  : access String ) return INT; 
  95.     pragma Import( Stdcall, SHGetFolderPathA, "SHGetFolderPathA" ); 
  96.  
  97. end Support.Win;