Interdire / interrompre l'exécution de processus

Commenter

Contenu du snippet

copier la catégorie FORM ds une nouvelle feuille
ajouter un module et coller la catégorie module dedans
L'exécution s'arrête lorsque la feuille est fermée

Source / Exemple : 


'feuille FORM
Public Function existe(valeur As String) As Boolean

'Test si valeur appartient à la collection des interdits

Dim i As Integer
i = 1
While i < interdit.Count And interdit.Item(i) <> valeur
i = i + 1
Wend
If interdit.Item(i) = valeur Then
existe = True
Else
existe = False
End If
End Function

Public Sub ferme_process(valeur As String)
'ferme le processus dont l'ID est valeur
' valeur devrait être de type long ms  ce paramétrage
'permet d'utiliser de l'hexadécimal

Dim ID_proc As Long
Dim hprocess As Long
Dim nRet As Long
Dim tache As String
Dim cpt As Integer
ID_proc = CLng(valeur)
hprocess = OpenProcess(PROCESS_QUERY_INFORMATION, False, ID_proc)
GetExitCodeProcess hprocess, nRet
Call TerminateProcess(hprocess, nRet)
Call CloseHandle(hprocess)
End Sub

Public Sub retourne_processus()
'retourne la liste des processus actifs (sauf notre app)

Dim cpt As Integer
Dim strNomExe As String
Dim strProcessID As String
Dim lngSnapShot As Long
Dim r As Long
Dim uProcess As PROCESSENTRY32
lngSnapShot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
If lngSnapShot <> 0 Then
uProcess.lSize = Len(uProcess)
r = ProcessFirst(lngSnapShot, uProcess)

    Do While r
       strNomExe = Left(uProcess.sExeFile, InStr(1, uProcess.sExeFile, vbNullChar) - 1)
         If retourne_exe(strNomExe) <>  App.EXEName Then
          collect.Add retourne_exe(strNomExe), retourne_exe(strNomExe) & cpt 'plusieurs instances du même EXE possible
          cpt = cpt + 1
          collect.Add CStr(uProcess.lProcessId), CStr(uProcess.lProcessId)
         End If
       r = ProcessNext(lngSnapShot, uProcess)
   Loop
    CloseHandle (lngSnapShot)
End If
End Sub

Public Function retourne_exe(valeur As String) As String

'cette fonction renvoit uniquement le nom de l'EXE
'nb: cette fonction était utile ds mon projet ms vous
'pouvez la supprimer pour avoir le chemin complt des EXE

Dim ind As Integer
Dim ancien As Integer
ancien = 0
i = Len(valeur)
Do
ind = InStr(ancien + 1, valeur, "\", vbBinaryCompare)
If ind <> 0 Then
ancien = ind
Else
Exit Do
End If
Loop
retourne_exe = Right(valeur, i - ancien)
End Function

Private Sub Form_Load()
'exemple de fichiers à interdire
Me.Show
interdit.Add "REGEDIT.EXE", "REGEDIT.EXE"
interdit.Add "IEXPLORE.EXE", "IEXPLORE.EXE"
interdit.Add "MSCONFIG.EXE", "MSCONFIG.EXE"
interdit.Add "WINIPCFG.EXE", "WINIPCFG.EXE"

Do
Set collect = Nothing
retourne_processus
For i = 1 To collect.Count Step 2
    If existe(UCase(collect.Item(i))) Then 'si trouvé
    ferme_process (collect.Item(i + 1))
    MsgBox "Session [" & collect.Item(i) & "] trouvée", vbExclamation, "Attention"
    End If
Next i
DoEvents 'multitaches
Loop Until fin
End Sub

Private Sub Form_Unload(Cancel As Integer)
fin = True
End Sub

' module
'var globale de fin  du prog
Public fin As Boolean

'collections
Public collect As New Collection
Public interdit As New Collection

'constantes processus
Public Const MAX_PATH = 260
Public Const TH32CS_SNAPPROCESS = 2&
Public Const PROCESS_QUERY_INFORMATION = &H400

'type processus
Public Type PROCESSENTRY32
    lSize            As Long
    lUsage           As Long
    lProcessId       As Long
    lDefaultHeapId   As Long
    lModuleId        As Long
    lThreads         As Long
    lParentProcessId As Long
    lPriClassBase    As Long
    lFlags           As Long
    sExeFile         As String * MAX_PATH
End Type

'API processus & threads
Public Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessId As Long) As Long
Public Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Public Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Public Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long)
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hprocess As Long, lpExitCode As Long) As Long
Public Declare Function TerminateProcess Lib "kernel32" (ByVal hprocess As Long, ByVal uExitCode As Long) As Long

Conclusion :


Vous pouvez nettement optimiser ce programme
Pour plus d'infos,
sub-zer0@caramail.com

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_sub-zero)