home *** CD-ROM | disk | FTP | other *** search
/ PC World Plus! (NZ) 2001 June / HDC50.iso / Runimage / Delphi50 / Source / Rtl / Win / TLHELP32.PAS < prev    next >
Pascal/Delphi Source File  |  1999-08-11  |  16KB  |  480 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Borland Delphi Runtime Library                  }
  5. {       Tool Help Functions, Types, and Definitions     }
  6. {                                                       }
  7. {       Copyright (C) 1996,99 Inprise Corporation       }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit TLHelp32;
  12.  
  13. {$WEAKPACKAGEUNIT}
  14.  
  15. interface
  16.  
  17. uses Windows;
  18.  
  19. {$HPPEMIT '#include <tlhelp32.h>'}
  20.  
  21. const
  22. {$EXTERNALSYM MAX_MODULE_NAME32}
  23.   MAX_MODULE_NAME32 = 255;
  24.  
  25. (****** Shapshot function **********************************************)
  26.  
  27. {$EXTERNALSYM CreateToolhelp32Snapshot}
  28. function CreateToolhelp32Snapshot(dwFlags, th32ProcessID: DWORD): THandle;
  29.  
  30. type
  31.   TCreateToolhelp32Snapshot = function (dwFlags, th32ProcessID: DWORD): THandle stdcall;
  32. //
  33. // The th32ProcessID argument is only used if TH32CS_SNAPHEAPLIST or
  34. // TH32CS_SNAPMODULE is specified. th32ProcessID == 0 means the current
  35. // process.
  36. //
  37. // NOTE that all of the snapshots are global except for the heap and module
  38. //    lists which are process specific. To enumerate the heap or module
  39. //    state for all WIN32 processes call with TH32CS_SNAPALL and the
  40. //    current process. Then for each process in the TH32CS_SNAPPROCESS
  41. //    list that isn't the current process, do a call with just
  42. //    TH32CS_SNAPHEAPLIST and/or TH32CS_SNAPMODULE.
  43. //
  44. // dwFlags
  45. //
  46. const
  47. {$EXTERNALSYM TH32CS_SNAPHEAPLIST}
  48.   TH32CS_SNAPHEAPLIST = $00000001;
  49. {$EXTERNALSYM TH32CS_SNAPPROCESS}
  50.   TH32CS_SNAPPROCESS  = $00000002;
  51. {$EXTERNALSYM TH32CS_SNAPTHREAD}
  52.   TH32CS_SNAPTHREAD   = $00000004;
  53. {$EXTERNALSYM TH32CS_SNAPMODULE}
  54.   TH32CS_SNAPMODULE   = $00000008;
  55. {$EXTERNALSYM TH32CS_SNAPALL}
  56.   TH32CS_SNAPALL      = TH32CS_SNAPHEAPLIST or TH32CS_SNAPPROCESS or
  57.     TH32CS_SNAPTHREAD or TH32CS_SNAPMODULE;
  58. {$EXTERNALSYM TH32CS_INHERIT}
  59.   TH32CS_INHERIT      = $80000000;
  60. //
  61. // Use CloseHandle to destroy the snapshot
  62. //
  63.  
  64. (****** heap walking ***************************************************)
  65.  
  66. type
  67. {$EXTERNALSYM tagHEAPLIST32}
  68.   tagHEAPLIST32 = record
  69.     dwSize: DWORD;
  70.     th32ProcessID: DWORD;  // owning process
  71.     th32HeapID: DWORD;     // heap (in owning process's context!)
  72.     dwFlags: DWORD;
  73.   end;
  74. {$EXTERNALSYM HEAPLIST32}
  75.   HEAPLIST32 = tagHEAPLIST32;
  76. {$EXTERNALSYM PHEAPLIST32}
  77.   PHEAPLIST32 = ^tagHEAPLIST32;
  78. {$EXTERNALSYM LPHEAPLIST32}
  79.   LPHEAPLIST32 = ^tagHEAPLIST32;
  80.   THeapList32 = tagHEAPLIST32;
  81. //
  82. // dwFlags
  83. //
  84. const
  85. {$EXTERNALSYM HF32_DEFAULT}
  86.   HF32_DEFAULT = 1;  // process's default heap
  87. {$EXTERNALSYM HF32_SHARED}
  88.   HF32_SHARED  = 2;  // is shared heap
  89.  
  90. {$EXTERNALSYM Heap32ListFirst}
  91. function Heap32ListFirst(hSnapshot: THandle; var lphl: THeapList32): BOOL;
  92. {$EXTERNALSYM Heap32ListNext}
  93. function Heap32ListNext(hSnapshot: THandle; var lphl: THeapList32): BOOL;
  94.  
  95. type
  96.   THeap32ListFirst = function (hSnapshot: THandle; var lphl: THeapList32): BOOL stdcall;
  97.   THeap32ListNext = function (hSnapshot: THandle; var lphl: THeapList32): BOOL stdcall;
  98.  
  99. type
  100. {$EXTERNALSYM tagHEAPENTRY32}
  101.   tagHEAPENTRY32 = record
  102.     dwSize: DWORD;
  103.     hHandle: THandle;     // Handle of this heap block
  104.     dwAddress: DWORD;      // Linear address of start of block
  105.     dwBlockSize: DWORD;   // Size of block in bytes
  106.     dwFlags: DWORD;
  107.     dwLockCount: DWORD;
  108.     dwResvd: DWORD;
  109.     th32ProcessID: DWORD; // owning process
  110.     th32HeapID: DWORD;    // heap block is in
  111.   end;
  112. {$EXTERNALSYM HEAPENTRY32}
  113.   HEAPENTRY32 = tagHEAPENTRY32;
  114. {$EXTERNALSYM PHEAPENTRY32}
  115.   PHEAPENTRY32 = ^tagHEAPENTRY32;
  116. {$EXTERNALSYM LPHEAPENTRY32}
  117.   LPHEAPENTRY32 = ^tagHEAPENTRY32;
  118.   THeapEntry32 = tagHEAPENTRY32;
  119. //
  120. // dwFlags
  121. //
  122. const
  123. {$EXTERNALSYM LF32_FIXED}
  124.   LF32_FIXED    = $00000001;
  125. {$EXTERNALSYM LF32_FREE}
  126.   LF32_FREE     = $00000002;
  127. {$EXTERNALSYM LF32_MOVEABLE}
  128.   LF32_MOVEABLE = $00000004;
  129.  
  130. {$EXTERNALSYM Heap32First}
  131. function Heap32First(var lphe: THeapEntry32; th32ProcessID, th32HeapID: DWORD): BOOL;
  132. {$EXTERNALSYM Heap32Next}
  133. function Heap32Next(var lphe: THeapEntry32): BOOL;
  134. {$EXTERNALSYM Toolhelp32ReadProcessMemory}
  135. function Toolhelp32ReadProcessMemory(th32ProcessID: DWORD; lpBaseAddress: Pointer;
  136.   var lpBuffer; cbRead: DWORD; var lpNumberOfBytesRead: DWORD): BOOL;
  137.  
  138. type
  139.   THeap32First = function (var lphe: THeapEntry32; th32ProcessID,
  140.     th32HeapID: DWORD): BOOL stdcall;
  141.   THeap32Next = function (var lphe: THeapEntry32): BOOL stdcall;
  142.   TToolhelp32ReadProcessMemory = function (th32ProcessID: DWORD;
  143.     lpBaseAddress: Pointer; var lpBuffer; cbRead: DWORD;
  144.     var lpNumberOfBytesRead: DWORD): BOOL stdcall;
  145.  
  146. (***** Process walking *************************************************)
  147.  
  148. type
  149. {$EXTERNALSYM tagPROCESSENTRY32W}
  150.   tagPROCESSENTRY32W = packed record
  151.     dwSize: DWORD;
  152.     cntUsage: DWORD;
  153.     th32ProcessID: DWORD;       // this process
  154.     th32DefaultHeapID: DWORD;
  155.     th32ModuleID: DWORD;        // associated exe
  156.     cntThreads: DWORD;
  157.     th32ParentProcessID: DWORD; // this process's parent process
  158.     pcPriClassBase: Longint;    // Base priority of process's threads
  159.     dwFlags: DWORD;
  160.     szExeFile: array[0..MAX_PATH - 1] of WChar;// Path
  161.   end;
  162. {$EXTERNALSYM PROCESSENTRY32W}
  163.   PROCESSENTRY32W = tagPROCESSENTRY32W;
  164. {$EXTERNALSYM PPROCESSENTRY32W}
  165.   PPROCESSENTRY32W = ^tagPROCESSENTRY32W;
  166. {$EXTERNALSYM LPPROCESSENTRY32W}
  167.   LPPROCESSENTRY32W = ^tagPROCESSENTRY32W;
  168.   TProcessEntry32W = tagPROCESSENTRY32W;
  169.  
  170. {$EXTERNALSYM Process32FirstW}
  171. function Process32FirstW(hSnapshot: THandle; var lppe: TProcessEntry32W): BOOL;
  172. {$EXTERNALSYM Process32NextW}
  173. function Process32NextW(hSnapshot: THandle; var lppe: TProcessEntry32W): BOOL;
  174.  
  175. type
  176.   TProcess32FirstW = function (hSnapshot: THandle; var lppe: TProcessEntry32W): BOOL stdcall;
  177.   TProcess32NextW = function (hSnapshot: THandle; var lppe: TProcessEntry32W): BOOL stdcall;
  178.  
  179. {$EXTERNALSYM tagPROCESSENTRY32}
  180.   tagPROCESSENTRY32 = packed record
  181.     dwSize: DWORD;
  182.     cntUsage: DWORD;
  183.     th32ProcessID: DWORD;       // this process
  184.     th32DefaultHeapID: DWORD;
  185.     th32ModuleID: DWORD;        // associated exe
  186.     cntThreads: DWORD;
  187.     th32ParentProcessID: DWORD; // this process's parent process
  188.     pcPriClassBase: Longint;    // Base priority of process's threads
  189.     dwFlags: DWORD;
  190.     szExeFile: array[0..MAX_PATH - 1] of Char;// Path
  191.   end;
  192. {$EXTERNALSYM PROCESSENTRY32}
  193.   PROCESSENTRY32 = tagPROCESSENTRY32;
  194. {$EXTERNALSYM PPROCESSENTRY32}
  195.   PPROCESSENTRY32 = ^tagPROCESSENTRY32;
  196. {$EXTERNALSYM LPPROCESSENTRY32}
  197.   LPPROCESSENTRY32 = ^tagPROCESSENTRY32;
  198.   TProcessEntry32 = tagPROCESSENTRY32;
  199.  
  200. {$EXTERNALSYM Process32First}
  201. function Process32First(hSnapshot: THandle; var lppe: TProcessEntry32): BOOL;
  202. {$EXTERNALSYM Process32Next}
  203. function Process32Next(hSnapshot: THandle; var lppe: TProcessEntry32): BOOL;
  204.  
  205. type
  206.   TProcess32First = function (hSnapshot: THandle; var lppe: TProcessEntry32): BOOL stdcall;
  207.   TProcess32Next = function (hSnapshot: THandle; var lppe: TProcessEntry32): BOOL stdcall;
  208.  
  209. (***** Thread walking **************************************************)
  210.  
  211. type
  212. {$EXTERNALSYM tagTHREADENTRY32}
  213.   tagTHREADENTRY32 = record
  214.     dwSize: DWORD;
  215.     cntUsage: DWORD;
  216.     th32ThreadID: DWORD;       // this thread
  217.     th32OwnerProcessID: DWORD; // Process this thread is associated with
  218.     tpBasePri: Longint;
  219.     tpDeltaPri: Longint;
  220.     dwFlags: DWORD;
  221.   end;
  222. {$EXTERNALSYM THREADENTRY32}
  223.   THREADENTRY32 = tagTHREADENTRY32;
  224. {$EXTERNALSYM PTHREADENTRY32}
  225.   PTHREADENTRY32 = ^tagTHREADENTRY32;
  226. {$EXTERNALSYM LPTHREADENTRY32}
  227.   LPTHREADENTRY32 = ^tagTHREADENTRY32;
  228.   TThreadEntry32 = tagTHREADENTRY32;
  229.  
  230. {$EXTERNALSYM Thread32First}
  231. function Thread32First(hSnapshot: THandle; var lpte: TThreadEntry32): BOOL; stdcall;
  232. {$EXTERNALSYM Thread32Next}
  233. function Thread32Next(hSnapshot: THandle; var lpte: TThreadENtry32): BOOL; stdcall;
  234.  
  235. type
  236.   TThread32First = function (hSnapshot: THandle; var lpte: TThreadEntry32): BOOL stdcall;
  237.   TThread32Next = function (hSnapshot: THandle; var lpte: TThreadENtry32): BOOL stdcall;
  238.  
  239. (***** Module walking *************************************************)
  240.  
  241. type
  242. {$EXTERNALSYM tagMODULEENTRY32}
  243.   tagMODULEENTRY32 = record
  244.     dwSize: DWORD;
  245.     th32ModuleID: DWORD;  // This module
  246.     th32ProcessID: DWORD; // owning process
  247.     GlblcntUsage: DWORD;  // Global usage count on the module
  248.     ProccntUsage: DWORD;  // Module usage count in th32ProcessID's context
  249.     modBaseAddr: PBYTE;   // Base address of module in th32ProcessID's context
  250.     modBaseSize: DWORD;   // Size in bytes of module starting at modBaseAddr
  251.     hModule: HMODULE;     // The hModule of this module in th32ProcessID's context
  252.     szModule: array[0..MAX_MODULE_NAME32] of Char;
  253.     szExePath: array[0..MAX_PATH - 1] of Char;
  254.   end;
  255. {$EXTERNALSYM MODULEENTRY32}
  256.   MODULEENTRY32 = tagMODULEENTRY32;
  257. {$EXTERNALSYM PMODULEENTRY32}
  258.   PMODULEENTRY32 = ^tagMODULEENTRY32;
  259. {$EXTERNALSYM LPMODULEENTRY32}
  260.   LPMODULEENTRY32 = ^tagMODULEENTRY32;
  261.   TModuleEntry32 = tagMODULEENTRY32;
  262.  
  263. //
  264. // NOTE CAREFULLY that the modBaseAddr and hModule fields are valid ONLY
  265. // in th32ProcessID's process context.
  266. //
  267.  
  268. {$EXTERNALSYM Module32First}
  269. function Module32First(hSnapshot: THandle; var lpme: TModuleEntry32): BOOL;
  270. {$EXTERNALSYM Module32Next}
  271. function Module32Next(hSnapshot: THandle; var lpme: TModuleEntry32): BOOL;
  272.  
  273. type
  274.   TModule32First = function (hSnapshot: THandle; var lpme: TModuleEntry32): BOOL stdcall;
  275.   TModule32Next = function (hSnapshot: THandle; var lpme: TModuleEntry32): BOOL stdcall;
  276.  
  277. {$EXTERNALSYM tagMODULEENTRY32W}
  278.   tagMODULEENTRY32W = record
  279.     dwSize: DWORD;
  280.     th32ModuleID: DWORD;  // This module
  281.     th32ProcessID: DWORD; // owning process
  282.     GlblcntUsage: DWORD;  // Global usage count on the module
  283.     ProccntUsage: DWORD;  // Module usage count in th32ProcessID's context
  284.     modBaseAddr: PBYTE;   // Base address of module in th32ProcessID's context
  285.     modBaseSize: DWORD;   // Size in bytes of module starting at modBaseAddr
  286.     hModule: HMODULE;     // The hModule of this module in th32ProcessID's context
  287.     szModule: array[0..MAX_MODULE_NAME32] of WChar;
  288.     szExePath: array[0..MAX_PATH - 1] of WChar;
  289.   end;
  290. {$EXTERNALSYM MODULEENTRY32}
  291.   MODULEENTRY32W = tagMODULEENTRY32W;
  292. {$EXTERNALSYM PMODULEENTRY32}
  293.   PMODULEENTRY32W = ^tagMODULEENTRY32W;
  294. {$EXTERNALSYM LPMODULEENTRY32}
  295.   LPMODULEENTRY32W = ^tagMODULEENTRY32W;
  296.   TModuleEntry32W = tagMODULEENTRY32W;
  297.  
  298. //
  299. // NOTE CAREFULLY that the modBaseAddr and hModule fields are valid ONLY
  300. // in th32ProcessID's process context.
  301. //
  302.  
  303. {$EXTERNALSYM Module32FirstW}
  304. function Module32FirstW(hSnapshot: THandle; var lpme: TModuleEntry32W): BOOL;
  305. {$EXTERNALSYM Module32NextW}
  306. function Module32NextW(hSnapshot: THandle; var lpme: TModuleEntry32W): BOOL;
  307.  
  308. type
  309.   TModule32FirstW = function (hSnapshot: THandle; var lpme: TModuleEntry32W): BOOL stdcall;
  310.   TModule32NextW = function (hSnapshot: THandle; var lpme: TModuleEntry32W): BOOL stdcall;
  311.  
  312. implementation
  313.  
  314. const
  315.   kernel32 = 'kernel32.dll';
  316.  
  317. var
  318.   KernelHandle: THandle;
  319.   _CreateToolhelp32Snapshot: TCreateToolhelp32Snapshot;
  320.   _Heap32ListFirst: THeap32ListFirst;
  321.   _Heap32ListNext: THeap32ListNext;
  322.   _Heap32First: THeap32First;
  323.   _Heap32Next: THeap32Next;
  324.   _Toolhelp32ReadProcessMemory: TToolhelp32ReadProcessMemory;
  325.   _Process32First: TProcess32First;
  326.   _Process32Next: TProcess32Next;
  327.   _Process32FirstW: TProcess32FirstW;
  328.   _Process32NextW: TProcess32NextW;
  329.   _Thread32First: TThread32First;
  330.   _Thread32Next: TThread32Next;
  331.   _Module32First: TModule32First;
  332.   _Module32Next: TModule32Next;
  333.   _Module32FirstW: TModule32FirstW;
  334.   _Module32NextW: TModule32NextW;
  335.  
  336. function InitToolHelp: Boolean;
  337. begin
  338.   if KernelHandle = 0 then
  339.   begin
  340.     KernelHandle := GetModuleHandle(kernel32);
  341.     if KernelHandle <> 0 then
  342.     begin
  343.       @_CreateToolhelp32Snapshot := GetProcAddress(KernelHandle, 'CreateToolhelp32Snapshot');
  344.       @_Heap32ListFirst := GetProcAddress(KernelHandle, 'Heap32ListFirst');
  345.       @_Heap32ListNext := GetProcAddress(KernelHandle, 'Heap32ListNext');
  346.       @_Heap32First := GetProcAddress(KernelHandle, 'Heap32First');
  347.       @_Heap32Next := GetProcAddress(KernelHandle, 'Heap32Next');
  348.       @_Toolhelp32ReadProcessMemory := GetProcAddress(KernelHandle, 'Toolhelp32ReadProcessMemory');
  349.       @_Process32First := GetProcAddress(KernelHandle, 'Process32First');
  350.       @_Process32Next := GetProcAddress(KernelHandle, 'Process32Next');
  351.       @_Process32FirstW := GetProcAddress(KernelHandle, 'Process32FirstW');
  352.       @_Process32NextW := GetProcAddress(KernelHandle, 'Process32NextW');
  353.       @_Thread32First := GetProcAddress(KernelHandle, 'Thread32First');
  354.       @_Thread32Next := GetProcAddress(KernelHandle, 'Thread32Next');
  355.       @_Module32First := GetProcAddress(KernelHandle, 'Module32First');
  356.       @_Module32Next := GetProcAddress(KernelHandle, 'Module32Next');
  357.       @_Module32FirstW := GetProcAddress(KernelHandle, 'Module32FirstW');
  358.       @_Module32NextW := GetProcAddress(KernelHandle, 'Module32NextW');
  359.     end;
  360.   end;
  361.   Result := (KernelHandle <> 0) and Assigned(_CreateToolhelp32Snapshot);
  362. end;
  363.  
  364. function CreateToolhelp32Snapshot;
  365. begin
  366.   if InitToolHelp then
  367.     Result := _CreateToolhelp32Snapshot(dwFlags, th32ProcessID)
  368.   else Result := 0;
  369. end;
  370.  
  371. function Heap32ListFirst;
  372. begin
  373.   if InitToolHelp then
  374.     Result := _Heap32ListFirst(hSnapshot, lphl)
  375.   else Result := False;
  376. end;
  377.  
  378. function Heap32ListNext;
  379. begin
  380.   if InitToolHelp then
  381.     Result := _Heap32ListNext(hSnapshot, lphl)
  382.   else Result := False;
  383. end;
  384.  
  385. function Heap32First;
  386. begin
  387.   if InitToolHelp then
  388.     Result := _Heap32First(lphe, th32ProcessID, th32HeapID)
  389.   else Result := False;
  390. end;
  391.  
  392. function Heap32Next;
  393. begin
  394.   if InitToolHelp then
  395.     Result := _Heap32Next(lphe)
  396.   else Result := False;
  397. end;
  398.  
  399. function Toolhelp32ReadProcessMemory;
  400. begin
  401.   if InitToolHelp then
  402.     Result := _Toolhelp32ReadProcessMemory(th32ProcessID, lpBaseAddress,
  403.       lpBuffer, cbRead, lpNumberOfBytesRead)
  404.   else Result := False;
  405. end;
  406.  
  407. function Process32First;
  408. begin
  409.   if InitToolHelp then
  410.     Result := _Process32First(hSnapshot, lppe)
  411.   else Result := False;
  412. end;
  413.  
  414. function Process32Next;
  415. begin
  416.   if InitToolHelp then
  417.     Result := _Process32Next(hSnapshot, lppe)
  418.   else Result := False;
  419. end;
  420.  
  421. function Process32FirstW;
  422. begin
  423.   if InitToolHelp then
  424.     Result := _Process32FirstW(hSnapshot, lppe)
  425.   else Result := False;
  426. end;
  427.  
  428. function Process32NextW;
  429. begin
  430.   if InitToolHelp then
  431.     Result := _Process32NextW(hSnapshot, lppe)
  432.   else Result := False;
  433. end;
  434.  
  435. function Thread32First;
  436. begin
  437.   if InitToolHelp then
  438.     Result := _Thread32First(hSnapshot, lpte)
  439.   else Result := False;
  440. end;
  441.  
  442. function Thread32Next;
  443. begin
  444.   if InitToolHelp then
  445.     Result := _Thread32Next(hSnapshot, lpte)
  446.   else Result := False;
  447. end;
  448.  
  449. function Module32First;
  450. begin
  451.   if InitToolHelp then
  452.     Result := _Module32First(hSnapshot, lpme)
  453.   else Result := False;
  454. end;
  455.  
  456. function Module32Next;
  457. begin
  458.   if InitToolHelp then
  459.     Result := _Module32Next(hSnapshot, lpme)
  460.   else Result := False;
  461. end;
  462.  
  463. function Module32FirstW;
  464. begin
  465.   if InitToolHelp then
  466.     Result := _Module32FirstW(hSnapshot, lpme)
  467.   else Result := False;
  468. end;
  469.  
  470. function Module32NextW;
  471. begin
  472.   if InitToolHelp then
  473.     Result := _Module32NextW(hSnapshot, lpme)
  474.   else Result := False;
  475. end;
  476.  
  477. end.
  478.  
  479.  
  480.