unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TfMain = class(TForm)
    btnExploreMem: TButton;
    Label1: TLabel;
    lPageSize: TLabel;
    Label2: TLabel;
    bv1: TBevel;
    Label3: TLabel;
    bv2: TBevel;
    pnStateFree: TPanel;
    pnStateReserve: TPanel;
    pnStateCommit: TPanel;
    pnProtectNoAccess: TPanel;
    pnProtectReadOnly: TPanel;
    pnProtectReadWrite: TPanel;
    pnProtectWriteCopy: TPanel;
    btnAllocMemory: TButton;
    btnFree: TButton;
    procedure btnExploreMemClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnAllocMemoryClick(Sender: TObject);
    procedure btnFreeClick(Sender: TObject);
  private
    procedure DrawMemoryChart;
  public
    { Public declarations }
  end;

  TMemInfo = record
    State   : DWORD;
    Protect : DWORD;
  end;

var
  fMain: TfMain;

  PageSize : DWORD;
  MemInfo  : array of TMemInfo;

  LargeBlock : pointer;

const
  LinesCount = 4;
  LineHeight = 20;

  chrtTopMargin = 10;
  chrtLeftMargin = 10;

  clStateFree = $0073F9CA;
  clStateReserve = $004293FF;
  clStateCommit = $002828FF;

  clProtectNoAccess = $002828FF;
  clProtectReadOnly = $004293FF;
  clProtectReadWrite = $0073F9CA;
  clProtectWriteCopy = $00FFB99F;

implementation

{$R *.dfm}

function Max3(n1, n2, n3: DWORD): DWORD;
begin
  Result := n1;
  if n2 > n1 then Result := n2 else
    if n3 > n1 then Result := n3;
end;

function Max4(n1, n2, n3, n4: DWORD): DWORD;
var n : DWORD;
begin
  n := Max3(n1, n2, n3);
  if n >= n4 then Result := n else result := n4;
end;

procedure TfMain.btnExploreMemClick(Sender: TObject);
var SystemInfo: TSystemInfo;
    mbi : TMemoryBasicInformation;
    State, Protect : DWORD;
    CurrAddr : Int64;
begin
  GetSystemInfo(SystemInfo);
  PageSize := SystemInfo.dwPageSize;
  lPageSize.Caption := IntToStr(PageSize);

  MemInfo := nil;
  CurrAddr := 0;
  while CurrAddr < 4294967296 do begin
    VirtualQuery(Ptr(CurrAddr), mbi, SizeOf(mbi));
    State := mbi.State;
    if mbi.Protect > 0 then Protect := mbi.Protect;

    SetLength(MemInfo, Length(MemInfo) + 1);
    MemInfo[High(MemInfo)].Protect := Protect;
    MemInfo[High(MemInfo)].State := State;

    Inc(CurrAddr, PageSize);
  end;

  DrawMemoryChart;
end;

procedure TfMain.btnFreeClick(Sender: TObject);
begin
  VirtualFree(LargeBlock, 0, MEM_RELEASE);
end;

procedure TfMain.btnAllocMemoryClick(Sender: TObject);
begin
  LargeBlock := VirtualAlloc(Ptr(512 * 1024 * 1024), 100 * 1024 * 4096, MEM_RESERVE or MEM_COMMIT,
    PAGE_READWRITE);
end;

procedure TfMain.DrawMemoryChart;
var PagesPerLine, PagesPerPixel : DWORD;
    L, I, J, StartPage, EndPage, Max : DWORD;
    Col : TColor;
    CommitCnt, ReserveCnt, FreeCnt : word;
    NoAccessCnt, ReadOnlyCnt, ReadWriteCnt, WriteCopyCnt: word;
    ChartWidth, TopMargin1, TopMargin2 : word;
    ColWidth : real;
begin
  if Length(MemInfo) = 0 then Exit;

  ChartWidth := ClientWidth - 2 * chrtLeftMargin;
  PagesPerLine := Length(MemInfo) div LinesCount;
  PagesPerPixel := PagesPerLine div ChartWidth;
  TopMargin1 := bv1.Top + bv1.Height + chrtTopMargin;
  TopMargin2 := bv2.Top + bv2.Height + chrtTopMargin;

  for L := 1 to LinesCount do begin
    for I := 0 to ChartWidth - 1 do begin
      CommitCnt := 0; ReserveCnt := 0; FreeCnt := 0;
      NoAccessCnt := 0; ReadOnlyCnt := 0; ReadWriteCnt := 0; WriteCopyCnt := 0;

      StartPage := I * PagesPerPixel + (PagesperLine * (L - 1));
      EndPage := (I + 1) * PagesPerPixel + (PagesperLine * (L - 1)) - 1;
      for J := StartPage to EndPage do begin
        if J > High(MemInfo) then Exit;
        case MemInfo[J].State of
          MEM_COMMIT  : Inc(CommitCnt);
          MEM_RESERVE : Inc(ReserveCnt);
          MEM_FREE    : Inc(FreeCnt);
        end;
        case MemInfo[J].Protect of
          PAGE_NOACCESS, PAGE_EXECUTE : Inc(NoAccessCnt);
          PAGE_READONLY, PAGE_EXECUTE_READ : Inc(ReadOnlyCnt);
          PAGE_READWRITE, PAGE_EXECUTE_READWRITE : Inc(ReadWriteCnt);
          PAGE_WRITECOPY, PAGE_EXECUTE_WRITECOPY : Inc(WriteCopyCnt);
        end;
      end;

      Col := clWhite;
      Max := Max3(CommitCnt, ReserveCnt, FreeCnt);
      if Max = CommitCnt then Col := clStateCommit else
        if Max = Reservecnt then Col := clStateReserve else
          if Max = FreeCnt then Col := clStateFree;
      Canvas.Pen.Color := Col;
      Canvas.MoveTo(chrtLeftMargin + I, TopMargin1 + (L-1)*LineHeight);
      Canvas.LineTo(chrtLeftMargin + I, TopMargin1 + L*LineHeight);

      if (NoAccessCnt > 0) or (ReadOnlyCnt > 0) or
         (ReadWriteCnt > 0) or (WriteCopyCnt > 0) then begin
        Max := Max4(NoAccessCnt, ReadOnlyCnt, ReadWriteCnt, WriteCopyCnt);
        if Max = NoAccessCnt then Col := clProtectNoAccess else
          if Max = ReadOnlyCnt then Col := clProtectReadOnly else
            if Max = ReadWriteCnt then Col := clProtectReadWrite else
              if Max = WriteCopyCnt then Col := clProtectWriteCopy;
      end else Col := clWhite;
      Canvas.Pen.Color := Col;
      Canvas.MoveTo(chrtLeftMargin + I, TopMargin2 + (L-1)*LineHeight);
      Canvas.LineTo(chrtLeftMargin + I, TopMargin2 + L*LineHeight);
    end;
  end;
  Canvas.Pen.Color := $006C6C6C;
  Canvas.Brush.Style := bsClear;
  for L := 1 to LinesCount do begin
    Canvas.Rectangle(chrtLeftMargin - 1, TopMargin1 + (L-1)*LineHeight,
      chrtLeftMargin + ChartWidth, TopMargin1 + L*LineHeight+1);
    Canvas.Rectangle(chrtLeftMargin - 1, TopMargin2 + (L-1)*LineHeight,
      chrtLeftMargin + ChartWidth, TopMargin2 + L*LineHeight+1);
  end;
  ColWidth := ChartWidth / 10;
  for I := 1 to 9 do begin
    Canvas.MoveTo(chrtLeftMargin + Round(ColWidth * I), TopMargin1);
    Canvas.LineTo(chrtLeftMargin + Round(ColWidth * I), TopMargin1 + LinesCount * LineHeight);
    Canvas.MoveTo(chrtLeftMargin + Round(ColWidth * I), TopMargin2);
    Canvas.LineTo(chrtLeftMargin + Round(ColWidth * I), TopMargin2 + LinesCount * LineHeight);
  end;
end;

procedure TfMain.FormCreate(Sender: TObject);
begin
  pnStateFree.Color := clStateFree;
  pnStateReserve.Color := clStateReserve;
  pnStateCommit.Color := clStateCommit;

  pnProtectNoAccess.Color := clProtectNoAccess;
  pnProtectReadOnly.Color := clProtectReadOnly;
  pnProtectReadWrite.Color := clProtectReadWrite;
  pnProtectWriteCopy.Color := clProtectWriteCopy;
end;

procedure TfMain.FormResize(Sender: TObject);
begin
  bv1.Width := ClientWidth - 2 * bv1.Left;
  bv2.Width := ClientWidth - 2 * bv2.Left;
  DrawMemoryChart;
end;

end.
