Max CPU & Memory

[ksutton]

I need a quick little app to max out my cpu and memory for short periods of time (1-5 minutes).

I would like to schedule this to run several times a day on an idle box to test out a possible hardware problem.

What can I do to consume all availale memory and CPU cycles without crashing the machine?

Thanks!

[kedaman]

Private Type MEMORYSTATUS
        dwLength As Long
        dwMemoryLoad As Long
        dwTotalPhys As Long
        dwAvailPhys As Long
        dwTotalPageFile As Long
        dwAvailPageFile As Long
        dwTotalVirtual As Long
        dwAvailVirtual As Long
End Type
Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
Declare Function GetTickCount Lib "kernel32" () As Long

Sub MAXout(Dealy As Long)
    Dim t As Long, temp As MEMORYSTATUS, buffer() As Byte, freemem As Long
    
    t = GetTickCount
    Do Until GetTickCount > t + Dealy
        GlobalMemoryStatus temp
        freemem = temp.dwAvailPhys
        If freemem Then
            ReDim buffer(UBound(buffer) + freemem)
        End If
    Loop
    
End Sub

Well here's some code i just made for you, haven't tested but should max out both cpu usage and memory + will refill the memory if it's freed from another app. I'm not sure how the consequences will be if your system starts to free memory and swap stuff, it may be catastrofal, so be cautious and start with small amount of time, specify it in dealy as milliseconds. Also if this is a problem, have a small amount of memory free all the time, by changing this line:
ReDim buffer(UBound(buffer) + freemem)
to for instance:
ReDim buffer(UBound(buffer) + freemem - 32768)

[ksutton]

What would be the best way to create some hard disk activity? Should I just do random reads & writes?

[kedaman]

No don't do any random stuff, Create a temporary file of say 1M and read the contents into a byte array, then put it back, over and over again, well not hard at all.

Dim Buffer() as byte
Open "C:\Temp" For Binary As #1
   Redim Buffer(1048575)
   Do
       Put#1,,Buffer
       Get#1,,Buffer
   Loop While (Youdecidetoquit
Close #1

[ksutton]

Thank you kindly for your help!!! Not much left for me to do!

[ksutton]

I am getting a Subscript out of Range for the first snippet of code at:
ReDim buffer(UBound(buffer) + freemem)

Any ideas?

Thanks!

[kedaman]

place this line
ReDim buffer(0)
before
t = GetTickCount

Sorry about the bug You can't always be perfect

[ksutton]

Ran perfectly for about 45 seconds. Now it throws an "Out of Memory Error."

In Task manager, the CPU maxed out at 100%. The memory never got above 50% (I currently have 512MB). Since the first error, it now throws it immediately on the following line:
ReDim buffer(UBound(buffer) + freemem - 32768)

Thanks for your QUICK replies!!!!

Any ideas?

[kedaman]

damn, 512M!!! that's a bit too much, you could try to fill up empty space in different arrays.