[API] Trouver et tuer un Process Windows
- Code : Tout sélectionner
Option Public
Option Explicit
Private Const TH32CS_SNAPPROCESS = &H2&
Private Const hNull = 0
Const WM_SYSCOMMAND = &H112
Const SC_CLOSE = &HF060
Const PROCESS_QUERY_INFORMATION = &H400
Const PROCESS_VM_READ = &H10
Declare Function OpenProcess Lib "kernel32" (Byval dwDesiredAccess As Long, Byval bInheritHandle As Long, Byval dwProcessId As Long) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (Byval hwnd As Long, Byval wMsg As Long, Byval wParam As Long, lParam As Long) As Long
Declare Function GetExitCodeProcess Lib "kernel32" (Byval hProcess As Long, lpExitCode As Long) As Long
Declare Function TerminateProcess Lib "kernel32" (Byval hProcess As Long, Byval uExitCode As Long) As Long
Declare Sub ExitProcess Lib "kernel32" (Byval uExitCode As Long)
Declare Function CloseHandle Lib "kernel32" (Byval hObject As Long) As Long
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * 260
End Type
Declare Function Process32First Lib "kernel32" (Byval hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Declare Function Process32Next Lib "kernel32" (Byval hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Declare Function CreateToolhelp32Snapshot Lib "kernel32" (Byval dwFlags As Long, Byval th32ProcessID As Long) As Long
Function ExeRunning(Byval ExeFind As String)
Dim hProc As Long
Dim lRet As Long, Proc As PROCESSENTRY32
Dim fullstr As Long, string2 As String
Dim sClean As String
Dim IRETURNCODE As Long
Dim ProcFromprocid As Long
Dim lpExitCode As Long
Const NILL = 0&
hProc = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
ExeRunning = False
If hProc = 0 Then
Exit Function
End If
Proc.dwSize = Len(Proc)
lRet = Process32First(hProc, Proc)
Do While lRet
sClean = Left(Proc.szExeFile, Instr(Proc.szExeFile, Chr(0)) - 1)
string2 = ""
For fullstr = Len(sClean) To 1 Step -1
If Mid(sClean, fullstr, 1) = "\" Then Exit For
string2 = Mid(sClean, fullstr, 1) & string2
Next
If Ucase(string2) = Ucase(ExeFind) Then
ExeRunning = True
ProcFromprocid = OpenProcess(PROCESS_QUERY_INFORMATION Or _
PROCESS_VM_READ, 0, Proc.th32ProcessID)
Call GetExitCodeProcess(ProcFromprocid, lpExitCode)
Msgbox("Found " & Procfromprocid & " " & lpexitcode)
Call TerminateProcess(ProcFromprocid, lpExitCode)
Exit Function
End If
lRet = Process32Next(hProc, Proc)
Loop
End Function
Utilisation :
- Code : Tout sélectionner
Call exerunning("excel.exe")