Existe uma função que me diga se um executável da máquina foi startado?

 

Obrigado.

Private Declare Sub CloseHandle Lib "Kernel32" (ByVal hPass As Long)
Private Declare Function TerminateProcess Lib "Kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function OpenProcess Lib "Kernel32" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Private Declare Function CreateToolhelp32Snapshot Lib "Kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function Process32Min Lib "Kernel32" (ByVal hSnapShot As Long, uProcess As PROC) As Long
Private Declare Function Process32Next Lib "Kernel32" (ByVal hSnapShot As Long, uProcess As PROC) As Long
Private Type PROC
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
Function ScanProcess(sProc As String) As Boolean
On Error Resume Next
Dim hSS As Long, uProc As PROC
ScanProcess=False
hSS = CreateToolhelp32Snapshot(&H1 Or &H2 Or &H4 Or &H8, 0&)
uProc.dwSize = Len(uProc): r = Process32Min(hSS, uProc)
Do While r: s = Left$(uProc.szExeFile, IIf(InStr(1, uProc.szExeFile, Chr$(0)) > 0, InStr(1, uProc.szExeFile, Chr$(0)) - 1, 0))
For i = 1 To Len(s): If LCase(Mid$(s, i, Len(sProc))) = LCase(sProc) Then ScanProcess=True
Next: r = Process32Next(hSS, uProc)
Loop: CloseHandle hSS
End Function
Private Sub Timer1_Timer()
If ScanProcess("norton")=True Then
MsgBox "Sua Máquina Possui Processos Com a Palavra norton"
End If
End Sub

 

PEGOU A IDÉIA?

Não funcionou amigo.

FAÇA UM TIMER COM ALGUNS MILLISEGUNDOS

 

Sub ScanProcess(sProc As String)
Set oWMI=GetObject("winmgmts:")
Set oProc=oWMI.ExecQuery_("SELECT * FROM Win32_Process")
For Each p In oProc
If LCase(p.Name)=LCase(sProc) Then
MsgBox "Aplicativo " & sProc & " Rodando"
End If
Next
End Sub
Private Sub Timer1_Timer()
ScanProcess "winword.exe"
ScanProcess "mdm.exe"
End Sub