posted January 13, 2004 07:35 AM            

 
 
' FILE : Process_memoryInfo.INC
' File to be #INCLUDEd in programs to get memory usage info about the current process
'  =================================================================================================
' returns: TRUE: S has CRLF delimited process memory info, FALSE S contains message why it doesn't
' FUNCTION GetProcessMemoryStatistics (S AS STRING) AS LONG
' -------------------------------------------------------------------------------------------------
' -------------------------------------------------------------------------------------------------
' PSAPI header conversions Courtesy: Jose Roca 11/2002 at
' http://www.powerbasic.com/support/forums/Forum7/HTML/001630.html 
' The PSAPI functions are only supported on platform 5 machines. THis code detects OS and acts accordingly
' This file contains only the DECLARES, UDTs and functions necessary to
' support the GetProcessMemoryInfo function
' 1/11/04
' Michael Mattias Racine WI
' Placed in public domain by author 1/12/04
' Tested OK on Win/98 1/11/04 (not that that is a terribly useful test.)
' Tested by others on other OS; See http://www.powerbasic.com/support/forums/Forum6/HTML/003994.html 
' Compiler       PB/Windows v 7.02
' Win32API.INC   May 9 2002

' STRUCTURE RETURNED BY GetProcessMemoryInfo
'  The "WorkingSetSize" members are the best indicator of a process' total memory usage.
'
TYPE W_PROCESS_MEMORY_COUNTERS
   cb                         AS DWORD   '// Size of the structure, in bytes.
   PageFaultCount             AS DWORD   '// Number of page faults.
   PeakWorkingSetSize         AS DWORD   '// Peak working set size.
   WorkingSetSize             AS DWORD   '// Current working set size.
   QuotaPeakPagedPoolUsage    AS DWORD   '// Peak paged pool usage.
   QuotaPagedPoolUsage        AS DWORD   '// Current paged pool usage.
   QuotaPeakNonPagedPoolUsage AS DWORD   '// Peak nonpaged pool usage.
   QuotaNonPagedPoolUsage     AS DWORD   '// Current nonpaged pool usage.
   PagefileUsage              AS DWORD   '// Current space allocated for the pagefile.
                                         '// Those pages may or may not be in memory.
   PeakPagefileUsage          AS DWORD   '// Peak space allocated for the pagefile.
END TYPE

#IF 0
' DECLARE FOR GetProcessMemoryInfo. Note this DECLARE is not used in this file, it
' is supplied only for reference.
DECLARE FUNCTION GetProcessMemoryInfo LIB "PSAPI.DLL" ALIAS "GetProcessMemoryInfo" ( _
        BYVAL hProcess        AS DWORD, _
              ppsmemCounters  AS PROCESS_MEMORY_COUNTERS, _
        BYVAL cb              AS DWORD _
) AS LONG
#ENDIF
' DECLARE FOR USE WITH CALL DWORD IN THIS INCLUDE FILE
DECLARE FUNCTION W_GetProcessMemoryInfo _
      ( BYVAL             hProcess AS DWORD, _
        ppsmemCounters             AS W_PROCESS_MEMORY_COUNTERS, _
        BYVAL             cb       AS DWORD _
      ) AS LONG

#IF NOT %DEF(%WINAPI)
  #INCLUDE "WIN32API.INC"
#ENDIF
$PSAPI_LIBNAME               =   "PSAPI.DLL"
$PSAPI_GETPROCESSMEMORYINFO  = "GetProcessMemoryInfo"
TYPE FormatWPMCType
    Statistic       AS STRING *  40
    Value           AS STRING *  16
    eol             AS STRING *   2   ' end of line
END TYPE

FUNCTION Formatted_WPMC (WPMC AS W_PROCESS_MEMORY_COUNTERS) AS STRING
    LOCAL w AS STRING, mask AS STRING, FW AS FormatWpmcType
    mask   = "* #,"      ' format for integers
    w      = ""
    FW.Eol               =  $CR & $LF           ' or $CRLF if sufficient compiler version
    LSET FW.Statistic    = "Page Fault Count"
    RSET FW.Value        =  FORMAT$(WPMC.PageFaultCount, mask)
    w                    =  w & PEEK$(VARPTR(FW), SIZEOF(FW))
    LSET FW.Statistic    =  "Peak Working Set Size"
    RSET FW.Value        =  FORMAT$(WPMC.PeakWorkingSetSize, mask)
    w                    =  w & PEEK$(VARPTR(FW), SIZEOF(FW))
    LSET FW.Statistic    =  "Current Working Set Size"
    RSET FW.Value        =  FORMAT$(WPMC.WorkingSetSize, mask)
    w                    =  w & PEEK$(VARPTR(FW), SIZEOF(FW))
    LSET FW.Statistic    =  "Quota Peak Paged Pool Usage"
    RSET FW.Value        =  FORMAT$(WPMC.QuotaPeakPagedPoolUsage, mask)
    w                    =  w & PEEK$(VARPTR(FW), SIZEOF(FW))
    LSET FW.Statistic    =  "Current Quota Paged Pool Usage"
    RSET FW.Value        =  FORMAT$(WPMC.QuotaPagedPoolUsage, mask)
    w                    =  w & PEEK$(VARPTR(FW), SIZEOF(FW))
    LSET FW.Statistic    =  "Quota Peak Non-Paged Pool Usage"
    RSET FW.Value        =  FORMAT$(WPMC.QuotaPeakNonPagedPoolUsage, mask)
    w                    =  w & PEEK$(VARPTR(FW), SIZEOF(FW))
    LSET FW.Statistic    =  "Current Quota Non-Paged Pool Usage"
    RSET FW.Value        =  FORMAT$(WPMC.QuotaNonPagedPoolUsage, mask)
    w                    =  w & PEEK$(VARPTR(FW), SIZEOF(FW))
    LSET FW.Statistic    =  "Peak Page File Usage"
    RSET FW.Value        =  FORMAT$(WPMC.PeakPageFileUsage, mask)
    w                    =  w & PEEK$(VARPTR(FW), SIZEOF(FW))
    LSET FW.Statistic    =  "Current Page File Usage"
    RSET FW.Value        =  FORMAT$(WPMC.PageFileUsage, mask)
    w                    =  w & PEEK$(VARPTR(FW), SIZEOF(FW))
    FUNCTION             =  RTRIM$(W, ANY CHR$(13,10))   'remove trailing CRLF
END FUNCTION

' MAIN CALLED FUNCTION
' returns: TRUE: S has CRLF delimited process memory info, FALSE S contains messages why it doesn't
FUNCTION GetProcessMemoryStatistics (S AS STRING) AS LONG
    LOCAL hProcess AS DWORD,  lret AS LONG, cb AS LONG, isP5 AS LONG
    LOCAL WPMC     AS W_PROCESS_MEMORY_COUNTERS
    LOCAL OSV AS OSVERSIONINFO
    LOCAL szLibName    AS ASCIIZ * %MAX_PATH, szProcName AS ASCIIZ * %MAX_PATH
    LOCAL hLIB         AS LONG,  dwAddr AS DWORD
    FUNCTION                  =  %FALSE         ' don't set to true until we have the info
    s                         = ""
    ' get the OS Version and decide if we are on a platform 5 machine
    OSV.dwOsVersionInfoSize   =  SIZEOF(OSV)
    lRet                      =  GetVersionEx (OSV)
    IF ISTRUE lRet THEN
        IsP5                  =  (OSV.dwPlatformID  = %VER_PLATFORM_WIN32_NT)
    ELSE
        S = "Can't get operating system version.. this is really bad!"
        EXIT FUNCTION
    END IF
    ' if this is a platform 5 machine..
    ' Lie about OS for test on Win/98, should return unable to load library, it does.
    ' isP5     = %TRUE
    IF ISTRUE  isP5 THEN
        ' Get the address of the function in PSAPI.DLL
        szLibName      = $PSAPI_LIBNAME
        szProcName     = $PSAPI_GETPROCESSMEMORYINFO
        hLib           = LoadLibrary (szLibName)
        IF ISTRUE  hLIB THEN
            dwAddr     =  GetProcAddress (hLib, szProcName)
            IF ISTRUE dwAddr THEN
                hProcess      = GetCurrentProcess
                cb            = SIZEOF(WPMC)
                ' call the function
                CALL DWORD dwAddr USING W_GetProcessMemoryInfo (hPRocess, WPMC,cb) TO lret
                IF ISTRUE lret THEN     ' function succeeded, format the WPMC structure
                    S     = Formatted_WPMC (WPMC)
                    FUNCTION   = %TRUE
                ELSE
                    S     = "GetProcessMemoryInfoFailed"
                END IF
            ELSE
                S         = "Can't Get Address for " & szProcName
            END IF
            FreeLibrary      hLib
        ELSE
            S             = "Can't load library " & szLibName
        END IF
     ELSE
            s             = "Process Memory Information N/A on this operating system."
            #IF 0
            ' for test of formatting only on Win 9x..
            WPMC.PageFaultCount              = 1234567890
            WPMC.PeakWorkingSetSize          = 1234567891
            WPMC.WorkingSetSize              = 1234567892
            WPMC.QuotaPeakPagedPoolUsage     = 1234567893
            WPMC.QuotaPagedPoolUsage         = 1234567894
            WPMC.QuotaPeakNonPagedPoolUsage  = 1234567895
            WPMC.QuotaNonPagedPoolUsage      = 1234567896
            WPMC.PeakPageFileUsage           = 1234567897
            WPMC.PageFileUsage               = 1234567898
            s             = Formatted_WPMC (WPMC)
            #ENDIF
     END IF

END FUNCTION
' // END OF FILE 

 
' FILE : Process_memoryInfo.bas
' Demo of Function GetProcessMemoryStatistics in #INCLUDE file process_memoryinfo.inc
' Author: Michael Mattias Racine WI    1-12-04
' Usage:  Placed in public domain by author 1-13-04
' compiler:      PB/Windows v 7.02
' Win32API.INC   May 9 2002  (Called in by #INCLUDE file if not already included)
' tested on:     Windows/98, Windows 2000, Windows XP
#COMPILE      EXE
#DEBUG        ERROR ON
#REGISTER     NONE
#TOOLS        OFF
#DIM          ALL

#INCLUDE  "WIN32API.INC"
#INCLUDE "process_memoryinfo.inc"
' Contains: FUNCTION GetProcessMemoryStatistics (S AS STRING) AS LONG
' returns: TRUE: S has CRLF delimited process memory info, FALSE S contains message why it doesn't
FUNCTION PBMAIN () AS LONG
  LOCAL s AS STRING, l AS LONG, Z() AS STRING * 1024
  LOCAL hFile AS LONG, szFile AS ASCIIZ * %MAX_PATH
  LOCAL pID   AS DWORD, sBuff AS STRING
  
  
    szFile    = "Process_memory_Statistics.txt"
    
    hFile    = FREEFILE
    OPEN       szFile  FOR OUTPUT AS hFile
    PID      = GetCurrentProcessID
    sBUff    = "Process Memory Statistics for Process ID " & STR$(PID) & " on " & DATE$ & " at " & TIME$
    PRINT      #hFile, sBUff
    PRINT      #hFile,
    
    
  ' allocate   50 mb of memory and get statistics..
    REDIM       Z (50 * 1024)
    L        = GetProcessMemoryStatistics (s)
    
    sBUff    = "Process Memory Statistics with Array Allocated"
    PRINT #hFile, sBuff
    PRINT #hFile, s
    PRINT #hFile,
    
    
  ' De-allocate the memory...
    ERASE Z()
  ' ... and get 'end of job' statistics.
  ' We should see 'peak' numbers much less than 'current' numbers
  ' (and somewhere approximately 50 Mb of difference)
    L        = GetProcessMemoryStatistics (s)
    sBUff    = "Process Memory Statistics with Array De-Allocated"
    PRINT #hFile, sBuff
    PRINT #hFile, s
    PRINT #hFile,
    sBuff    = "END OF REPORT"
    PRINT #hFile, sBuff
    
    CLOSE hFile
    
    PID = SHELLExecute (GetDesktopWindow, "open", szFile, BYVAL %NULL, BYVAL %NULL, %SW_SHOW)
    
END FUNCTION
' // END OF FILE