A process has limited resources available.
They can be of several kinds, here we cover GDI objects, RAM and Disk.
If your program must be able to handle, or at least not to crash with huge amounts of data, you'll probably will need to check resources to see if you can safely do something, or decide to use files over variables, or whatever.
The normal GDI object limit is of 10000. Each font, bitmap, pen, brush, metafile, etc consume GDI handles.
The actual value of GDI the handles limit can be found on the registry key
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Windows\GDIProcessHandleQuota
About the RAM memory, a 32 bits process can use as much as 2 GB.
And the disk, is the free space on the system unit.
Here are the functions:
HTH.
They can be of several kinds, here we cover GDI objects, RAM and Disk.
If your program must be able to handle, or at least not to crash with huge amounts of data, you'll probably will need to check resources to see if you can safely do something, or decide to use files over variables, or whatever.
The normal GDI object limit is of 10000. Each font, bitmap, pen, brush, metafile, etc consume GDI handles.
The actual value of GDI the handles limit can be found on the registry key
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Windows\GDIProcessHandleQuota
About the RAM memory, a 32 bits process can use as much as 2 GB.
And the disk, is the free space on the system unit.
Here are the functions:
Code:
Private Declare Function GetDiskFreeSpaceEx Lib "kernel32" Alias "GetDiskFreeSpaceExA" (ByVal lpRootPathName As String, lpFreeBytesAvailableToCaller As Currency, lpTotalNumberOfBytes As Currency, lpTotalNumberOfFreeBytes As Currency) As Long
Private Type PROCESS_MEMORY_COUNTERS_EX
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
PrivateUsage As Long
End Type
Private Declare Function GetProcessMemoryInfo Lib "PSAPI.DLL" (ByVal hProcess As Long, ppsmemCounters As PROCESS_MEMORY_COUNTERS_EX, ByVal cb As Long) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetGuiResources Lib "user32.dll" (ByVal hProcess As Long, ByVal uiFlags As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () 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 CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Public Function FolderExists(ByVal nFolderPath As String) As Boolean
On Error Resume Next
FolderExists = (GetAttr(nFolderPath) And vbDirectory) = vbDirectory
Err.Clear
End Function
Public Function GetTempFolder() As String
Dim lChar As Long
Static sValue As String
If sValue = "" Then
sValue = String$(255, 0)
lChar = GetTempPath(255, sValue)
sValue = Left$(sValue, lChar)
If Right$(sValue, 1) <> "\" Then sValue = sValue & "\"
End If
GetTempFolder = sValue
End Function
Public Function GetProcessTempPath() As String
Static sValue As String
If sValue = "" Then
sValue = GetTempFolder & "BSP_temp" & CStr(GetCurrentProcessId)
If Right$(sValue, 1) <> "\" Then sValue = sValue & "\"
If Not FolderExists(sValue) Then
MkDir sValue
End If
End If
GetProcessTempPath = sValue
End Function
Public Function GDIResourcesLow() As Boolean
Static sMaxGDIObjects As Long
Const GR_GDIOBJECTS = 0
Const HKEY_LOCAL_MACHINE = &H80000002
Dim iGDICount As Long
If sMaxGDIObjects = 0 Then
sMaxGDIObjects = QueryRegValue(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Windows", "GDIProcessHandleQuota")
If sMaxGDIObjects = 0 Then
sMaxGDIObjects = 9000
Else
sMaxGDIObjects = sMaxGDIObjects - 1000
End If
If sMaxGDIObjects < 100 Then sMaxGDIObjects = 100
End If
iGDICount = GetGuiResources(GetCurrentProcess, GR_GDIOBJECTS)
GDIResourcesLow = (iGDICount >= sMaxGDIObjects)
End Function
Public Function GDIResourcesCritical() As Boolean
Static sMaxGDIObjects As Long
Const GR_GDIOBJECTS = 0
Const HKEY_LOCAL_MACHINE = &H80000002
Dim iGDICount As Long
If sMaxGDIObjects = 0 Then
sMaxGDIObjects = QueryRegValue(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Windows", "GDIProcessHandleQuota")
If sMaxGDIObjects = 0 Then
sMaxGDIObjects = 9500
Else
sMaxGDIObjects = sMaxGDIObjects - 500
End If
If sMaxGDIObjects < 150 Then sMaxGDIObjects = 150
End If
iGDICount = GetGuiResources(GetCurrentProcess, GR_GDIOBJECTS)
GDIResourcesCritical = (iGDICount >= sMaxGDIObjects)
End Function
Public Function GetGDIUsedObjectsCount() As Long
Const GR_GDIOBJECTS = 0
GetGDIUsedObjectsCount = GetGuiResources(GetCurrentProcess, GR_GDIOBJECTS)
End Function
Public Function FreeMemoryAvailableIsLow() As Boolean
Dim pmc As PROCESS_MEMORY_COUNTERS_EX
Dim iProcessHandle As Long
Dim LRet As Long
Const PROCESS_QUERY_INFORMATION = 1024
Const PROCESS_VM_READ = 16
iProcessHandle = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, GetCurrentProcessId)
If iProcessHandle = 0 Then Exit Function
pmc.cb = LenB(pmc)
LRet = GetProcessMemoryInfo(iProcessHandle, pmc, pmc.cb)
If LRet = 0 Then Exit Function
FreeMemoryAvailableIsLow = pmc.WorkingSetSize > 1600000000
LRet = CloseHandle(iProcessHandle)
End Function
Public Function FreeMemoryAvailableIsCritical() As Boolean
Dim pmc As PROCESS_MEMORY_COUNTERS_EX
Dim iProcessHandle As Long
Dim LRet As Long
Const PROCESS_QUERY_INFORMATION = 1024
Const PROCESS_VM_READ = 16
iProcessHandle = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, GetCurrentProcessId)
If iProcessHandle = 0 Then Exit Function
pmc.cb = LenB(pmc)
LRet = GetProcessMemoryInfo(iProcessHandle, pmc, pmc.cb)
If LRet = 0 Then Exit Function
FreeMemoryAvailableIsCritical = pmc.WorkingSetSize > 1700000000
LRet = CloseHandle(iProcessHandle)
End Function
Public Function FreeDiscSpaceIsCritical() As Boolean
Dim BytesFreeToCalller As Currency, TotalBytes As Currency
Dim TotalFreeBytes As Currency, TotalBytesUsed As Currency
If GetDiskFreeSpaceEx(GetTempFolder, BytesFreeToCalller, TotalBytes, TotalFreeBytes) Then
FreeDiscSpaceIsCritical = (CCur(100) * BytesFreeToCalller \ TotalBytes < 1)
End If
End Function