home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware 1 2 the Maxx
/
sw_1.zip
/
sw_1
/
WINDOWS
/
UTILS
/
AUDIT.ZIP
/
AUDIT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-04-26
|
10KB
|
352 lines
{**** 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.