1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
| Option Explicit
Private Declare Function SetThreadExecutionState Lib "kernel32" (ByVal esFlags As Long) As Long
'SetThreadExecutionState Permet à une application d'informer le système qu'il est en cours d'utilisation, _
' ce qui empêche le système d'enclencher la mise en veille ou éteindre l'écran _
' lorsque l'application est en cours d'exécution.
Public Enum EXECUTION_STATE
ES_CONTINUOUS = &H80000000 'Informe le système que l'État étant programmée doit rester en vigueur jusqu'à l'appel suivant qui utilise ES_CONTINUOUS et l'un des autres drapeaux de l'Etat est effacé.
ES_DISPLAY_REQUIRED = &H2 'Force l'affichage soit par la réinitialisation de l'affichage minuteur d'inactivité.
ES_SYSTEM_REQUIRED = &H1 'Force le système d'être dans l'état de fonctionnement en réinitialisant le système minuteur d'inactivité.
ES_AWAYMODE_REQUIRED = &H40
End Enum
'Valeur de retour
'Si la fonction réussit, la valeur de retour est l'état d'exécution du thread précédente.
'Si la fonction échoue, la valeur de retour est NULL .
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Type STARTUPINFO 'Indique la station de fenêtre, bureau, poignées standards, et l'apparence de la fenêtre principale d'un processus lors de la création.
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type
'fonction WaitForSingleObject va servir à attendre que l'objet passé en paramètre _
' atteigne un certain état ou qu'il arrive au bout du temps imparti. _
' Cette fonction ne fonctionne pas uniquement pour les threads, _
' elle fonctionne aussi pour les changements d'état, les saisies consoles, les événements,...
Private Declare Function WaitForSingleObject Lib "kernel32" ( _
ByVal hHandle As Long, _
ByVal dwMilliseconds As Long) As Long
'dwMilliseconds [en]L 'intervalle de temps mort, en millisecondes. _
' Si une valeur non nulle est spécifié, la fonction attend jusqu'à ce que _
' l'objet est signalé ou l'intervalle se écoule. _
' Si dwMilliseconds est nul, la fonction ne entre pas dans un état ??d'attente si l'objet ne est pas signalé; elle retourne toujours immédiatement. _
' Si dwMilliseconds est INFINITE , la fonction reviendra seulement lorsque l'objet est signalée.
'Remarque Le dwMilliseconds valeur ne inclut pas le temps passé dans les Etats de faible puissance. _
' Par exemple, le délai d'attente ne sera pas garder le compte à rebours lorsque l'ordinateur est en veille.
Private Declare Function CreateProcessA Lib "kernel32" ( _
ByVal lpApplicationName As String, _
ByVal lpCommandLine As String, _
ByVal lpProcessAttributes As Long, _
ByVal lpThreadAttributes As Long, _
ByVal bInheritHandles As Long, _
ByVal dwCreationFlags As Long, _
ByVal lpEnvironment As Long, _
ByVal lpCurrentDirectory As String, _
lpStartupInfo As STARTUPINFO, _
lpProcessInformation As _
PROCESS_INFORMATION) As Long
'lpApplicationName As String (facultaif) :La chaîne peut spécifier le chemin complet et le nom du module à exécuter ou il peut spécifier un nom partiel. Dans le cas d'une partie du nom, la fonction utilise le lecteur en cours et le répertoire en cours pour compléter la spécification. La fonction ne sera pas utiliser le chemin de recherche. Ce paramètre doit inclure l'extension de nom de fichier; pas d'extension par défaut est supposé.
'Ce paramètre peut être NULL . Dans ce cas, le nom du module doit être le premier jeton séparés par des espaces blancs dans le lpCommandLine
'lpCommandLine As String, [in, out, facultatif]La ligne de commande à exécuter. La longueur maximale de cette chaîne est 32 768 caractères, y compris le caractère nul de terminaison Unicode. Si IpApplicationName est NULL , la partie nom du module de lpCommandLine est limitée à MAX_PATH caractères.
'Le lpCommandLine paramètre peut être NULL. Dans ce cas, la fonction utilise la chaîne pointée par IpApplicationName que la ligne de commande.
'lpProcessAttributes [in, facultatif] Un pointeur vers une SECURITY_ATTRIBUTES structure qui détermine si le handle retourné au nouvel objet de processus peut être héritée par les processus enfants. Si lpProcessAttributes est NULL , la poignée ne peut pas être héritée.
'lpThreadAttributes [in, facultatif]
'Un pointeur vers une SECURITY_ATTRIBUTES structure qui détermine si le handle retourné au nouvel objet de fil peut être hérité par les processus enfants. Si lpThreadAttributes est NULL, la poignée ne peut pas être héritée. _
'bInheritHandles [en] Si ce paramètre TRUE, chaque poignée héréditaire dans le processus d'appel est héritée par le nouveau processus. Si le paramètre est FAUX, les poignées ne sont pas héritées. Notez que les poignées héritées ont les mêmes droits de valeur et accès que les poignées d'origine. _
'dwCreationFlags [en]Les drapeaux qui contrôlent la classe de priorité et la création du processus. Pour une liste des valeurs, voir Drapeaux processus de création . _
'lpEnvironment [in, facultatif]Un pointeur vers le bloc d'environnement pour le nouveau processus. Si ce paramètre est NULL , le nouveau procédé utilise l'environnement du processus d'appel. _
'lpCurrentDirectory [in, facultatif] Le chemin complet vers le répertoire courant pour le processus. La chaîne peut également spécifier un chemin UNC.
'Si ce paramètre est NULL , le nouveau processus aura le même lecteur et le répertoire que le processus d'appel. _
'lpStartupInfo [en]Un pointeur vers une STARTUPINFO ou STARTUPINFOEX structure.
'Poignées dans STARTUPINFO ou STARTUPINFOEX doivent être fermées avec CloseHandle quand ils ne sont plus nécessaires.
'lpProcessInformation [out]Un pointeur vers une PROCESS_INFORMATION structure qui reçoit des informations d'identification sur le nouveau processus.
'Poignées dans PROCESS_INFORMATION doivent être fermées avec CloseHandle quand ils ne sont plus nécessaires.
'Valeur de retour
'Si la fonction réussit, la valeur de retour est différent de zéro.
'Si la fonction échoue, la valeur de retour est zéro. Pour obtenir des informations sur l'erreur, appelez GetLastError .
'Notez que la fonction retourne avant que le processus a terminé l'initialisation. Si une DLL requise ne peut être situé ou ne se initialise pas, le processus est terminé. Pour obtenir le statut de terminaison d'un processus, appeler GetExitCodeProcess .
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
'Récupère le statut de terminaison du processus spécifié.
Private Declare Function GetExitCodeProcess Lib "kernel32" ( _
ByVal hProcess As Long, _
lpExitCode As Long) As Long
'lpExitCode [out]Un pointeur vers une variable pour recevoir le statut de la fin du processus.
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&
'
Public Function ExecCmd(cmdline$)
Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
Dim ret As Long
' Initialisez la structure STARTUPINFO :
start.cb = Len(start)
' Démarrez l'application Shell :
ret = CreateProcessA(vbNullString, cmdline$, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, vbNullString, start, proc)
SleepOff 'désactivation de la mise en veille
' Attendez la fin de l'application Shell :
ret = WaitForSingleObject(proc.hProcess, INFINITE)
Call GetExitCodeProcess(proc.hProcess, ret)
Call CloseHandle(proc.hThread)
Call CloseHandle(proc.hProcess)
SleepOn 'Activation de la mise en veille
ExecCmd = ret
End Function
Private Sub Main()
Dim retval As Long
retval = ExecCmd("C:\Program Files\Google\Picasa3\Picasa3.exe")
' REMARQUE:L 'instruction de la boîte de message suivant la fonction ExecCmd ()
' n 'est pas exécutée car la fonction WaitForSingleObject () l'en empêche.
' La boîte de message apparaît uniquement lorsque
' le Bloc-notes est fermé à l'aide de l'élément Quitter du menu Fichier du Bloc-notes (ALT, F, X).
'MsgBox "Le processus est terminé, code de sortie " & retval
End Sub
Public Sub SleepOff()
SetThreadExecutionState (EXECUTION_STATE.ES_DISPLAY_REQUIRED Or EXECUTION_STATE.ES_CONTINUOUS)
End Sub
Public Sub SleepOn()
SetThreadExecutionState (EXECUTION_STATE.ES_CONTINUOUS)
End Sub |
