Tuer 2 processur

Question

Bonjour,

Je cherche à fermer une appli qui lance 2 process. J'ai regarder les codes qui ferment des appli mais dans mon cas, ça ne fonctionne pas ; peut-être pas qu'il y a 2 process de lancé justement.

Comment pourrais-je supprimer ses 2 process dont je connais le nom ?

Merci de vos réponses.

cs_CanisLupus · Answer

Salut,

Tu es sûr que tu as fermé tous tes formulaires, déchargé tous tes objets et refermé tes accès à des bases ? (unload form, set objet = nothing et rs.close db.close).

Si tu ne peux pas faire autrement alors met ce qui suit dans un module :

'
' UTILISATION : KillProcessus "truc.exe"
'

Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, lProcessID As Long) As Long

Const MAX_PATH As Integer = 260

Private Type LUID
    LowPart As Long
    HighPart As Long
End Type

Private Type LUID_AND_ATTRIBUTES
    pLuid As LUID
    Attributes As Long
End Type

Private Type TOKEN_PRIVILEGES
    PrivilegeCount As Long
    TheLuid As LUID
    Attributes As Long
End Type

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 * MAX_PATH
End Type

Private Function ProcessTerminate(Optional lProcessID As Long, Optional lHwndWindow As Long) As Boolean
     Dim lhwndProcess As Long
     Dim lExitCode As Long
     Dim lRetVal As Long
     Dim lhThisProc As Long
     Dim lhTokenHandle As Long
     Dim tLuid As LUID
     Dim tTokenPriv As TOKEN_PRIVILEGES, tTokenPrivNew As TOKEN_PRIVILEGES
     Dim lBufferNeeded As Long     Const PROCESS_ALL_ACCESS &H1F0FFF, PROCESS_TERMINAT &H1     Const ANYSIZE_ARRAY 1, TOKEN_ADJUST_PRIVILEGES &H20     Const TOKEN_QUERY &H8, SE_DEBUG_NAME As String "SeDebugPrivilege"
     Const SE_PRIVILEGE_ENABLED = &H2

     On Error Resume Next
     If lHwndWindow Then
        lRetVal = GetWindowThreadProcessId(lHwndWindow, lProcessID)
     End If
     If lProcessID Then
        lhThisProc = GetCurrentProcess
        OpenProcessToken lhThisProc, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, lhTokenHandle
        LookupPrivilegeValue "", SE_DEBUG_NAME, tLuid
        tTokenPriv.PrivilegeCount = 1
        tTokenPriv.TheLuid = tLuid
        tTokenPriv.Attributes = SE_PRIVILEGE_ENABLED
        AdjustTokenPrivileges lhTokenHandle, False, tTokenPriv, Len(tTokenPrivNew), tTokenPrivNew, lBufferNeeded
        lhwndProcess = OpenProcess(PROCESS_TERMINAT, 0, lProcessID)
        If lhwndProcess Then
         ProcessTerminate = CBool(TerminateProcess(lhwndProcess, lExitCode))
         Call CloseHandle(lhwndProcess)
        End If
     End If
     On Error GoTo 0
End Function

Public Function KillProcessus(ByVal sProcessNameExe As String) As String
     Dim i As Integer
     Dim hSnapshot As Long
     Dim uProcess As PROCESSENTRY32
     Dim r As Long
     Dim nom(1 To 100)
     Dim num(1 To 100)
     Dim nr As Integer
     Const TH32CS_SNAPPROCESS As Long = 2&
     
     nr = 0
     hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
     If hSnapshot = 0 Then Exit Function
     uProcess.dwSize = Len(uProcess)
     r = ProcessFirst(hSnapshot, uProcess)
     Do While r
        nr = nr + 1
        nom(nr) = uProcess.szexeFile
        num(nr) = uProcess.th32ProcessID
        r = ProcessNext(hSnapshot, uProcess)
     Loop
     For i = 1 To nr
         If InStr(UCase(nom(i)), UCase(sProcessNameExe)) <> 0 Then
            ProcessTerminate (num(i))
            Exit For
         End If
     Next i
End Function

Cordialement

CanisLupus

cs_fred_konga · Answer

Ok merci,

Je vais essayé lundi au boulot

cs_fred_konga · Answer

Un grand merci CanisLupus,

J'avoue ne rien comprendre au code que tu m'as envoyé mais il marche impec.

cs_CanisLupus · Answer

Ouaip, g eu du mal aussi !

C un code que g récupéré je ne sais plus où mais, comme tu dis, il marche.

Faut que je fasse un tuto ou au moins documenter in french ce code car il a l'air de convenir à +sieurs développeurs. Mais, bon, faut le temps.

En gros, la proc principale (KillProcessus) recherche le process que tu lui indiques (sProcessNameExe) et le termine.
Tout ça c à base d'APIs non documentées (ou très peu).

Cordialement

CanisLupus

Tuer 2 processur

4 réponses

Discussions similaires