home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / das_buch / windows / drwalk / drwalker.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-06-04  |  9.3 KB  |  343 lines
  1. PROGRAM DrWalker;
  2.  
  3. {$R DrWalker}
  4. {$D Dr. Walker v0.45, (c)1993 by Reebear}
  5.  
  6. {$IFNDEF VER70}
  7.   USES WinTypes, WinProcs, WinDos, WObjects, ToolHelp, Strings;
  8. {$ELSE}
  9.   USES WinTypes, WinProcs, WinDos, Objects, ODialogs, OWindows, ToolHelp, Strings;
  10. {$ENDIF}
  11.  
  12. CONST
  13.   Titel : pChar = 'Address Size    Flags       Type       ';
  14.   id_Box        = 201;
  15.   id_Static     = 202;
  16.   id_ScrollBar  = 203;
  17.   cm_ShowCount  = 101;
  18.   id_ShowList   = 102;
  19.   cm_About      = 105;
  20.   XSize         = 320;
  21.   YSize         = 400;
  22.  
  23. TYPE
  24.   TBlockEntry = ARRAY [0..8] OF CHAR;
  25.   TResEntry   = ARRAY [0..15] OF CHAR;
  26.   TMaxEntry   = ARRAY [0..18] OF CHAR;
  27.   TGlobalData = RECORD
  28.     dwAddress: LONGINT;
  29.     dwBlockSize: LONGINT;
  30.     hBlock: tHandle;
  31.     hOwner: tHandle;
  32.     wType: WORD;
  33.     wData: WORD;
  34.   END;
  35.   TLocalData = RECORD
  36.     wAddress: WORD;
  37.     wSize: WORD;
  38.     lFlags: LONGINT;
  39.     lType: LONGINT;
  40.   END;
  41.   TGDIObjCount = ARRAY [0..10] OF WORD;
  42.  
  43. CONST
  44.   MemObjFlags: ARRAY [1..4] OF TBlockEntry =
  45.     ( 'Fixed', 'Free', 'Unknown', 'Moveable' );
  46.  
  47.   GDITypes: ARRAY [0..10] OF TMaxEntry =
  48.     ( 'Normal', 'Pen', 'Brush', 'Font', 'Palette', 'Bitmap', 'Region', 'DC',
  49.       'Disabled DC', 'Meta DC', 'Metafile'
  50.     );
  51.  
  52. TYPE
  53.   PGDICollection = ^TGDICollection;
  54.   TGDICollection = OBJECT (TStrCollection)
  55.     FUNCTION KeyOf (Item: POINTER): POINTER; VIRTUAL;
  56.     PROCEDURE ChangeSelect (ChangeTo: WORD);
  57.   END;
  58.  
  59.   TListXferRec = RECORD
  60.     ListStrings: PGDICollection;
  61.     ListSelect: INTEGER;
  62.   END;
  63.  
  64.   TShowXferRec = RECORD
  65.     List: PStrCollection;
  66.     ListSelect: INTEGER;
  67.   END;
  68.  
  69.   PGDIHeapWindow = ^TGDIHeapWindow;
  70.   TGDIHeapWindow = OBJECT (tWindow)
  71.     AListBox: pListBox;
  72.     AStatic: pStatic;
  73.     Xfer: TListXferRec;
  74.     TheFont: hFont;
  75.     PROCEDURE WalkOnTheWildSide;
  76.     CONSTRUCTOR Init (aTitle: pChar);
  77.     PROCEDURE SetupWindow; VIRTUAL;
  78.     PROCEDURE GetWindowClass (VAR aWndClass: tWndClass); VIRTUAL;
  79.     PROCEDURE WMGetMinMaxInfo (VAR Msg: tMessage); VIRTUAL wm_First +
  80.                                                            wm_GetMinMaxInfo;
  81.     PROCEDURE WMCtlColor (VAR Msg: tMessage); VIRTUAL wm_First + wm_CtlColor;
  82.     PROCEDURE WMSize (VAR Msg: tMessage); VIRTUAL wm_First + wm_Size;
  83.     PROCEDURE ShowCount (VAR Msg: tMessage); VIRTUAL cm_First + cm_ShowCount;
  84.     PROCEDURE CMAbout (VAR Msg: tMessage); VIRTUAL cm_First + cm_About;
  85.   END;
  86.  
  87.   PShowCountDialog = ^TShowCountDialog;
  88.   TShowCountDialog = OBJECT (tDialog)
  89.     XferRec: TShowXferRec;
  90.     ShowList: pListBox;
  91.     CONSTRUCTOR Init (aParent: pWindowsObject; aTitle: pChar);
  92.     PROCEDURE SetupWindow; VIRTUAL;
  93.   END;
  94.  
  95.   tMyApplication = OBJECT (tApplication)
  96.     PROCEDURE InitMainWindow; VIRTUAL;
  97.   END;
  98.  
  99. VAR
  100.   BlockHandle: tHandle;
  101.   OldGDIObjCount, GDIObjCount: TGDIObjCount;
  102.  
  103. (* ====================================================== *)
  104.  
  105. PROCEDURE GlobalHeapWalk (Print: BOOLEAN);
  106. VAR
  107.   GlobalEntry: PGlobalEntry;
  108.   ModuleEntry: PModuleEntry;
  109.   TaskEntry: PTaskEntry;
  110.   GlobalData: TGlobalData;
  111.   Buffer: ARRAY [0..79] OF CHAR;
  112.   Result: Bool;
  113. BEGIN
  114.   New (GlobalEntry);
  115.   GlobalEntry^.dwSize := SizeOf (TGlobalEntry);
  116.   Result := GlobalFirst (GlobalEntry, global_All);
  117.  
  118.   WHILE Result DO
  119.   BEGIN
  120.     GlobalData.dwAddress := GlobalEntry^.dwAddress;
  121.     GlobalData.dwBlockSize := GlobalEntry^.dwBlockSize;
  122.     GlobalData.hBlock := GlobalEntry^.hBlock;
  123.     GlobalData.hOwner := GlobalEntry^.hOwner;
  124.     GlobalData.wType := GlobalEntry^.wType;
  125.     GlobalData.wData := GlobalEntry^.wData;
  126.  
  127.     New(ModuleEntry);
  128.     ModuleEntry^.dwSize := SizeOf(TModuleEntry);
  129.  
  130.     IF ModuleFindHandle(ModuleEntry, GlobalData.hOwner) = 0 THEN
  131.     BEGIN
  132.       IF (GlobalData.hOwner = 0) THEN StrCopy (ModuleEntry^.szModule, 'FREE');
  133.       New (TaskEntry);
  134.       TaskEntry^.dwSize := SizeOf (TTaskEntry);
  135.       IF TaskFindHandle (TaskEntry, GlobalData.hOwner)
  136.         THEN StrCopy(ModuleEntry^.szModule, TaskEntry^.szModule)
  137.         ELSE StrPCopy (ModuleEntry^.szModule, 'Don''t know much...');
  138.       Dispose (TaskEntry);
  139.     END;
  140.  
  141.     GlobalData.wType := GlobalEntry^.wType;
  142.  
  143.     IF (GlobalEntry^.wHeapPresent AND (GlobalEntry^.wType = gt_DGroup) AND
  144.         (StrIComp(ModuleEntry^.szModule, 'GDI') = 0))
  145.       THEN BlockHandle := GlobalEntry^.hBlock;
  146.  
  147.     Dispose (ModuleEntry);
  148.     Result := GlobalNext (GlobalEntry, global_All);
  149.   END;
  150.   Dispose (GlobalEntry);
  151. END;
  152.  
  153. FUNCTION TGDICollection.KeyOf (Item: POINTER): POINTER;
  154. VAR
  155.   P: pChar;
  156. BEGIN
  157.   P := TStrCollection.KeyOf (Item);
  158.   Inc(P, 28);
  159.   KeyOf := P;
  160. END;
  161.  
  162. PROCEDURE TGDICollection.ChangeSelect (ChangeTo: WORD);
  163. BEGIN
  164. END;
  165.  
  166. CONSTRUCTOR TShowCountDialog.Init (aParent: pWindowsObject; aTitle: pChar);
  167. VAR
  168.   i: WORD;
  169. BEGIN
  170.   tDialog.Init (aParent, aTitle);
  171.   ShowList := New(pListBox, InitResource(@Self, id_ShowList));
  172.   XferRec.List := New (PStrCollection, Init(10,2));
  173.   TransferBuffer := @XferRec;
  174. END;
  175.  
  176. PROCEDURE TShowCountDialog.SetupWindow;
  177. VAR
  178.   Buffer: ARRAY [0..29] OF CHAR;
  179.   i: WORD;
  180.   Internal: RECORD
  181.     lType: LONGINT;
  182.     wCount: WORD;
  183.     wChange: INTEGER;
  184.   END;
  185. BEGIN
  186.   tDialog.SetupWindow;
  187.   FOR i := 0 TO 10 DO
  188.   BEGIN
  189.     Internal.lType := LONGINT(@GDITypes[i]);
  190.     Internal.wCount := GDIObjCount[i];
  191.     Internal.wChange := GDIObjCount[i] - OldGDIObjCount[i];
  192.     wvSprintF (Buffer, '%-12s %4i   %4i', Internal);
  193.     XferRec.List^.Insert (StrNew (Buffer));
  194.     ShowList^.Transfer (@XferRec, tf_SetData);
  195.   END;
  196. END;
  197.  
  198. (* ====================================================== *)
  199.  
  200. CONSTRUCTOR TGDIHeapWindow.Init (aTitle: pChar);
  201. VAR
  202.   i: WORD;
  203. BEGIN
  204.   tWindow.Init (NIL, aTitle);
  205.   Attr.w := XSize;
  206.   Attr.h := YSize;
  207.   Attr.Menu := LoadMenu (hInstance, 'DrWalker');
  208.  
  209.   AListBox := New (pListBox, Init (@Self, id_Box, 0, 16, XSize, YSize));
  210.   AListBox^.Attr.Style := ((AListBox^.Attr.Style AND NOT ws_Border)
  211.                             OR lbs_NoIntegralHeight) AND NOT lbs_Sort;
  212.   AStatic := New (pStatic, Init (@Self, id_Static, Titel, 0, 0, XSize, 15,
  213.                   StrLen(Titel)));
  214.   AStatic^.Attr.Style := AStatic^.Attr.Style OR ss_LeftNoWordWrap;
  215.   Xfer.ListStrings := New (PGDICollection, Init (200,20));
  216.   Xfer.ListStrings^.Duplicates := TRUE;
  217.   TransferBuffer := @Xfer;
  218.   EnableKBHandler;
  219.  
  220.   FOR i := 0 TO 10 DO
  221.   BEGIN
  222.     GDIObjCount[i] := 0;
  223.     OldGDIObjCount[i] := 0;
  224.   END;
  225.  
  226. END;
  227.  
  228. PROCEDURE TGDIHeapWindow.WalkOnTheWildSide;
  229. VAR
  230.   i: WORD;
  231.   LouReed: PLocalEntry;
  232.   Result: Bool;
  233.   LocalData: TLocalData;
  234.   Buffer: ARRAY [0..79] OF CHAR;
  235. BEGIN
  236.   (* Fill StringCollection *)
  237.   GlobalHeapWalk (FALSE);
  238.  
  239.   FOR i := 0 TO 10 DO
  240.     GDIObjCount[i] := 0;
  241.  
  242.   (* BlockHandle is the handle of local heap *)
  243.   New (LouReed);
  244.   LouReed^.dwSize := SizeOf (TLocalEntry);
  245.   Result := LocalFirst (LouReed, BlockHandle);
  246.   WHILE Result DO BEGIN
  247.     LocalData.wAddress := LouReed^.wAddress;
  248.     LocalData.wSize    := LouReed^.wSize;
  249.     LocalData.lFlags  := LONGINT(@MemObjFlags[LouReed^.wFlags]);
  250.     IF (LouReed^.wType < 11)
  251.       THEN BEGIN
  252.         LocalData.lType := LONGINT(@GDITypes[LouReed^.wType]);
  253.         Inc(GDIObjCount[LouReed^.wType]);
  254.       END
  255.       ELSE LocalData.lType := LONGINT(pChar('Free'));
  256.     wvSprintF (Buffer, '%05X   %4i    %-9s   %-9s', LocalData);
  257.     Xfer.ListStrings^.Insert (StrNew (Buffer));
  258.     Result := LocalNext (LouReed);
  259.   END;
  260.  
  261.   Dispose (LouReed);
  262. END;
  263.  
  264. PROCEDURE TGDIHeapWindow.SetupWindow;
  265. BEGIN
  266.   tWindow.SetupWindow;
  267.  
  268.   TheFont := CreateFont (8, 0, 0, 0, 400, 0, 0, 0, ANSI_CharSet,
  269.              out_Default_Precis, clip_Default_Precis,
  270.              Default_Quality, 0, 'COURIER');
  271.  
  272.   SendMessage (AStatic^.hWindow, wm_SetFont, TheFont, 0);
  273.   SendMessage (AListBox^.hWindow, wm_SetFont, TheFont, 0);
  274.  
  275.   WalkOnTheWildSide;
  276.   AListBox^.Transfer (@Xfer, tf_SetData);
  277. END;
  278.  
  279. PROCEDURE TGDIHeapWindow.GetWindowClass (VAR aWndClass: tWndClass);
  280. BEGIN
  281.   tWindow.GetWindowClass (aWndClass);
  282.   aWndClass.hIcon := LoadIcon (hInstance, 'DrWalker');
  283. END;
  284.  
  285. PROCEDURE TGDIHeapWindow.WMGetMinMaxInfo (VAR Msg: tMessage);
  286. TYPE
  287.   PInfo= ^TInfo;
  288.   TInfo= ARRAY [0..4] OF tPoint;
  289. BEGIN
  290.   PInfo(Msg.lParam)^[4].x := XSize;
  291. END;
  292.  
  293. PROCEDURE TGDIHeapWindow.WMCtlColor (VAR Msg: tMessage);
  294. BEGIN
  295.   DefWndProc (Msg);
  296.   IF (Msg.lParamHi = ctlcolor_Static)
  297.     THEN BEGIN
  298.       SetTextColor (Msg.wParam, RGB(255, 0, 0));
  299.       SetBkColor (Msg.wParam, RGB(200, 200, 200));
  300.     END;
  301. END;
  302.  
  303. PROCEDURE TGDIHeapWindow.WMSize (VAR Msg: tMessage);
  304. BEGIN
  305.   tWindow.WMSize (Msg);
  306.   MoveWindow (AListBox^.hWindow, 0, 16, Msg.lParamLo, Msg.lParamHi-16, TRUE);
  307. END;
  308.  
  309. PROCEDURE TGDIHeapWindow.ShowCount (VAR Msg: tMessage);
  310. VAR
  311.   Dialog: PShowCountDialog;
  312. BEGIN
  313.   WalkOnTheWildSide;
  314.   Dialog := New (PShowCountDialog, Init(@Self, MakeIntResource ('ShowCount')));
  315.   Application^.ExecDialog (Dialog);
  316.   OldGDIObjCount := GDIObjCount;
  317. END;
  318.  
  319. PROCEDURE TGDIHeapWindow.CMAbout (VAR Msg: tMessage);
  320. VAR
  321.   Dialog: pDialog;
  322. BEGIN
  323.   Dialog := New (pDialog, Init(@Self, MakeIntResource ('About')));
  324.   Application^.ExecDialog (Dialog);
  325. END;
  326.  
  327. PROCEDURE tMyApplication.InitMainWindow;
  328. BEGIN
  329.   MainWindow := New (PGDIHeapWindow, Init ('Dr. Walker'));
  330. END;
  331.  
  332. VAR
  333.   ListApp: tMyApplication;
  334.   BWCCHandle: tHandle;
  335.  
  336. BEGIN
  337.   BWCCHandle := LoadLibrary ('BWCC.DLL');
  338.   ListApp.Init ('Dr. Walker');
  339.   ListApp.Run;
  340.   ListApp.Done;
  341.   FreeLibrary (BWCCHandle);
  342. END.
  343.