|
with GNAT.OS_Lib;
use
GNAT.OS_Lib;
with
Interfaces.C;
use Interfaces.C;
with
GWindows;
use GWindows;
with
Gwindows.Base;
package
UD_Shell32
is
-------------------------------------------------------------------------------------------------
Type Scenario is (SHLogOff, SHShutDown, SHReBoot, SHForce,
SHPowerOff);
procedure SHRestartSystemMB (Win
: in
GWindows.Base.Base_Window_Type'Class;
Prompt
: in
String
:= "";
How
: in
Scenario
:= SHReBoot);
procedure SHRestartSystemMB (Prompt
: in
String
:= "";
How : in Scenario
:= SHReBoot);
-------------------------------------------------------------------------------------------------
procedure SHShutDownDialog;
-------------------------------------------------------------------------------------------------
Type RunFlag is (SHNo_Browse, SHNo_MRU, SHRelative_Path,
SHNo_Label, SHNo_SeparateMem);
Type RunFlagArray is Array (RunFlag) of
Boolean;
procedure SHRunDialog (Win
: in
GWindows.Base.Base_Window_Type'Class;
IconName :
in
String
:= "";
Directory : in
String
:= GetEnv ("WinDir").all;
Title : in String
:= "";
Comment :
in
String
:= "";
FlagArray : in
RunFlagArray
:= (Others => False));
procedure SHRunDialog (IconName
: in
String
:= "";
Directory : in
String
:= GetEnv ("WinDir").all;
Title
: in
String
:= "";
Comment :
in
String
:= "";
FlagArray : in
RunFlagArray
:= (Others => False));
-------------------------------------------------------------------------------------------------
type SHObj_Type is (SHPrinter, SHFile);
procedure SHObjectProperties (Win
: in GWindows.Base.Base_Window_Type'Class;
Target
: in
SHObj_Type
:= SHFile;
Path_FName : in String;
TabName :
in
String);
procedure SHObjectProperties (Target
: in SHObj_Type
:= SHFile;
Path_FName : in String;
TabName :
in
String);
-------------------------------------------------------------------------------------------------
type SHString_Access is
access String;
procedure SHChangeIconDialog (Win
: in
GWindows.Base.Base_Window_Type'Class;
IconFile
: in
out SHString_Access;
SystemDir
: in
Boolean :=True;
NumIcon
: in
out Integer;
Cancel
: out
Boolean);
procedure SHChangeIconDialog (IconFile
: in out SHString_Access;
SystemDir
: in
Boolean :=True;
NumIcon
: in
out Integer;
Cancel
: out
Boolean);
-------------------------------------------------------------------------------------------------
private
--
APIs non-documentées & constantes utiles
DeskTopHwnd : constant Interfaces.C.long
:= 16#0#;
-------------------------------------------------------------------------------------------------
function SHRestartSystemMBA (hwnd
: Interfaces.C.long;
PromptA :
char_array;
Flags
: Interfaces.C.unsigned)
return
Interfaces.C.long;
function SHRestartSystemMBW (hwnd
: Interfaces.C.long;
PromptW : wchar_array;
Flags
: Interfaces.C.unsigned)
return
Interfaces.C.long;
LogOff : constant Interfaces.C.unsigned :=
16#0#;
ShutDown : constant Interfaces.C.unsigned :=
16#1#;
ReBoot : constant Interfaces.C.unsigned :=
16#2#;
Force : constant Interfaces.C.unsigned :=
16#4#;
PowerOff : constant Interfaces.C.unsigned :=
16#8#;
-------------------------------------------------------------------------------------------------
gwYes : constant Interfaces.C.long
:= 16#6#;
gwNo :
constant Interfaces.C.long
:= 16#7#;
-------------------------------------------------------------------------------------------------
function SHShutDownDialogAW (hwnd
: Interfaces.C.long) -- Pas de chaînes
return
Interfaces.C.long;
-------------------------------------------------------------------------------------------------
function SHRunDialogA (hwnd
: Interfaces.C.long;
hIcon
: Interfaces.C.long;
DirectoryA : char_array;
TitleA
: char_array;
CommentA :
char_array;
Flags
: Interfaces.C.unsigned)
return
Interfaces.C.long;
function SHRunDialogW (hwnd
: Interfaces.C.long;
hIcon
: Interfaces.C.long;
DirectoryW : wchar_array;
TitleW
: wchar_array;
CommentW :
wchar_array;
Flags
: Interfaces.C.unsigned)
return
Interfaces.C.long;
No_Browse : constant Interfaces.C.unsigned :=
16#1#;
No_MRU : constant Interfaces.C.unsigned :=
16#2#;
Relative_Path
: constant Interfaces.C.unsigned
:= 16#4#;
--
petit bug sur les chemins comportant un espace...
No_Label : constant Interfaces.C.unsigned :=
16#8#;
No_SeparateMem
: constant Interfaces.C.unsigned
:= 16#20#;--NT seulement
-------------------------------------------------------------------------------------------------
function SHChangeIconDialogA (hwnd
: Interfaces.C.long;
FileNameA :
char_array;
nMaxFile :
Interfaces.C.long;
IconIndex : access
Interfaces.C.long)
return Interfaces.C.long;
function SHChangeIconDialogW (hwnd
: Interfaces.C.long;
FileNameW :
wchar_array;
nMaxFile :
Interfaces.C.long;
IconIndex : access Interfaces.C.long)
return
Interfaces.C.long;
gwCancel : constant Interfaces.C.long
:= 16#0#;
gwOk :
constant Interfaces.C.long
:= 16#1#;
-------------------------------------------------------------------------------------------------
function SHObjectPropertiesA
(hwnd :
Interfaces.C.long;
uFlags :
Interfaces.C.unsigned;
sNameA :
char_array;
sParamA :
char_array)
return
Interfaces.C.long;
function SHObjectPropertiesW
(hwnd :
Interfaces.C.long;
uFlags
: Interfaces.C.unsigned;
sNameW :
wchar_array;
sParamW :
wchar_array)
return
Interfaces.C.long;
Printer : constant Interfaces.C.unsigned :=
16#1#;
File :
constant Interfaces.C.unsigned
:= 16#2#;
-------------------------------------------------------------------------------------------------
function IsWin9x return Boolean;
-------------------------------------------------------------------------------------------------
-- APIs documentées fort utiles...
function hInst return Interfaces.C.long;
function LoadIcon (hInst : Interfaces.C.long;
pszIcon : GString_C)
return
Interfaces.C.long;
function GetSystemDirectory (Path
: GString_C;
nSize :
Interfaces.C.size_t)
return
Interfaces.C.size_t;
type OSVERSIONINFO is record
dwOSVersionInfoSize :
Interfaces.C.unsigned_long;
dwMajorVersion
: Interfaces.C.unsigned_long;
dwMinorVersion
: Interfaces.C.unsigned_long;
dwBuildNumber
: Interfaces.C.unsigned_long;
dwPlatformId
: Interfaces.C.unsigned_long;
szCSDVersion
: GString_C (0
..
127);
end record;
type LPOSVERSIONINFO is
access all OSVERSIONINFO;
function GetVersionEx (lpVersionInformation :
LPOSVERSIONINFO)
return
Interfaces.C.int;
OVI_Win9x : constant Interfaces.C.unsigned_long :=
1;
Max_Path : constant Interfaces.C.size_t
:= 260;
--
pragmas
pragma Linker_Options ("-lUDshell32");
pragma Import (Stdcall, SHRestartSystemMBA, "SHRestartSystemMB");
pragma Import (Stdcall, SHRestartSystemMBW, "SHRestartSystemMB");
pragma Import (Stdcall, SHShutDownDialogAW, "SHShutDownDialog");
--
Pas de chaînes
pragma Import (Stdcall, SHRunDialogA, "SHRunDialog");
pragma Import (Stdcall, SHRunDialogW, "SHRunDialog");
pragma Import (Stdcall, SHChangeIconDialogA, "SHChangeIconDialog");
pragma Import (Stdcall, SHChangeIconDialogW, "SHChangeIconDialog");
pragma Import (Stdcall, SHObjectPropertiesA, "SHObjectProperties");
pragma Import (Stdcall, SHObjectPropertiesW, "SHObjectProperties");
pragma Import (C, hInst, "rts_get_hInstance");
pragma Import (StdCall, LoadIcon, "LoadIcon"
&
Character_Mode_Identifier);
pragma Import (Stdcall, GetSystemDirectory, "GetSystemDirectory"
&
Character_Mode_Identifier);
pragma Convention (C, OSVERSIONINFO);
pragma Import (Stdcall, GetVersionEx, "GetVersionEx"
&
Character_Mode_Identifier);
end
UD_Shell32;
|