1185 lines
37 KiB
ObjectPascal
1185 lines
37 KiB
ObjectPascal
(*
|
|
|
|
Fast Memory Manager Usage Tracker 2.00
|
|
|
|
Description:
|
|
|
|
- Shows FastMM4 allocation usage
|
|
|
|
- Shows VM Memory in graphical map
|
|
- Free
|
|
- Commit
|
|
- Reserved
|
|
- EXE (Red)
|
|
- DLLs (Blue)
|
|
|
|
- VM Dump of the whole process
|
|
(2GB standard, 3GB with the /3G switch set, and 4GB under WoW64)
|
|
|
|
- General Information
|
|
- System memory usage
|
|
- Process memory usage
|
|
- 5 Largest contiguous free VM memory spaces
|
|
- FastMM4 summary information
|
|
|
|
Usage:
|
|
- Add the FastMMUsageTracker unit
|
|
- Add the ShowFastMMUsageTracker procedure to an event
|
|
- FastMMUsageTracker form should not be autocreated
|
|
|
|
Notes:
|
|
- Consider setting the base adress of your BPLs & DLLs or use Microsoft's
|
|
ReBase.exe to set third party BPLs and DLLs. Libraries that do not have to
|
|
be relocated can be shared across processes, thus conserving system
|
|
resources.
|
|
- The first of the "Largest contiguous free VM memory spaces" gives you an
|
|
indication of the largest single memory block that can be allocated.
|
|
|
|
Change log:
|
|
|
|
Version 2.10 (22 September 2009):
|
|
- New usage tracker implemented by Hanspeter Widmer with many new features.
|
|
(Thanks Hanspeter!);
|
|
- Colour coding of changes in the allocation map added by Murray McGowan
|
|
(red for an increase in usage, green for a decrease). (Thanks Murray!)
|
|
|
|
*)
|
|
|
|
unit FastMMUsageTracker;
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
|
Dialogs, StdCtrls, ExtCtrls, Grids, Buttons, ComCtrls, Menus, FastMM4;
|
|
|
|
type
|
|
TChunkStatusEx = (
|
|
{Items that correspond to the same entry in TChunkStatus}
|
|
csExUnallocated,
|
|
csExAllocated,
|
|
csExReserved,
|
|
csExSysAllocated,
|
|
csExSysReserved,
|
|
{TChunkStatusEx additional detail}
|
|
csExSysExe,
|
|
csExSysDLL);
|
|
|
|
TMemoryMapEx = array[0..65535] of TChunkStatusEx;
|
|
|
|
TfFastMMUsageTracker = class(TForm)
|
|
tTimer: TTimer;
|
|
bClose: TBitBtn;
|
|
bUpdate: TBitBtn;
|
|
ChkAutoUpdate: TCheckBox;
|
|
smVMDump: TPopupMenu;
|
|
smMM4Allocation: TPopupMenu;
|
|
smGeneralInformation: TPopupMenu;
|
|
miVMDumpCopyAlltoClipboard: TMenuItem;
|
|
miGeneralInformationCopyAlltoClipboard: TMenuItem;
|
|
siMM4AllocationCopyAlltoClipboard: TMenuItem;
|
|
pcUsageTracker: TPageControl;
|
|
tsAllocation: TTabSheet;
|
|
tsVMGraph: TTabSheet;
|
|
tsVMDump: TTabSheet;
|
|
tsGeneralInformation: TTabSheet;
|
|
mVMStatistics: TMemo;
|
|
sgVMDump: TStringGrid;
|
|
Label1: TLabel;
|
|
Label2: TLabel;
|
|
Label3: TLabel;
|
|
eAddress: TEdit;
|
|
eState: TEdit;
|
|
eDLLName: TEdit;
|
|
ChkSmallGraph: TCheckBox;
|
|
sgBlockStatistics: TStringGrid;
|
|
dgMemoryMap: TDrawGrid;
|
|
procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
|
procedure tTimerTimer(Sender: TObject);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure bCloseClick(Sender: TObject);
|
|
procedure dgMemoryMapDrawCell(Sender: TObject; ACol, ARow: Integer;
|
|
Rect: TRect; State: TGridDrawState);
|
|
procedure dgMemoryMapSelectCell(Sender: TObject; ACol, ARow: Integer;
|
|
var CanSelect: Boolean);
|
|
procedure bUpdateClick(Sender: TObject);
|
|
procedure ChkAutoUpdateClick(Sender: TObject);
|
|
procedure ChkSmallGraphClick(Sender: TObject);
|
|
procedure sgVMDumpMouseDown(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
procedure sgVMDumpMouseUp(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
procedure sgVMDumpDrawCell(Sender: TObject; ACol, ARow: Integer;
|
|
Rect: TRect; State: TGridDrawState);
|
|
procedure miVMDumpCopyAlltoClipboardClick(Sender: TObject);
|
|
procedure miGeneralInformationCopyAlltoClipboardClick(Sender: TObject);
|
|
procedure siMM4AllocationCopyAlltoClipboardClick(Sender: TObject);
|
|
procedure sgBlockStatisticsDrawCell(Sender: TObject; ACol,
|
|
ARow: Integer; Rect: TRect; State: TGridDrawState);
|
|
private
|
|
{The current and previous memory manager states}
|
|
FMemoryManagerState, FPrevMemoryManagerState: TMemoryManagerState;
|
|
FMemoryMapEx: TMemoryMapEx;
|
|
AddressSpacePageCount: Integer;
|
|
OR_VMDumpDownCell: TGridCoord;
|
|
procedure HeaderClicked(AGrid: TStringgrid; const ACell: TGridCoord);
|
|
procedure SortGrid(grid: TStringgrid; PB_Nummeric: Boolean; byColumn: Integer; ascending: Boolean);
|
|
procedure UpdateGraphMetrics;
|
|
public
|
|
{Refreshes the display}
|
|
procedure RefreshSnapShot;
|
|
end;
|
|
|
|
function ShowFastMMUsageTracker: TfFastMMUsageTracker;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Clipbrd, PsAPI;
|
|
|
|
{$R *.dfm}
|
|
|
|
const
|
|
SystemBasicInformation = 0;
|
|
SystemPerformanceInformation = 2;
|
|
SystemTimeInformation = 3;
|
|
|
|
|
|
type
|
|
{To get access to protected methods}
|
|
TLocalStringGrid = class(TStringGrid);
|
|
|
|
TMemoryStatusEx = packed record
|
|
dwLength: DWORD;
|
|
dwMemoryLoad: DWORD;
|
|
ullTotalPhys: Int64;
|
|
ullAvailPhys: Int64;
|
|
ullTotalPageFile: Int64;
|
|
ullAvailPageFile: Int64;
|
|
ullTotalVirtual: Int64;
|
|
ullAvailVirtual: Int64;
|
|
ullAvailExtendedVirtual: Int64;
|
|
end;
|
|
PMemoryStatusEx = ^TMemoryStatusEx;
|
|
LPMEMORYSTATUSEX = PMemoryStatusEx;
|
|
|
|
TP_GlobalMemoryStatusEx = function(
|
|
var PR_MemStatusEx: TMemoryStatusEx): LongBool; stdcall;
|
|
|
|
TSystem_Basic_Information = packed record
|
|
dwUnknown1: DWORD;
|
|
uKeMaximumIncrement: ULONG;
|
|
uPageSize: ULONG;
|
|
uMmNumberOfPhysicalPages: ULONG;
|
|
uMmLowestPhysicalPage: ULONG;
|
|
uMmHighestPhysicalPage: ULONG;
|
|
uAllocationGranularity: ULONG;
|
|
pLowestUserAddress: Pointer;
|
|
pMmHighestUserAddress: Pointer;
|
|
uKeActiveProcessors: ULONG;
|
|
bKeNumberProcessors: Byte;
|
|
bUnknown2: Byte;
|
|
wUnknown3: Word;
|
|
end;
|
|
|
|
TSystem_Performance_Information = packed record
|
|
liIdleTime: LARGE_INTEGER;
|
|
dwSpare: array[0..75] of DWORD;
|
|
end;
|
|
|
|
TSystem_Time_Information = packed record
|
|
liKeBootTime: LARGE_INTEGER;
|
|
liKeSystemTime: LARGE_INTEGER;
|
|
liExpTimeZoneBias: LARGE_INTEGER;
|
|
uCurrentTimeZoneId: ULONG;
|
|
dwReserved: DWORD;
|
|
end;
|
|
|
|
TP_NtQuerySystemInformation = function(InfoClass: DWORD; Buffer: Pointer;
|
|
BufSize: DWORD; ReturnSize: PCardinal): DWORD; stdcall;
|
|
|
|
var
|
|
MP_GlobalMemoryStatusEx: TP_GlobalMemoryStatusEx = nil;
|
|
MP_NtQuerySystemInformation: TP_NtQuerySystemInformation = nil;
|
|
|
|
//-----------------------------------------------------------------------------
|
|
// Various Global Procedures
|
|
//-----------------------------------------------------------------------------
|
|
|
|
function ShowFastMMUsageTracker: TfFastMMUsageTracker;
|
|
begin
|
|
Application.CreateForm(TfFastMMUsageTracker, Result);
|
|
if Assigned(Result) then
|
|
begin
|
|
Result.RefreshSnapShot;
|
|
Result.Show;
|
|
end;
|
|
end;
|
|
|
|
function CardinalToStringFormatted(const ACardinal: Cardinal): string;
|
|
begin
|
|
Result := FormatFloat('#,##0', ACardinal);
|
|
end;
|
|
|
|
function Int64ToStringFormatted(const AInt64: Int64): string;
|
|
begin
|
|
Result := FormatFloat('#,##0', AInt64);
|
|
end;
|
|
|
|
function CardinalToKStringFormatted(const ACardinal: Cardinal): string;
|
|
begin
|
|
Result := FormatFloat('#,##0', ACardinal div 1024) + 'K';
|
|
end;
|
|
|
|
function Int64ToKStringFormatted(const AInt64: Int64): string;
|
|
begin
|
|
Result := FormatFloat('#,##0', AInt64 div 1024) + 'K';
|
|
end;
|
|
|
|
procedure CopyGridContentsToClipBoard(AStringGrid: TStringGrid);
|
|
const
|
|
TAB = Chr(VK_TAB);
|
|
CRLF = #13#10;
|
|
var
|
|
LI_r, LI_c: Integer;
|
|
LS_S: string;
|
|
begin
|
|
LS_S := '';
|
|
for LI_r := 0 to AStringGrid.RowCount - 1 do
|
|
begin
|
|
for LI_c := 0 to AStringGrid.ColCount - 1 do
|
|
begin
|
|
LS_S := LS_S + AStringGrid.Cells[LI_c, LI_r];
|
|
if LI_c < AStringGrid.ColCount - 1 then
|
|
LS_S := LS_S + TAB;
|
|
end;
|
|
if LI_r < AStringGrid.RowCount - 1 then
|
|
LS_S := LS_S + CRLF;
|
|
end;
|
|
ClipBoard.SetTextBuf(PChar(LS_S));
|
|
end;
|
|
|
|
function LocSort(P1, P2: Pointer): Integer;
|
|
begin
|
|
if NativeUInt(P1) = NativeUInt(P2) then
|
|
Result := 0
|
|
else
|
|
begin
|
|
if NativeUInt(P1) > NativeUInt(P2) then
|
|
Result := -1
|
|
else
|
|
Result := 1;
|
|
end;
|
|
end;
|
|
|
|
//-----------------------------------------------------------------------------
|
|
// Form TfFastMMUsageTracker
|
|
//-----------------------------------------------------------------------------
|
|
|
|
procedure TfFastMMUsageTracker.FormCreate(Sender: TObject);
|
|
var
|
|
LR_SystemInfo: TSystemInfo;
|
|
begin
|
|
pcUsageTracker.ActivePage := tsAllocation;
|
|
GetSystemInfo(LR_SystemInfo);
|
|
{Get the number of address space pages}
|
|
if (Cardinal(LR_SystemInfo.lpMaximumApplicationAddress) and $80000000) = 0 then
|
|
AddressSpacePageCount := 32768
|
|
else
|
|
AddressSpacePageCount := 65536;
|
|
{Update the graph metricx}
|
|
UpdateGraphMetrics;
|
|
{Set up the StringGrid columns}
|
|
with sgBlockStatistics do
|
|
begin
|
|
Cells[0, 0] := 'Block Size';
|
|
Cells[1, 0] := '# Live Pointers';
|
|
Cells[2, 0] := 'Live Size';
|
|
Cells[3, 0] := 'Used Space';
|
|
Cells[4, 0] := 'Efficiency';
|
|
end;
|
|
with sgVMDump do
|
|
begin
|
|
Cells[0, 0] := 'VM Block';
|
|
Cells[1, 0] := 'Size';
|
|
Cells[2, 0] := 'Type';
|
|
Cells[3, 0] := 'State';
|
|
Cells[4, 0] := 'EXE/DLL';
|
|
end;
|
|
end;
|
|
|
|
procedure TfFastMMUsageTracker.FormClose(Sender: TObject; var Action: TCloseAction);
|
|
begin
|
|
Action := caFree;
|
|
end;
|
|
|
|
procedure TfFastMMUsageTracker.SortGrid(grid: TStringgrid; PB_Nummeric: Boolean; byColumn: Integer; ascending: Boolean);
|
|
|
|
function CompareNumeric(const S1, S2: string): Integer;
|
|
var
|
|
LVal1, LVal2: Integer;
|
|
begin
|
|
begin
|
|
LVal1 := StrToInt(S1);
|
|
LVal2 := StrToInt(S2);
|
|
if LVal1 = LVal2 then
|
|
begin
|
|
Result := 0;
|
|
end
|
|
else
|
|
begin
|
|
if LVal1 > LVal2 then
|
|
Result := 1
|
|
else
|
|
Result := -1;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure ExchangeGridRows(i, j: Integer);
|
|
var
|
|
k: Integer;
|
|
begin
|
|
for k := 0 to Grid.ColCount - 1 do
|
|
Grid.Cols[k].Exchange(i, j);
|
|
end;
|
|
|
|
procedure QuickSortNummeric(L, R: Integer);
|
|
var
|
|
I, J: Integer;
|
|
P: string;
|
|
begin
|
|
repeat
|
|
I := L;
|
|
J := R;
|
|
P := Grid.Cells[byColumn, (L + R) shr 1];
|
|
repeat
|
|
while CompareNumeric(Grid.Cells[byColumn, I], P) < 0 do
|
|
Inc(I);
|
|
while CompareNumeric(Grid.Cells[byColumn, J], P) > 0 do
|
|
Dec(J);
|
|
if I <= J then
|
|
begin
|
|
if I <> J then
|
|
ExchangeGridRows(I, J);
|
|
Inc(I);
|
|
Dec(J);
|
|
end;
|
|
until I > J;
|
|
if L < J then
|
|
QuickSortNummeric(L, J);
|
|
L := I;
|
|
until I >= R;
|
|
end;
|
|
|
|
procedure QuickSortString(L, R: Integer);
|
|
var
|
|
I, J: Integer;
|
|
P: string;
|
|
begin
|
|
repeat
|
|
I := L;
|
|
J := R;
|
|
P := Grid.Cells[byColumn, (L + R) shr 1];
|
|
repeat
|
|
while CompareText(Grid.Cells[byColumn, I], P) < 0 do
|
|
Inc(I);
|
|
while CompareText(Grid.Cells[byColumn, J], P) > 0 do
|
|
Dec(J);
|
|
if I <= J then
|
|
begin
|
|
if I <> J then
|
|
ExchangeGridRows(I, J);
|
|
Inc(I);
|
|
Dec(J);
|
|
end;
|
|
until I > J;
|
|
if L < J then
|
|
QuickSortString(L, J);
|
|
L := I;
|
|
until I >= R;
|
|
end;
|
|
|
|
procedure InvertGrid;
|
|
var
|
|
i, j: Integer;
|
|
begin
|
|
i := Grid.Fixedrows;
|
|
j := Grid.Rowcount - 1;
|
|
while i < j do
|
|
begin
|
|
ExchangeGridRows(I, J);
|
|
Inc(i);
|
|
Dec(j);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
Screen.Cursor := crHourglass;
|
|
Grid.Perform(WM_SETREDRAW, 0, 0);
|
|
try
|
|
if PB_Nummeric then
|
|
QuickSortNummeric(Grid.FixedRows, Grid.Rowcount - 1)
|
|
else
|
|
QuickSortString(Grid.FixedRows, Grid.Rowcount - 1);
|
|
if not Ascending then
|
|
InvertGrid;
|
|
finally
|
|
Grid.Perform(WM_SETREDRAW, 1, 0);
|
|
Grid.Refresh;
|
|
Screen.Cursor := crDefault;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TfFastMMUsageTracker.HeaderClicked(AGrid: TStringgrid; const ACell: TGridCoord);
|
|
var
|
|
i: Integer;
|
|
LNumericSort: Boolean;
|
|
begin
|
|
// The header cell stores a flag in the Objects property that signals the
|
|
// current sort order of the grid column. A value of 0 shows no sort marker,
|
|
// 1 means sorted ascending, -1 sorted descending
|
|
// clear markers
|
|
for i := AGrid.FixedCols to AGrid.ColCount - 1 do
|
|
begin
|
|
if Assigned(AGrid.Objects[i, 0]) and (i <> ACell.x) then
|
|
begin
|
|
AGrid.Objects[i, 0] := nil;
|
|
TLocalStringGrid(AGrid).InvalidateCell(i, 0);
|
|
end;
|
|
end;
|
|
// Sort grid on new column. If grid is currently sorted ascending on this
|
|
// column we invert the sort direction, otherwise we sort it ascending.
|
|
if ACell.X = 1 then
|
|
LNumericSort := True
|
|
else
|
|
LNumericSort := False;
|
|
if Integer(AGrid.Objects[ACell.x, ACell.y]) = 1 then
|
|
begin
|
|
SortGrid(AGrid, LNumericSort, ACell.x, False);
|
|
AGrid.Objects[ACell.x, 0] := Pointer(-1);
|
|
end
|
|
else
|
|
begin
|
|
SortGrid(AGrid, LNumericSort, ACell.x, True);
|
|
AGrid.Objects[ACell.x, 0] := Pointer(1);
|
|
end;
|
|
TLocalStringGrid(AGrid).InvalidateCell(ACell.x, ACell.y);
|
|
end;
|
|
|
|
procedure TfFastMMUsageTracker.UpdateGraphMetrics;
|
|
begin
|
|
if ChkSmallGraph.Checked then
|
|
begin
|
|
dgMemoryMap.DefaultColWidth := 4;
|
|
dgMemoryMap.ColCount := 128;
|
|
end
|
|
else
|
|
begin
|
|
dgMemoryMap.DefaultColWidth := 8;
|
|
dgMemoryMap.ColCount := 64;
|
|
end;
|
|
dgMemoryMap.DefaultRowHeight := dgMemoryMap.DefaultColWidth;
|
|
dgMemoryMap.RowCount := AddressSpacePageCount div dgMemoryMap.ColCount;
|
|
end;
|
|
|
|
procedure TfFastMMUsageTracker.RefreshSnapShot;
|
|
var
|
|
LP_FreeVMList: TList;
|
|
LU_MEM_FREE: SIZE_T;
|
|
LU_MEM_COMMIT: SIZE_T;
|
|
LU_MEM_RESERVE: SIZE_T;
|
|
LAllocatedSize, LTotalBlocks, LTotalAllocated, LTotalReserved,
|
|
LPrevAllocatedSize, LPrevTotalBlocks, LPrevTotalAllocated, LPrevTotalReserved: NativeUInt;
|
|
|
|
procedure UpdateVMGraph(var AMemoryMap: TMemoryMapEx);
|
|
var
|
|
LInd, LIndTop, I1: Integer;
|
|
LChunkState: TChunkStatusEx;
|
|
LMBI: TMemoryBasicInformation;
|
|
LA_Char: array[0..MAX_PATH] of Char;
|
|
begin
|
|
LInd := 0;
|
|
repeat
|
|
{If the chunk is not allocated by this MM, what is its status?}
|
|
if AMemoryMap[LInd] = csExSysAllocated then
|
|
begin
|
|
{Get all the reserved memory blocks and windows allocated memory blocks, etc.}
|
|
VirtualQuery(Pointer(LInd * 65536), LMBI, SizeOf(LMBI));
|
|
if LMBI.State = MEM_COMMIT then
|
|
begin
|
|
if (GetModuleFileName(DWord(LMBI.AllocationBase), LA_Char, MAX_PATH) <> 0) then
|
|
begin
|
|
if DWord(LMBI.AllocationBase) = SysInit.HInstance then
|
|
LChunkState := csExSysExe
|
|
else
|
|
LChunkState := csExSysDLL;
|
|
end
|
|
else
|
|
begin
|
|
LChunkState := csExSysAllocated;
|
|
end;
|
|
if LMBI.RegionSize > 65536 then
|
|
begin
|
|
LIndTop := (Cardinal(LMBI.BaseAddress) + Cardinal(LMBI.RegionSize)) div 65536;
|
|
// Fill up multiple tables
|
|
for I1 := LInd to LIndTop do
|
|
AMemoryMap[I1] := LChunkState;
|
|
LInd := LIndTop;
|
|
end
|
|
else
|
|
begin
|
|
AMemoryMap[LInd] := LChunkState;
|
|
end;
|
|
end
|
|
end;
|
|
Inc(LInd);
|
|
until LInd >= AddressSpacePageCount;
|
|
end;
|
|
|
|
procedure UpdateVMDump;
|
|
var
|
|
LP_Base: PByte;
|
|
LR_Info: TMemoryBasicInformation;
|
|
LU_rv: SIZE_T;
|
|
LI_I: Integer;
|
|
LA_Char: array[0..MAX_PATH] of Char;
|
|
begin
|
|
LP_Base := nil;
|
|
LU_rv := VirtualQuery(LP_Base, LR_Info, sizeof(LR_Info));
|
|
LI_I := 1;
|
|
while LU_rv = sizeof(LR_Info) do
|
|
begin
|
|
with sgVMDump do
|
|
begin
|
|
Cells[0, LI_I] := IntToHex(Integer(LR_Info.BaseAddress), 8);
|
|
Cells[1, LI_I] := IntToStr(LR_Info.RegionSize);
|
|
Cells[3, LI_I] := IntToHex(Integer(LR_Info.Protect), 8);
|
|
case LR_Info.State of
|
|
|
|
MEM_Commit:
|
|
begin
|
|
LU_MEM_COMMIT := LU_MEM_COMMIT + LR_Info.RegionSize;
|
|
if (GetModuleFileName(dword(LR_Info.AllocationBase), LA_Char, MAX_PATH) <> 0) then
|
|
begin
|
|
if DWord(LR_Info.AllocationBase) = SysInit.HInstance then
|
|
Cells[2, LI_I] := 'Exe'
|
|
else
|
|
Cells[2, LI_I] := 'DLL';
|
|
Cells[4, LI_I] := ExtractFileName(LA_Char);
|
|
end
|
|
else
|
|
begin
|
|
Cells[4, LI_I] := '';
|
|
Cells[2, LI_I] := 'Commited';
|
|
end;
|
|
end;
|
|
|
|
MEM_RESERVE:
|
|
begin
|
|
LU_MEM_RESERVE := LU_MEM_RESERVE + LR_Info.RegionSize;
|
|
Cells[2, LI_I] := 'Reserved';
|
|
Cells[4, LI_I] := '';
|
|
end;
|
|
|
|
MEM_FREE:
|
|
begin
|
|
LP_FreeVMList.Add(Pointer(LR_Info.RegionSize));
|
|
LU_MEM_FREE := LU_MEM_FREE + Lr_Info.RegionSize;
|
|
Cells[2, LI_I] := 'Free';
|
|
Cells[4, LI_I] := '';
|
|
end;
|
|
end;
|
|
|
|
Inc(LP_Base, LR_Info.RegionSize);
|
|
LU_rv := VirtualQuery(LP_Base, LR_Info, sizeof(LR_Info));
|
|
Inc(LI_I);
|
|
end;
|
|
end;
|
|
|
|
sgVMDump.RowCount := LI_I;
|
|
end;
|
|
|
|
procedure UpdateFastMM4Data;
|
|
var
|
|
LInd: Integer;
|
|
LU_StateLength: Cardinal;
|
|
LPrevSBState, LSBState: ^TSmallBlockTypeState;
|
|
|
|
procedure UpdateBlockStatistics(c, r, current, prev: Integer);
|
|
var
|
|
s : string;
|
|
begin
|
|
s := IntToStr(current);
|
|
if current > prev then
|
|
s := s + ' (+' + IntToStr(current - prev) + ')'
|
|
else if current < prev then
|
|
s := s + ' (-' + IntToStr(prev - current) + ')';
|
|
sgBlockStatistics.Cells[c, r] := s;
|
|
sgBlockStatistics.Objects[c, r] := Pointer(current - prev);
|
|
end;
|
|
|
|
begin
|
|
LU_StateLength := Length(FMemoryManagerState.SmallBlockTypeStates);
|
|
{Set up the row count}
|
|
sgBlockStatistics.RowCount := LU_StateLength + 4;
|
|
sgBlockStatistics.Cells[0, LU_StateLength + 1] := 'Medium Blocks';
|
|
sgBlockStatistics.Cells[0, LU_StateLength + 2] := 'Large Blocks';
|
|
sgBlockStatistics.Cells[0, LU_StateLength + 3] := 'Overall';
|
|
for LInd := 0 to High(FMemoryManagerState.SmallBlockTypeStates) do
|
|
begin
|
|
sgBlockStatistics.Cells[0, LInd + 1] :=
|
|
IntToStr(FMemoryManagerState.SmallBlockTypeStates[LInd].InternalBlockSize)
|
|
+ '(' + IntToStr(FMemoryManagerState.SmallBlockTypeStates[LInd].UseableBlockSize) + ')';
|
|
end;
|
|
{Set the texts inside the results string grid}
|
|
for LInd := 0 to High(FMemoryManagerState.SmallBlockTypeStates) do
|
|
begin
|
|
LPrevSBState := @FPrevMemoryManagerState.SmallBlockTypeStates[LInd];
|
|
LSBState := @FMemoryManagerState.SmallBlockTypeStates[LInd];
|
|
UpdateBlockStatistics(1, LInd + 1, LSBState.AllocatedBlockCount, LPrevSBState.AllocatedBlockCount);
|
|
Inc(LTotalBlocks, LSBState.AllocatedBlockCount);
|
|
Inc(LPrevTotalBlocks, LPrevSBState.AllocatedBlockCount);
|
|
LAllocatedSize := LSBState.AllocatedBlockCount * LSBState.UseableBlockSize;
|
|
LPrevAllocatedSize := LPrevSBState.AllocatedBlockCount * LPrevSBState.UseableBlockSize;
|
|
UpdateBlockStatistics(2, LInd + 1, LAllocatedSize, LPrevAllocatedSize);
|
|
Inc(LTotalAllocated, LAllocatedSize);
|
|
Inc(LPrevTotalAllocated, LPrevAllocatedSize);
|
|
UpdateBlockStatistics(3, LInd + 1, LSBState.ReservedAddressSpace, LPrevSBState.ReservedAddressSpace);
|
|
Inc(LTotalReserved, LSBState.ReservedAddressSpace);
|
|
Inc(LPrevTotalReserved, LPrevSBState.ReservedAddressSpace);
|
|
if LSBState.ReservedAddressSpace > 0 then
|
|
sgBlockStatistics.Cells[4, LInd + 1] := FormatFloat('0.##%', LAllocatedSize / LSBState.ReservedAddressSpace * 100)
|
|
else
|
|
sgBlockStatistics.Cells[4, LInd + 1] := 'N/A';
|
|
end;
|
|
{-----------Medium blocks---------}
|
|
LInd := length(FMemoryManagerState.SmallBlockTypeStates) + 1;
|
|
UpdateBlockStatistics(1, LInd, FMemoryManagerState.AllocatedMediumBlockCount, FPrevMemoryManagerState.AllocatedMediumBlockCount);
|
|
Inc(LTotalBlocks, FMemoryManagerState.AllocatedMediumBlockCount);
|
|
Inc(LPrevTotalBlocks, FPrevMemoryManagerState.AllocatedMediumBlockCount);
|
|
UpdateBlockStatistics(2, LInd, FMemoryManagerState.TotalAllocatedMediumBlockSize, FPrevMemoryManagerState.TotalAllocatedMediumBlockSize);
|
|
Inc(LTotalAllocated, FMemoryManagerState.TotalAllocatedMediumBlockSize);
|
|
Inc(LPrevTotalAllocated, FPrevMemoryManagerState.TotalAllocatedMediumBlockSize);
|
|
UpdateBlockStatistics(3, LInd, FMemoryManagerState.ReservedMediumBlockAddressSpace, FPrevMemoryManagerState.ReservedMediumBlockAddressSpace);
|
|
Inc(LTotalReserved, FMemoryManagerState.ReservedMediumBlockAddressSpace);
|
|
Inc(LPrevTotalReserved, FPrevMemoryManagerState.ReservedMediumBlockAddressSpace);
|
|
if FMemoryManagerState.ReservedMediumBlockAddressSpace > 0 then
|
|
sgBlockStatistics.Cells[4, LInd] := FormatFloat('0.##%', FMemoryManagerState.TotalAllocatedMediumBlockSize / FMemoryManagerState.ReservedMediumBlockAddressSpace * 100)
|
|
else
|
|
sgBlockStatistics.Cells[4, LInd] := 'N/A';
|
|
{----------Large blocks----------}
|
|
LInd := Length(FMemoryManagerState.SmallBlockTypeStates) + 2;
|
|
UpdateBlockStatistics(1, LInd, FMemoryManagerState.AllocatedLargeBlockCount, FPrevMemoryManagerState.AllocatedLargeBlockCount);
|
|
Inc(LTotalBlocks, FMemoryManagerState.AllocatedLargeBlockCount);
|
|
Inc(LPrevTotalBlocks, FPrevMemoryManagerState.AllocatedLargeBlockCount);
|
|
UpdateBlockStatistics(2, LInd, FMemoryManagerState.TotalAllocatedLargeBlockSize, FPrevMemoryManagerState.TotalAllocatedLargeBlockSize);
|
|
Inc(LTotalAllocated, FMemoryManagerState.TotalAllocatedLargeBlockSize);
|
|
Inc(LPrevTotalAllocated, FPrevMemoryManagerState.TotalAllocatedLargeBlockSize);
|
|
UpdateBlockStatistics(3, LInd, FMemoryManagerState.ReservedLargeBlockAddressSpace, FPrevMemoryManagerState.ReservedLargeBlockAddressSpace);
|
|
Inc(LTotalReserved, FMemoryManagerState.ReservedLargeBlockAddressSpace);
|
|
Inc(LPrevTotalReserved, FPrevMemoryManagerState.ReservedLargeBlockAddressSpace);
|
|
if FMemoryManagerState.ReservedLargeBlockAddressSpace > 0 then
|
|
sgBlockStatistics.Cells[4, LInd] := FormatFloat('0.##%', FMemoryManagerState.TotalAllocatedLargeBlockSize / FMemoryManagerState.ReservedLargeBlockAddressSpace * 100)
|
|
else
|
|
sgBlockStatistics.Cells[4, LInd] := 'N/A';
|
|
{-----------Overall--------------}
|
|
LInd := Length(FMemoryManagerState.SmallBlockTypeStates) + 3;
|
|
UpdateBlockStatistics(1, Lind, LTotalBlocks, LPrevTotalBlocks);
|
|
UpdateBlockStatistics(2, Lind, LTotalAllocated, LPrevTotalAllocated);
|
|
UpdateBlockStatistics(3, Lind, LTotalReserved, LPrevTotalReserved);
|
|
if LTotalReserved > 0 then
|
|
sgBlockStatistics.Cells[4, LInd] := FormatFloat('0.##%', LTotalAllocated / LTotalReserved * 100)
|
|
else
|
|
sgBlockStatistics.Cells[4, LInd] := 'N/A';
|
|
end;
|
|
|
|
procedure UpdateStatisticsData;
|
|
const
|
|
CI_MaxFreeBlocksList = 9;
|
|
|
|
var
|
|
LR_SystemInfo: TSystemInfo;
|
|
LR_GlobalMemoryStatus: TMemoryStatus;
|
|
LR_GlobalMemoryStatusEx: TMemoryStatusEx;
|
|
LR_ProcessMemoryCounters: TProcessMemoryCounters;
|
|
LR_SysBaseInfo: TSystem_Basic_Information;
|
|
LU_MinQuota: {$if CompilerVersion >= 23}NativeUInt{$else}Cardinal{$ifend};
|
|
LU_MaxQuota: {$if CompilerVersion >= 23}NativeUInt{$else}Cardinal{$ifend};
|
|
LI_I: Integer;
|
|
LI_Max: Integer;
|
|
begin
|
|
mVMStatistics.Lines.BeginUpdate;
|
|
try
|
|
mVMStatistics.Clear;
|
|
|
|
LU_MinQuota := 0;
|
|
LU_MaxQuota := 0;
|
|
|
|
if Assigned(MP_GlobalMemoryStatusEx) then
|
|
begin
|
|
ZeroMemory(@LR_GlobalMemoryStatusEx, SizeOf(TMemoryStatusEx));
|
|
LR_GlobalMemoryStatusEx.dwLength := SizeOf(TMemoryStatusEx);
|
|
|
|
if not MP_GlobalMemoryStatusEx(LR_GlobalMemoryStatusEx) then
|
|
begin
|
|
mVMStatistics.Lines.Add('GlobalMemoryStatusEx err: ' + SysErrorMessage(GetLastError));
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
LR_GlobalMemoryStatus.dwLength := SizeOf(TMemoryStatus);
|
|
GlobalMemoryStatus(LR_GlobalMemoryStatus);
|
|
end;
|
|
|
|
LP_FreeVMList.SortList(LocSort);
|
|
|
|
GetProcessWorkingSetSize(GetCurrentProcess, LU_MinQuota, LU_MaxQuota);
|
|
GetSystemInfo(LR_SystemInfo);
|
|
|
|
with mVMStatistics.Lines do
|
|
begin
|
|
Add('System Info:');
|
|
Add('------------');
|
|
|
|
Add('Processor Count = ' + IntToStr(LR_SystemInfo.dwNumberOfProcessors));
|
|
Add('Allocation Granularity = ' + IntToStr(LR_SystemInfo.dwAllocationGranularity));
|
|
|
|
if Assigned(MP_GlobalMemoryStatusEx) then
|
|
begin
|
|
with LR_GlobalMemoryStatusEx do
|
|
begin
|
|
Add('Available Physical Memory = ' + Int64ToKStringFormatted(ullAvailPhys));
|
|
Add('Total Physical Memory = ' + Int64ToKStringFormatted(ullTotalPhys));
|
|
Add('Available Virtual Memory = ' + Int64ToKStringFormatted(ullAvailVirtual));
|
|
Add('Total Virtual Memory = ' + Int64ToKStringFormatted(ullTotalVirtual));
|
|
Add('Total Virtual Extended Memory = ' + Int64ToKStringFormatted(ullAvailExtendedVirtual));
|
|
end;
|
|
end
|
|
|
|
else
|
|
begin
|
|
with LR_GlobalMemoryStatus do
|
|
begin
|
|
Add('Available Physical Memory = ' + Int64ToKStringFormatted(dwAvailPhys));
|
|
Add('Total Physical Memory = ' + Int64ToKStringFormatted(dwTotalPhys));
|
|
Add('Available Virtual Memory = ' + Int64ToKStringFormatted(dwAvailVirtual));
|
|
Add('Total Virtual Memory = ' + Int64ToKStringFormatted(dwTotalVirtual));
|
|
end;
|
|
end;
|
|
|
|
if Assigned(MP_NtQuerySystemInformation) then
|
|
begin
|
|
if MP_NtQuerySystemInformation(SystemBasicInformation, @LR_SysBaseInfo, SizeOf(LR_SysBaseInfo), nil) = 0 then
|
|
begin
|
|
with LR_SysBaseInfo do begin
|
|
Add('Maximum Increment = ' + CardinalToKStringFormatted(uKeMaximumIncrement));
|
|
Add('Page Size = ' + CardinalToKStringFormatted(uPageSize));
|
|
Add('Number of Physical Pages = ' + CardinalToKStringFormatted(uMmNumberOfPhysicalPages));
|
|
Add('Lowest Physical Page = ' + CardinalToStringFormatted(uMmLowestPhysicalPage));
|
|
Add('Highest Physical Page = ' + CardinalToKStringFormatted(uMmHighestPhysicalPage));
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// same as GetProcessMemoryInfo & NtQuerySystemInformation (SystemBasicInformation
|
|
|
|
// The working set is the amount of memory physically mapped to the process context at a given
|
|
// time. Memory in the paged pool is system memory that can be transferred to the paging file
|
|
// on disk (paged) when it is not being used. Memory in the nonpaged pool is system memory
|
|
// that cannot be paged to disk as long as the corresponding objects are allocated. The pagefile
|
|
// usage represents how much memory is set aside for the process in the system paging file.
|
|
// When memory usage is too high, the virtual memory manager pages selected memory to disk.
|
|
// When a thread needs a page that is not in memory, the memory manager reloads it from the
|
|
// paging file.
|
|
|
|
|
|
if GetProcessMemoryInfo(GetCurrentProcess, @LR_ProcessMemoryCounters, SizeOf(LR_ProcessMemoryCounters)) then
|
|
begin
|
|
with LR_ProcessMemoryCounters do
|
|
begin
|
|
Add('Page Fault Count = ' + CardinalToKStringFormatted(PageFaultCount));
|
|
Add('Peak Working Set Size = ' + Int64ToKStringFormatted(PeakWorkingSetSize));
|
|
Add('Working Set Size = ' + Int64ToKStringFormatted(WorkingSetSize));
|
|
Add('Quota Peak Paged Pool Usage = ' + Int64ToKStringFormatted(QuotaPeakPagedPoolUsage));
|
|
Add('Quota Paged Pool Usage = ' + Int64ToKStringFormatted(QuotaPagedPoolUsage));
|
|
Add('Quota Peak Non-Paged Pool Usage = ' + Int64ToKStringFormatted(QuotaPeakNonPagedPoolUsage));
|
|
Add('Quota Non-Paged Pool Usage = ' + Int64ToKStringFormatted(QuotaNonPagedPoolUsage));
|
|
Add('Pagefile Usage = ' + Int64ToKStringFormatted(PagefileUsage));
|
|
Add('Peak Pagefile Usage = ' + Int64ToKStringFormatted(PeakPagefileUsage));
|
|
end;
|
|
end;
|
|
|
|
Add('');
|
|
Add('Process Info: PID (' + IntToStr(GetCurrentProcessId) + ')');
|
|
Add('------------------------');
|
|
Add('Minimum Address = ' + Int64ToKStringFormatted(NativeUInt(LR_SystemInfo.lpMinimumApplicationAddress)));
|
|
Add('Maximum VM Address = ' + Int64ToKStringFormatted(NativeUInt(LR_SystemInfo.lpMaximumApplicationAddress)));
|
|
Add('Page Protection & Commit Size = ' + IntToStr(LR_SystemInfo.dWPageSize));
|
|
Add('');
|
|
Add('Quota info:');
|
|
Add('-----------');
|
|
Add('Minimum Quota = ' + Int64ToKStringFormatted(LU_MinQuota));
|
|
Add('Maximum Quota = ' + Int64ToKStringFormatted(LU_MaxQuota));
|
|
Add('');
|
|
Add('VM Info:');
|
|
Add('--------');
|
|
Add('Total Free = ' + Int64ToKStringFormatted(LU_MEM_FREE));
|
|
Add('Total Reserve = ' + Int64ToKStringFormatted(LU_MEM_RESERVE));
|
|
Add('Total Commit = ' + Int64ToKStringFormatted(LU_MEM_COMMIT));
|
|
|
|
if LP_FreeVMList.Count > CI_MaxFreeBlocksList then
|
|
LI_Max := CI_MaxFreeBlocksList - 1
|
|
else
|
|
LI_Max := LP_FreeVMList.Count - 1;
|
|
|
|
for LI_I := 0 to LI_Max do
|
|
begin
|
|
Add('Largest Free Block ' + IntToStr(LI_I + 1) + '. = ' + Int64ToKStringFormatted(NativeUInt(LP_FreeVMList.List[LI_I])));
|
|
end;
|
|
|
|
Add('');
|
|
Add('FastMM4 Info:');
|
|
Add('-------------');
|
|
Add('Total Blocks = ' + Int64ToKStringFormatted(LTotalBlocks));
|
|
Add('Total Allocated = ' + Int64ToKStringFormatted(LTotalAllocated));
|
|
Add('Total Reserved = ' + Int64ToKStringFormatted(LTotalReserved));
|
|
end;
|
|
|
|
finally
|
|
mVMStatistics.Lines.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
Save_Cursor: TCursor;
|
|
begin
|
|
if SizeOf(TMemoryMap) <> SizeOf(TMemoryMapEx) then
|
|
begin
|
|
Showmessage('Internal implementation error');
|
|
Exit;
|
|
end;
|
|
|
|
LU_MEM_FREE := 0;
|
|
LU_MEM_COMMIT := 0;
|
|
LU_MEM_RESERVE := 0;
|
|
|
|
LTotalBlocks := 0;
|
|
LTotalAllocated := 0;
|
|
LTotalReserved := 0;
|
|
|
|
LPrevTotalBlocks := 0;
|
|
LPrevTotalAllocated := 0;
|
|
LPrevTotalReserved := 0;
|
|
|
|
// Set hourglass cursor
|
|
Save_Cursor := Screen.Cursor;
|
|
Screen.Cursor := crHourGlass;
|
|
LP_FreeVMList := TList.Create;
|
|
try
|
|
// retrieve FastMM4 info
|
|
|
|
GetMemoryManagerState(FMemoryManagerState);
|
|
GetMemoryMap(TMemoryMap(FMemoryMapEx));
|
|
|
|
// Update FastMM4 Graph with EXE & DLL locations
|
|
UpdateVMGraph(FMemoryMapEx);
|
|
|
|
// VM dump
|
|
UpdateVMDump;
|
|
|
|
// FastMM4 data
|
|
UpdateFastMM4Data;
|
|
|
|
// General Information
|
|
UpdateStatisticsData;
|
|
|
|
// Screen updates
|
|
dgMemoryMap.Invalidate;
|
|
|
|
FPrevMemoryManagerState := FMemoryManagerState;
|
|
finally
|
|
FreeAndNil(LP_FreeVMList);
|
|
Screen.Cursor := Save_Cursor;
|
|
end;
|
|
end;
|
|
|
|
procedure TfFastMMUsageTracker.sgBlockStatisticsDrawCell(Sender: TObject;
|
|
ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
|
|
var
|
|
d: integer;
|
|
y: integer;
|
|
s: string;
|
|
LOldColour, LColour: TColor;
|
|
begin
|
|
d := Integer(sgBlockStatistics.Objects[ACol, ARow]);
|
|
if d <> 0 then
|
|
begin
|
|
LOldColour := sgBlockStatistics.Canvas.Brush.Color;
|
|
if d < 0 then
|
|
LColour := clLime
|
|
else
|
|
LColour := clRed;
|
|
sgBlockStatistics.Canvas.Brush.Color := LColour;
|
|
sgBlockStatistics.Canvas.Font.Color := clWindowText;
|
|
s := sgBlockStatistics.Cells[ACol, ARow];
|
|
y := sgBlockStatistics.Canvas.TextHeight(s);
|
|
y := ((Rect.Bottom - Rect.Top) - y) div 2;
|
|
sgBlockStatistics.Canvas.TextRect(Rect, Rect.Left + 2, Rect.top + y, s);
|
|
sgBlockStatistics.Canvas.Brush.Color := LOldColour;
|
|
end;
|
|
end;
|
|
|
|
procedure TfFastMMUsageTracker.tTimerTimer(Sender: TObject);
|
|
begin
|
|
tTimer.Enabled := False;
|
|
try
|
|
RefreshSnapShot;
|
|
finally
|
|
tTimer.Enabled := True;
|
|
end;
|
|
end;
|
|
|
|
procedure TfFastMMUsageTracker.bCloseClick(Sender: TObject);
|
|
begin
|
|
Close;
|
|
end;
|
|
|
|
procedure TfFastMMUsageTracker.dgMemoryMapDrawCell(Sender: TObject; ACol,
|
|
ARow: Integer; Rect: TRect; State: TGridDrawState);
|
|
var
|
|
LChunkIndex: integer;
|
|
LChunkColour: TColor;
|
|
begin
|
|
{Get the chunk index}
|
|
LChunkIndex := ARow * dgMemoryMap.ColCount + ACol;
|
|
|
|
{Get the correct colour}
|
|
case FMemoryMapEx[LChunkIndex] of
|
|
|
|
csExAllocated:
|
|
begin
|
|
LChunkColour := $9090FF;
|
|
end;
|
|
|
|
csExReserved:
|
|
begin
|
|
LChunkColour := $90F090;
|
|
end;
|
|
|
|
csExSysAllocated:
|
|
begin
|
|
LChunkColour := $707070;
|
|
end;
|
|
|
|
csExSysExe:
|
|
begin
|
|
LChunkColour := clRed;
|
|
end;
|
|
|
|
csExSysDLL:
|
|
begin
|
|
LChunkColour := clBlue;
|
|
end;
|
|
|
|
csExSysReserved:
|
|
begin
|
|
LChunkColour := $C0C0C0;
|
|
end
|
|
|
|
else
|
|
begin
|
|
{ExUnallocated}
|
|
LChunkColour := $FFFFFF;
|
|
end;
|
|
end;
|
|
|
|
{Draw the chunk background}
|
|
dgMemoryMap.Canvas.Brush.Color := LChunkColour;
|
|
|
|
if State = [] then
|
|
dgMemoryMap.Canvas.FillRect(Rect)
|
|
else
|
|
dgMemoryMap.Canvas.Rectangle(Rect);
|
|
end;
|
|
|
|
procedure TfFastMMUsageTracker.dgMemoryMapSelectCell(Sender: TObject; ACol,
|
|
ARow: Integer; var CanSelect: Boolean);
|
|
var
|
|
LChunkIndex: Cardinal;
|
|
LMBI: TMemoryBasicInformation;
|
|
LA_Char: array[0..MAX_PATH] of char;
|
|
begin
|
|
eDLLName.Text := '';
|
|
LChunkIndex := ARow * dgMemoryMap.ColCount + ACol;
|
|
eAddress.Text := Format('$%0.8x', [LChunkIndex shl 16]);
|
|
|
|
case FMemoryMapEx[LChunkIndex] of
|
|
|
|
csExAllocated:
|
|
begin
|
|
eState.Text := 'FastMM Allocated';
|
|
end;
|
|
|
|
csExReserved:
|
|
begin
|
|
eState.Text := 'FastMM Reserved';
|
|
end;
|
|
|
|
csExSysAllocated:
|
|
begin
|
|
eState.Text := 'System Allocated';
|
|
end;
|
|
|
|
csExSysExe:
|
|
begin
|
|
eState.Text := 'System Exe';
|
|
VirtualQuery(Pointer(LChunkIndex shl 16), LMBI, SizeOf(LMBI));
|
|
if (GetModuleFileName(dword(LMBI.AllocationBase), LA_Char, MAX_PATH) <> 0) then
|
|
begin
|
|
eDLLName.Text := LA_Char;
|
|
end;
|
|
end;
|
|
|
|
csExSysDLL:
|
|
begin
|
|
eState.Text := 'System/User DLL';
|
|
VirtualQuery(Pointer(LChunkIndex shl 16), LMBI, SizeOf(LMBI));
|
|
if (GetModuleFileName(dword(LMBI.AllocationBase), LA_Char, MAX_PATH) <> 0) then
|
|
begin
|
|
eDLLName.Text := LA_Char;
|
|
end;
|
|
end;
|
|
|
|
csExSysReserved:
|
|
begin
|
|
eState.Text := 'System Reserved';
|
|
end
|
|
|
|
else
|
|
begin
|
|
{ExUnallocated}
|
|
eState.Text := 'Free';
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfFastMMUsageTracker.bUpdateClick(Sender: TObject);
|
|
begin
|
|
RefreshSnapShot;
|
|
end;
|
|
|
|
procedure TfFastMMUsageTracker.ChkAutoUpdateClick(Sender: TObject);
|
|
begin
|
|
tTimer.Enabled := ChkAutoUpdate.Checked;
|
|
end;
|
|
|
|
procedure TfFastMMUsageTracker.ChkSmallGraphClick(Sender: TObject);
|
|
begin
|
|
UpdateGraphMetrics;
|
|
dgMemoryMap.Invalidate;
|
|
dgMemoryMap.SetFocus;
|
|
end;
|
|
|
|
procedure TfFastMMUsageTracker.sgVMDumpMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
if (Button = mbLeft) and (Shift = [ssLeft]) then
|
|
begin
|
|
(Sender as TStringgrid).MouseToCell(X, Y, OR_VMDumpDownCell.X, OR_VMDumpDownCell.Y);
|
|
end
|
|
else
|
|
begin
|
|
OR_VMDumpDownCell.X := 0;
|
|
OR_VMDumpDownCell.Y := 0;
|
|
end;
|
|
end;
|
|
|
|
procedure TfFastMMUsageTracker.sgVMDumpMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
p: TGridCoord;
|
|
LGrid: TStringgrid;
|
|
begin
|
|
LGrid := Sender as TStringGrid;
|
|
if (Button = mbLeft) and (Shift = []) then
|
|
begin
|
|
LGrid.MouseToCell(X, Y, p.X, p.Y);
|
|
if CompareMem(@p, @OR_VMDumpDownCell, sizeof(p))
|
|
and (p.Y < LGrid.FixedRows)
|
|
and (p.X >= LGrid.FixedCols) then
|
|
begin
|
|
HeaderClicked(LGrid, p);
|
|
end;
|
|
end;
|
|
OR_VMDumpDownCell.X := 0;
|
|
OR_VMDumpDownCell.Y := 0;
|
|
end;
|
|
|
|
procedure TfFastMMUsageTracker.sgVMDumpDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
|
|
var
|
|
LGrid: TStringgrid;
|
|
LMarker: Char;
|
|
begin
|
|
LGrid := Sender as TStringgrid;
|
|
// paint the sort marker on header columns
|
|
if (ACol >= LGrid.FixedCols) and (aRow = 0) then
|
|
begin
|
|
if Assigned(LGrid.Objects[aCol, aRow]) then
|
|
begin
|
|
if Integer(LGrid.Objects[aCol, aRow]) > 0 then
|
|
LMarker := 't' // up wedge in Marlett font
|
|
else
|
|
LMarker := 'u'; // down wedge in Marlett font
|
|
with LGrid.canvas do
|
|
begin
|
|
Font.Name := 'Marlett';
|
|
Font.Charset := SYMBOL_CHARSET;
|
|
Font.Size := 12;
|
|
TextOut(Rect.Right - TextWidth(LMarker), Rect.Top, LMarker);
|
|
Font := LGrid.font;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfFastMMUsageTracker.siMM4AllocationCopyAlltoClipboardClick(Sender: TObject);
|
|
begin
|
|
CopyGridContentsToClipBoard(sgBlockStatistics);
|
|
end;
|
|
|
|
procedure TfFastMMUsageTracker.miVMDumpCopyAlltoClipboardClick(Sender: TObject);
|
|
begin
|
|
CopyGridContentsToClipBoard(sgVMDump);
|
|
end;
|
|
|
|
procedure TfFastMMUsageTracker.miGeneralInformationCopyAlltoClipboardClick(Sender: TObject);
|
|
begin
|
|
with mVMStatistics do
|
|
begin
|
|
Lines.BeginUpdate;
|
|
try
|
|
SelectAll;
|
|
CopyToClipboard;
|
|
SelStart := 0;
|
|
finally
|
|
Lines.EndUpdate;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure ModuleInit;
|
|
begin
|
|
if Win32Platform = VER_PLATFORM_WIN32_NT then
|
|
begin
|
|
MP_GlobalMemoryStatusEx := TP_GlobalMemoryStatusEx(
|
|
GetProcAddress(GetModuleHandle(kernel32), 'GlobalMemoryStatusEx'));
|
|
MP_NtQuerySystemInformation := TP_NtQuerySystemInformation(
|
|
GetProcAddress(GetModuleHandle('ntdll.dll'), 'NtQuerySystemInformation'));
|
|
end;
|
|
end;
|
|
|
|
initialization
|
|
ModuleInit;
|
|
|
|
end.
|