VERIFICAR EXECUCAO DE UM PROGRAMA

Citação:

Private Sub Command1_Click()
Dim uLngProcess As Long
uLngProcess = GetProcessIDByEXEName(Me.Text1.Text)
If uLngProcess = 0 Then
MsgBox ("Esse processo não está em execução !!"), vbCritical
Else
If MsgBox("Esse processo está em execução, deseja encerrá-lo ?", vbQuestion + vbYesNo) = vbYes Then
If uLngProcess <> 0 Then ProcessTerminate uLngProcess
Else
MsgBox ("Processo em execução e não terminado !!"), vbInformation
End If
End If
End Sub

Citação:

Global Const MAX_PATH = 260
Private Const SE_PRIVILEGE_ENABLED = &H2
Private Const TH32CS_SNAPPROCESS As Long = 2&
Private Const TOKEN_ADJUST_PRIVILEGES = &H20
Private Const TOKEN_QUERY = &H8

Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long

Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) 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 GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Private Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32" (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 TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () 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 * MAX_PATH: End Type
Private Type LUID: UsedPart As Long: IgnoredForNowHigh32BitPart As Long: End Type
Private Type TOKEN_PRIVILEGES: PrivilegeCount As Long: TheLuid As LUID: Attributes As Long: End Type

Function GetProcessIDByEXEName(ByVal EXEName As String) As Long
    
Dim hSnapShot As Long
Dim uProcess As PROCESSENTRY32
Dim R As Long, lStrtemp As String

hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&)

    If hSnapShot = -1 Then Exit Function

uProcess.dwSize = Len(uProcess)
R = ProcessFirst(hSnapShot, uProcess)

    Do While R
    
        If InStr(UCase(uProcess.szExeFile), UCase(EXEName)) <> 0 Then
        GetProcessIDByEXEName = uProcess.th32ProcessID
        Call CloseHandle(hSnapShot)
        Exit Function
        End If
    
    R = ProcessNext(hSnapShot, uProcess)
    
    Loop

Call CloseHandle(hSnapShot)

End Function

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_TERMINATE = &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
        'Get the process ID from the window handle
        lRetVal = GetWindowThreadProcessId(lHwndWindow, lProcessID)
    End If
    
    If lProcessID Then
        'Give Kill permissions to this process
        lhThisProc = GetCurrentProcess
        
        OpenProcessToken lhThisProc, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, lhTokenHandle
        LookupPrivilegeValue "", SE_DEBUG_NAME, tLuid
        'Set the number of privileges to be change
        tTokenPriv.PrivilegeCount = 1
        tTokenPriv.TheLuid = tLuid
        tTokenPriv.Attributes = SE_PRIVILEGE_ENABLED
        'Enable the kill privilege in the access token of this process
        AdjustTokenPrivileges lhTokenHandle, False, tTokenPriv, Len(tTokenPrivNew), tTokenPrivNew, lBufferNeeded

        'Open the process to kill
        lhwndProcess = OpenProcess(PROCESS_TERMINATE, 0, lProcessID)
        
        If lhwndProcess Then
            'Obtained process handle, kill the process
            ProcessTerminate = CBool(TerminateProcess(lhwndProcess, lExitCode))
            Call CloseHandle(lhwndProcess)
        End If
    End If
    On Error GoTo 0
End Function

Citação:

FERTEL escreveu:
Nicollas, ainda não testei esse procedimento que você postou, mas vou testar daqui a pouco, mas já me adiantando, como eu poderia fazer para ao invés de ocorrer a verificação quando clicasse no botão, ele fizesse de tempos em tempos? Seria utilizando o coponente Timer né? Alguma idéia de como eu poderia substituir o button pelo Timer nesse caso? Ou alguém mais que saiba? Tem tempo que não mexo com Timer, esqueci.

Obrigado desde já.

Private Sub Timer1_Timer()
Dim uLngProcess As Long
    uLngProcess = GetProcessIDByEXEName(Me.Text1.Text)
    If uLngProcess = 0 Then
        MsgBox ("Esse processo não está em execução !!"), vbCritical
    Else
        If MsgBox("Esse processo está em execução, deseja encerrá-lo ?", vbQuestion + vbYesNo) = vbYes Then
            If uLngProcess <> 0 Then ProcessTerminate uLngProcess
        Else
            MsgBox ("Processo em execução e não terminado !!"), vbInformation
        End If
    End If

End Sub