Acceso a los Procesos del Sistema

En este articulo te muestro como es posible leer los procesos del sistema, y si esto te sabe a poco he diseñado un metodo para que cuando se encuentre un proceso nuevo se genere un evento y si este se cierra se genere otro evento de cierre. Para ello debemos añadir un control ListView al control Active-X llamado 'Listado' y a parte tendremos que añadir un control Timer llamado 'Tiempo' que se encargara de ir actualizando el listado según se encuentren mas o menos procesos que los mostrados en la lista. A parte yo le he añadido dos controles Label y un control Image para, en el control image mostrar una imagen descriptiva del control y en los Labels mostrar informacion de que es lo que va haciendo el control.

A continuación te muestro como se hace esto mismo:

 

   Option Explicit
' ***************************************************************
' Active-X Dedicado a controlar los procesos del sistema
'
' Escrito por Pol Florez Viciana        05-05-2005 - 23-06-2005
' ***************************************************************

' Constantes de Utilizacion propia
Private Const Cero = 0
Private Const Uno = 1
Private Const Dos = 2
Private Const Tres = 3
Private Const Cuatro = 4
Private Const Cinco = 5
Private Const Seis = 6
Private Const Siete = 7
Private Const Ocho = 8
Private Const Nueve = 9
Private Const Diez = 10
Private Const Once = 11
Private Const Doce = 12
Private Const Trece = 13
Private Const Catorce = 14
Private Const Quince = 15
Private Const Dieziseis = 16
Private Const Diezisiete = 17
Private Const Dieziocho = 18
Private Const Diezinueve = 19
Private Const Veinte = 20
Private Const Veintiuno = 21
Private Const Veintidos = 22
Private Const Veintitres = 23
Private Const Veinticuatro = 24
Private Const Veinticinco = 25
Private Const Veintiseis = 26
Private Const Veintisiete = 27
Private Const Veintiocho = 28
Private Const Veintinueve = 29
Private Const Treinta = 30
Private Const Treintaiuno = 31
Private Const Treintaidos = 32

Private Const Nada As String = ""
Private Const Barra As String * Uno = "/"
Private Const Contrabarra As String * Uno = "\"
Private Const Punto As String * Uno = "."
Private Const DosPuntos As String * Uno = ":"
Private Const Asterisco As String * Uno = "*"

' Declaracion tipos definidos por mi    ( Como no )
Public Type ProcessItem
    PID As Integer
    PHandle As Long
    PName As String
    PPath As String
    PCommandLine As String
    PRealSize As Long
    PVirtualSize As Long
    PCreationDate As String ' Date Execution
    PCreationTime As String ' Time Execution
    PNameUser As String
    PNameDomain As String
End Type

Public Type ProcessList
    PItem() As ProcessItem
    PCount As Integer
End Type

' Declaracion de Eventos para el control
Public Event ListChanged()
Public Event Initialized()
Public Event ProcessClick(ProcessItemClicked As ProcessItem)
Public Event ProcessDblClick(ProcessItemClicked As ProcessItem)
Public Event AgregatedItem(AgreItem As ProcessItem)
Public Event DeletedItem(DeleteItem As ProcessItem)
Public Event MouseUp(KeyButton As Integer, KeyShift As Integer, XPos As Single, YPos As Single)
Public Event MouseMove(KeyButton As Integer, KeyShift As Integer, XPos As Single, YPos As Single)
Public Event MouseDown(KeyButton As Integer, KeyShift As Integer, XPos As Single, YPos As Single)
Public Event KeyboardPress(KeyCode As Integer)

' Declaracion de Propiedades del control

Public Property Let Selected(ByVal ItemIndex As Integer)
On Error Resume Next
' Con esta podemos seleccionar un 'Item' del listado mediante
' codigo
Listado.ListItems.Item(ItemIndex).Selected = True

End Property

Public Property Get Selected() As Integer
On Error Resume Next
' Y con esta ver cual esta seleccionado, hay que decir
' que si esta devuelve cero es que no hay ningun Item seleccionado
Static Man As Integer   ' Con Static son mas rapidas

Selected = Cero
For Man = Uno To Listado.ListItems.Count
    If Listado.ListItems.Item(Man).Selected = True Then _
        Selected = Man: Exit For
Next

End Property

' Declaracion de Funciones
Public Function GetProcessList() As ProcessList
On Error Resume Next
' Esta nos devolvera toda una Lista de Procesos activos

Static Process, objWMIService, colProcesses
Static Man As Integer, T As String, R As Integer

' Accedemos a los Objetos necesarios ( Servicio WMI )
'         WMI = WINDOWS MANAGEMENT INSTRUMENTATION
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & Punto & "\root\cimv2")
' Y dentro del Objeto WMI accedemos a la columna de procesos
Set colProcesses = objWMIService.ExecQuery("select * from win32_process")

' Añadimos los procesos que hay actualmente a ListCount
GetProcessList.PCount = colProcesses.Count
' Y redimensionamos el Array de Tipos de Proceso
ReDim GetProcessList.PItem(Uno To GetProcessList.PCount)

' La Var 'Man' nos servira para ir contando los procesos
Man = Cero
For Each Process In colProcesses
  Man = Man + Uno
  T = Nada
 With GetProcessList
  .PItem(Man).PID = Process.ProcessId
  .PItem(Man).PHandle = CLng(Process.ProcessId)
  .PItem(Man).PName = Process.Name
  .PItem(Man).PPath = Process.ExecutablePath
  .PItem(Man).PRealSize = FileLen(.PItem(Man).PPath)
  T = Process.CreationDate
  .PItem(Man).PCreationDate = ObtainDateOrTime(True, T)
  .PItem(Man).PCreationTime = ObtainDateOrTime(False, T)
  .PItem(Man).PCommandLine = Process.CommandLine
  .PItem(Man).PVirtualSize = Process.VirtualSize
  R = Process.GetOwner(.PItem(Man).PNameUser, .PItem(Man).PNameDomain)
 End With
Next

' Y Descargamos los objetos
Set objWMIService = Nothing
Set colProcesses = Nothing
Set Process = Nothing

End Function

Public Function GetProcessItem(ByVal PrcId As Integer) As ProcessItem
On Error Resume Next
' Esta nos servira para acceder a un solo proceso activo
' partiendo de su PID ( Process Identifier )

Static Process, objWMIService, colProcesses
Static T As String

' Accedemos a los Objetos necesarios ( Servicio WMI )
'         WMI = WINDOWS MANAGEMENT INSTRUMENTATION
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & Punto & "\root\cimv2")
' Y dentro del Objeto WMI accedemos a la columna de procesos
Set colProcesses = objWMIService.ExecQuery("select * from win32_process")

' Y empezamos a leer uno a uno para ver cual tiene el PID
' solicitado
For Each Process In colProcesses
  If PrcId = Process.ProcessId Then
    With GetProcessItem
     T = Nada
     .PID = Process.ProcessId
     .PHandle = CLng(Process.ProcessId)
     .PName = Process.Name
     .PPath = Process.ExecutablePath
     .PRealSize = FileLen(.PPath)
     T = Process.CreationDate
     .PCreationDate = ObtainDateOrTime(True, T)
     .PCreationTime = ObtainDateOrTime(False, T)
     .PCommandLine = Process.CommandLine
     .PVirtualSize = Process.VirtualSize
    End With
   Exit For
  End If
Next

' Y Descargamos los objetos
Set objWMIService = Nothing
Set colProcesses = Nothing
Set Process = Nothing

End Function

Public Function GetProcessCount() As Integer
On Error Resume Next

' Aqui solo declaramos el objeto WMI con las Columnas de Procesos
Static objWMIService, colProcesses

' Accedemos a los Objetos necesarios ( Servicio WMI )
'         WMI = WINDOWS MANAGEMENT INSTRUMENTATION
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & Punto & "\root\cimv2")
' Y dentro del Objeto WMI accedemos a la columna de procesos
Set colProcesses = objWMIService.ExecQuery("select * from win32_process")

GetProcessCount = Cero

    GetProcessCount = colProcesses.Count

' Y los descargamos
Set objWMIService = Nothing
Set colProcesses = Nothing

End Function

Public Function ListAllItems() As ProcessList
On Error Resume Next
' Esta nos devolvera toda la lista visible de procesos ( La del
' listado )
Static Man As Integer

With ListAllItems
ReDim .PItem(Uno To Listado.ListItems.Count)
.PCount = Listado.ListItems.Count

For Man = Uno To .PCount
 .PItem(Man).PID = CInt(Listado.ListItems.Item(Man).Text)
 .PItem(Man).PHandle = CLng(Listado.ListItems.Item(Man).SubItems(Uno))
 .PItem(Man).PName = Listado.ListItems.Item(Man).SubItems(Dos)
 .PItem(Man).PPath = Listado.ListItems.Item(Man).SubItems(Tres)
 .PItem(Man).PCommandLine = Listado.ListItems.Item(Man).SubItems(Cuatro)
 .PItem(Man).PRealSize = CLng(Listado.ListItems.Item(Man).SubItems(Cinco))
 .PItem(Man).PVirtualSize = CLng(Listado.ListItems.Item(Man).SubItems(Seis))
 .PItem(Man).PCreationDate = Listado.ListItems.Item(Man).SubItems(Siete)
 .PItem(Man).PCreationTime = Listado.ListItems.Item(Man).SubItems(Ocho)
Next
End With

End Function

Public Function List(ByVal LIndex As Integer, _
            Optional ByVal LSubIndex As Integer) As String
On Error Resume Next
' Esta nos devolvera un solo Registro dado del listado
If LSubIndex < Uno Then
  List = Listado.ListItems.Item(LIndex).Text
Else
  List = Listado.ListItems.Item(LIndex).SubItems(LSubIndex)
End If

End Function

Public Function ListItem(ByVal LIndex As Integer) As ProcessItem
On Error Resume Next
' Esta nos devolvera toda la fila de un proceso del listado
With ListItem
.PID = CInt(Listado.ListItems.Item(LIndex).Text)
.PHandle = CLng(Listado.ListItems.Item(LIndex).SubItems(Uno))
.PName = Listado.ListItems.Item(LIndex).SubItems(Dos)
.PPath = Listado.ListItems.Item(LIndex).SubItems(Tres)
.PCommandLine = Listado.ListItems.Item(LIndex).SubItems(Cuatro)
.PRealSize = CLng(Listado.ListItems.Item(LIndex).SubItems(Cinco))
.PVirtualSize = CLng(Listado.ListItems.Item(LIndex).SubItems(Seis))
.PCreationDate = Listado.ListItems.Item(LIndex).SubItems(Siete)
.PCreationTime = Listado.ListItems.Item(LIndex).SubItems(Ocho)
.PNameUser = Listado.ListItems.Item(LIndex).SubItems(Nueve)
.PNameDomain = Listado.ListItems.Item(LIndex).SubItems(Diez)
End With

End Function

Public Function ListCount() As Integer
On Error Resume Next
' Sin comentarios...
ListCount = Listado.ListItems.Count

End Function

Public Function KillProcess(ByVal PrcId As Integer)
On Error Resume Next
' Esta se encargara de cerrar el proceso seleccionado
' aunque me he fijado que si el proceso lo inicio un usuario
' distinto al nuestro ( por ejemplo SYSTEM ) este no se cierra
' correctamente y no se resolverlo pero bueno este es el metodo

Static Process, objWMIService, colProcesses

' Accedemos a los Objetos necesarios ( para variar )
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & Punto & "\root\cimv2")
' Y dentro del Objeto WMI accedemos a la columna de procesos
Set colProcesses = objWMIService.ExecQuery("select * from win32_process")
    
For Each Process In colProcesses
 ' Buscamos su PID y a continuacion le mandamos que se cierre
 ' ( o lo mandamos a la mie... )
 If PrcId = Process.ProcessId Then
 Process.Terminate PrcId: Exit For
 End If
Next

' Y Descargamos los objetos
Set objWMIService = Nothing
Set colProcesses = Nothing
Set Process = Nothing

End Function

Public Function RefreshList()
  CreateNewList
End Function

Public Function ProcessIdIsRun(ByVal ProcIdToSearch As Integer) As Boolean
On Error Resume Next
' Esta comprueba si un cierto PID esta ejecutandose
Static Process, objWMIService, colProcesses

Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & Punto & "\root\cimv2")
Set colProcesses = objWMIService.ExecQuery("select * from win32_process")

For Each Process In colProcesses
   If ProcIdToSearch = Process.ProcessId Then ProcessIdIsRun = True: Exit For
Next

' Y Descargamos los objetos
Set objWMIService = Nothing
Set colProcesses = Nothing
Set Process = Nothing

End Function

Public Function ProcessIdExist(ByVal ProcIdToSearch As Integer) As Boolean
On Error Resume Next
' Esta comprueba si un cierto PID esta en el Listado.List

Static Man As Integer, H As Integer

For Man = Uno To Listado.ListItems.Count
    H = CInt(Listado.ListItems.Item(Man).Text)
   If ProcIdToSearch = H Then ProcessIdExist = True: Exit For
Next

End Function

Public Function ProcessIdExistInThisList _
            (ListOfSearchPID As ProcessList, _
              PIDToSearch As Integer) As Boolean
On Error Resume Next
' Esta comprueba si existe un PID dentro de un Listado ya dado
Static Man As Integer

For Man = Uno To ListOfSearchPID.PCount
   If PIDToSearch = ListOfSearchPID.PItem(Man).PID Then
     ProcessIdExistInThisList = True: Exit For
   End If
Next

End Function

Private Function ObtainDateOrTime _
            (ByVal DateTrueTimeFalse As Boolean, _
             ByVal OriginalDateCreation As String) As String
On Error Resume Next
' Esta es de fabricacion propia y sirve para traducir
' la fecha y hora de ejecucion a formato legible
Dim YE As String, MO As String, DA As String
Dim HO As String, MI As String, Re As String, H As Long

YE = Left(OriginalDateCreation, Cuatro) ' Año
H = Len(OriginalDateCreation) - Cuatro
Re = Right(OriginalDateCreation, H)
MO = Left(Re, Dos)                      ' Mes
H = Len(OriginalDateCreation) - Seis
Re = Right(OriginalDateCreation, H)
DA = Left(Re, Dos)                      ' Dia
H = Len(OriginalDateCreation) - Ocho
Re = Right(OriginalDateCreation, H)
HO = Left(Re, Dos)                      ' Hora
H = Len(OriginalDateCreation) - Diez
Re = Right(OriginalDateCreation, H)
MI = Left(Re, Dos)                      ' Minutos

If DateTrueTimeFalse = True Then
   ObtainDateOrTime = DA & Barra & MO & Barra & YE
Else
   ObtainDateOrTime = HO & DosPuntos & MI
End If

End Function

Private Function CreateNewList()
On Error Resume Next

' Esta creara un nuevo listado cada vez que lo necesitemos

Static Process, objWMIService, colProcesses
Static T As String, I As Integer, N As String, D As String, R As Integer

' Accedemos a los Objetos necesarios
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & Punto & "\root\cimv2")
' Y dentro del Objeto WMI accedemos a la columna de procesos
Set colProcesses = objWMIService.ExecQuery("select * from win32_process")

Listado.ListItems.Clear
For Each Process In colProcesses
    T = Process.ProcessId
    Listado.ListItems.Add , , T
    I = Listado.ListItems.Count
   T = Process.Handle
   Listado.ListItems.Item(I).SubItems(Uno) = T
   T = Process.Name
   Listado.ListItems.Item(I).SubItems(Dos) = T
   T = Nada
   T = Process.ExecutablePath
   Listado.ListItems.Item(I).SubItems(Tres) = T
   Listado.ListItems.Item(I).SubItems(Cinco) = FileLen(T)
   T = Nada
   T = Process.CommandLine
   Listado.ListItems.Item(I).SubItems(Cuatro) = T
   T = Process.VirtualSize
   Listado.ListItems.Item(I).SubItems(Seis) = T
   T = Process.CreationDate
   If Process.ProcessId > Cinco Then
        T = ObtainDateOrTime(True, T)
   End If
   Listado.ListItems.Item(I).SubItems(Siete) = T
   T = Process.CreationDate
   If Process.ProcessId > Cinco Then
        T = ObtainDateOrTime(False, T)
   End If
   Listado.ListItems.Item(I).SubItems(Ocho) = T
   N = Nada: D = Nada
   R = Process.GetOwner(N, D)
   Listado.ListItems.Item(I).SubItems(Nueve) = N
   Listado.ListItems.Item(I).SubItems(Diez) = D
Next

NumProc.Caption = Listado.ListItems.Count
Estado.Caption = "El listado a Cambiado"
DoEvents

' Y Descargamos los objetos
Set objWMIService = Nothing
Set colProcesses = Nothing
Set Process = Nothing

RaiseEvent ListChanged

End Function

Private Sub Listado_Click()
On Error Resume Next
If Me.Selected = Cero Then Exit Sub

Dim S As Integer, ItemProcess As ProcessItem

S = Me.Selected

ItemProcess = ListItem(S)

RaiseEvent ProcessClick(ItemProcess)

End Sub

Private Sub Listado_DblClick()
On Error Resume Next
If Me.Selected = Cero Then Exit Sub

Dim S As Integer, ItemProcess As ProcessItem

S = Me.Selected

ItemProcess = ListItem(S)

RaiseEvent ProcessDblClick(ItemProcess)

End Sub

Private Sub Listado_ItemClick(ByVal Item As MSComctlLib.ListItem)
    Listado_Click
End Sub

Private Sub Listado_KeyPress(KeyAscii As Integer)
  RaiseEvent KeyboardPress(KeyAscii)
End Sub

Private Sub Listado_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error Resume Next
  RaiseEvent MouseDown(Button, Shift, x, y)
End Sub

Private Sub Listado_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error Resume Next
  RaiseEvent MouseMove(Button, Shift, x, y)
End Sub

Private Sub Listado_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error Resume Next
  RaiseEvent MouseUp(Button, Shift, x, y)
End Sub

Private Sub Tiempo_Timer()
On Error Resume Next
' Con esto iremos comprobando si han aparecido Nuevos Procesos
' o si por el contrario se termino algun proceso

' ListCount And ListActivesProcess
Dim LC As Integer, LA As Integer

LC = Me.ListCount
LA = Me.GetProcessCount

If LC = LA Then
  ' No Changes, Exit Sub
 Exit Sub
End If

' Caso Excepcional ListCount = 0 Initial Event
If LC = Cero Then _
    CreateNewList: _
    Estado.Caption = "Inicializacion del Control": _
    RaiseEvent Initialized: _
    Exit Sub

Dim TempList As ProcessList
Static Man As Integer

TempList = Me.ListAllItems
CreateNewList
DoEvents

If LC < LA Then
  ' ListCount Is Minor ListActiveProcesses
  For Man = Uno To Listado.ListItems.Count
   If Me.ProcessIdExistInThisList(TempList, CInt(Listado.ListItems.Item(Man).Text)) = False Then
     RaiseEvent AgregatedItem(Me.ListItem(Man))
     Estado.Caption = "Se ha iniciado un nuevo proceso"
   End If
  Next
 Exit Sub
End If

If LC > LA Then
  ' ListActiveProcesses Is Minor ListCount
  For Man = Uno To TempList.PCount
    If Me.ProcessIdExist(TempList.PItem(Man).PID) = False Then
      RaiseEvent DeletedItem(TempList.PItem(Man))
      Estado.Caption = "Se ha cerrado un proceso"
    End If
  Next
 Exit Sub
End If

End Sub

Private Sub UserControl_Resize()
On Error Resume Next
' Sin comentarios...

With UserControl
    Listado.Left = .ScaleLeft
    Listado.Top = .ScaleTop
    Listado.Width = .ScaleWidth
    Listado.Height = .ScaleHeight - Imagen.Height
    NumProc.Left = .ScaleLeft
    NumProc.Top = .ScaleHeight - Imagen.Height
    .Refresh
    DoEvents
    Imagen.Left = NumProc.Left + NumProc.Width
    Imagen.Top = .ScaleHeight - Imagen.Height
    .Refresh
    DoEvents
    Estado.Left = Imagen.Left + Imagen.Width
    Estado.Top = .ScaleHeight - Imagen.Height
    Estado.Width = .ScaleWidth - Imagen.Width - NumProc.Width
End With

End Sub

Espero que esto le sirva de ayuda a mas de uno.

Fichero con el código de ejemplo: polflo_ProcessCtrl.zip - 37,5 KB