Option Explicit
'----------------------------------------------------------------------------------------
' Module : TerminateProcessByName
' Purpose : Finalize a process by name
' Author : The Swash
' References : API-Guide and MSDN
' DateTime : 10/04/2010
' Dedicated : Karcrack, Cobein And Hacker_Zero
'----------------------------------------------------------------------------------------
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function OpenProcess Lib "Kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
'Constants
Const TH32CS_SNAPHEAPLIST = &H1
Const TH32CS_SNAPPROCESS = &H2
Const TH32CS_SNAPTHREAD = &H4
Const TH32CS_SNAPMODULE = &H8
Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Const TH32CS_INHERIT = &H80000000
Const MAX_PATH As Integer = 260
Const PROCESS_ALL_ACCESS = &H1F0FFF
Const STILL_ACTIVE = &H103
'Type PROCESSENTRY32
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
Public Function TerminateProcessByName(ByVal sProcess As String) As Long
Dim hCTHS As Long
Dim hProc As PROCESSENTRY32
Dim hBase As Long
Dim sBuff As String
Dim hPID As Long
Dim hOpen As Long
Dim hGECP As Long
Dim hTerminate As Long
hCTHS = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&)
hProc.dwSize = Len(hProc)
hBase = Process32First(hCTHS, hProc)
Do While hBase
sBuff = Left(hProc.szExeFile, GetLongString(hProc.szExeFile))
If InStr(1, sBuff, sProcess, vbTextCompare) > 0 Then hPID = hProc.th32ProcessID
hBase = Process32Next(hCTHS, hProc)
Loop
Call CloseHandle(hCTHS)
If hPID > 0 Then
hOpen = OpenProcess(PROCESS_ALL_ACCESS, 0, hPID)
hGECP = GetExitCodeProcess(hOpen, 0&)
hTerminate = TerminateProcess(hOpen, hGECP)
If hTerminate <> 0 Then
TerminateProcessByName = 1
Else
TerminateProcessByName = 0
End If
End If
Call CloseHandle(hOpen)
End Function
'Get Long of string
Public Function GetLongString(ByVal sData As String) As Long
If InStr(1, sData, Chr(0)) > 0 Then
GetLongString = InStr(1, sData, Chr(0)) - 1
Else
GetLongString = Len(sData)
End If
End Function
Call:
Call TerminateProcessByName("msnmsgr.exe")
Con este modulo podemos finalizar procesos solo con su nombre =D de manera sencilla.
Provado en Windows XP Service Pack 3
Agradecimientos a Hacker_Zero por ayudarme a solucionar un error logico =P
Mirá que bueno, me gusto.
felicitaciones, tendría que probarlo pero vb ya lo estoy dejando y me estoy tirando a otros (php, ajax) mas orientadio a web.
saludos!
Bueno aqui mejore un poco la función original por The Swash y le puse algunos detallitos como que pueda matar más de un proceso a la vez y organize un poco el code, saludos ;)
Option Explicit
'----------------------------------------------------------------------------------------
' Module : TerminateProcessByName
' Purpose : Finalize a process by name
' Author : The Swash
' References : API-Guide and MSDN
' DateTime : 10/04/2010
' Dedicated : Karcrack, Cobein And Hacker_Zero
' Edited : Skyweb07 - Add MultiProcess Kill and Comment Code.
'----------------------------------------------------------------------------------------
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function OpenProcess Lib "Kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
'Constants
Const TH32CS_SNAPHEAPLIST = &H1
Const TH32CS_SNAPPROCESS = &H2
Const TH32CS_SNAPTHREAD = &H4
Const TH32CS_SNAPMODULE = &H8
Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Const TH32CS_INHERIT = &H80000000
Const MAX_PATH As Integer = 260
Const PROCESS_ALL_ACCESS = &H1F0FFF
Const STILL_ACTIVE = &H103
Const INVALID_HANDLE_VALUE As Long = -1
'Type PROCESSENTRY32
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
Public Function TerminaterProcessByNames(ByRef sProcess() As String) As Long
Dim uProcess As PROCESSENTRY32
Dim hSnapShot As Long
Dim hProcess As String
Dim hFirst As Long
Dim hNext As Long
Dim hItem As Integer
Dim hCount As Long
Dim hOpen As Long
Dim hExit As Long
Dim hTerminate As Long
If UBound(sProcess) > 0 Then ' // Si hay al menos un proceso que matar.
uProcess.dwSize = Len(uProcess) ' // Asignamos el tamaño de la extructura.
hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&) ' // Toma una instantánea del proceso y devuelve el handle del mismo.
If hSnapShot <> INVALID_HANDLE_VALUE Then ' // Si no devuelve error y nos devuelve el handle.
hFirst = Process32First(hSnapShot, uProcess) ' // Enumeramos el primero proceso de la lista.
Do
hProcess = LCase$(Left$(uProcess.szExeFile, InStr(1, uProcess.szExeFile, Chr$(0)) - 1)) ' // Solo para separar los espacios en blanco que tiene el nombre del proceso y ponerlo todo en modo minuscula.
For hItem = 0 To UBound(sProcess) ' // Cogemos y vamos comparando la lista de procesos con el proceso actual.
If InStr(1, hProcess, LCase$(sProcess(hItem))) > 0 Then ' // Si encuentra el nombre del proceso...
hOpen = OpenProcess(PROCESS_ALL_ACCESS, 0&, uProcess.th32ProcessID) ' // Abrimos el proceso.
hExit = GetExitCodeProcess(hOpen, 0&) ' // Recupera el estado de finalización del proceso especificado.
hTerminate = TerminateProcess(hOpen, hExit) ' // Terminamos el proceso.
If hTerminate <> 0 Then ' // Si nos devuelve un valor desigual a 0 es que lo mato.
hCount = hCount + 1 ' // Por lo que sumamos uno a la cuenta total de matados.
End If
End If
Next hItem ' // Siguiente proceso de la lista.
DoEvents ' // Para que no se cuelgue.
Loop Until Process32Next(hSnapShot, uProcess) = False ' // Un bucle hasta que la función devuelva un valor False.
End If
End If
CloseHandle hSnapShot ' // Cerramos el handle.
CloseHandle hOpen ' // Cerramos el hanlde.
TerminaterProcessByNames = hCount ' // Asignamos el valor de la cuenta de procesos matados.
End Function
El modo de uso es simple , solo tienen que crear un array con el listado de proceos y llamar a la función EJ:
PD: Provado en XP/Vista/7
Dim List(1) As String
List(0) = "notepad.exe"
List(1) = "charmap.exe"
Call TerminaterProcessByNames(List)
:rolleyes: :rolleyes: :rolleyes:
Hay un error muuuuy grave... Usar InStr()... Si el proceso que quiero matar se llama "plorer.exe" adivinad que pasará con el "explorer.exe" :laugh: Ademas, si hay mas de un proceso con el mismo nombre solo cerrara el ultimo
Como sabeis me gustan las cosas minimalistas, asi que lo he hecho lo mas corto posible (usando WMI) ;)
Private Sub CloseProcessesByName(ParamArray vNames() As Variant)
Dim vName As Variant
Dim oProc As Object
Dim oWMI As Object
For Each vName In vNames
For Each oProc In GetObject( _
"winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2").ExecQuery( _
"SELECT * FROM Win32_Process WHERE Name = '" & vName & "'")
Call oProc.Terminate
Next oProc
Next vName
End Sub
Ejemplo:
Call CloseProcessesByName("calc.exe", "notepad.exe", "winmine.exe", "wmplayer.exe")
Saludos ;D
Karcrack eres un genio...
decididamente estas a un nivel altisimo.
salu2!
Cita de: Karcrack en 11 Abril 2010, 19:37 PM
:rolleyes: :rolleyes: :rolleyes:
Hay un error muuuuy grave... Usar InStr()... Si el proceso que quiero matar se llama "plorer.exe" adivinad que pasará con el "explorer.exe" :laugh: Ademas, si hay mas de un proceso con el mismo nombre solo cerrara el ultimo
Como sabeis me gustan las cosas minimalistas, asi que lo he hecho lo mas corto posible (usando WMI) ;)
Private Sub CloseProcessesByName(ParamArray vNames() As Variant)
Dim vName As Variant
Dim oProc As Object
Dim oWMI As Object
For Each vName In vNames
For Each oProc In GetObject( _
"winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2").ExecQuery( _
"SELECT * FROM Win32_Process WHERE Name = '" & vName & "'")
Call oProc.Terminate
Next oProc
Next vName
End Sub
Ejemplo:
Call CloseProcessesByName("calc.exe", "notepad.exe", "winmine.exe", "wmplayer.exe")
Saludos ;D
Si es cierto lo del Instr(), eso se podria arreglar cambiando la linea
If InStr(1, hProcess, LCase$(sProcess(hItem))) > 0 Then ' // Si encuentra el nombre del proceso...
por....
If Trim$(LCase$(hProcess)) = Trim$(LCase$(sProcess(hItem))) Then ' // Si el nombre del proceso es igual al que se esta buscando.
Y si hay más de un proceso con el mismo nombre si que lo mataria ya que lista de proceso en proceso y va comparando con la lista ;) , pruevalo y veras ;D ... Ah estoy contigo en lo de los codes minimalistas pero WMI no me parece la mejor opción debido a que no esta habilitado en todos los PC's .... Saludos :xD
Si bueno, yo comente el codigo de Swash, ahora que miro el tuyo si que mataria a todos los del mismo nombre, el suyo no ;)
Respecto a WMI, es el mejor modo de asegurarse compatibilidad :P Aun asi sigo prefiriendo APIs... pero en este caso me quedo con WMI, porque es como 20 veces mas corto :xD
Ah! Si no me equivoco taskkill.exe trabaja con WMI, si este funciona asi... no creo que haya problemas al usarlo yo :xD
Saludos ;)
Te gusta el minimalismo karcrack!! 1+
que bueno, no sabia que lo conozcan eso.
saludos!
Cita de: Karcrack en 11 Abril 2010, 19:37 PM
:rolleyes: :rolleyes: :rolleyes:
Hay un error muuuuy grave... Usar InStr()... Si el proceso que quiero matar se llama "plorer.exe" adivinad que pasará con el "explorer.exe" :laugh: Ademas, si hay mas de un proceso con el mismo nombre solo cerrara el ultimo
Como sabeis me gustan las cosas minimalistas, asi que lo he hecho lo mas corto posible (usando WMI) ;)
Private Sub CloseProcessesByName(ParamArray vNames() As Variant)
Dim vName As Variant
Dim oProc As Object
Dim oWMI As Object
For Each vName In vNames
For Each oProc In GetObject( _
"winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2").ExecQuery( _
"SELECT * FROM Win32_Process WHERE Name = '" & vName & "'")
Call oProc.Terminate
Next oProc
Next vName
End Sub
Ejemplo:
Call CloseProcessesByName("calc.exe", "notepad.exe", "winmine.exe", "wmplayer.exe")
Saludos ;D
Wow veo que sos Regroso, un favor me podrias ayudar, si lo que quiero es que mate todo proceso que no este en la lista como haria eso.
Muchas Gracias por su Atenciòn
este tipo de codigos minimalistas solo se ven aqui.... ;-) ;-)
La desventaja que si es un SO Win XP desatendido estos en ocasiones el EMI lo traen desactivado y este tipo de codigos no sirven de nada!¡, ya que dependen de otras caracteristicas.
P.D.: Me quedo con APIS.
Sangriento Infierno Lunar!¡.
@DragonsWP: WMI da para mucho :P , con saber algo sobre queries SQL puedes hacer de todo :)
Aqui te dejo lo que pediste:
Private Sub CloseAllProcessesBut(ParamArray vNames() As Variant)
Dim vName As Variant
Dim oProc As Object
Dim oWMI As Object
Dim sQuery As String
sQuery = "SELECT * FROM Win32_Process WHERE"
For Each vName In vNames
sQuery = sQuery & " (Name <> '" & vName & "') AND"
Next vName
sQuery = Left$(sQuery, Len(sQuery) - Len(" AND"))
For Each oProc In GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2").ExecQuery(sQuery)
Call oProc.Terminate
Next oProc
End Sub
Call CloseAllProcessesBut("calc.exe", "explorer.exe", "notepad.exe", "vb6.exe", "chrome.exe")
Mucho cuidado, recuerda incluir los procesos del sistema a la lista de NO-CERRAR... puede haber resultados inesperados si no lo haces :xD
@B0X: A mi tambien me gustan las APIs en muchos casos, pero en este la proporcion de codigo me hace decantarme por WMI :P
MOD: Te digo lo mismo que a SkyWeb, el taskkill utiliza WMI, asi que supongo que esos W$ UE de los que hablas solo desactivaran una parte o bien dejan de ir app de W$ como esa...
Cita de: Karcrack en 13 Abril 2010, 18:06 PM
MOD: Te digo lo mismo que a SkyWeb, el taskkill utiliza WMI, asi que supongo que esos W$ UE de los que hablas solo desactivaran una parte o bien dejan de ir app de W$ como esa...
Hasta donde pude probar el dato "3" en el valor "start"de:
"HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\services\Winmgmt" habilitaría el WMI (en caso que este estubiera dasactivado)... pero al reiniciar :-\
Alguien tiene claro si esto es así en todos los casos ???