Advertisement
Guest User

Untitled

a guest
Jun 19th, 2017
73
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. ; ########################################## Dokumentation ##########################################
  2. ;
  3. ;
  4. ;
  5. ;
  6. ;
  7. ;
  8. ;
  9. ; ########################################## Variablen ##########################################
  10.  
  11.  
  12.  
  13. Structure Main
  14.   Quit.a
  15. EndStructure
  16. Global Main.Main
  17.  
  18. Structure Window_Main
  19.   ID.i
  20.   Width.u
  21.   Height.u
  22.   Bytes_Per_Pixel.d
  23.   Image.i
  24.   Image_ID.i
  25. EndStructure
  26. Global Window_Main.Window_Main
  27.  
  28. Structure Heap_Entry
  29.   *Pointer
  30.   Size.l
  31.   Region_Index.a
  32. EndStructure
  33. Global NewList Heap_Entry.Heap_Entry()
  34.  
  35. Structure PROCESS_HEAP_ENTRY_BLOCK
  36.   *hMem
  37.   dwReserved.l  [3]
  38. EndStructure
  39. Structure PROCESS_HEAP_ENTRY_REGION
  40.   dwCommittedSize.l
  41.   dwUnCommittedSize.l
  42.   *lpFirstBlock
  43.   *lpLastBlock
  44. EndStructure
  45. Structure PROCESS_HEAP_ENTRY
  46.   *lpData
  47.   cbData.l
  48.   cbOverhead.a
  49.   iRegionIndex.a
  50.   wFlags.w
  51.   StructureUnion
  52.     Block.PROCESS_HEAP_ENTRY_BLOCK
  53.     Region.PROCESS_HEAP_ENTRY_REGION
  54.   EndStructureUnion
  55. EndStructure
  56.  
  57. Global NewList Temp()
  58.  
  59. ; ########################################## Declares ############################################
  60.  
  61. ; ########################################## Ladekram ############################################
  62.  
  63. ; ########################################## Macros ##############################################
  64.  
  65. Macro Get_X(Position, Width)
  66.   ((Position) % Width)
  67. EndMacro
  68.  
  69. Macro Get_Y(Position, Width)
  70.   ((Position) / Width)
  71. EndMacro
  72.  
  73. ; ########################################## Proceduren ##########################################
  74.  
  75. Procedure Heap_Walk()
  76.   Protected Entry.PROCESS_HEAP_ENTRY
  77.  
  78.   Protected Heaps = GetProcessHeaps_(0, 0)
  79.   If Heaps = 0
  80.     ProcedureReturn GetLastError_()
  81.   EndIf
  82.  
  83.   ClearList(Heap_Entry())
  84.  
  85.   Protected *Heaps_Array = AllocateMemory(Heaps*4)
  86.  
  87.   Protected Heaps_Temp = Heaps
  88.  
  89.   Heaps = GetProcessHeaps_(Heaps_Temp, *Heaps_Array)
  90.   If Heaps = 0
  91.     ProcedureReturn GetLastError_()
  92.   ElseIf Heaps > Heaps_Temp
  93.     ProcedureReturn -1
  94.   EndIf
  95.  
  96.   For i = 0 To Heaps-1
  97.     Protected Heap = PeekL(*Heaps_Array+i*4)
  98.    
  99.     If HeapLock_(Heap) = #False
  100.       ProcedureReturn GetLastError_()
  101.     EndIf
  102.    
  103.     Entry\lpData = #Null
  104.     While HeapWalk_(Heap, @Entry)
  105.       If Entry\wFlags & #PROCESS_HEAP_ENTRY_BUSY
  106.         ;PrintN("Allocated block")
  107.         If Entry\wFlags & #PROCESS_HEAP_ENTRY_MOVEABLE
  108.           ;PrintN("movable with HANDLE "+Str(Entry\Block\hMem))
  109.         EndIf
  110.         If Entry\wFlags & #PROCESS_HEAP_ENTRY_DDESHARE
  111.           ;PrintN("DDESHARE")
  112.         EndIf
  113.       ElseIf Entry\wFlags & #PROCESS_HEAP_REGION
  114.         ;PrintN("Region")
  115.         ;PrintN("  "+Str(Entry\Region\dwCommittedSize)+" bytes committed")
  116.         ;PrintN("  "+Str(Entry\Region\dwUnCommittedSize)+" bytes uncommitted")
  117.         ;PrintN("  First block address: "+Str(Entry\Region\lpFirstBlock)+"")
  118.         ;PrintN("  Last block address: "+Str(Entry\Region\lpLastBlock)+"")
  119.       ElseIf Entry\wFlags & #PROCESS_HEAP_UNCOMMITTED_RANGE
  120.         ;PrintN("Uncommitted range")
  121.       Else
  122.         ;PrintN("Block")
  123.       EndIf
  124.    
  125.       ;PrintN("  Data portion begins at: "+Str(Entry\lpData))
  126.       ;PrintN("  Size: "+Str(Entry\cbData)+" bytes")
  127.       ;PrintN("  Overhead: "+Str(Entry\cbOverhead)+" bytes")
  128.       ;PrintN("  Region index: "+Str(Entry\iRegionIndex))
  129.       ;PrintN("")
  130.      
  131.       AddElement(Heap_Entry())
  132.       Heap_Entry()\Pointer = Entry\lpData
  133.       Heap_Entry()\Size = Entry\cbData
  134.       Heap_Entry()\Region_Index = Entry\iRegionIndex
  135.     Wend
  136.    
  137.     Protected LastError = GetLastError_()
  138.     If LastError <> #ERROR_NO_MORE_ITEMS
  139.       ProcedureReturn LastError
  140.     EndIf
  141.    
  142.     If HeapUnlock_(Heap) = #False
  143.       ProcedureReturn GetLastError_()
  144.     EndIf
  145.    
  146.   Next
  147.  
  148.   FreeMemory(*Heaps_Array)
  149.  
  150.   ProcedureReturn 0
  151. EndProcedure
  152.  
  153. Procedure Window_Main(Open, Width, Height)
  154.   If Open = 1 And Window_Main\ID = 0
  155.     Window_Main(0, Width, Height)
  156.   EndIf
  157.  
  158.   If Open = 1 And Window_Main\ID = 0
  159.    
  160.     Window_Main\Width  = Width
  161.     Window_Main\Height = Height
  162.     Window_Main\Bytes_Per_Pixel = (4294967296)/(Window_Main\Width*Window_Main\Height)
  163.    
  164.     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)
  165.     If Window_Main\ID
  166.       Window_Main\Image_ID = CreateImage(#PB_Any, Window_Main\Width, Window_Main\Height)
  167.       Window_Main\Image = ImageGadget(#PB_Any, 0, 0, Window_Main\Width, Window_Main\Height, ImageID(Window_Main\Image_ID))
  168.     EndIf
  169.   ElseIf Open = 0 And Window_Main\ID <> 0
  170.     CloseWindow(Window_Main\ID)
  171.     FreeImage(Window_Main\Image_ID)
  172.     Window_Main\ID = 0
  173.   EndIf
  174. EndProcedure
  175.  
  176. Procedure Window_Main_Draw()
  177.   If Window_Main\ID
  178.     If StartDrawing(ImageOutput(Window_Main\Image_ID))
  179.      
  180.       Box(0, 0, Window_Main\Width, Window_Main\Height, 0)
  181.      
  182.       Allocated = 0
  183.      
  184.       ForEach Heap_Entry()
  185.         Position = Heap_Entry()\Pointer / Window_Main\Bytes_Per_Pixel
  186.         Size = Round(Heap_Entry()\Size/Window_Main\Bytes_Per_Pixel, 1)
  187.         Allocated + Heap_Entry()\Size
  188.         Color = RGB(Position%256,Size%256,255)
  189.         While Size > 0
  190.           X = Get_X(Position, Window_Main\Width)
  191.           Y = Get_Y(Position, Window_Main\Width)
  192.           Image_Size = Size
  193.           Image_Size_Max = Window_Main\Width - X
  194.           If Image_Size > Image_Size_Max : Image_Size = Image_Size_Max : EndIf
  195.           LineXY(X, Y, X+Image_Size, Y, Color)
  196.           Size - Image_Size
  197.           Position + Image_Size
  198.         Wend
  199.       Next
  200.      
  201.       DrawingMode(#PB_2DDrawing_Transparent )
  202.       X = 0
  203.       Y = Window_Main\Height/2
  204.       DrawText(X, Y, "Allocated: "+StrD(Allocated/1000000,3)+"MB", RGB(255,255,255)) : Y + 15
  205.       DrawText(X, Y, StrD(Allocated*100/4294967296,1)+"%", RGB(255,255,255)) : Y + 15
  206.       DrawText(X, Y, "Allocations: "+Str(ListSize(Heap_Entry())), RGB(255,255,255)) : Y + 15
  207.      
  208.       StopDrawing()
  209.       SetGadgetState(Window_Main\Image, ImageID(Window_Main\Image_ID))
  210.     EndIf
  211.   EndIf
  212. EndProcedure
  213.  
  214. ; ####################################################### Initkram #########################################################
  215.  
  216. Window_Main(1, 800, 600)
  217.  
  218. ; ####################################################### Hauptschleife ####################################################
  219.  
  220. Repeat
  221.  
  222.   Repeat
  223.     Window_Event = WindowEvent()
  224.     Event_Window = EventWindow()
  225.     Event_Gadget = EventGadget()
  226.     Event_Type = EventType()
  227.    
  228.     If Event_Window = Window_Main\ID
  229.       Select Window_Event
  230.         Case #PB_Event_Gadget
  231.           Select EventGadget()
  232.            
  233.           EndSelect
  234.          
  235.         Case #PB_Event_SizeWindow
  236.           Window_Main\Width  = WindowWidth(Event_Window)
  237.           Window_Main\Height = WindowHeight(Event_Window)
  238.           If Window_Main\Width And Window_Main\Height
  239.             ResizeImage(Window_Main\Image_ID, Window_Main\Width, Window_Main\Height)
  240.             Window_Main\Bytes_Per_Pixel = (4294967296)/(Window_Main\Width*Window_Main\Height)
  241.           EndIf
  242.        
  243.         Case #PB_Event_CloseWindow
  244.           Main\Quit = 1
  245.          
  246.         Case 0
  247.           Break
  248.          
  249.       EndSelect
  250.     EndIf
  251.   ForEver
  252.  
  253.   Delay(10)
  254.  
  255.   Heap_Walk()
  256.   Window_Main_Draw()
  257.  
  258.   ; ##### Allocate and Free...
  259.   For i = 1 To 2
  260.     If Random(1)
  261.       AddElement(Temp())
  262.       Result = AllocateMemory(Random(100000000))
  263.       If Result
  264.         Temp() = Result
  265.       EndIf
  266.     Else
  267.       If SelectElement(Temp(), Random(ListSize(Temp())-1))
  268.         FreeMemory(Temp())
  269.         DeleteElement(Temp())
  270.       EndIf
  271.     EndIf
  272.   Next
  273.  
  274. Until Main\Quit
  275.  
  276. ; ######################################################## Ende ##############################################################
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement