RE:Ver procesos con el VB 6.0
Publicado por
Jyns (1 intervención) el 05/03/2007 12:59:35
Buenas,
Pegando este código en un módulo y llamando a ActiveProcess te escribe (por ejemplo) en un fichero el nombre de todos los procesos activos en el sistema, lo que ya no sé es como sacar el usuario que lo está ejecutando.
Espero que te sirva de alguna ayuda.
Saludos.
Option Explicit
Public Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Public Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Public Declare Function CloseHandle Lib "Kernel32.dll" (ByVal Handle As Long) As Long
Public Declare Function OpenProcess Lib "Kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Public Declare Function EnumProcesses Lib "psapi.dll" (ByRef lpidProcess As Long, ByVal Cb As Long, ByRef CbNeeded As Long) As Long
Public Declare Function GetModuleFileNameExA Lib "psapi.dll" (ByVal HProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long
Public Declare Function EnumProcessModules Lib "psapi.dll" (ByVal HProcess As Long, ByRef lphModule As Long, ByVal Cb As Long, ByRef CbNeeded As Long) As Long
Public Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Public Declare Function GetVersionExA Lib "kernel32" (lpVersionInformation As OSVERSIONINFO) As Integer
Public Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long ' This process
th32DefaultHeapID As Long
th32ModuleID As Long ' Associated exe
cntThreads As Long
th32ParentProcessID As Long ' This process's parent process
pcPriClassBase As Long ' Base priority of process threads
dwFlags As Long
szExeFile As String * 260 ' MAX_PATH
End Type
Public Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long '1 = Windows 95.
'2 = Windows NT
szCSDVersion As String * 128
End Type
Public Const PROCESS_QUERY_INFORMATION = 1024
Public Const PROCESS_VM_READ = 16
Public Const MAX_PATH = 260
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
Public Const SYNCHRONIZE = &H100000
'STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF
Public Const PROCESS_ALL_ACCESS = &H1F0FFF
Public Const TH32CS_SNAPPROCESS = &H2&
Public Const hNull = 0
Public Type STARTUPINFO
Cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Public Type PROCESS_INFORMATION
HProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type
Public Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Public Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Public Declare Function GetExitCodeProcess Lib "kernel32" (ByVal HProcess As Long, lpExitCode As Long) As Long
Public Const NORMAL_PRIORITY_CLASS = &H20&
Public Const INFINITE = -1&
Public Const WS_MINIMIZE = &H20000000
Public Sub ActiveProcess()
Dim F As Long, SName As String, ModuleName As String
Dim Proc As PROCESSENTRY32
Dim Cb As Long, CbNeeded As Long, NumElements As Long, ProcessIDs() As Long, CbNeeded2 As Long, NumElements2 As Long, HSnap As Long
Dim LRet As Long, nSize As Long, HProcess As Long, I As Long
Dim Modules(1 To 200) As Long
Select Case getVersion()
Case 1 'Windows 95/98
HSnap = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
If HSnap = hNull Then End
Proc.dwSize = Len(Proc)
' Iterate through the processes
F = Process32First(HSnap, Proc)
Do While F
SName = StrZToStr(Proc.szExeFile)
F = Process32Next(HSnap, Proc)
Loop
Case 2 'Windows NT
'Get the array containing the process id's for each process object
Cb = 8
CbNeeded = 96
Do While Cb <= CbNeeded
Cb = Cb * 2
ReDim ProcessIDs(Cb / 4) As Long
LRet = EnumProcesses(ProcessIDs(1), Cb, CbNeeded)
Loop
NumElements = CbNeeded / 4
For I = 1 To NumElements
'Get a handle to the Process
HProcess = OpenProcess(PROCESS_QUERY_INFORMATION _
Or PROCESS_VM_READ, 0, ProcessIDs(I))
'Got a Process handle
If HProcess <> 0 Then
'Get an array of the module handles for the specified
'process
LRet = EnumProcessModules(HProcess, Modules(1), 200, _
CbNeeded2)
'If the Module Array is retrieved, Get the ModuleFileName
If LRet <> 0 Then
ModuleName = Space(MAX_PATH)
nSize = 500
LRet = GetModuleFileNameExA(HProcess, Modules(1), _
ModuleName, nSize)
Open "c:\procesos_activos.log" For Append As #100
Print #100, ModuleName
Close #100
End If
End If
'Close the handle to the process
LRet = CloseHandle(HProcess)
Next
End Select
End Sub
Public Function getVersion() As Long
Dim osinfo As OSVERSIONINFO
Dim retvalue As Integer
osinfo.dwOSVersionInfoSize = 148
osinfo.szCSDVersion = Space$(128)
retvalue = GetVersionExA(osinfo)
getVersion = osinfo.dwPlatformId
End Function
Function StrZToStr(S As String) As String
StrZToStr = Left$(S, Len(S) - 1)
End Function
