Soyez le premier à donner votre avis sur cette source.
Snippet vu 10 895 fois - Téléchargée 71 fois
'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
ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Sont des APIs devant exister a partir de windows 95...mais pas pour NT4.
Connaissez vous des équivalents?
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.