home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / das_buch / windows / drwalk / checky.pas next >
Encoding:
Pascal/Delphi Source File  |  1993-06-04  |  7.1 KB  |  259 lines
  1. {$A-,B-,D+,F-,G-,I+,L+,N-,R-,S+,V+,W+,X+}
  2. {$M 8192,8192}
  3. PROGRAM Check;
  4.  
  5. USES WinTypes, WinProcs, ToolHelp, WinCrt, Strings;
  6.  
  7. TYPE
  8.   TBlockEntry = ARRAY [0..8] OF CHAR;
  9.   TResEntry   = ARRAY [0..15] OF CHAR;
  10.   TMaxEntry   = ARRAY [0..18] OF CHAR;
  11.   TGlobalData = RECORD
  12.     dwAddress: LONGINT;
  13.     dwBlockSize: LONGINT;
  14.     hBlock: tHandle;
  15.     hOwner: tHandle;
  16.     wType: WORD;
  17.     wData: WORD;
  18.   END;
  19.   TLocalData = RECORD
  20.     wAddress: WORD;
  21.     wSize: WORD;
  22.     szFlags: TBlockEntry;
  23.     szType: TMaxEntry;
  24.     szHeapType: TBlockEntry;
  25.   END;
  26.  
  27. CONST
  28.   BlockTypes : ARRAY [0..10] OF TBlockEntry =
  29.     (
  30.         'Private', 'DGroup', 'Data', 'Code', 'Task', 'Resource',
  31.         'Module', 'Free', 'Internal', 'Sentinel', 'BMaster'
  32.     );
  33.  
  34.   ResTypes: ARRAY [0..15] OF TResEntry =
  35.     ( 'UserDefined',  'CursorComponent', 'Bitmap', 'IconComponent',
  36.       'Menu', 'Dialog', 'String', 'FontDir', 'Font', 'Accelerators',
  37.       'RCData', 'ErrTable', 'Cursor', 'Icon', 'NameTable', 'Max_Resource'
  38.     );
  39.  
  40.   MemObjFlags: ARRAY [1..4] OF TBlockEntry =
  41.     ( 'Fixed', 'Free', 'Unknown', 'Moveable' );
  42.  
  43.   HeapTypes: ARRAY [0..2] OF TBlockEntry =
  44.     ( 'Normal', 'User', 'GDI' );
  45.  
  46.   LocalTypes: ARRAY [0..36] OF TMaxEntry =
  47.     ( 'Free', 'Bitmap', 'Brush', 'DC', 'Disabled DC', 'Font', 'Max', 'MetaDC',
  48.       'Metafile', 'Palette', 'Pen', 'Region', 'Normal', 'Atoms', 'BWL',
  49.       'ComboBox', 'CheckPoint', 'Class', 'Clip', 'DCE', 'Edit', 'HandleTable',
  50.       'HookList', 'HotkeyList', 'ListBox', 'LockInputState', 'Menu', 'Misc',
  51.       'MWP', 'OwnerDraw', 'User_Palette', 'PopupMenu', 'Property', 'SPB',
  52.       'String', 'UserSeeUserDoAlloc', 'Window'
  53.     );
  54.  
  55. CONST
  56.   cm_Test = 101;
  57.   cm_Exit = 102;
  58.  
  59. VAR
  60.   Window: hWND;
  61.   PrevWinProc: tFarProc;
  62.   Menu: hMenu;
  63.   BlockHandle: tHandle;
  64.  
  65. FUNCTION NewWndProc (Window: hWND; Message, wParam: WORD;
  66.                       lParam: LONGINT): LONGINT; EXPORT;
  67. BEGIN
  68.   IF (Message = wm_Command) THEN
  69.   BEGIN
  70.     CASE wParam OF
  71.       cm_Test: BEGIN
  72.         MessageBox(Window, 'Hallo', 'Hallo', mb_OK);
  73.         NewWndProc := 0;
  74.       END;
  75.       cm_Exit: DoneWinCrt;
  76.       ELSE NewWndProc := CallWindowProc (PrevWinProc, Window, Message, wParam, lParam);
  77.     END;
  78.   END ELSE NewWndProc := CallWindowProc (PrevWinProc, Window, Message, wParam, lParam);
  79. END;
  80.  
  81. PROCEDURE GlobalHeapWalk (Print: BOOLEAN);
  82. VAR
  83.   GlobalEntry: PGlobalEntry;
  84.   ModuleEntry: PModuleEntry;
  85.   TaskEntry: PTaskEntry;
  86.   GlobalData: TGlobalData;
  87.   Buffer: ARRAY [0..79] OF CHAR;
  88.   Result: Bool;
  89.   i: WORD;
  90. BEGIN
  91.   New (GlobalEntry);
  92.   GlobalEntry^.dwSize := SizeOf (TGlobalEntry);
  93.   Result := GlobalFirst (GlobalEntry, global_All);
  94.  
  95.   i := 1;
  96.   WHILE Result DO
  97.   BEGIN
  98.     GlobalData.dwAddress := GlobalEntry^.dwAddress;
  99.     GlobalData.dwBlockSize := GlobalEntry^.dwBlockSize;
  100.     GlobalData.hBlock := GlobalEntry^.hBlock;
  101.     GlobalData.hOwner := GlobalEntry^.hOwner;
  102.     GlobalData.wType := GlobalEntry^.wType;
  103.     GlobalData.wData := GlobalEntry^.wData;
  104.  
  105.     New(ModuleEntry);
  106.     ModuleEntry^.dwSize := SizeOf(TModuleEntry);
  107.  
  108.     IF ModuleFindHandle(ModuleEntry, GlobalData.hOwner) = 0 THEN
  109.     BEGIN
  110.       IF (GlobalData.hOwner = 0) THEN StrCopy (ModuleEntry^.szModule, 'FREE');
  111.       New (TaskEntry);
  112.       TaskEntry^.dwSize := SizeOf (TTaskEntry);
  113.       IF TaskFindHandle (TaskEntry, GlobalData.hOwner)
  114.         THEN StrCopy(ModuleEntry^.szModule, TaskEntry^.szModule)
  115.         ELSE StrPCopy (ModuleEntry^.szModule, 'Don''t know much...');
  116.       Dispose (TaskEntry);
  117.     END;
  118.  
  119.     GlobalData.wType := GlobalEntry^.wType;
  120.                                +
  121.     IF (GlobalEntry^.wHeapPresent AND (GlobalEntry^.wType = gt_DGroup) AND
  122.         (StrIComp(ModuleEntry^.szModule, 'GDI') = 0))
  123.       THEN BlockHandle := GlobalEntry^.hBlock;
  124.  
  125.     wvSprintF (Buffer, 'Addr=%08lX Size=%08lX Hndl=%04X Ownr=%04X',GlobalData);
  126.     IF Print THEN BEGIN
  127.       Write (Buffer, ' Type=',BlockTypes[GlobalData.wType], '  ', ModuleEntry^.szModule);
  128.       IF (GlobalData.wType = gt_Resource)
  129.         THEN WriteLn (ResTypes[GlobalData.wData])
  130.         ELSE WriteLn;
  131.       IF (i MOD 20) = 0 THEN ReadLn;
  132.     END;
  133.     Dispose (ModuleEntry);
  134.     Result := GlobalNext (GlobalEntry, global_All);
  135.     Inc(i);
  136.   END;
  137.   Dispose (GlobalEntry);
  138. END;
  139.  
  140. PROCEDURE TaskListWalk;
  141. TYPE
  142.   TTaskData = RECORD
  143.     wTask: WORD;
  144.     wInst: WORD;
  145.     wModule: WORD;
  146.     lModule: LONGINT;
  147.   END;
  148. VAR
  149.   TaskEntry: PTaskEntry;
  150.   TaskData: TTaskData;
  151.   Result: Bool;
  152.   Buffer: ARRAY [0..79] OF CHAR;
  153.   i: WORD;
  154. BEGIN
  155.   New (TaskEntry);
  156.   TaskEntry^.dwSize := SizeOf (TTaskEntry);
  157.   Result := TaskFirst (TaskEntry);
  158.   i := 1;
  159.   WHILE Result DO
  160.   BEGIN
  161.     TaskData.wTask := TaskEntry^.hTask;
  162.     TaskData.wInst := TaskEntry^.hInst;
  163.     TaskData.wModule := TaskEntry^.hModule;
  164.     TaskData.lModule := LONGINT(@TaskEntry^.szModule);
  165.     wvSprintF (Buffer, 'Task %04X  Inst %04X  Module %04X  Module %-9s ', TaskData);
  166.     WriteLn (Buffer);
  167.     IF (i MOD 20 = 0) THEN ReadLn;
  168.     Inc(i);
  169.     Result := TaskNext (TaskEntry);
  170.   END;
  171.  
  172.   Dispose (TaskEntry);
  173. END;
  174.  
  175. PROCEDURE ModuleListWalk;
  176. VAR
  177.   Buffer: ARRAY [0..79] OF CHAR;
  178.   SModuleEntry: PModuleEntry;
  179.   Result: Bool;
  180.   i: WORD;
  181.   DataRec: RECORD
  182.     lModule: LONGINT;
  183.     wUsage: WORD;
  184.     wHandle: WORD;
  185.   END;
  186. BEGIN
  187.   New (SModuleEntry);
  188.   SModuleEntry^.dwSize := SizeOf (TModuleEntry);
  189.   Result := ModuleFirst (SModuleEntry);
  190.   i := 1;
  191.   WHILE Result DO
  192.   BEGIN
  193.     DataRec.lModule := LONGINT(@SModuleEntry^.szModule);
  194.     DataRec.wUsage := SModuleEntry^.wUsageFlags;
  195.     DataRec.wHandle := SModuleEntry^.hModule;
  196.     wvSprintF (Buffer,'Module: %9s  Usage count: %04i Handle: %04X', DataRec);
  197.     WriteLn (Buffer);
  198.     Result := ModuleNext (SModuleEntry);
  199.     IF (i MOD 20) = 0 THEN ReadLn;
  200.     Inc(i);
  201.   END;
  202.   Dispose (SModuleEntry);
  203. END;
  204.  
  205. PROCEDURE GDIHeapWalk;
  206. VAR
  207.   ALocal: PLocalEntry;
  208.   Result: Bool;
  209.   LocalData: TLocalData;
  210.   Buffer: ARRAY [0..79] OF CHAR;
  211.   i: WORD;
  212. BEGIN
  213.   (* BlockHandle is the handle of local heap *)
  214.   New (ALocal);
  215.   ALocal^.dwSize := SizeOf (TLocalEntry);
  216.   Result := LocalFirst (ALocal, BlockHandle);
  217.   i := 1;
  218.   WHILE Result DO BEGIN
  219.     LocalData.wAddress := ALocal^.wAddress;
  220.     LocalData.wSize    := ALocal^.wSize;
  221.     LocalData.szFlags  := MemObjFlags[ALocal^.wFlags];
  222.     LocalData.szType   := LocalTypes[ALocal^.wType];
  223.     LocalData.szHeapType := HeapTypes[ALocal^.wHeapType];
  224.     wvSprintF (Buffer, 'A=%04X  Size=%03i  ', LocalData);
  225.     WriteLn (Buffer,'Flags= ',ALocal^.wFlags:2,LocalData.szFlags:9, '  Content= ',LocalData.szType);
  226.     Result := LocalNext (ALocal);
  227.     IF (i MOD 20) = 0 THEN ReadLn;
  228.     Inc(i);
  229.   END;
  230.   Dispose (ALocal);
  231. END;
  232.  
  233. BEGIN
  234.   InitWinCrt;
  235.   Window := GetActiveWindow;
  236.   Menu := LoadMenu (hInstance, 'Menu_1');
  237.   SetMenu (Window, Menu);
  238.   PrevWinProc := tFarProc(GetWindowLong(Window, gwl_WndProc));
  239.   SetWindowLong (Window, gwl_WndProc, LONGINT(@NewWndProc));
  240.  
  241.   TaskListWalk;
  242.   ReadLn;
  243.  
  244.   GlobalHeapWalk (TRUE);
  245.   ReadLn;
  246.   GDIHeapWalk;
  247.   WriteLn ('Back from the walk');
  248.   ReadLn;
  249.   DoneWinCrt;
  250.   
  251.   GlobalHeapWalk (TRUE);
  252.   ReadLn;
  253.  
  254.   ModuleListWalk;
  255.  
  256.   ReadLn;
  257.   PostQuitMessage(0);
  258. END.
  259.