Foro de elhacker.net

Private Type PROCESS_MEMORY_COUNTERS
cb As Long
PageFaultCount As Long
PeakWorkingSetSize As Long
WorkingSetSize As Long
QuotaPeakPagedPoolUsage As Long
QuotaPagedPoolUsage As Long
QuotaPeakNonPagedPoolUsage As Long
QuotaNonPagedPoolUsage As Long
PagefileUsage As Long
PeakPagefileUsage As Long
End Type

Private Const PROCESS_QUERY_INFORMATION = 1024
Private Const PROCESS_VM_READ = 16
Private Const MAX_PATH = 260

Private Type LARGE_INTEGER
lowpart As Long
highpart As Long
End Type

Private Type MEMORYSTATUSEX
dwLength As Long
dwMemoryLoad As Long
ullTotalPhys As LARGE_INTEGER
ullAvailPhys As LARGE_INTEGER
ullTotalPageFile As LARGE_INTEGER
ullAvailPageFile As LARGE_INTEGER
ullTotalVirtual As LARGE_INTEGER
ullAvailVirtual As LARGE_INTEGER
ullAvailExtendedVirtual As LARGE_INTEGER
End Type

Private Declare Function EnumProcesses Lib "PSAPI.DLL" (lpidProcess As Long, ByVal cb As Long, cbNeeded As Long) As Long
Private Declare Function EnumProcessModules Lib "PSAPI.DLL" (ByVal hProcess As Long, lphModule As Long, ByVal cb As Long, lpcbNeeded As Long) 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 GetModuleFileNameExA Lib "PSAPI.DLL" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long
Private Declare Function GetProcessMemoryInfo Lib "PSAPI.DLL" (ByVal hProcess As Long, ppsmemCounters As PROCESS_MEMORY_COUNTERS, ByVal cb As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal Handle As Long) As Long

Private Function GetProcessMemory(ByVal EXEName As String) As Long
Dim lngLength As Long
Dim strProcessName As String
Dim lngCBSize As Long
Dim lngCBSizeReturned As Long
Dim lngNumElements As Long
Dim lngProcessIDs() As Long
Dim lngCBSize2 As Long
Dim lngModules(1 To 200) As Long
Dim lngReturn As Long
Dim strModuleName As String
Dim lngSize As Long
Dim lngHwndProcess As Long
Dim lngLoop As Long
Dim pmc As PROCESS_MEMORY_COUNTERS
Dim lRet As Long
Dim strProcName2 As String
On Error GoTo Error_handler
EXEName = UCase$(Trim$(EXEName))
lngLength = Len(EXEName)
lngCBSize = 8
lngCBSizeReturned = 96
Do While lngCBSize <= lngCBSizeReturned
lngCBSize = lngCBSize * 2
ReDim lngProcessIDs(lngCBSize / 4) As Long
lngReturn = EnumProcesses(lngProcessIDs(1), lngCBSize, lngCBSizeReturned)
Loop
lngNumElements = lngCBSizeReturned / 4
For lngLoop = 1 To lngNumElements
lngHwndProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, lngProcessIDs(lngLoop))
If lngHwndProcess <> 0 Then
lngReturn = EnumProcessModules(lngHwndProcess, lngModules(1), 200, lngCBSize2)
If lngReturn <> 0 Then
strModuleName = Space(MAX_PATH)
lngSize = 500
lngReturn = GetModuleFileNameExA(lngHwndProcess, lngModules(1), strModuleName, lngSize)
strProcessName = Left$(strModuleName, lngReturn)
strProcName2 = GetExeName(strProcessName)
If strProcName2 = EXEName Then
pmc.cb = LenB(pmc)
lRet = GetProcessMemoryInfo(lngHwndProcess, pmc, pmc.cb)
GetProcessMemory = pmc.WorkingSetSize / 1024
End If
End If
End If
lngReturn = CloseHandle(lngHwndProcess)
Next lngLoop
IsProcessRunning_Exit:
Exit Function
Error_handler:
Resume Next
End Function

Private Function GetExeName(ByVal sPath As String) As String
Dim lPos1 As Long
Dim lPos2 As Long
On Error Resume Next
lPos1 = InStr(1, sPath, Chr$(0))
lPos2 = InStrRev(sPath, "\")
If lPos1 > 0 Then
GetExeName = UCase$(Mid$(sPath, lPos2 + 1, lPos1 - lPos2))
Else
GetExeName = UCase$(Mid$(sPath, lPos2 + 1))
End If
End Function

Private Sub Command1_Click()
MsgBox "Este Procesos Ocupa en Memoria " & GetProcessMemory("CALC.EXE") & " KB", vbInformation 'para la calculadora de windows...
End Sub