[RESOLVED] Memory usage information about my application

How can i get the current memory usage of my program (like the memory usage shown in task manager)?

I'm thinking that the GlobalMemoryStatusEx API may be involved? But this seems to be more about the system memory than info specific to my app.
Another option is GetProcessMemoryInfo()?

TIA

Re: Memory usage information about my application

See Memory Performance Information and Performance Counters.

Re: Memory usage information about my application

I've found some VB6 code which uses the GetProcessMemoryInfo API to get memory usage but the value returned by the API does not match what Task Manager shows me. It's using the WorkingSetSize member of the PROCESS_MEMORY_COUNTERS structure as the process memory value. But again, that value doesn't match up with Task Manager. For example - this code is showing that my app running within the VB6 IDE is using 143MB of memory while Task Manager shows private working memory of 73MB.

Here's the code:

Code:

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 Declare Function GetCurrentProcessId Lib "kernel32.dll" () 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 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 'Only supported by NT systems Public Function GetProcessMemoryUsage() As Long On Error Resume Next Dim ProcId As Long Dim pmc As PROCESS_MEMORY_COUNTERS Dim HwndProcess As Long, lRet As Long ProcId = GetCurrentProcessId() HwndProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, ProcId) If HwndProcess = 0 Then Exit Function pmc.cb = LenB(pmc) lRet = GetProcessMemoryInfo(HwndProcess, pmc, pmc.cb) If lRet = 0 Then Exit Function GetMemory = pmc.WorkingSetSize lRet = CloseHandle(HwndProcess) End Function

Re: Memory usage information about my application

It turns out that the code I posted above returns the "Working Set" memory size. But what Task Manager shows, and what I want, is the "Private Working Set" memory size. There's a difference between the two:

Working set actually tells you how many virtual pages for the process are mapped into physical memory. Working set memory is the amount of memory in the private working set plus the amount of memory the process is using that can be shared by other running processes. So basically private working set is the subset of working set that specifically describes the amount of memory a process is using that cannot be shared by other processes.

So I'm still in search of VB6 code to give me the memory size of the private working set for my program.

Re: Memory usage information about my application

You'll probably have to use QueryWorkingSet() instead.

Re: Memory usage information about my application

Quote:

Originally Posted by dilettante

You'll probably have to use QueryWorkingSet() instead.

Thanks. That looks like a pain from what I can see and there's no sample VB6 code out there for this...

There does seem to be a pretty painless way to get this value using WMI which I've had no luck running. I have no experience with WMI. Is there an easy way to get this VBA code snippet to run in VB6?

Set objWMI = GetObject("winmgmts:\\.\root\cimv2")
Set colProcesses = objWMI.ExecQuery( "Select * from Win32_PerfRawData_PerfProc_Process" )
For Each objProcess in colProcesses
Wscript.Echo objProcess.Name & " => " & CLng(objProcess.WorkingSetPrivate/1024) & "K"
Next

Re: Memory usage information about my application

For anyone following this thread now or in the future, I've figured out how to use WMI to get Process Raw Performance Data. Here's the code:

Code:

Option Explicit Private Declare Function GetCurrentProcessId Lib "kernel32.dll" () As Long Sub Main() Dim lngCurrentProcessID As Long lngCurrentProcessID = GetCurrentProcessId Dim lngErrCode As Long Call GetProcessRawPerformanceData(lngCurrentProcessID, lngErrCode) End Sub Private Sub GetProcessRawPerformanceData(ByVal plngProcessID As Long, ByRef plngErrCode As Long) On Error GoTo PROC_ERROR '// Purpose: Get Process Raw Performance data for given process '// using Windows Management Instrumentation (WMI) ' '//requires a reference be set to Microsoft WMI Scripting Library (c:\windows\syswow64\wbemdisp.tlp) Dim objLocator As WbemScripting.SWbemLocator Dim objService As WbemScripting.SWbemServices Dim objProcesses As WbemScripting.SWbemObjectSet Dim objProcess As WbemScripting.SWbemObject Dim objProp As WbemScripting.SWbemProperty '' '//requires no reference to be set (is slower than above) '' Dim objLocator As Object '' Dim objService As Object '' Dim objProcesses As Object '' Dim objProcess As Object '' Dim objProp As Object '--Retrieve a locator object Dim strObjectName As String strObjectName = "WbemScripting.SWbemLocator" Set objLocator = CreateObject(strObjectName) If objLocator Is Nothing Then plngErrCode = vbObjectError GoTo PROC_EXIT End If '--Log on to the namespace 'If you do not specify a computer in the call to ConnectServer, 'then WMI connects to the local computer. If you do not specify a namespace, 'then WMI connects to the namespace specified in the registry key. Dim strServer As String Dim strNamespace As String strServer = "." strNamespace = "root\cimv2" Set objService = objLocator.ConnectServer(strServer, strNamespace) If objService Is Nothing Then plngErrCode = vbObjectError GoTo PROC_EXIT End If '-- query for the desired data Dim strProcessID As String Dim strQuery As String strProcessID = CStr(plngProcessID) strQuery = "Select * from Win32_PerfRawData_PerfProc_Process Where IDProcess = " & strProcessID Set objProcesses = objService.ExecQuery(strQuery) If objProcesses Is Nothing Then plngErrCode = vbObjectError GoTo PROC_EXIT End If 'should be only one process matching the given process ID If objProcesses.Count <> 1 Then GoTo PROC_EXIT End If 'get a reference to the process Set objProcess = objProcesses.ItemIndex(0) '0-based collection If objProcess Is Nothing Then plngErrCode = vbObjectError GoTo PROC_EXIT End If 'iterate through the process info, getting each Property Name and Value Const COLON_SPACE As String = ": " Dim strPropName As String Dim strPropValue As String Dim strPropNameAndValue As String With objProcess For Each objProp In .Properties_ With objProp '...property name strPropName = .Name '...property value If .CIMType = wbemCimtypeString Then 'handle Null value case If IsNull(.Value) Then strPropValue = .Value & "" Else strPropValue = .Value End If Else strPropValue = CStr(.Value) End If End With strPropNameAndValue = strPropName & COLON_SPACE & strPropValue Debug.Print strPropNameAndValue Next End With PROC_EXIT: If Not (objProp Is Nothing) Then Set objProp = Nothing If Not (objProcess Is Nothing) Then Set objProcess = Nothing If Not (objProcesses Is Nothing) Then Set objProcesses = Nothing If Not (objService Is Nothing) Then Set objService = Nothing If Not (objLocator Is Nothing) Then Set objLocator = Nothing Exit Sub PROC_ERROR: plngErrCode = Err.Number Resume PROC_EXIT Resume End Sub

Re: Memory usage information about my application

It turns out that WMI can provide the WorkingSetPrivate mem size. The documentation on the MS web site for the Win32_PerfRawData_PerfProc_Process class was incomplete and did not include the WorkingSetPrivate property but it's there and returns the correct value. I've corrected the WMI code above with this additional property.

So this works. It's slow however. I'd love to find a more performant way of obtaining this - like API for instance.

Re: Memory usage information about my application

Here is an impl using QueryWorkingSet API

thinBasic Code:

Option Explicit
 
Private Declare Function QueryWorkingSet Lib "psapi" (ByVal hProcess As Long, pv As Any, ByVal cb As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
 
Private Function GetWorkingSetInfo(ByVal hProcess As Long, lTotal As Long, lPrivate As Long, lShared As Long, lSharable As Long) As Boolean
    Const FLAG_SHARED   As Long = 2 ^ 8                         ' 0x100
    Const MASK_SHARE_COUNT As Long = 2 ^ 7 Or 2 ^ 6 Or 2 ^ 5    ' 0xE0
    Const ERR_BAD_LENGTH As Long = 24
    Dim lIdx            As Long
    Dim laBuffer()      As Long
        
    Call QueryWorkingSet(hProcess, lIdx, 4)
    lIdx = (lIdx + 1023) And -1024
    Do
        ReDim laBuffer(0 To lIdx)
        If QueryWorkingSet(hProcess, laBuffer(0), (UBound(laBuffer) + 1) * 4) <> 0 Then
            Exit Do
        ElseIf Err.LastDllError <> ERR_BAD_LENGTH Then
            Exit Function
        End If
        lIdx = lIdx + 1024
    Loop
    lTotal = laBuffer(0)
    lPrivate = 0
    lShared = 0
    lSharable = 0
    For lIdx = 1 To laBuffer(0)
        If (laBuffer(lIdx) And FLAG_SHARED) = 0 Then
            lPrivate = lPrivate + 1
        Else
            lSharable = lSharable + 1
            '-- count only if shared more than once
            If (laBuffer(lIdx) And MASK_SHARE_COUNT) > 2 ^ 5 Then
                lShared = lShared + 1
            End If
        End If
    Next
    '--- success
    GetWorkingSetInfo = True
End Function
 
Private Sub Form_Load()
    Dim lTotal          As Long
    Dim lPrivate        As Long
    Dim lShared         As Long
    Dim lSharable       As Long
    
    If GetWorkingSetInfo(GetCurrentProcess(), lTotal, lPrivate, lShared, lSharable) Then
        Debug.Print "Working Set: " & Format$((lTotal * 4096) / 1024# / 1024#, "#,#.00 MB")
        Debug.Print "Private WS:  " & Format$((lPrivate * 4096) / 1024# / 1024#, "#,#.00 MB")
        Debug.Print "Shared WS:   " & Format$((lShared * 4096) / 1024# / 1024#, "#,#.00 MB")
        Debug.Print "Sharable WS: " & Format$((lSharable * 4096) / 1024# / 1024#, "#,#.00 MB")
    End If
End Sub

cheers,
</wqw>

1 Attachment(s)

Re: Memory usage information about my application

Here's an example of using the Performance Counters API to obtain the current process' Private Working Set:

Code:

Option Explicit Private Const ERROR_SUCCESS As Long = &H0 Private Const PDH_MAX_COUNTER_PATH As Long = 2048 Private Const PERF_DETAIL_NOVICE As Long = 100 Private Const PERF_DETAIL_ADVANCED As Long = 200 Private Const PERF_DETAIL_EXPERT As Long = 300 Private Const PERF_DETAIL_WIZARD As Long = 400 Private Declare Function PdhCloseQuery Lib "pdh.dll" (ByVal QueryHandle As Long) As Long Private Declare Function PdhCollectQueryData Lib "pdh.dll" (ByVal QueryHandle As Long) As Long Private Declare Function PdhVbAddCounter Lib "pdh.dll" (ByVal QueryHandle As Long, ByVal CounterPath As String, ByRef CounterHandle As Long) As Long Private Declare Function PdhVbGetDoubleCounterValue Lib "pdh.dll" (ByVal CounterHandle As Long, ByRef CounterStatus As Long) As Double Private Declare Function PdhVbGetOneCounterPath Lib "pdh.dll" (ByVal PathString As String, ByVal PathLength As Long, ByVal DetailLevel As Long, ByVal CaptionString As String) As Long Private Declare Function PdhVbIsGoodStatus Lib "pdh.dll" (ByVal StatusValue As Long) As Long Private Declare Function PdhVbOpenQuery Lib "pdh.dll" (ByRef QueryHandle As Long) As Long Private Declare Function SysReAllocStringLen Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long, Optional ByVal Length As Long) As Long Private m_hQuery As Long Private m_hCounter As Long Private m_sCounterPath As String Private Sub Form_Click() Dim RV As Long, sCounterPath As String If m_hQuery Then Timer1 = False RV = PdhCloseQuery(m_hQuery): Debug.Assert RV = ERROR_SUCCESS If RV = ERROR_SUCCESS Then m_hCounter = 0& m_hQuery = 0& End If End If RV = PdhVbOpenQuery(m_hQuery): Debug.Assert RV = ERROR_SUCCESS If RV = ERROR_SUCCESS Then '#Const BrowseforPerformanceCounter = True #If BrowseforPerformanceCounter Then SysReAllocStringLen VarPtr(m_sCounterPath), , PDH_MAX_COUNTER_PATH RV = PdhVbGetOneCounterPath(m_sCounterPath, PDH_MAX_COUNTER_PATH, PERF_DETAIL_WIZARD, "Browse Performance Counters") m_sCounterPath = Left$(m_sCounterPath, RV) If LenB(m_sCounterPath) Then #Else If App.LogMode Then m_sCounterPath = "\Process(Project1)\Working Set - Private" Else m_sCounterPath = "\Process(VB6)\Working Set - Private" End If #End If RV = PdhVbAddCounter(m_hQuery, m_sCounterPath, m_hCounter): Debug.Assert RV = ERROR_SUCCESS If RV = ERROR_SUCCESS Then Timer1 = True #If BrowseforPerformanceCounter Then End If #End If End If End Sub Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyEscape Then Unload Me End Sub Private Sub Form_Unload(Cancel As Integer) Dim RV As Long If m_hQuery Then RV = PdhCloseQuery(m_hQuery): Debug.Assert RV = ERROR_SUCCESS End Sub Private Sub Timer1_Timer() Dim RV As Long, CtrStatus As Long, CtrValue As Double RV = PdhCollectQueryData(m_hQuery): Debug.Assert RV = ERROR_SUCCESS If RV = ERROR_SUCCESS Then CtrValue = PdhVbGetDoubleCounterValue(m_hCounter, CtrStatus) If PdhVbIsGoodStatus(CtrStatus) Then Caption = m_sCounterPath & " = " & FormatNumber(CtrValue / &H100000, 2&) & " MB [" & Timer & "]" '<-- The Timer is proof the Pdh* APIs are working as fast as they can End If End If End Sub 'Visual Basic 4.0 definitions file for use with PDH.DLL the Peformance Data Helper DLL 'http://ftp.scana.com.ua/pub/ntreskit/PerfTool/LogTools/PDHDEFS.TXT

According to MSDN, "Applications such as the Windows Task Manager, the Reliability and Performance Monitor, and the Process Explorer tool use performance counters to display memory information for the system and for individual processes."

Re: Memory usage information about my application

@Victor Bravo VI: If I have couple of vb6.exe/project1.exe started which one's Private WS gets counted in your implementation?

cheers,
</wqw>

Re: Memory usage information about my application

@wqweto - Thank you.

Your implementation works great. I wish I understood it better however - you seem to be using a generic memory buffer rather than a PSAPI_WORKING_SET_INFORMATION structure like the function description in MSDN calls for and you're moving about it to get the values you want. There are many calculations I don't understand the purpose of in there too. It's wizardry to me!

Re: Memory usage information about my application

Quote:

Originally Posted by wqweto

If I have couple of vb6.exe/project1.exe started which one's Private WS gets counted in your implementation?

Great question! As written, the demo above will always display the Private WS of the first instance of VB6.EXE/Project1.exe.

The Specifying a Counter Path topic describes how to construct a counter path that specifies a particular instance of an object (Process, Thread, etc.). Basically, the instance is identified via an index number. For example, if there are 2 or more Project1.exes, the 2nd instance can be specified like so:

Code:

'Instance indexes are 0-based. The index isn't required when specifying the 1st one. m_sCounterPath = "\Process(Project1#1)\Working Set - Private"

Based on my limited testing, instance indexes appear to be in the order that they are enumerated by Process32First/Process32Next.

Re: Memory usage information about my application

@ Victor Bravo VI - thank you.

The PDH example is interesting and I'm able to make it work on my desktop but I think that there's a gotcha in here for which I've not found a workaround. The counter path string passed to PdhVbAddCounter must be localized or else it will fail in non-English locales. (See note in here: https://msdn.microsoft.com/en-us/lib...v=vs.85).aspx)

There is a language neutral version of this function called PdhAddEnglishCounter. But attempts to declare and call this routine rather than PdhVbAddCounter produce errors of Dll Entry Point not found. There doesn't seem to be a language-neutral version function among the PDH functions offered to VB developers?
https://msdn.microsoft.com/en-us/lib...(v=vs.85).aspx

I need a solution which is language-neutral.

Re: Memory usage information about my application

Quote:

Originally Posted by AAraya

The PDH example is interesting and I'm able to make it work on my desktop but I think that there's a gotcha in here for which I've not found a workaround. The counter path string passed to PdhVbAddCounter must be localized or else it will fail in non-English locales. (See note in here: https://msdn.microsoft.com/en-us/lib...v=vs.85).aspx)

There is a language neutral version of this function called PdhAddEnglishCounter. But attempts to declare and call this routine rather than PdhVbAddCounter produce errors of Dll Entry Point not found.

You're probably calling it in an OS prior to Vista. As stated in the Requirements section of the PdhAddEnglishCounter function, the "Minimum supported client" is "Windows Vista". I've checked the exports of pdh.dll (via Dependency Walker) in both Windows XP and 7 and I can confirm that PdhAddEnglishCounter is indeed not available in XP.

Quote:

Originally Posted by AAraya

There doesn't seem to be a language-neutral version function among the PDH functions offered to VB developers?

Unfortunately, yes. The good news though, is that PdhAddEnglishCounter plays nicely with the VB PDH* functions, so there's really no need for a VB version.

Quote:

Originally Posted by AAraya

I need a solution which is language-neutral.

I'm guessing you also need a solution that works in XP and later OSs. In that case, the approach I've shown might not be the best choice. Sorry.

Re: Memory usage information about my application

Quote:

You're probably calling it in an OS prior to Vista.

I'm on Win10

The problem was that there is no function exported by the pdh.dll with the name " PdhAddEnglishCounter". Using Dependency Walker as you suggested I was able to see that the correct name is either PdhAddEnglishCounterA or PdhAddEnglishCounterW. Once I made this change, all worked great! Thanks for your help.

Re: Memory usage information about my application

I was able to get the Private Working Set memory size for the currently running process using the PDH API. This can be tweaked to return any performance counter defined on a system. Here's the code:

Code:

Option Explicit '//PDH related declares Private Const ERROR_SUCCESS As Long = &H0 Private Declare Function PdhVbOpenQuery Lib "pdh.dll" (ByRef QueryHandle As Long) As Long Private Declare Function PdhAddEnglishCounterW Lib "pdh.dll" (ByVal QueryHandle As Long, ByVal lpCounterPath As Long, ByVal dwUserData As Long, ByRef CounterHandle As Long) As Long Private Declare Function PdhValidatePathW Lib "pdh.dll" (ByVal lpCounterPath As Long) As Long Private Declare Function PdhCollectQueryData Lib "pdh.dll" (ByVal QueryHandle As Long) As Long Private Declare Function PdhVbGetDoubleCounterValue Lib "pdh.dll" (ByVal CounterHandle As Long, ByRef CounterStatus As Long) As Double Private Declare Function PdhVbIsGoodStatus Lib "pdh.dll" (ByVal StatusValue As Long) As Long Private Declare Function PdhCloseQuery Lib "pdh.dll" (ByVal QueryHandle As Long) As Long '//Process related declares Private Declare Function GetCurrentProcessId Lib "kernel32.dll" () As Long Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal Handle As Long) As Long Private Declare Function GetModuleBaseName Lib "psapi" Alias "GetModuleBaseNameW" (ByVal hProcess As Long, ByVal hModule As Long, ByVal lpBaseName As Long, ByVal nSize As Long) As Long Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As Long) As Long Private Const API_NULL As Long = 0 Private Const PROCESS_QUERY_INFORMATION As Long = 1024 'Required to retrieve certain information about a process, Private Const PROCESS_VM_READ As Long = 16 'Required to read memory in a process using OpenProcess or ReadProcessMemory Private Sub Form_Load() Dim dblWorkingSetPrivateMem As Double dblWorkingSetPrivateMem = GetWorkingSetPrivateMemUsePDH If dblWorkingSetPrivateMem <> 0 Then Dim strWorkingSetPrivateMemFormatted As String strWorkingSetPrivateMemFormatted = FormatNumber(dblWorkingSetPrivateMem / &H100000, 2&) & " MB" MsgBox "Private Working Set: " & strWorkingSetPrivateMemFormatted End If End Sub Private Function GetWorkingSetPrivateMemUsePDH() As Double '//Purpose: Get the Private Working Set memory size using the PDH API '// Private Working Set memory is the value shown by Task Manager for a process ' 'To collect performance data using the PDH functions, perform the following steps. ' '1. Create a query '2. Add counters to the query '3. Collect the performance data '4. Display the performance data '5. Close the query Dim lngRetVal As Long Dim lngQueryHandle As Long Dim strCounterPath As String Dim lngCounterHandle As Long Dim lngCounterStatus As Long Dim dblCounterValue As Double 'init lngQueryHandle = 0 lngCounterHandle = 0 'create and initializes a query object that is used to manage the collection of performance data lngRetVal = PdhVbOpenQuery(lngQueryHandle) '...check return code If lngRetVal <> ERROR_SUCCESS Then GoTo PROC_EXIT End If 'specify a counter path 'format used is: "\"Process"(process name w/out extension)\counter name" Dim strProcessName As String Dim strProcessNameNoExt As String Dim strProcessNameNoExtInParens As String Const PROCESS_TEXT As String = "Process" Const BACKSLASH As String = "\" Const COUNTER_NAME As String = "Working Set - Private" strProcessName = GetCurrentProcessName() strProcessNameNoExt = RemoveExtension(strProcessName) strProcessNameNoExtInParens = EncloseInParenthesis(strProcessNameNoExt) strCounterPath = BACKSLASH & PROCESS_TEXT & strProcessNameNoExtInParens & BACKSLASH & COUNTER_NAME 'validate that the counter exists on this computer lngRetVal = PdhValidatePathW(StrPtr(strCounterPath)) '...check return code If lngRetVal <> ERROR_SUCCESS Then GoTo PROC_EXIT End If 'create a locale-neutral counter entry in the query object lngRetVal = PdhAddEnglishCounterW(lngQueryHandle, StrPtr(strCounterPath), 0&, lngCounterHandle) '...check return code If lngRetVal <> ERROR_SUCCESS Then GoTo PROC_EXIT End If 'Collect the current raw data value for all counters in the specified query 'and update the status code of each counter. lngRetVal = PdhCollectQueryData(lngQueryHandle) '...check return code If lngRetVal <> ERROR_SUCCESS Then GoTo PROC_EXIT End If 'Get the current value of the specified counter as a double-precision floating point value. dblCounterValue = PdhVbGetDoubleCounterValue(lngCounterHandle, lngCounterStatus) '...check Counter status lngRetVal = PdhVbIsGoodStatus(lngCounterStatus) If lngRetVal = 0 Then dblCounterValue = 0 End If PROC_EXIT: If lngQueryHandle <> 0 Then PdhCloseQuery lngQueryHandle End If GetWorkingSetPrivateMemUsePDH = dblCounterValue Exit Function End Function Private Function GetCurrentProcessName() As String Dim lngCurrentProcessID As Long Dim lngAccessRights As Long Dim lngHwndProcess As Long Dim strProcessName As String Dim lngModuleHandle As Long Dim lngRetVal As Long Const MAX_COMPONENT_LEN As Long = 255 'get the ID of the current process (this program) lngCurrentProcessID = GetCurrentProcessId() 'open process object lngAccessRights = PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ lngHwndProcess = OpenProcess(lngAccessRights, 0, lngCurrentProcessID) '...check the return code If lngHwndProcess = 0 Then strProcessName = vbNullString GoTo PROC_EXIT End If 'get the name of the process '...get a module handle needed for GetModuleBaseName '...('If parameter is NULL, GetModuleHandle returns a handle to the file used to create the calling process (.exe file).) lngModuleHandle = GetModuleHandle(API_NULL) '...create a buffer to hold the name Dim strBuffer As String strBuffer = String$(MAX_COMPONENT_LEN, vbNullChar) lngRetVal = GetModuleBaseName(lngHwndProcess, lngModuleHandle, StrPtr(strBuffer), MAX_COMPONENT_LEN) '...check the return code If lngRetVal = 0 Then strProcessName = vbNullString GoTo PROC_EXIT End If strProcessName = Left$(strBuffer, lngRetVal) PROC_EXIT: 'close the process handle If lngHwndProcess <> 0 Then lngRetVal = CloseHandle(lngHwndProcess) End If GetCurrentProcessName = strProcessName End Function Private Function RemoveExtension(ByVal pstrString As String) As String Const DOT_CHAR As String = "." Dim lngDotPosition As Long lngDotPosition = InStrRev(pstrString, DOT_CHAR, -1, vbBinaryCompare) If lngDotPosition <> 0 Then RemoveExtension = Left$(pstrString, lngDotPosition - 1) Else RemoveExtension = pstrString End If End Function Private Function EncloseInParenthesis(ByVal pstrString As String) As String EncloseInParenthesis = "(" & pstrString & ")" End Function

Re: [RESOLVED] Memory usage information about my application

Don't forget the caveat above regarding multiple instances! ;) If your program ensures that there can be only 1 instance running, then there's nothing to modify. Otherwise, if your application allows multiple instances, then you'll have to explicitly specify the instance index of the current process. You can figure out the index by enumerating processes through Process32First/Process32Next.

Re: [RESOLVED] Memory usage information about my application

I needed something like this, so I smartened it up so that it actually works.

It could be streamlined a bit more, as I call GetCurrentProcessName twice, but it works for my purposes.

Personally, I'd be curious to note how much of my 2GB address allowance (without LAA turned on) that I'm using. I'm hoping the following is a close approximation of how much of that I'm using.

Code:

Option Explicit ' Private 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 * 260& End Type ' Private Declare Function PdhVbOpenQuery Lib "pdh.dll" (ByRef QueryHandle As Long) As Long Private Declare Function PdhAddEnglishCounterW Lib "pdh.dll" (ByVal QueryHandle As Long, ByVal lpCounterPath As Long, ByVal dwUserData As Long, ByRef CounterHandle As Long) As Long Private Declare Function PdhValidatePathW Lib "pdh.dll" (ByVal lpCounterPath As Long) As Long Private Declare Function PdhCollectQueryData Lib "pdh.dll" (ByVal QueryHandle As Long) As Long Private Declare Function PdhVbGetDoubleCounterValue Lib "pdh.dll" (ByVal CounterHandle As Long, ByRef CounterStatus As Long) As Double Private Declare Function PdhVbIsGoodStatus Lib "pdh.dll" (ByVal StatusValue As Long) As Long Private Declare Function PdhCloseQuery Lib "pdh.dll" (ByVal QueryHandle As Long) As Long ' Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal Handle As Long) As Long Private Declare Function GetModuleBaseName Lib "psapi" Alias "GetModuleBaseNameW" (ByVal hProcess As Long, ByVal hModule As Long, ByVal lpBaseName As Long, ByVal nSize As Long) As Long Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As Long) As Long Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long ' Private Sub Form_Load() Dim dWorkingSetPrivateMem As Double dWorkingSetPrivateMem = GetPrivateWorkingSetMemUsed If dWorkingSetPrivateMem <> 0# Then MsgBox "Private Working Set: " & FormatNumber(dWorkingSetPrivateMem / &H100000, 2&) & " MB" End Sub Private Function GetPrivateWorkingSetMemUsed() As Double ' Get the Private Working Set memory size using the PDH API. ' Private Working Set memory is the value shown by Task Manager for a process. ' Dim iRet As Long Dim hQuery As Long Dim sPath As String Dim iHandle As Long Dim iStatus As Long ' iRet = PdhVbOpenQuery(hQuery) ' Create and initializes a query object that is used to manage the collection of performance data. If iRet <> 0& Then GoTo GetOut ' sPath = "\Process(" & RemoveExtension(GetCurrentProcessName()) & "#" & Format$(GetCurrentProcessIndex) & ")\Working Set - Private" iRet = PdhValidatePathW(StrPtr(sPath)) ' Validate that the counter exists on this computer. If iRet <> 0& Then GoTo GetOut ' iRet = PdhAddEnglishCounterW(hQuery, StrPtr(sPath), 0&, iHandle) ' Create a locale-neutral counter entry in the query object. If iRet <> 0& Then GoTo GetOut ' iRet = PdhCollectQueryData(hQuery) ' Collect the current raw data value for all counters in the specified query and update the status code of each counter. If iRet <> 0& Then GoTo GetOut ' GetPrivateWorkingSetMemUsed = PdhVbGetDoubleCounterValue(iHandle, iStatus) ' Get the current value of the specified counter as a double-precision floating point value. iRet = PdhVbIsGoodStatus(iStatus) If iRet = 0& Then GetPrivateWorkingSetMemUsed = 0# ' GetOut: If hQuery <> 0& Then PdhCloseQuery hQuery End Function Private Function GetCurrentProcessName() As String Dim iProcessID As Long Dim iRights As Long Dim hProcess As Long Dim sName As String Dim hModule As Long Dim iRet As Long Dim sBuf As String ' Const MAX_COMPONENT_LEN As Long = 255& Const PROCESS_QUERY_INFORMATION As Long = 1024& ' Required to retrieve certain information about a process, Const PROCESS_VM_READ As Long = 16& ' Required to read memory in a process using OpenProcess or ReadProcessMemory ' iProcessID = GetCurrentProcessId() ' Get the ID of the current process (this program). iRights = PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ ' Open process object. hProcess = OpenProcess(iRights, 0, iProcessID) If hProcess = 0& Then GoTo GetOut ' hModule = GetModuleHandle(0&) ' If parameter is 0, GetModuleHandle returns a handle to the file used to create the calling process (.exe file). sBuf = String$(MAX_COMPONENT_LEN, vbNullChar) ' Create a buffer to hold the name. iRet = GetModuleBaseName(hProcess, hModule, StrPtr(sBuf), MAX_COMPONENT_LEN) If iRet = 0& Then GoTo GetOut ' GetCurrentProcessName = Left$(sBuf, iRet) ' GetOut: If hProcess <> 0& Then iRet = CloseHandle(hProcess) End Function Private Function GetCurrentProcessIndex() As Long Dim iProcessID As Long Dim sProcessName As String Dim iIndex As Long Dim iRet As Long ' Dim hSnapShot As Long Dim uProcess As PROCESSENTRY32 ' Const TH32CS_SNAPPROCESS As Long = 2& ' GetCurrentProcessIndex = -1& iProcessID = GetCurrentProcessId() ' Get the ID of the current process (this program). sProcessName = LCase$(GetCurrentProcessName()) ' hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&) If hSnapShot = -1& Then GoTo GetOut ' uProcess.dwSize = Len(uProcess) iRet = ProcessFirst(hSnapShot, uProcess) If iRet <> 1& Then GoTo GetOut ' Do If LCase$(Left$(uProcess.szExeFile, InStr(uProcess.szExeFile, Chr$(0&)) - 1&)) = sProcessName Then GetCurrentProcessIndex = GetCurrentProcessIndex + 1& If uProcess.th32ProcessID = iProcessID Then Exit Do End If iRet = ProcessNext(hSnapShot, uProcess) If iRet = 0& Then GetCurrentProcessIndex = -1& Exit Do End If Loop ' GetOut: If hSnapShot <> 0& Then iRet = CloseHandle(hSnapShot) End Function Private Function RemoveExtension(ByVal s As String) As String Dim iPos As Long iPos = InStrRev(s, ".") If iPos <> 0& Then RemoveExtension = Left$(s, iPos - 1&) Else RemoveExtension = s End Function

Re: [RESOLVED] Memory usage information about my application

Quote:

Originally Posted by Elroy

It could be streamlined a bit more, as I call GetCurrentProcessName twice, but it works for my purposes.

You don't have to make function calls to get the EXE file name. It's in App.EXEName. In the IDE, it returns the project name. In an EXE, it returns the base EXE file name without ".exe", like "Project1".

Re: [RESOLVED] Memory usage information about my application

Quote:

Originally Posted by qvb6

You don't have to make function calls to get the EXE file name. It's in App.EXEName. In the IDE, it returns the project name. In an EXE, it returns the base EXE file name without ".exe", like "Project1".

Yeah, once compiled, you're right.

However, to do this from the IDE, you've got to get the VB6.exe name, not the project's name.

Re: [RESOLVED] Memory usage information about my application

It could be great to find a way to track memory leaks.

I have 2 applications where I know there is at least 1 memory leak, but I tried to find it, and no way :(
I spent hundred of hours, but no way to find the memory leak :(
I have some doubt on one control, but not sure

Re: [RESOLVED] Memory usage information about my application

Quote:

Originally Posted by Thierry69

It could be great to find a way to track memory leaks.

I have 2 applications where I know there is at least 1 memory leak, but I tried to find it, and no way :(
I spent hundred of hours, but no way to find the memory leak :(
I have some doubt on one control, but not sure

You are actually after private bytes. Working set is just the portion of the memory of your process that is currently resident. You will need to get your current process id. Leaks will show up in private bytes.

This will get you started and is very simple. Returns handle count and private bytes which are the two common leaks. Wont tell you where a leak is but it will help.

Code:

Public Function tcpAgentgetPerfmonHandles(handleCount As Long, privateBytes As Double) 10 On Error GoTo errorHandler Dim myProcessId As Long Dim objWmiProcess As Object Dim wmiQuery As String Dim Process As Object Dim colProcesses As Object 20 myProcessId = GetCurrentProcessId 30 Set objWmiProcess = CreateObject("winmgmts:\\" & ".") 40 wmiQuery = "Select * from Win32_PerfRawData_PerfProc_Process where IDProcess = " + CStr(myProcessId) 50 Set colProcesses = objWmiProcess.ExecQuery(wmiQuery, , 48) 60 For Each Process In colProcesses 70 handleCount = Process.handleCount 80 privateBytes = Process.privateBytes 90 Next Process 100 Set colProcesses = Nothing 110 Set objWmiProcess = Nothing 120 Exit Function errorHandler: 130 errorDisplay Err.description, "tcpAgentGetPermonHandles", Erl 140 Set colProcesses = Nothing 150 Set objWmiProcess = Nothing 160 Resume endofitall endofitall: End Function

Re: [RESOLVED] Memory usage information about my application

Good to test.
Just tried it, but I think it should be compiled :)
I'll compile and test it

Re: [RESOLVED] Memory usage information about my application

vbwins:
I tried to implement your example;
Fails with:

Quote:

ActiveX Component Can't Create Object

Code:

30 Set objWmiProcess = CreateObject("winmgmts:\\" & ".")

Always used GetObject for WMI.
But so far searching for the moniker to run SQL after line 30 hasn't yielded much.

Finally found this:
https://wutils.com/wmi/root/cimv2/wi...fproc_process/

Any suggestions?

Re: [RESOLVED] Memory usage information about my application

Quote:

Originally Posted by Thierry69

It could be great to find a way to track memory leaks.

I have 2 applications where I know there is at least 1 memory leak, but I tried to find it, and no way :(
I spent hundred of hours, but no way to find the memory leak :(
I have some doubt on one control, but not sure

I've used two different tools to help with this problem: C++ Memory Validator and GlowCode.

Re: [RESOLVED] Memory usage information about my application

Thanks, I'll give a look.

Re: [RESOLVED] Memory usage information about my application

Quote:

Originally Posted by Thierry69

Thanks, I'll give a look.

I should have changed up the order of those two suggestions as I've found GlowCode to be much more effective for me. I was also able to get a large discount from them since they longer actively support VB6. Can't guarantee that they'll offer you the same but no harm asking them.

Re: [RESOLVED] Memory usage information about my application

I'm having a problem with PdhVbGetOneCounterPath, it always returns zero and m_sCounterPath is always filled with char(0) instead of what I selected. (I'm using Windows 10)

I tried PdhCreateCounterPathList, but the dialog won't go away when I click OK