Code: Select all
EnableExplicit
#programName = "MeasureMemoryInThreads.pb"
Prototype.l GetProcessMemoryInfo(hProcess.l, *p, cb.l)
Global Dim thisEvent.i(99)
Define result.i
Define msgText.s
Define psApiDLL.i
Define threadIndex.i
Define threadNumber.i
Define memoryInUseMB.f
Define GetProcessMemoryInfo.GetProcessMemoryInfo
Define p.PROCESS_MEMORY_COUNTERS
psApiDLL = OpenLibrary(#PB_Any, "PSAPI.DLL")
If psApiDLL > 0
GetProcessMemoryInfo = GetFunction(psApiDLL, "GetProcessMemoryInfo")
Else
MessageRequester(#programName, "Unable to open PSAPI.DLL")
End
EndIf
Procedure.i NewThread(threadNumber.i)
WaitForSingleObject_(thisEvent(threadNumber), #INFINITE)
EndProcedure
Repeat
GetProcessMemoryInfo(GetCurrentProcess_(), @p, SizeOf(PROCESS_MEMORY_COUNTERS))
memoryInUseMB = (p\WorkingSetSize + p\PagefileUsage) / 1048576
If msgText > ""
msgText + #LF$
EndIf
msgText + "With " + Str(threadNumber) + " threads, memory use = " + StrF(memoryInUseMB, 2) + " MBytes"
result = MessageRequester(#programName, msgText + #LF$ + #LF$ + "Continue?", #PB_MessageRequester_YesNo)
If result = #PB_MessageRequester_No
For threadIndex=1 To threadNumber
SetEvent_(thisEvent(threadIndex))
Delay(50)
Next
Break
EndIf
threadNumber + 1
If threadNumber > 99
MessageRequester(#programName, "Maximum number of threads reached, press <enter> to end")
Break
EndIf
thisEvent(threadNumber) = CreateEvent_(0, 0, 0, #ProgramName + "_Event_" + Str(threadNumber))
CreateThread(@NewThread(), threadNumber)
Delay(50)
ForEver
End