{****  Audit 1.0 Copyright 1992 Doug Overmyer ********}
program Audit;
{$R audit.RES}
uses WinTypes, WinProcs, WObjects, StdDlgs,Strings,StdWnds,
		win31,toolhelp,sclptext;
const
  AU_Name =  'Heap Audit';
  id_St0       = 100;
  id_St1       = 101;
  id_St2       = 102;
  id_St3       = 103;
  id_St4       = 104;
  id_St5       = 105;
  id_St6       = 106;
  id_St7       = 107;
  id_St8       = 108;
  id_St9       = 109;
  id_St10      = 110;
  idm_AUChange = 301;
  idm_AUShowHide=302;
  um_ReSize    = 401;
  id_About     = 501;
  id_IG1  =      600;
  id_CMGDI =     601;
  id_CMUser =    602;
  id_CMMemMgr =  603;
  id_CMExit =    610;
{**********************  TYPES      ******************************}
type
  TAUApp = object(TApplication)
  procedure InitMainWindow; virtual;
end;

PAUWindow = ^TAUWindow;
TAUWindow = object(TWindow)
	StA,StB:Array[0..10] of PSText;
  StH,StJ:PSText;
	SHI:TSysHeapInfo;
  constructor Init(ATitle: PChar);
  destructor Done; virtual;
  procedure SetupWindow;virtual;
  procedure IDCMGDI(Var Msg:TMessage);virtual cm_First+id_CMGDI;
  procedure IDCMUser(Var Msg:TMessage);virtual cm_First+id_CMUser;
  procedure IDCMMemMgr(Var Msg:TMessage);virtual cm_First+id_CMMemMgr;
  procedure IDCMExit(Var Msg:TMessage);virtual cm_First+id_CMExit;
  procedure SetHeader(Msg:Pchar);
  procedure	WMSysCommand(var Msg:TMessage);virtual wm_First+wm_SysCommand;
end;
{**********************  METHODS    ******************************}
procedure TAUApp.InitMainWindow;
begin
  MainWindow := New(PAUWindow, Init(AU_Name));
end;
{**********************  TAUWindow  *******************************}
constructor TAUWindow.Init(ATitle: PChar);
var
  Indx:Integer;
begin
  TWindow.Init(nil, ATitle);
  with Attr do
    begin
    X := 50; Y := 50; W := 320; H := 360;
 		Attr.Style := ws_Overlapped or ws_SysMenu or ws_MinimizeBox;
    Menu := LoadMenu(hInstance,'AU_Menu');
    end;
  StH := New(PSText,Init(@Self,id_St0,'',25,30,265,20,sr_Raised,
  			dt_Center or dt_VCenter or dt_SingleLine));
  StJ := New(PSText,Init(@Self,id_St0,'',35,5,245,20,sr_Raised,
  			dt_Center or dt_VCenter or dt_SingleLine));
	for Indx := 1 to 10 do
  	begin
 		StA[Indx] := New(PSText,Init(@Self,101+Indx,'',15,35+25*Indx,180,20,sr_Recessed,
  			dt_Right or dt_VCenter or dt_SingleLine));
 		StB[Indx] := New(PSText,Init(@Self,101+Indx,'',215,35+25*Indx,85,20,sr_Recessed,
  			dt_Right or dt_VCenter or dt_SingleLine));
    end;
end;

destructor TAUWindow.Done;
begin
  TWindow.Done;
end;

procedure TAUWindow.SetupWindow;
var
  SysMenu:HMenu;
  Res :Bool;
  R:record
  	Glob:LongInt;
    PGDI:Word;
    PUser:Word;
    Msg:PChar;
	end;
  Buf:Array[0..200] of Char;
begin
  TWindow.SetupWindow;
  SetClassWord(HWindow,GCW_HIcon,LoadIcon(HInstance,'AU_Icon'));
  SetClassWord(HWindow,GCW_HBrBackground,GetStockObject(ltGray_Brush));
  Sysmenu := GetSystemMenu(hWindow,false);
  AppendMenu(SysMenu,MF_Separator,0,nil);
  AppendMenu(Sysmenu,0,id_About,'About...');
  SetHeader('');
	end;

procedure TAUWindow.SetHeader(Msg:PChar);
var
  Res :Bool;
  R:record
  	Glob:LongInt;
    PGDI:Word;
    PUser:Word;
    Msg:PChar;
	end;
  Buf:Array[0..200] of Char;
begin
  Shi.dwSize := Sizeof(SHI);
  Res := SystemHeapInfo(@SHI);
  R.Glob := GetFreeSpace(0);
  R.PGDI := SHI.wGDIFreePercent;
  R.PUser := SHI.wUserFreePercent;
  wvsprintf(Buf,'GMem:%lu  %%GDI:%u  %%User:%u',R);
  StH^.SetText(Buf);
  StJ^.SetText(Msg);
end;

procedure TAUWindow.IDCMGDI(var Msg:TMessage);
var
  Res:Bool;
  LI:TLocalInfo;
  LE:TLocalEntry;
  Indx:Integer;
  Buf:Array[0..50] of Char;
  H:record
  	cBitmap,cBrush,cDC,CFont,cMetaFile,cMetaDC,cPalette,
  	cPen,cRgn:Integer;
  end;
begin
	H.cBitmap := 0;H.cBrush := 0;H.cDC := 0;H.cFont := 0;
  H.cMetaFile := 0;H.cMetaDC := 0;H.cPalette := 0;H.cPen := 0;H.cRgn := 0;
  LI.dwSize := sizeof(LI);
  Res := LocalInfo(@LI,SHI.hGDISegment);
  LE.dwSize := sizeof(LE);
  for Indx := 0 to Pred(LI.wcItems) do
  	begin
    if Indx = 0 then
    	res := LocalFirst(@LE,SHI.hGDISegment)
    else
    	res := LocalNext(@LE);
  	case LE.wType of
    	LT_GDI_BITMAP:Inc(H.cBitmap);
      LT_GDI_BRUSH:Inc(H.cBrush);
      LT_GDI_DC:Inc(H.cDC);
      LT_GDI_FONT:Inc(H.cFont);
      LT_GDI_METADC:Inc(H.cMetaDC);
      LT_GDI_METAFILE:Inc(H.cMetaFile);
      LT_GDI_PALETTE:Inc(H.cPalette);
      LT_GDI_PEN:Inc(H.cPen);
      LT_GDI_RGN:Inc(H.cRgn);
    end;
  	end;
	for Indx := 1 to 10 do
  	begin
    StA[Indx]^.SetText('');
    STB[Indx]^.SetText('');
    end;
  StA[1]^.SetText('# Bitmaps:');
  StA[2]^.SetText('# Brushes');
  StA[3]^.SetText('# Device Contexts:');;
  StA[4]^.SetText('# Fonts:');
  StA[5]^.SetText('# Metafiles:');
  StA[6]^.SetText('# MetaDCs:');
  StA[7]^.SetText('# Palettes:');
  StA[8]^.SetText('# Pens:');
  StA[9]^.SetText('# Regions:');
  StA[10]^.SetText('');
	SetHeader('GDI Local Heap Info');

  wvsprintf(Buf,'%i',H.cBitmap);
  StB[1]^.SetText(buf);
  wvsprintf(Buf,'%i',H.cBrush);
  StB[2]^.SetText(buf);
  wvsprintf(Buf,'%i',H.cDC);
  StB[3]^.SetText(buf);
  wvsprintf(Buf,'%i',H.cFont);
  StB[4]^.SetText(buf);
  wvsprintf(Buf,'%i',H.cMetaFile);
  StB[5]^.SetText(buf);
  wvsprintf(Buf,'%i',H.cMetaDC);
  StB[6]^.SetText(buf);
  wvsprintf(Buf,'%i',H.cPalette);
  StB[7]^.SetText(buf);
  wvsprintf(Buf,'%i',H.cPen);
  StB[8]^.SetText(buf);
  wvsprintf(Buf,'%i',H.cRgn);
  StB[9]^.SetText(buf);
  StB[10]^.SetText('');
end;

procedure TAUWindow.IDCMUser(var Msg:TMessage);
var
  Res:Bool;
  LI:TLocalInfo;
  LE:TLocalEntry;
  Indx:Integer;
  Buf:Array[0..50] of Char;
  H:record
  	cAtoms,cCBox,cClass,CEd,cLBIV,cMenu,cProp,
  	cWnd:Integer;
  end;
begin
	H.cAtoms := 0;H.cCBox := 0;H.cClass := 0;H.cEd := 0;
  H.cLBIV := 0;H.cMenu := 0;H.cProp := 0;H.cWnd := 0; 
  LI.dwSize := sizeof(LI);
  Res := LocalInfo(@LI,SHI.hUserSegment);
  LE.dwSize := sizeof(LE);
  for Indx := 0 to Pred(LI.wcItems) do
  	begin
    if Indx = 0 then
    	res := LocalFirst(@LE,SHI.hUserSegment)
    else
    	res := LocalNext(@LE);
  	case LE.wType of
    	LT_USER_ATOMS:Inc(H.cAtoms);
      LT_USER_CBOX:Inc(H.cCBox);
      LT_USER_CLASS:Inc(H.cClass);
      LT_USER_ED:Inc(H.cED);
      LT_USER_LBIV:Inc(H.cLBIV );
      LT_USER_MENU:Inc(H.cMenu);
      LT_USER_PROP:Inc(H.cProp);
      LT_USER_WND:Inc(H.cWnd);
    end;
  	end;
	for Indx := 1 to 10 do
  	begin
    StA[Indx]^.SetText('');
    STB[Indx]^.SetText('');
    end;
  StA[1]^.SetText('# Atoms');
  wvsprintf(Buf,'%i',H.cAtoms);
  StB[1]^.SetText(buf);

  STA[2]^.SetText('# Combo Boxes');
  wvsprintf(Buf,'%i',H.cCBox);
  StB[2]^.SetText(buf);

  StA[3]^.SetText('# Class Structures');
  wvsprintf(Buf,'%i',H.cClass);
  StB[3]^.SetText(buf);

  STA[4]^.SetText('# Edit Controls');
  wvsprintf(Buf,'%i',H.cEd );
  StB[4]^.SetText(buf);

  StA[5]^.SetText('# Listbox Controls');
  wvsprintf(Buf,'%i',H.cLBIV);
  StB[5]^.SetText(buf);

  STA[6]^.SetText('# Menus');
  wvsprintf(Buf,'%i',H.cMenu);
  StB[6]^.SetText(buf);

  STA[7]^.SetText('# Property Structures');
  wvsprintf(Buf,'%i',H.cProp);
  StB[7]^.SetText(buf);

  STA[8]^.SetText('# Window Structures');
  wvsprintf(Buf,'%i',H.cWnd);
  StB[8]^.SetText(buf);

  SetHeader('User Local Heap Info (Debug only)');
end;

procedure TAUWindow.IDCMMemMgr(var Msg:TMessage);
var
	MMI:TMemManInfo;
  Buf:Array[0..50] of Char;
  dwFlag:LongInt;
  Indx :Integer;
begin
	for Indx := 1 to 10 do
  	begin
    StA[Indx]^.SetText('');
    STB[Indx]^.SetText('');
    end;
	dwFlag := GetWinFlags;
  if dwFlag and WF_ENHANCED  =  0 then
  	begin
  	SetHeader('Valid info in 386 Enhanced only!');
  	Exit;
    end;
	MMI.dwSize := sizeOf(MMI);
  MemManInfo(@MMI);
  MMI.dwFreeLinearSpace := MMI.dwFreeLinearSpace * MMI.wPageSize;
  MMI.dwTotalLinearSpace := MMI.dwTotalLinearSpace * MMI.wPageSize;

  StA[1]^.SetText('Largest Free Block');
  wvsprintf(Buf,'%lu',MMI.dwLargestFreeBlock);
  StB[1]^.SetText(buf);
  StA[2]^.SetText('Max Pages Available');
  wvsprintf(Buf,'%lu',MMI.dwMaxPagesAvailable);
  StB[2]^.SetText(buf);
  StA[3]^.SetText('Max Pages Lockable');
  wvsprintf(Buf,'%lu',MMI.dwMaxPagesLockable);
  StB[3]^.SetText(buf);
  StA[4]^.SetText('Total Linear Space');
  wvsprintf(Buf,'%lu',MMI.dwTotalLinearSpace );
  StB[4]^.SetText(buf);
  StA[5]^.SetText('Total Unlocked Pages');
  wvsprintf(Buf,'%lu',MMI.dwTotalUnlockedPages);
  StB[5]^.SetText(buf);
  StA[6]^.SetText('Free Pages');
  wvsprintf(Buf,'%lu',MMI.dwFreePages);
  StB[6]^.SetText(buf);
  StA[7]^.SetText('Total Pages');
  wvsprintf(Buf,'%lu',MMI.dwTotalPages);
  StB[7]^.SetText(buf);
  StA[8]^.SetText('Free Linear Space');
  wvsprintf(Buf,'%lu',MMI.dwFreeLinearSpace);
  StB[8]^.SetText(buf);
  StA[9]^.SetText('Swap File Pages');
  wvsprintf(Buf,'%lu',MMI.dwSwapFilePages);
  StB[9]^.SetText(buf);
  StA[10]^.SetText('Page Size');
  wvsprintf(Buf,'%u',MMI.wPageSize);
  StB[10]^.SetText(buf);
	SetHeader('Memory Manager Info');
end;

procedure TAUWindow.IDCMExit(var Msg:TMessage);
begin
	CloseWindow;
end;

procedure	TAUWindow.WMSysCommand(var Msg:TMessage);
begin
	case Msg.Wparam of
		id_About:
 			application^.ExecDialog(New(PDialog,Init(@Self,'AU_About')));
   	else
   		DefWndProc(Msg);
   	end;
end;

{**********************  MainLine   *******************************}
var
  AUApp: TAUApp;
begin
  AUApp.Init(AU_Name);
  AUApp.Run;
  AUApp.Done;
end.