VB Forum / Win API / February 2007

Hi
Background:
I have a VB 6 app that calls the GetSystemInfo to locate the memory
addresses utilized by the app.  I then use the addresses to determine where
to read memory useage.  When I check the memory COM gets a chance to free
memory and doesn't continue adding memory useage to the point where the
computer is thrashing memory to disk rather than performming the work it
should.  A cycle for this app should be less than 15 seconds for a slow
process and the computer could slow down to the point where it would take
over a minute.

Problem:
I now have a site where the call to GetSystemInfo returns normal values
except for the MaximumApplicationAddress, which returns a negative number.  
Since the max address is used for the upper limit of addresses to check, it
doesn't check any and returns 0 for the total memory use.

Can anyone think of a solution?

Code below:
Public lngMemoryStart      As Long
Public objRestartLog       As Log

Type MEMORY_BASIC_INFORMATION ' 28 bytes
   BaseAddress As Long
   AllocationBase As Long
   AllocationProtect As Long
   RegionSize As Long
   State As Long
   Protect As Long
   lType As Long
End Type

Declare Function VirtualQuery Lib "kernel32" (ByVal lpAddress As Long,
lpBuffer As _
   MEMORY_BASIC_INFORMATION, ByVal dwLength As Long) As Long

Type SYSTEM_INFO ' 36 Bytes
   dwOemID As Long
   dwPageSize As Long
   lpMinimumApplicationAddress As Long
   lpMaximumApplicationAddress As Long
   dwActiveProcessorMask As Long
   dwNumberOrfProcessors As Long
   dwProcessorType As Long
   dwAllocationGranularity As Long
   wProcessorLevel As Integer
   wProcessorRevision As Integer
End Type

Const MEM_PRIVATE& = &H20000
Const MEM_COMMIT& = &H1000

Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)

'**************************************************
' Name: Process memory usage
' Description:Sometimes, it's useful to
'     know how much memory your program uses.
'
' Inputs:None
'
' Returns:GetProcessPrivateBytes() returns
'     the number of bytes used by the current
'     process. Returns -1 if there was a problem.
'
'**************************************************

Function GetProcessPrivateBytes() As Long
   ' returns -1 if function fails, number of
   '     bytes used by current process otherwise
   Dim lpMem As Long ' memory pointer
   Dim lPrivateBytes As Long 'total bytes used so far
   Dim ret As Long ' API return code
   Dim si As SYSTEM_INFO ' used to find out address range used my this
process
   Dim mbi As MEMORY_BASIC_INFORMATION ' memory block status
   Dim lLenMbi As Long
   Dim lPos As Long
   
   On Error GoTo ET
   
   GetProcessPrivateBytes = -1 ' default to failure
   lLenMbi = Len(mbi) ' number of bytes in MEMORY_BASIC_INFORMATION structure
   Call GetSystemInfo(si) ' find the address range used by this process
   
   If blnShowMemoryCalculations Then
     WriteToDebugLog "In GetProcessPrivateBytes" & vbCrLf & _
                     "***********" & vbCrLf & _
                     "SYSTEM_INFO" & vbCrLf & _
                     "***********" & vbCrLf & _
                     "dwOemID: " & si.dwOemID & vbCrLf & _
                     "dwPageSize: " & si.dwPageSize & vbCrLf & _
                     "lpMinimumApplicationAddress: " & _
                     si.lpMinimumApplicationAddress & vbCrLf & _
                     "lpMaximumApplicationAddress: " & _
                     si.lpMaximumApplicationAddress & vbCrLf & _
                     "dwActiveProcessorMask: " & _
                     si.dwActiveProcessorMask & vbCrLf & _
                     "dwNumberOrfProcessors: " & _
                     si.dwNumberOrfProcessors & vbCrLf & _
                     "dwProcessorType: " & _
                     si.dwProcessorType & vbCrLf & _
                     "dwAllocationGranularity: " & _
                     si.dwAllocationGranularity & vbCrLf & _
                     "wProcessorLevel: " & _
                     si.wProcessorLevel & vbCrLf & _
                     "wProcessorRevision: " & _
                     si.wProcessorRevision
   End If
   
   
   lpMem = si.lpMinimumApplicationAddress
       
   While lpMem < si.lpMaximumApplicationAddress
       mbi.RegionSize = 0
       ret = VirtualQuery(lpMem, mbi, lLenMbi)
       
       If ret = lLenMbi Then
           If ((mbi.lType = MEM_PRIVATE) And (mbi.State = MEM_COMMIT)) Then
               ' this block is in use by this process
               lPrivateBytes = lPrivateBytes + mbi.RegionSize
               If blnShowMemoryCalculations Then
                   WriteToDebugLog "In GetProcessPrivateBytes" & vbCrLf & _
                                   "************************" & vbCrLf & _
                                   "MEMORY_BASIC_INFORMATION" & vbCrLf & _
                                   "************************" & vbCrLf & _
                                   "BaseAddress: " & mbi.BaseAddress &
vbCrLf & _
                                   "AllocationBase: " & mbi.AllocationBase
& vbCrLf & _
                                   "AllocationProtect: " &
mbi.AllocationProtect & vbCrLf & _
                                   "RegionSize: " & mbi.RegionSize & vbCrLf
& _
                                   "State: " & mbi.State & vbCrLf & _
                                   "Protect: " & mbi.Protect & vbCrLf & _
                                   "lType: " & mbi.lType & vbCrLf & _
                                   "ret: " & ret & vbCrLf & _
                                   "lLenMbi: " & lLenMbi & vbCrLf & _
                                   "lPrivateBytes: " & lPrivateBytes
               End If
           End If
           lpMem = mbi.BaseAddress + mbi.RegionSize
       Else ' function failed
           Exit Function ' abort now
       End If
   Wend
Finished:
   GetProcessPrivateBytes = lPrivateBytes
   If blnShowMemoryCalculations Then
       WriteToDebugLog "In GetProcessPrivateBytes" & vbCrLf & _
                       "Return value: " & GetProcessPrivateBytes & " Bytes."
   End If
   Exit Function
ET:
   GetProcessPrivateBytes = lPrivateBytes
   End If
   Err.Clear
End Function

Any and all help will be appreciated.
Thanks