Faire une pose sur un executable

Salut JP!

Tu pourrais utiliser les APIs SuspendThread et ResumeThread.

Je t'ai fais un petit exemple. Il y a 2 exécutable en jeu.

Voici le code du premier premier exécutable.. ce dernier ne fait rien de
spécial.. la couleur de fond change une fois par seconde.
'***
' Project1
' Form1
' 1 Timer
Option Explicit

Private Sub Form_Load()
Me.Caption = "SuspendThread/ResumeThread APIs Sample - Target's Form"
Me.BackColor = vbWhite
Timer1.Interval = 1000
Timer1.Enabled = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
Timer1.Enabled = False
End Sub

Private Sub Timer1_Timer()
Me.BackColor = IIf(Me.BackColor = vbWhite, vbBlack, vbWhite)
End Sub
'***

Compile le.



Voici le code du second projet. Ce projet permet de lancer, suspendre,
reactiver et arrêter un processus (son thread principal en fait.)
'***
' Project2
' Form1
' 4 CommandButtons
' 1 TextBox
Option Explicit

Private Sub Command1_Click()

Dim lRet As Long

lRet = StartProcess(Text1.Text)

If (lRet = 0) Then
Command1.Enabled = False
Command2.Enabled = True
Command4.Enabled = True
Else
Call MsgBox(FormatMessage(lRet))
End If

End Sub

Private Sub Command2_Click()

If (SuspendThread <> -1) Then
Command2.Enabled = False
Command3.Enabled = True
Else
Call MsgBox(FormatMessage(Err.LastDllError))
End If

End Sub

Private Sub Command3_Click()

If (ResumeThread <> -1) Then
Command3.Enabled = False
Command2.Enabled = True
Else
Call MsgBox(FormatMessage(Err.LastDllError))
End If

End Sub

Private Sub Command4_Click()

If (CloseProcess) Then
Call ResetButtonsState
Else
If (KillProcess) Then Call ResetButtonsState
End If

End Sub

Private Sub Form_Load()

Call ResetButtonsState
Call InitControls

End Sub

Private Sub Form_Unload(Cancel As Integer)

Call CloseProcess

End Sub

Private Sub Text1_GotFocus()
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
End Sub

Private Sub ResetButtonsState()
Command1.Enabled = True
Command2.Enabled = False
Command3.Enabled = False
Command4.Enabled = False
End Sub

Private Sub InitControls()

Call Me.Move(Me.Left, Me.Top, 6990, 1500)
Call Text1.Move(120, 120, 6615, 285)
Call Command4.Move(5160, 480, 1575, 375)
Call Command3.Move(3480, 480, 1575, 375)
Call Command2.Move(1800, 480, 1575, 375)
Call Command1.Move(120, 480, 1575, 375)

Me.Caption = "SuspendThread/ResumeThread APIs Sample - Thread Manager
Form"
Command1.Caption = "&Start"
Command2.Caption = "&Pause"
Command3.Caption = "&Resume"
Command4.Caption = "&Kill"
Text1.Text = "D:TestSuspend_ThreadProject1Project1.exe"

Command4.TabIndex = 0
Command3.TabIndex = 0
Command2.TabIndex = 0
Command1.TabIndex = 0
Text1.TabIndex = 0

End Sub


' Module1
Option Explicit

' Conserve les informations du processus
Private m_pi As PROCESS_INFORMATION

' Variable sentinelle, permet de déterminer
' si le message WM_CLOSE à réussi
Private m_bClosed As Boolean



' STARTUPINFO's ShowWindow values
Private Const SW_SHOWNORMAL As Long = 1

' STARTUPINFO Flags
Private Const STARTF_USESHOWWINDOW As Long = &H1

' Constantes pour les messages systèmes
Private Const FORMAT_MESSAGE_IGNORE_INSERTS As Long = &H200&
Private Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000&
Private Const LANG_NEUTRAL As Long = &H0&

' Consante pour tuer un propessus
Private Const SYNCHRONIZE As Long = &H100000
Private Const PROCESS_TERMINATE As Long = &H1

' Message permettant la fermeture d'une fenêtre
Private Const WM_CLOSE As Long = &H40

Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadId As Long
End Type

Private Type STARTUPINFO
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 Byte
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type

Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type

' Creation's flag values
Private Const NORMAL_PRIORITY_CLASS As Long = &H20
Private Const IDLE_PRIORITY_CLASS As Long = &H40
Private Const HIGH_PRIORITY_CLASS As Long = &H80
Private Const REALTIME_PRIORITY_CLASS As Long = &H100

Private Declare Function CreateProcess _
Lib "kernel32" _
Alias "CreateProcessA" _
( _
ByVal lpApplicationName As String, _
ByVal lpCommandLine As String, _
ByRef lpProcessAttributes As SECURITY_ATTRIBUTES, _
ByRef lpThreadAttributes As SECURITY_ATTRIBUTES, _
ByVal bInheritHandles As Long, _
ByVal dwCreationFlags As Long, _
ByRef lpEnvironment As Any, _
ByVal lpCurrentDriectory As String, _
ByRef lpStartupInfo As STARTUPINFO, _
ByRef lpProcessInformation As PROCESS_INFORMATION _
) As Long

Private Declare Function SuspendThreadAPI _
Lib "kernel32" _
Alias "SuspendThread" _
( _
ByVal hThread As Long _
) As Long

Private Declare Function ResumeThreadAPI _
Lib "kernel32" _
Alias "ResumeThread" _
( _
ByVal hThread As Long _
) As Long

Private Declare Function OpenProcess _
Lib "Kernel32.dll" _
( _
ByVal dwDesiredAccessas As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcId As Long _
) As Long

Private Declare Function TerminateProcess _
Lib "kernel32" _
( _
ByVal hProcess As Long, _
ByVal uExitCode As Long _
) As Long

Private Declare Function CloseHandle _
Lib "kernel32" _
( _
ByVal hObject As Long _
) As Long

Private Declare Function FormatMessageA _
Lib "kernel32" _
( _
ByVal dwFlags As Long, _
ByRef lpSource As Any, _
ByVal dwMessageId As Long, _
ByVal dwLanguageId As Long, _
ByVal lpBuffer As String, _
ByVal nSize As Long, _
ByRef Arguments As Long _
) As Long

Private Declare Function EnumThreadWindows _
Lib "user32" _
( _
ByVal dwThreadId As Long, _
ByVal lpfn As Long, _
ByVal lParam As Long _
) As Long

Private Declare Function GetWindowThreadProcessId _
Lib "user32" _
( _
ByVal hwnd As Long, _
ByRef lpdwProcessId As Long _
) As Long

Private Declare Function SendMessage _
Lib "user32" _
Alias "SendMessageA" _
( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByRef lParam As Any _
) As Long

Public Function EnumThreadWindowsProc(ByVal hwnd As Long, ByVal lParam As
Long) As Boolean

Call SendMessage(hwnd, WM_CLOSE, 0, ByVal 0&)
EnumThreadWindowsProc = True

End Function


Public Function StartProcess _
( _
ByRef sFilePath As String _
) As Long

Dim sa1 As SECURITY_ATTRIBUTES
Dim sa2 As SECURITY_ATTRIBUTES
Dim si As STARTUPINFO

If (Not FileExists(sFilePath)) Then Exit Function

sa1.nLength = LenB(sa1)
sa2.nLength = LenB(sa2)

si.cb = LenB(si)
si.dwFlags = STARTF_USESHOWWINDOW
si.wShowWindow = SW_SHOWNORMAL

If (CreateProcess(vbNullString, _
sFilePath, _
sa1, _
sa2, _
0, _
NORMAL_PRIORITY_CLASS, _
0&, _
GetDirectoryFromFilePath(sFilePath), _
si, _
m_pi) > 0) Then

Else
Call MsgBox(FormatMessage(Err.LastDllError))
End If

End Function

Private Function GetDirectoryFromFilePath(ByRef sFilePath As String) As
String
GetDirectoryFromFilePath = Left$(sFilePath, InStrRev(sFilePath, "") -
1)
End Function

Private Function FileExists(ByRef sFilePath As String) As Boolean
On Error Resume Next
FileExists = (GetAttr(sFilePath) And vbDirectory) = 0
End Function

Public Function FormatMessage(ByRef lErrorNumber As Long) As String
FormatMessage = Space$(255)
Call FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, lErrorNumber,
LANG_NEUTRAL, FormatMessage, 255, ByVal 0&)
FormatMessage = Left$(FormatMessage, InStr(FormatMessage, vbNewLine) -
1)
End Function

Public Function CloseProcess() As Boolean

If (Not ProcessStarted) Then Exit Function

Call EnumThreadWindows(m_pi.dwThreadId, AddressOf EnumThreadWindowsProc,
0)

If (m_pi.hThread <> 0) Then Call CloseHandle(m_pi.hThread)
If (m_pi.hProcess <> 0) Then Call CloseHandle(m_pi.hProcess)

End Function

Public Function SuspendThread() As Long
If (ProcessStarted) Then SuspendThread = SuspendThreadAPI(m_pi.hThread)
End Function

Public Function ResumeThread() As Long
If (ProcessStarted) Then ResumeThread = ResumeThreadAPI(m_pi.hThread)
End Function

Public Function ProcessStarted() As Boolean
ProcessStarted = m_pi.hProcess <> 0
End Function

' par Karl E. Peterson
Public Function KillProcess() As Boolean

Dim hProc As Long

If (Not ProcessStarted) Then Exit Function

' Ouvre le processus avec les droits en fermeture..
hProc = OpenProcess(SYNCHRONIZE Or PROCESS_TERMINATE, 0&,
m_pi.dwProcessID)
If (hProc) Then
If (TerminateProcess(hProc, 0&)) Then KillProcess = True
Call CloseHandle(hProc)
End If

End Function
'***

Tu n'as pas besoin de compiler ce projet. Démarre le projet et entre le
chemin d'accès vers l'exécutable du premier projet (Project1.exe, par
exemple).



note : j'vais poster les projets en attachement dans le message qui suivra.

--
Cordialement
Yanick Lefebvre - MVP pour Visual Basic
http://faq.vb.free.fr/?rubrique=0 - http://www.mvps.org/vbnet/
http://www.mentalis.org/agnet/apiguide.shtml - http://www.mztools.com/

Merci de poster les réponses au groupe afin d'en faire profiter à tous
"jp" <jp@aa.fr> wrote in message
news:eSXCKsr2DHA.1684@TK2MSFTNGP12.phx.gbl...

Bonjour,

je lance un programme externe par la commande Shell et récupére le
handle du process sans problème.

Toutrefois je souhaiterai STOPPER (programme externe) temporairement puis
reprendre le processus.

FAIRE UNE PAUSE EN SORTE.....

Merci

il faudrait modifier la fin de la fonction StartProcess()..

changer tout ce code :

If (CreateProcess(vbNullString, _
sFilePath, _
sa1, _
sa2, _
0, _
NORMAL_PRIORITY_CLASS, _
0&, _
GetDirectoryFromFilePath(sFilePath), _
si, _
m_pi) > 0) Then

Else
Call MsgBox(FormatMessage(Err.LastDllError))
End If

pour ça :
'***
StartProcess = CreateProcess(vbNullString, _
sFilePath, _
sa1, _
sa2, _
0, _
NORMAL_PRIORITY_CLASS, _
0&, _
GetDirectoryFromFilePath(sFilePath), _
si, _
m_pi)
'***

--
Cordialement
Yanick Lefebvre - MVP pour Visual Basic
http://faq.vb.free.fr/?rubrique=0 - http://www.mvps.org/vbnet/
http://www.mentalis.org/agnet/apiguide.shtml - http://www.mztools.com/

Merci de poster les réponses au groupe afin d'en faire profiter à tous

> Tu pourrais utiliser les APIs SuspendThread et ResumeThread.

François m'a fait remarqué quelque notes intéressantes au sujet de ces
APIs.. lit le deuxième paragraphe de la section Remarks
http://msdn.microsoft.com/library/en-us/dllproc/base/suspendthread.asp

--
Cordialement
Yanick Lefebvre - MVP pour Visual Basic
http://faq.vb.free.fr/?rubrique=0 - http://www.mvps.org/vbnet/
http://www.mentalis.org/agnet/apiguide.shtml - http://www.mztools.com/

Merci de poster les réponses au groupe afin d'en faire profiter à tous