Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- ; ########################################## Dokumentation ##########################################
- ;
- ;
- ;
- ;
- ;
- ;
- ;
- ; ########################################## Variablen ##########################################
- Structure Main
- Quit.a
- EndStructure
- Global Main.Main
- Structure Window_Main
- ID.i
- Width.u
- Height.u
- Bytes_Per_Pixel.d
- Image.i
- Image_ID.i
- EndStructure
- Global Window_Main.Window_Main
- Structure Heap_Entry
- *Pointer
- Size.l
- Region_Index.a
- EndStructure
- Global NewList Heap_Entry.Heap_Entry()
- Structure PROCESS_HEAP_ENTRY_BLOCK
- *hMem
- dwReserved.l [3]
- EndStructure
- Structure PROCESS_HEAP_ENTRY_REGION
- dwCommittedSize.l
- dwUnCommittedSize.l
- *lpFirstBlock
- *lpLastBlock
- EndStructure
- Structure PROCESS_HEAP_ENTRY
- *lpData
- cbData.l
- cbOverhead.a
- iRegionIndex.a
- wFlags.w
- StructureUnion
- Block.PROCESS_HEAP_ENTRY_BLOCK
- Region.PROCESS_HEAP_ENTRY_REGION
- EndStructureUnion
- EndStructure
- Global NewList Temp()
- ; ########################################## Declares ############################################
- ; ########################################## Ladekram ############################################
- ; ########################################## Macros ##############################################
- Macro Get_X(Position, Width)
- ((Position) % Width)
- EndMacro
- Macro Get_Y(Position, Width)
- ((Position) / Width)
- EndMacro
- ; ########################################## Proceduren ##########################################
- Procedure Heap_Walk()
- Protected Entry.PROCESS_HEAP_ENTRY
- Protected Heaps = GetProcessHeaps_(0, 0)
- If Heaps = 0
- ProcedureReturn GetLastError_()
- EndIf
- ClearList(Heap_Entry())
- Protected *Heaps_Array = AllocateMemory(Heaps*4)
- Protected Heaps_Temp = Heaps
- Heaps = GetProcessHeaps_(Heaps_Temp, *Heaps_Array)
- If Heaps = 0
- ProcedureReturn GetLastError_()
- ElseIf Heaps > Heaps_Temp
- ProcedureReturn -1
- EndIf
- For i = 0 To Heaps-1
- Protected Heap = PeekL(*Heaps_Array+i*4)
- If HeapLock_(Heap) = #False
- ProcedureReturn GetLastError_()
- EndIf
- Entry\lpData = #Null
- While HeapWalk_(Heap, @Entry)
- If Entry\wFlags & #PROCESS_HEAP_ENTRY_BUSY
- ;PrintN("Allocated block")
- If Entry\wFlags & #PROCESS_HEAP_ENTRY_MOVEABLE
- ;PrintN("movable with HANDLE "+Str(Entry\Block\hMem))
- EndIf
- If Entry\wFlags & #PROCESS_HEAP_ENTRY_DDESHARE
- ;PrintN("DDESHARE")
- EndIf
- ElseIf Entry\wFlags & #PROCESS_HEAP_REGION
- ;PrintN("Region")
- ;PrintN(" "+Str(Entry\Region\dwCommittedSize)+" bytes committed")
- ;PrintN(" "+Str(Entry\Region\dwUnCommittedSize)+" bytes uncommitted")
- ;PrintN(" First block address: "+Str(Entry\Region\lpFirstBlock)+"")
- ;PrintN(" Last block address: "+Str(Entry\Region\lpLastBlock)+"")
- ElseIf Entry\wFlags & #PROCESS_HEAP_UNCOMMITTED_RANGE
- ;PrintN("Uncommitted range")
- Else
- ;PrintN("Block")
- EndIf
- ;PrintN(" Data portion begins at: "+Str(Entry\lpData))
- ;PrintN(" Size: "+Str(Entry\cbData)+" bytes")
- ;PrintN(" Overhead: "+Str(Entry\cbOverhead)+" bytes")
- ;PrintN(" Region index: "+Str(Entry\iRegionIndex))
- ;PrintN("")
- AddElement(Heap_Entry())
- Heap_Entry()\Pointer = Entry\lpData
- Heap_Entry()\Size = Entry\cbData
- Heap_Entry()\Region_Index = Entry\iRegionIndex
- Wend
- Protected LastError = GetLastError_()
- If LastError <> #ERROR_NO_MORE_ITEMS
- ProcedureReturn LastError
- EndIf
- If HeapUnlock_(Heap) = #False
- ProcedureReturn GetLastError_()
- EndIf
- Next
- FreeMemory(*Heaps_Array)
- ProcedureReturn 0
- EndProcedure
- Procedure Window_Main(Open, Width, Height)
- If Open = 1 And Window_Main\ID = 0
- Window_Main(0, Width, Height)
- EndIf
- If Open = 1 And Window_Main\ID = 0
- Window_Main\Width = Width
- Window_Main\Height = Height
- Window_Main\Bytes_Per_Pixel = (4294967296)/(Window_Main\Width*Window_Main\Height)
- Window_Main\ID = OpenWindow(#PB_Any, 0, 0, Window_Main\Width, Window_Main\Height, "Heap-Walk", #PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget)
- If Window_Main\ID
- Window_Main\Image_ID = CreateImage(#PB_Any, Window_Main\Width, Window_Main\Height)
- Window_Main\Image = ImageGadget(#PB_Any, 0, 0, Window_Main\Width, Window_Main\Height, ImageID(Window_Main\Image_ID))
- EndIf
- ElseIf Open = 0 And Window_Main\ID <> 0
- CloseWindow(Window_Main\ID)
- FreeImage(Window_Main\Image_ID)
- Window_Main\ID = 0
- EndIf
- EndProcedure
- Procedure Window_Main_Draw()
- If Window_Main\ID
- If StartDrawing(ImageOutput(Window_Main\Image_ID))
- Box(0, 0, Window_Main\Width, Window_Main\Height, 0)
- Allocated = 0
- ForEach Heap_Entry()
- Position = Heap_Entry()\Pointer / Window_Main\Bytes_Per_Pixel
- Size = Round(Heap_Entry()\Size/Window_Main\Bytes_Per_Pixel, 1)
- Allocated + Heap_Entry()\Size
- Color = RGB(Position%256,Size%256,255)
- While Size > 0
- X = Get_X(Position, Window_Main\Width)
- Y = Get_Y(Position, Window_Main\Width)
- Image_Size = Size
- Image_Size_Max = Window_Main\Width - X
- If Image_Size > Image_Size_Max : Image_Size = Image_Size_Max : EndIf
- LineXY(X, Y, X+Image_Size, Y, Color)
- Size - Image_Size
- Position + Image_Size
- Wend
- Next
- DrawingMode(#PB_2DDrawing_Transparent )
- X = 0
- Y = Window_Main\Height/2
- DrawText(X, Y, "Allocated: "+StrD(Allocated/1000000,3)+"MB", RGB(255,255,255)) : Y + 15
- DrawText(X, Y, StrD(Allocated*100/4294967296,1)+"%", RGB(255,255,255)) : Y + 15
- DrawText(X, Y, "Allocations: "+Str(ListSize(Heap_Entry())), RGB(255,255,255)) : Y + 15
- StopDrawing()
- SetGadgetState(Window_Main\Image, ImageID(Window_Main\Image_ID))
- EndIf
- EndIf
- EndProcedure
- ; ####################################################### Initkram #########################################################
- Window_Main(1, 800, 600)
- ; ####################################################### Hauptschleife ####################################################
- Repeat
- Repeat
- Window_Event = WindowEvent()
- Event_Window = EventWindow()
- Event_Gadget = EventGadget()
- Event_Type = EventType()
- If Event_Window = Window_Main\ID
- Select Window_Event
- Case #PB_Event_Gadget
- Select EventGadget()
- EndSelect
- Case #PB_Event_SizeWindow
- Window_Main\Width = WindowWidth(Event_Window)
- Window_Main\Height = WindowHeight(Event_Window)
- If Window_Main\Width And Window_Main\Height
- ResizeImage(Window_Main\Image_ID, Window_Main\Width, Window_Main\Height)
- Window_Main\Bytes_Per_Pixel = (4294967296)/(Window_Main\Width*Window_Main\Height)
- EndIf
- Case #PB_Event_CloseWindow
- Main\Quit = 1
- Case 0
- Break
- EndSelect
- EndIf
- ForEver
- Delay(10)
- Heap_Walk()
- Window_Main_Draw()
- ; ##### Allocate and Free...
- For i = 1 To 2
- If Random(1)
- AddElement(Temp())
- Result = AllocateMemory(Random(100000000))
- If Result
- Temp() = Result
- EndIf
- Else
- If SelectElement(Temp(), Random(ListSize(Temp())-1))
- FreeMemory(Temp())
- DeleteElement(Temp())
- EndIf
- EndIf
- Next
- Until Main\Quit
- ; ######################################################## Ende ##############################################################
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement