Listar procesos, threads, módulos y ventanas.

[Slasher-K]

Bueno lo siguiente es un código que escribi hace mucho y que lista todos los procesos del sistema, cos sus threads, módulos atados y las ventanas de cada thread. Se puede utilizar para hacer un árbol de recursos o algo similar.

También tiene un sistema que loguea los procesos creando una tabla en memoria con los datos de todos los procesos y luego se puede guardar en un archivo.

El código es algo complejo pero no tengo ganas de ponerle los comentarios xDDD. Con sólo llamar a EnumProcesses la variable global SysProcess va a tener almacenados todos los procesos y sus datos.

Código [Seleccionar] Expandir


'*****************************************************************
'
'Autor: Slasher Keeper
'Descripción:
'   * Lista procesos del sistema y sus recursos.
'   * Loguea los procesos.
'*****************************************************************
'
Option Explicit
Option Base 1

Public Const MAX_PATH = 260

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)

Type WindowInfo
  ProcessId       As Long
  ThreadID        As Long
  NumThdWindows   As Long
  ThreadWindows() As Long
  hwndParent      As Long
  hwnd            As Long
  hModule         As Long
  hIcon           As Long
  Identifier      As Long
  WindowProc      As Long
  hInstance       As Long
  Style           As Long
  UserData        As Long
  ChildWindows()  As Long
  NumOfChild      As Integer
  Index           As Integer
  ClassName       As String
  Text            As String * MAX_PATH
  ModuleName      As String * MAX_PATH
End Type

Type ThreadInfo
  ThreadID      As Long
  BasePriority  As Long
  UsageCount    As Long
  AttachCount   As Long
End Type

Type ModuleInfo
  BaseAddress   As Long
  hModule       As Long
  ModuleSize    As Long
  ProcessId     As Long
  ModuleId      As Long
  GlobalUsage   As Long
  ProcessUsage  As Long
  Filename      As String * MAX_PATH
  ModuleName    As String * MAX_PATH
End Type

Type ProcessInfo
  hProcess          As Long
  ProcessId         As Long
  ParentProcessID   As Long
  PriorityClass     As Long
  MinWorkingSetSize As Long
  MaxWorkingSetSize As Long
  ExitCode          As Long
  AffinityMask      As Long
  SysAffinityMask   As Long
  HandleCount       As Long
  NumOfThreads      As Long
  NumOfModules      As Long
  CurrentMemPage    As Long
  Threads()         As ThreadInfo
  Modules()         As ModuleInfo
  ExeFilename       As String * MAX_PATH
  Index             As Integer
End Type

Type FileVersionInfo
    CompanyName      As String
    FileDescription  As String
    FileVersion      As String
    InternalName     As String
    LegalCopyright   As String
    OriginalFileName As String
    ProductName      As String
    ProductVersion   As String
    Comments         As String
    FileOS           As String
End Type

Type HEAPENTRY32
    dwSize        As Long
    hHandle       As Long
    dwAddress     As Long
    dwBlockSize   As Long
    dwFlags       As Long
    dwLockCount   As Long
    dwResvd       As Long
    th32ProcessID As Long
    th32HeapID    As Long
End Type

Type Var
    wLength         As Integer
    wValueLength    As Integer
    wType           As Integer
    szKey           As Long
    Padding         As Long
    Value()         As Long
End Type

Type MODULEENTRY32
    dwSize          As Long
    th32ModuleID    As Long
    th32ProcessID   As Long
    GlblcntUsage    As Long
    ProccntUsage    As Long
    modBaseAddr     As Long
    modBaseSize     As Long
    hModule         As Long
    szModule        As String * 256
    szExePath       As String * 256
End Type

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

Type THREADENTRY32
    dwSize As Long
    cntUsage As Long
    th32ThreadID As Long
    th32OwnerProcessID As Long
    tpBasePri As Long
    tpDeltaPri As Long
    dwFlags As Long
End Type

Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Declare Function Heap32First Lib "kernel32" (lpHE As HEAPENTRY32, ByVal th32ProcessID As Long, ByVal th32HeapID As Long) As Boolean
Declare Function Heap32ListFirst Lib "kernel32" (ByVal hSnapshot As Long, lphl As HEAPENTRY32) As Boolean
Declare Function Heap32ListNext Lib "kernel32" (ByVal hSnapshot As Long, lphl As HEAPENTRY32) As Boolean
Declare Function Heap32Next Lib "kernel32" (lpHE As HEAPENTRY32) As Boolean
Declare Function Module32First Lib "kernel32" (ByVal hSnapshot As Long, lpME As MODULEENTRY32) As Boolean
Declare Function Module32Next Lib "kernel32" (ByVal hSnapshot As Long, lpME As MODULEENTRY32) As Boolean
Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, lpPE As PROCESSENTRY32) As Boolean
Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, lpPE As PROCESSENTRY32) As Boolean
Declare Function Thread32First Lib "kernel32" (ByVal hSnapshot As Long, lpte As THREADENTRY32) As Boolean
Declare Function Thread32Next Lib "kernel32" (ByVal hSnapshot As Long, lpte As THREADENTRY32) As Boolean
Declare Function Toolhelp32ReadProcessMemory Lib "kernel32" (ByVal th32ProcessID As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal cbRead As Long, lpNumberOfBytesRead As Long) As Boolean

Declare Function GetCurrentThread Lib "kernel32" () As Long 'Devuelve una pseudo-referencia al subproceso actual.
Declare Function GetCurrentThreadId Lib "kernel32" () As Long   'Devuelve el identificador de subproceso del subproceso que llama a la función.
Declare Function GetExitCodeThread Lib "kernel32" (ByVal hThread As Long, lpExitCode As Long) As Long   'Devuelve el estado de terminación del subproceso actual.
Declare Function GetPriorityClass Lib "kernel32" (ByVal hProcess As Long) As Long   'Devuelve la clase de prioridad para el proceso especificado.
Declare Function GetProcessAffinityMask Lib "kernel32" (ByVal hProcess As Long, lpProcessAffinityMask As Long, SystemAffinityMask As Long) As Long  'Devuelve la máscara de afinidad (valor que indica sobre qué procesador se puede ejecutar) para el proceso especificado.
Declare Function GetProcessShutdownParameters Lib "kernel32" (lpdwLevel As Long, lpdwFlags As Long) As Long 'Devuelve los parámetros de cierre para el proceso que llama a la función.
Declare Function GetProcessWorkingSetSize Lib "kernel32" (ByVal hProcess As Long, lpMinimumWorkingSetSize As Long, lpMaximumWorkingSetSize As Long) As Long 'Obtiene el mínimo y el máximo del tamaño del espacio de trabajo (working set) de un proceso especificado.
Declare Function GetThreadPriority Lib "kernel32" (ByVal hThread As Long) As Long   'Devuelve el nivel de prioridad para el subproceso especificado.
Declare Function SetPriorityClass Lib "kernel32" (ByVal hProcess As Long, ByVal dwPriorityClass As Long) As Long    'Establece la clase de prioridad para el proceso especificado.

Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, lpBuffer As Any, ByVal nSize As Long, Optional lpNumberOfBytesWritten As Long) As Long
Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, lpBuffer As Any, ByVal nSize As Long, Optional lpNumberOfBytesWritten As Long) As Long

Declare Function GetWindowModuleFileName Lib "user32" Alias "GetWindowModuleFileNameA" (ByVal hwnd As Long, ByVal lpszFileName As String, ByVal cchFileNameMax As Long) As Long
Declare Function EnumThreadWindows Lib "user32" (ByVal dwThreadId As Long, ByVal lpfn As Long, lParam As WindowInfo) As Long
Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long

Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long


Public SysProcess()   As ProcessInfo
Public SysModule()    As ModuleInfo
Public Windows()      As WindowInfo

Public lSysProcCnt  As Long
Public lSysModCnt  As Long
Public lWinCnt      As Long

Private CancelProcessLog  As Boolean
Private bIsLogging        As Boolean
Private bProcLogStarted   As Boolean

Private hProcTable        As Long

Property Get ActiveProcessId() As Long
            Dim r&
  r = GetWindowThreadProcessId(GetForegroundWindow, ActiveProcessId)
End Property

Property Get ActiveProcess() As ProcessInfo
  ActiveProcess = GetProcessInfoById(ActiveProcessId)
End Property

Property Get ActiveThreadId() As Long
  ActiveThreadId = GetWindowThreadProcessId(GetForegroundWindow, 0)
End Property

Property Get IsProcessLogEnabled() As Boolean
  IsProcessLogEnabled = bIsLogging
End Property

Sub EnumProcesses(Optional OpenHandles As Boolean = False)
     
      Dim hSnap&
      Dim pe32 As PROCESSENTRY32

  Erase SysProcess
  lSysProcCnt = 0
 
  'Crea el objeto Snapshot.
  hSnap& = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&)
 
  pe32.dwSize = LenB(pe32)
 
  'Obtiene el primer proceso.
  If Process32First(hSnap, pe32) Then
    lSysProcCnt = 1
    ReDim SysProcess(lSysProcCnt) As ProcessInfo
   
    SysProcess(lSysProcCnt) = GetProcessInfo(pe32, OpenHandles)
    SysProcess(lSysProcCnt).Index = lSysProcCnt
   
    Do While Process32Next(hSnap, pe32)
      lSysProcCnt = lSysProcCnt + 1
      ReDim Preserve SysProcess(lSysProcCnt) As ProcessInfo
     
      SysProcess(lSysProcCnt) = GetProcessInfo(pe32, OpenHandles)
      SysProcess(lSysProcCnt).Index = lSysProcCnt
    Loop
  End If
 
  Call CloseHandle(hSnap)
 
End Sub

Function GetWindowInfo(ByVal hwnd As Long, Optional EnumThdWins As Boolean = True) As WindowInfo
  On Error Resume Next
 
          Dim r&
 
  With GetWindowInfo
    .hwnd = hwnd
    .hwndParent = GetParent(hwnd)
    .ThreadID = GetWindowThreadProcessId(hwnd, .ProcessId)
    .hIcon = GetClassLong(.hwndParent, GCL_HICON)
    .hInstance = GetWindowLong(.hwndParent, GWL_HINSTANCE)
    .Identifier = GetWindowLong(.hwndParent, GWL_ID)
    .Style = GetWindowLong(.hwndParent, GWL_STYLE)
    .WindowProc = GetWindowLong(.hwndParent, GWL_WNDPROC)
    .UserData = GetWindowLong(.hwndParent, GWL_USERDATA)
    r = EnumChildWindows(hwnd, AddressOf EnumChildProc, GetWindowInfo)
   
    .ClassName = String$(256, 0)
    r = GetClassName(hwnd, .ClassName, MAX_PATH)
    .ClassName = Left$(.ClassName, r)
   
    .Text = GetWindowText(hwnd)
   
    r = GetWindowModuleFileName(hwnd, .ModuleName, MAX_PATH)
    .ModuleName = Left$(.ModuleName, r)
   
    .hModule = GetModuleHandle(Trim(.ModuleName))
   
    If EnumThdWins Then _
    r = EnumThreadWindows(.ThreadID, AddressOf EnumThreadWndProc, GetWindowInfo)
  End With
 
End Function

Function GetProcessInfo(pProcess As PROCESSENTRY32, Optional OpenHandle As Boolean = False) As ProcessInfo
  'Obtiene información acerca de un proceso.
  '
  With GetProcessInfo
    .hProcess = OpenProcess(PROCESS_ALL_ACCESS, False, pProcess.th32ProcessID)
    .ProcessId = pProcess.th32ProcessID
    .ParentProcessID = pProcess.th32ParentProcessID
    .PriorityClass = GetPriorityClass(.hProcess)
    .NumOfThreads = pProcess.cntThreads
    .Threads = EnumThreads(.ProcessId)
    .Modules = EnumModules(.ProcessId, .NumOfModules)
    .ExeFilename = RTrim$(pProcess.szExeFile)
    .HandleCount = pProcess.cntUsage
    Call GetProcessWorkingSetSize(.hProcess, .MinWorkingSetSize, .MaxWorkingSetSize)
    Call GetExitCodeProcess(.hProcess, .ExitCode)
    Call GetProcessAffinityMask(.hProcess, .AffinityMask, .SysAffinityMask)
   
    If Not OpenHandle Then
      'Se cierra el controlador del proceso.
      '
      Call CloseHandle(.hProcess)
      .hProcess = 0
    End If
  End With
 
End Function

Function EnumThreads(ByVal ProcessId As Long) As ThreadInfo()

      Dim te32 As THREADENTRY32
      Dim thds() As ThreadInfo
      Dim iCount%
      Dim hSnap&
 
 
  'Crea el objeto snapshot.
  hSnap& = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&)
 
  te32.dwSize = LenB(te32)
 
  If Thread32First(hSnap, te32) Then
    'Si se obtiene el primer subproceso.
   
    If te32.th32OwnerProcessID = ProcessId Then GoSub GetThreadInfo
   
    Do While Thread32Next(hSnap, te32)
      'Obtiene los siguientes subprocesos y verifica
      'que pertenezcan al proceso especificado.
     
      If te32.th32OwnerProcessID = ProcessId Then
        GoSub GetThreadInfo
      End If
    Loop
  End If
 
  CloseHandle hSnap
  EnumThreads = thds
 
  Exit Function
 
GetThreadInfo:
  iCount = iCount + 1
  ReDim Preserve thds(iCount) As ThreadInfo
 
  With thds(iCount)
    .ThreadID = te32.th32ThreadID
    .BasePriority = te32.tpBasePri
    .UsageCount = te32.cntUsage
  End With
  Return
End Function

Function EnumModules(Optional ByVal ProcessId As Long, Optional NumOfModules As Long) As ModuleInfo()
     
      Dim me32 As MODULEENTRY32
      Dim pModule() As ModuleInfo
      Dim iCount%
      Dim hSnap&
 
  If ProcessId = 0 Then ProcessId = GetCurrentProcessId
 
  'Crea el objeto snapshot.
  hSnap& = CreateToolhelp32Snapshot(TH32CS_SNAPALL, ProcessId)
 
  me32.dwSize = LenB(me32)
 
  If Module32First(hSnap, me32) Then
    'Si se obtiene el primer módulo.
   
    GoSub GetModuleInfo
   
    Do While Module32Next(hSnap, me32)
      'Obtiene los siguientes módulos.
     
      If me32.th32ProcessID = ProcessId Then
        GoSub GetModuleInfo
      End If
    Loop
  End If
 
  CloseHandle hSnap
 
  NumOfModules = iCount
  EnumModules = pModule
 
  Exit Function
 
GetModuleInfo:
  iCount = iCount + 1
  ReDim Preserve pModule(iCount) As ModuleInfo
 
  With pModule(iCount)
    .hModule = me32.hModule
    .ModuleId = me32.th32ModuleID
    .BaseAddress = me32.modBaseAddr
    .ModuleSize = me32.modBaseSize
    .GlobalUsage = me32.GlblcntUsage
    .ProcessUsage = me32.ProccntUsage
    .ProcessId = ProcessId
    .ModuleName = Left$(me32.szModule, InStr(1, me32.szModule, vbNullChar) - 1)
    .Filename = Left$(me32.szExePath, InStr(1, me32.szExePath, vbNullChar) - 1)
  End With
  Return
 
End Function

Function EnumSysModules() As Long
  On Error Resume Next
 
        Dim i&, ind&
       
  Call EnumProcesses
  Erase SysModule
  lSysModCnt = 0
 
  For i = 1 To lSysProcCnt
    For ind = 1 To SysProcess(i).NumOfModules
      If Not ModuleExist(SysProcess(i).Modules(ind)) Then
        lSysModCnt = lSysModCnt + 1
        ReDim Preserve SysModule(lSysModCnt) As ModuleInfo
       
        SysModule(lSysModCnt) = SysProcess(i).Modules(ind)
      End If
    Next
  Next
 
  EnumSysModules = lSysModCnt
 
End Function

Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Boolean
     
      Dim pWin As WindowInfo

  pWin = GetWindowInfo(hwnd, False)
 
  lWinCnt = lWinCnt + 1
  ReDim Preserve Windows(lWinCnt) As WindowInfo
 
  pWin.Index = lWinCnt
  Windows(lWinCnt) = pWin
 
  EnumWindowsProc = True
 
End Function

Function EnumChildProc(ByVal hwnd As Long, lParam As WindowInfo) As Boolean
  With lParam
    .NumOfChild = .NumOfChild + 1
    ReDim Preserve .ChildWindows(.NumOfChild)
   
    .ChildWindows(.NumOfChild) = hwnd
   
  End With
 
  EnumChildProc = True
End Function

Function EnumThreadWndProc(ByVal hwnd As Long, lParam As WindowInfo) As Boolean
  With lParam
    .NumThdWindows = .NumThdWindows + 1
    ReDim Preserve .ThreadWindows(.NumThdWindows) As Long
   
    .ThreadWindows(.NumThdWindows) = hwnd
   
    EnumThreadWndProc = True
  End With
End Function

Function KillProcessByName(AppExeFilename As String, Optional Wait As Boolean = False, Optional WaitTime As Long, Optional KillAll As Boolean = False) As Boolean
            Dim sAppName$
            Dim i%
           
  Call EnumProcesses
 
  For i = 1 To lSysProcCnt
    sAppName = RTrim$(Replace(GetFileTitle(SysProcess(i).ExeFilename), vbNullChar, vbNullString))
   
    If InStr(1, sAppName, AppExeFilename, vbTextCompare) Then
      If SysProcess(i).ProcessId = GetCurrentProcessId Then Exit Function
     
      KillProcessByName = KillProcessById(SysProcess(i).ProcessId, Wait, WaitTime)
     
      If Not KillAll Then
        Exit For
      End If
    End If
  Next
 
End Function

Function KillProcessById(ProcessId As Long, Optional Wait As Boolean = False, Optional WaitTime As Long) As Boolean
            Dim hProcess&, r&

  If ProcessId = GetCurrentProcessId Then Exit Function
 
  hProcess = OpenProcess(PROCESS_ALL_ACCESS, False, ProcessId)
 
  If hProcess Then
    KillProcessById = (TerminateProcess(hProcess, 0))
   
    If Wait Then
      If WaitTime = 0 Then WaitTime = 3000
     
      r = WaitForSingleObject(hProcess, WaitTime)
     
      If r <> WAIT_OBJECT_0 Then
        KillProcessById = False
      End If
    End If
   
    r = CloseHandle(hProcess)
  End If
End Function

Function GetProcessInfoById(ProcessId As Long) As ProcessInfo
            Dim pProcess As ProcessInfo
            Dim i&

  Call EnumProcesses
 
  For i = 1 To lSysProcCnt
    If SysProcess(i).ProcessId = ProcessId Then
      GetProcessInfoById = SysProcess(i)
      Exit For
    End If
  Next
End Function

Private Function ModuleExist(pModuleInfo As ModuleInfo) As Boolean
  On Error Resume Next
 
          Dim i&

  For i = 1 To lSysModCnt
    If (pModuleInfo.Filename Like SysModule(i).Filename) And _
       pModuleInfo.ModuleId = SysModule(i).ModuleId Then
       
      ModuleExist = True
      Exit For
    End If
  Next
End Function


Sub ProcLogTmrProc(ByVal hwnd As Long, ByVal uMsg As Integer, ByVal idEvent As Integer, ByVal dwTime As Long)
          Dim r&

  r = KillTimer(0&, idEvent)
  bProcLogStarted = True
  Call StartProcessLog
End Sub

Function StartProcessLog() As Long

  'Devuelve un puntero a memoria en donde se encuentran
  'almacenados una serie de estructuras ProcessInfo
  'que identifican a los procesos.
  'Estas estructuras comienzan 4 (cuatro) bytes más
  'adelante que dicho puntero. Esto cuatro bytes
  'es un valor de tipo Long que indica la cantidad
  'de estructuras que existen en la tabla.
 
  On Error Resume Next
 
        Dim pProcessInfo As ProcessInfo
        Dim pProcess() As ProcessInfo
        Dim lProcCnt&
        Dim snTime!
        Dim i&, r&

  If Not bProcLogStarted Then
    r = SetTimer(0&, 0&, 0&, AddressOf ProcLogTmrProc)
    Exit Function
  End If
 
  Call EnumProcesses
  Call ProcTableInitialize
 
  snTime = Timer
 
  Do While Not CancelProcessLog
 
    If (Timer - snTime) > 2 Then
      Call EnumProcesses
     
      snTime = Timer
    End If
   
    If lSysProcCnt <> lProcCnt Then
      'Terminó o se creó un proceso.
      '
      If lProcCnt < lSysProcCnt Then
        'Fue creado un nuevo proceso.
        '

        For i = lProcCnt + 1 To lSysProcCnt
         
          Call ProcTableAddEntry(SysProcess(i))
         
          If i Mod 4 = 0 Then DoEvents
        Next
       
        pProcess = SysProcess
        lProcCnt = lSysProcCnt
       
      Else
        'Si terminó un proceso
        'busca el proceso que terminó.
        '
       
      End If
     
      pProcess = SysProcess
      lProcCnt = lSysProcCnt
   
    End If
   
    DoEvents
  Loop
 
  StartProcessLog = hProcTable
 
  CancelProcessLog = False
  bProcLogStarted = False
 
  Call ProcTableRelease
End Function

Sub EndProcessLog()
  CancelProcessLog = True
End Sub

Function ProcTableAddEntry(pInfo As ProcessInfo) As Boolean
            Dim lOffset&, r&, i&
            Dim dtNow As Date

  If ProcTableGetEntryCount >= 32767 Then Exit Function
 
  'Actualiza la tabla de módulos.
  '
  Call ProcTableRefreshModuleTable
 
  '16 bytes: 8 bytes to start time, 8 bytes to end time
 
  lOffset = ProcTableCalculateOffset(ProcTableGetEntryCount + 1)
  r = WriteProcessMemory(GetCurrentProcess(), lOffset, GetProcessInfoSize(pInfo), 4)
  lOffset = lOffset + 4
 
  r = WriteProcessMemory(GetCurrentProcess(), lOffset, pInfo, 52)
 
  lOffset = lOffset + 52
 
  For i = 1 To pInfo.NumOfThreads
    r = WriteProcessMemory(GetCurrentProcess(), lOffset, pInfo.Threads(i), Len(pInfo.Threads(i)))
   
    lOffset = lOffset + Len(pInfo.Threads(i))
  Next
 
  r = WriteProcessMemory(GetCurrentProcess(), lOffset, ProcTableGetIndexes(pInfo)(1), 4 * pInfo.NumOfModules)
  lOffset = lOffset + (4 * pInfo.NumOfModules)
 
  r = WriteProcessMemory(GetCurrentProcess(), lOffset, CInt(Len(RTrim$(Replace$(pInfo.ExeFilename, vbNullChar, vbNullString)))), 2&)
  lOffset = lOffset + 2
  r = WriteProcessMemory(GetCurrentProcess(), lOffset, ByVal pInfo.ExeFilename, Len(RTrim$(Replace$(pInfo.ExeFilename, vbNullChar, vbNullString))))
  lOffset = lOffset + Len(RTrim$(Replace$(pInfo.ExeFilename, vbNullChar, vbNullString)))
 
  dtNow = Now
 
  r = WriteProcessMemory(GetCurrentProcess(), lOffset, dtNow, 8)
  r = WriteProcessMemory(GetCurrentProcess(), lOffset + 8, dtNow, 8)
 
  If r Then
    r = WriteProcessMemory(GetCurrentProcess(), hProcTable, ProcTableGetEntryCount() + 1, 2)
  End If
 
  ProcTableAddEntry = (r <> 0)
End Function

Function ProcTableGetEntry(Index As Integer) As ProcessInfo
          Dim lOffset&, r&, i&
          Dim pEntry As ProcessInfo
          Dim iSize%, iModSize%
         
  If (Index < 0 Or Index > ProcTableGetEntryCount()) Or hProcTable = 0 Then Exit Function
 
  lOffset = ProcTableCalculateOffset(Index)
 
  r = ReadProcessMemory(GetCurrentProcess(), lOffset + 4, pEntry, 52)
  lOffset = lOffset + 4 + 52
 
  ReDim pEntry.Threads(1 To pEntry.NumOfThreads) As ThreadInfo
  r = ReadProcessMemory(GetCurrentProcess(), lOffset, pEntry.Threads(1), Len(pEntry.Threads(1)) * pEntry.NumOfThreads)
  lOffset = lOffset + (Len(pEntry.Threads(1)) * pEntry.NumOfThreads)
 
  ReDim pEntry.Modules(1 To pEntry.NumOfModules) As ModuleInfo
 
  For i = 1 To pEntry.NumOfModules
    r = ReadProcessMemory(GetCurrentProcess(), lOffset, pEntry.Modules(i), 28)
    lOffset = lOffset + 28
    r = ReadProcessMemory(GetCurrentProcess(), lOffset, iSize, 2&)
    lOffset = lOffset + 2
    r = ReadProcessMemory(GetCurrentProcess(), lOffset, ByVal pEntry.Modules(i).Filename, iSize)
    lOffset = lOffset + iSize
    r = ReadProcessMemory(GetCurrentProcess(), lOffset, iSize, 2&)
    lOffset = lOffset + 2
    r = ReadProcessMemory(GetCurrentProcess(), lOffset, ByVal pEntry.Modules(i).ModuleName, iSize)
    lOffset = lOffset + iSize
  Next
 
  r = ReadProcessMemory(GetCurrentProcess(), lOffset, iSize, 2)
  lOffset = lOffset + 2
  r = ReadProcessMemory(GetCurrentProcess(), lOffset, ByVal pEntry.ExeFilename, iSize)
 
  ProcTableGetEntry = pEntry
End Function

Function ProcTableGetEntryCount() As Integer
          Dim iCnt%
         
  If hProcTable Then
    Call ReadProcessMemory(GetCurrentProcess(), hProcTable, iCnt, 2)
    ProcTableGetEntryCount = iCnt
  End If
End Function

Function ProcTableFindEntry(ProcessId As Long, Optional outIndex As Integer) As ProcessInfo
        Dim pProcess As ProcessInfo
        Dim i%

  For i = 1 To ProcTableGetEntryCount()
    pProcess = ProcTableGetEntry(i)
   
    If pProcess.ProcessId = ProcessId Then
      ProcTableFindEntry = pProcess
      outIndex = i
     
      Exit For
    End If
  Next
End Function

Function ProcTableNotifyEnd(ProcessId As Long) As Boolean
            Dim dtEndTime As Date
            Dim pProcess As ProcessInfo
            Dim iIndex%, lOffset&
            Dim r&
           
  pProcess = ProcTableFindEntry(ProcessId, iIndex)
  lOffset = ProcTableGetOffset(pProcess) + ProcTableGetEntrySize(iIndex) - 8
 
  dtEndTime = Now
  r = WriteProcessMemory(GetCurrentProcess(), lOffset, dtEndTime, 8)

End Function

Function ProcTableCalculateOffset(Index As Integer) As Long
          Dim lOffset&
          Dim pProcInfo As ProcessInfo
          Dim pThdInfo As ThreadInfo
          Dim pModInfo  As ModuleInfo
          Dim i%, r&
          Dim lSize&


  lOffset = GetProcTableOffset
 
  For i = 1 To ProcTableGetEntryCount()
    lOffset = lOffset + lSize
    r = ReadProcessMemory(GetCurrentProcess(), hProcTable + lOffset, lSize, 4)
   
    If i = Index Then Exit For
   
  Next
 
  lOffset = hProcTable + lOffset
  ProcTableCalculateOffset = lOffset
 
End Function

Function ProcTableGetOffset(ProcessInfo As ProcessInfo) As Long
          Dim pProcInfo As ProcessInfo, i%

  For i = 1 To ProcTableGetEntryCount()
    pProcInfo = ProcTableGetEntry(i)
   
    If pProcInfo.ProcessId = ProcessInfo.ProcessId Then
      'Se encontró el proceso en la tabla.
      '
      ProcTableGetOffset = ProcTableCalculateOffset(i)
      Exit For
    End If
   
  Next
End Function

Function ProcTableGetEntrySize(Index As Integer) As Long
            Dim lOffset&, lSize&
            Dim r&
 
  lOffset = ProcTableCalculateOffset(Index)
  r = ReadProcessMemory(GetCurrentProcess(), lOffset, lSize, 4)

  ProcTableGetEntrySize = lSize
End Function

Function GetProcessInfoSize(ProcInfo As ProcessInfo) As Long
            Dim pThdInfo As ThreadInfo
            Dim pModInfo As ModuleInfo
            Dim lSize&, i&

  lSize = 52 + (Len(pThdInfo) * ProcInfo.NumOfThreads) + 16 + 4
 
  lSize = lSize + ProcInfo.NumOfModules * 4 'Tabla de indices de modulos.
 
  lSize = lSize + Len(RTrim$(Replace$(ProcInfo.ExeFilename, vbNullChar, vbNullString)))
  lSize = lSize + 2
 
  GetProcessInfoSize = lSize
End Function

Function ProcTableSaveToFile(Filename As String, Optional AppendData As Boolean = True) As Boolean
            Dim hFile&, sMagic$
            Dim lOffset&, lTableSize&
            Dim sData$, lDataSize&
            Dim r&

  hFile = CreateFile(Filename, GENERIC_READ Or GENERIC_WRITE, 1&, 0&, OPEN_ALWAYS, 0&, 0&)
  If hFile = INVALID_HANDLE_VALUE Then Exit Function
 
  sMagic = String$(3, 0)
  r = ReadFileStr(hFile, ByVal sMagic, 3&, 0&, ByVal 0&)
 
  If AppendData And StrComp(sMagic, "DAT") = False Then
    lOffset = GetFileSize(hFile, 0) + 1
   
  ElseIf Not AppendData Or StrComp(sMagic, "DAT") Then
    r = CloseHandle(hFile)
    r = DeleteFile(Filename)

    hFile = CreateFile(Filename, GENERIC_READ Or GENERIC_WRITE, 1&, 0&, CREATE_ALWAYS, 0&, 0&)
   
    r = WriteFileStr(hFile, ByVal "DAT", 3&, 0&, ByVal 0&)
   
    lOffset = 21
  End If
 
  lTableSize = ProcTableGetTableSize()
  lDataSize = GetModuleTableSize + lTableSize + 1
 
  r = SetFilePointer(hFile, 3, 0, FILE_BEGIN)
  r = WriteFile(hFile, ByVal hProcTable, 10, 0&, ByVal 0&)
  r = WriteFile(hFile, 1, 1, 0&, ByVal 0&)  'Formato del archivo.
  r = WriteFile(hFile, 1, 1, 0&, ByVal 0&)  'cifrado.
  r = WriteFile(hFile, lDataSize, 4, 0&, ByVal 0&)   'Longitud de los datos no cifrados.
  r = SetFilePointer(hFile, lOffset, 0, FILE_BEGIN)
 
  sData = String$(lDataSize, 0)
  r = ReadProcessMemory(GetCurrentProcess(), hProcTable + 10, ByVal sData, Len(sData))
 
  r = WriteFile(hFile, Len(sData), 4, 0&, ByVal 0&)    'Longitud de los datos cifrados.
  r = WriteFileStr(hFile, ByVal sData, Len(sData), 0&, ByVal 0&)  'Datos cifrados.

  r = CloseHandle(hFile)
End Function

Function ProcTableGetTableSize() As Long
            Dim lSize&, i%

  For i = 1 To ProcTableGetEntryCount()
    lSize = lSize + ProcTableGetEntrySize(i)
  Next
 
  ProcTableGetTableSize = lSize
End Function

Function GetModInfoSize(pInfo As ModuleInfo) As Long
          Dim lSize&
 
  With pInfo
    lSize = 28
    lSize = lSize + Len(RTrim$(Replace$(.Filename, vbNullChar, vbNullString)))
    lSize = lSize + Len(RTrim$(Replace$(.ModuleName, vbNullChar, vbNullString)))
   
    GetModInfoSize = lSize
  End With
End Function

Function GetProcTableOffset() As Long
          Dim lSize&
          Dim r&

  r = ReadProcessMemory(GetCurrentProcess(), hProcTable + 6, lSize, 4)
  GetProcTableOffset = lSize + 10
End Function

Function GetProcTableOffsetRVA() As Long
          Dim lSize&

  lSize = hProcTable + GetProcTableOffset
  GetProcTableOffsetRVA = lSize
End Function

Function ProcTableGetModuleCount() As Long
          Dim lCnt&, r&
         
  r = ReadProcessMemory(GetCurrentProcess(), hProcTable + 2, lCnt, 4)
  ProcTableGetModuleCount = lCnt
End Function

Function ProcTableGetModuleOffset(Index As Long) As Long
            Dim lOffset&, i&, r&
            Dim lSize&

  lOffset = 10
 
  For i = 1 To ProcTableGetModuleCount
    lOffset = lOffset + lSize
    r = ReadProcessMemory(GetCurrentProcess(), hProcTable + lOffset, lSize, 4&)
   
    If Index = i Then
      ProcTableGetModuleOffset = hProcTable + lOffset
      Exit For
    End If
  Next
End Function

Function ProcTableGetModuleInfo(Index As Long) As ModuleInfo
            Dim pModule As ModuleInfo
            Dim lOffset&, i&, r&
            Dim iSize%

  lOffset = ProcTableGetModuleOffset(Index) + 4
  r = ReadProcessMemory(GetCurrentProcess(), lOffset, pModule, 28)
  lOffset = lOffset + 28
 
  r = ReadProcessMemory(GetCurrentProcess(), lOffset, iSize, 2)
  lOffset = lOffset + 2
  If iSize > MAX_PATH Then iSize = MAX_PATH
  r = ReadProcessMemory(GetCurrentProcess(), lOffset, ByVal pModule.Filename, iSize)
 
  lOffset = lOffset + iSize
 
  r = ReadProcessMemory(GetCurrentProcess(), lOffset, iSize, 2)
  If iSize > MAX_PATH Then iSize = MAX_PATH
  lOffset = lOffset + 2
  r = ReadProcessMemory(GetCurrentProcess(), lOffset, ByVal pModule.ModuleName, iSize)

  ProcTableGetModuleInfo = pModule
End Function

Function ProcTableGetModuleIndex(ModuleId As Long) As Long
          Dim pModule As ModuleInfo
          Dim i&

  For i = 1 To ProcTableGetModuleCount
    pModule = ProcTableGetModuleInfo(i)
   
    If pModule.ModuleId = ModuleId Then
      ProcTableGetModuleIndex = i
      Exit For
    End If
  Next
End Function

Function ProcTableGetIndexes(ProcInfo As ProcessInfo) As Long()
          Dim pModule As ModuleInfo
          Dim lIndex&(), lCnt&
          Dim i&, ind%

  For i = 1 To ProcTableGetModuleCount
    pModule = ProcTableGetModuleInfo(i)
   
    For ind = 1 To ProcInfo.NumOfModules
      If pModule.ModuleId = ProcInfo.Modules(ind).ModuleId Then
        lCnt = lCnt + 1
        ReDim Preserve lIndex&(lCnt)
     
        lIndex&(lCnt) = i
       
        Exit For
       
      End If
    Next
  Next
 
  ProcTableGetIndexes = lIndex
 
End Function

Function GetModuleTableSize() As Long
        Dim lSize&, r&

  r = ReadProcessMemory(GetCurrentProcess(), hProcTable + 6, lSize, 4)
  GetModuleTableSize = lSize
End Function

Sub ProcTableInitialize()
  If hProcTable = 0 Then
    'Asigna memoria para 32767 entradas en la tabla, aprox..
    '
    hProcTable = VirtualAlloc(0&, 10551296 + 2&, MEM_COMMIT, PAGE_READWRITE)
    Call ProcTableInitModuleTable
  End If
End Sub

Sub ProcTableRelease(Optional Force As Boolean = False)
          Dim r&
         
  If hProcTable Then
    r = VirtualFree(hProcTable, 0&, MEM_RELEASE)
   
    If r Or Force Then
      hProcTable = 0
    End If
  End If
End Sub

Sub ProcTableInitModuleTable()
        Dim lOffset&, i&
        Dim lTableSize&
        Dim r&
       

  Call EnumSysModules
 
  lOffset = hProcTable + 10
 
  For i = 1 To lSysModCnt
    r = WriteProcessMemory(GetCurrentProcess(), lOffset, GetModInfoSize(SysModule(i)) + 4 + 4, 4)
    lOffset = lOffset + 4
    r = WriteProcessMemory(GetCurrentProcess(), lOffset, SysModule(i), 28)
    lOffset = lOffset + 28
   
    r = WriteProcessMemory(GetCurrentProcess(), lOffset, Len(RTrim$(Replace$(SysModule(i).Filename, vbNullChar, vbNullString))), 2)
    lOffset = lOffset + 2
    r = WriteProcessMemory(GetCurrentProcess(), lOffset, ByVal SysModule(i).Filename, Len(RTrim$(Replace$(SysModule(i).Filename, vbNullChar, vbNullString))))
    lOffset = lOffset + Len(RTrim$(Replace$(SysModule(i).Filename, vbNullChar, vbNullString)))
   
    r = WriteProcessMemory(GetCurrentProcess(), lOffset, Len(RTrim$(Replace$(SysModule(i).ModuleName, vbNullChar, vbNullString))), 2)
    lOffset = lOffset + 2
    r = WriteProcessMemory(GetCurrentProcess(), lOffset, ByVal SysModule(i).ModuleName, Len(RTrim$(Replace$(SysModule(i).ModuleName, vbNullChar, vbNullString))))
    lOffset = lOffset + Len(RTrim$(Replace$(SysModule(i).ModuleName, vbNullChar, vbNullString)))
   
    lTableSize = lTableSize + GetModInfoSize(SysModule(i)) + 4 + 2 + 2
  Next
 
  r = WriteProcessMemory(GetCurrentProcess(), hProcTable + 2, lSysModCnt, 4)
  r = WriteProcessMemory(GetCurrentProcess(), hProcTable + 6, lTableSize, 4)

End Sub

Sub ProcTableRefreshModuleTable()
        Dim hTmp&, lSize&, r&
 
  lSize = ProcTableGetTableSize
  hTmp = VirtualAlloc(0&, lSize, MEM_COMMIT, PAGE_READWRITE)
 
  If hTmp Then
    r = ReadProcessMemory(GetCurrentProcess(), GetProcTableOffsetRVA, _
        ByVal hTmp, lSize)
   
    If r Then
      Call ProcTableInitModuleTable
     
      r = ReadProcessMemory(GetCurrentProcess(), hTmp, _
          ByVal GetProcTableOffsetRVA, lSize)

    End If
   
    r = VirtualFree(hTmp, 0, MEM_RELEASE)
  End If
End Sub

Function GetVersionInfo(Filename As String) As FileVersionInfo
            Dim pFixedInfo As VS_FIXEDFILEINFO
            Dim pFileInfo As FileVersionInfo
            Dim sCharset$, btCharset(4) As Byte
            Dim lCharset&, hCharBlck&
            Dim lInfoSize&, hVersion&
            Dim sVerData$, sVerBlck$, lLen&
            Dim sVerInfo$(9), sData$, i%, r&
            Dim lBinType&
           
  lInfoSize = GetFileVersionInfoSize(Filename, 0&)
  sVerData$ = String$(lInfoSize, 0)
 
  r = GetFileVersionInfo(Filename, 0&, lInfoSize, sVerData)
 
  If r = 0 Then Exit Function
 
  r = VerQueryValue(sVerData, "\VarFileInfo\Translation", hCharBlck, lLen)
 
  If r = 0 Then Exit Function
 
  r = ReadProcessMemory(GetCurrentProcess(), hCharBlck, btCharset(1), lLen)
 
  lCharset = btCharset(3) + btCharset(4) * &H100 + _
             btCharset(1) * &H10000 + btCharset(2) * &H1000000
 
  sCharset$ = Hex$(lCharset)
  sCharset$ = String(8 - Len(sCharset$), "0") & sCharset$
 
  sVerInfo(1) = "CompanyName"
  sVerInfo(2) = "FileDescription"
  sVerInfo(3) = "FileVersion"
  sVerInfo(4) = "InternalName"
  sVerInfo(5) = "LegalCopyright"
  sVerInfo(6) = "OriginalFileName"
  sVerInfo(7) = "ProductName"
  sVerInfo(8) = "ProductVersion"
  sVerInfo(9) = "Comments"

  For i = 1 To 9
    sVerBlck$ = "\StringFileInfo\" & sCharset & "\" & sVerInfo(i)
   
    r = VerQueryValue(sVerData, sVerBlck, hVersion, lInfoSize)
   
    If r Then
      sData = String$(lInfoSize, 0)
     
      r = ReadProcessMemory(GetCurrentProcess(), hVersion, ByVal sData, lInfoSize)
     
      sData = Left$(sData, lInfoSize - 1)
     
      With GetVersionInfo
        Select Case i
          Case 1: .CompanyName = sData
          Case 2: .FileDescription = sData
          Case 3: .FileVersion = sData
          Case 4: .InternalName = sData
          Case 5: .LegalCopyright = sData
          Case 6: .OriginalFileName = sData
          Case 7: .ProductName = sData
          Case 8: .ProductVersion = sData
          Case 9: .Comments = sData
        End Select
       
        If GetBinaryType(Filename, lBinType) Then
          Select Case lBinType
            Case SCS_32BIT_BINARY: .FileOS = "Ejecutable Para Windows De 32 Bits"
            Case SCS_DOS_BINARY: .FileOS = "Ejecutable Para MS-DOS"
            Case SCS_OS216_BINARY: .FileOS = "Ejecutable Para OS/2 De 16 Bits"
            Case SCS_PIF_BINARY: .FileOS = "Acceso Directo A Programa De MS-DOS"
            Case SCS_POSIX_BINARY: .FileOS = "Archivo Ejecutable Para POSIX"
            Case SCS_WOW_BINARY: .FileOS = "Ejecutable Para Windows De 16 Bits"
            Case Else: .FileOS = "Sistema Desconocido"
          End Select
        End If

      End With
    End If
  Next
End Function

Function GetPriorityClassName(PriorityClass As Long) As String
            Dim sName$
       
  Select Case PriorityClass
    Case HIGH_PRIORITY_CLASS: sName$ = "Alta"
    Case IDLE_PRIORITY_CLASS: sName$ = "Inactivo"
    Case NORMAL_PRIORITY_CLASS: sName$ = "Normal"
    Case REALTIME_PRIORITY_CLASS: sName$ = "Tiempo Real"
    Case Else: sName$ = "Desconocida"
  End Select

  GetPriorityClassName = sName$
End Function

Function GetWindowText(hwnd As Long) As String
        Dim sTitle$, r&
       
  sTitle = String$(255, 0): r = Win.GetWindowText(hwnd, sTitle, 255)
  sTitle = Left$(sTitle, r)
 
  GetWindowText = sTitle
End Function

Function GetFileTitle(Filename As String) As String
  GetFileTitle = Trim(Replace(Mid$(Filename, InStrRev(Filename, "\") + 1), vbNullChar, vbNullString))
End Function



Enjoy!!

Saludos.