apiprocess.cls

来自「几个不错的VB例子」· CLS 代码 · 共 54 行

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ApiProcess"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

'\\ --[ ApiProcess ] ----------------------------------------------------

Private Declare Function EmptyWorkingSetApi Lib "psapi.dll" Alias "EmptyWorkingSet" (ByVal hProcess As Long) As Long
'The EmptyWorkingSet function removes as many pages as possible from the working set of the specified process.
'If the function succeeds, the return value is nonzero.

Private Declare Function EnumProcessModulesApi Lib "psapi.dll" Alias "EnumProcessModules" (ByVal hProcess As Long, lpModule As Long, ByVal cbSize As Long, lpcbNeeded As Long) As Long
'The EnumProcessModules function retrieves a handle for each module in the specified process.
'If the function succeeds, the return value is nonzero.

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 Declare Function GetProcessMemoryInfo Lib "psapi.dll" (ByVal hProcess As Long, ppsMemCounters As PROCESS_MEMORY_COUNTERS, ByVal cbSize As Long) As Long

Private mhProcess As Long 'Process handle


Public Property Get hProcess() As Long

    hProcess = mhProcess
    
End Property

Public Sub EmptyWorkingSet()

Dim lret As Long
lret = EmptyWorkingSetApi(mhProcess)
If lret = 0 Or Err.LastDllError > 0 Then
    ReportError Err.LastDllError, "ApiProcess:EmptyWorkingSet", APIDispenser.LastSystemError
End If

End Sub