home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kompon / d2345 / MSYSINFO.ZIP / Source / MiTeC_PSAPI.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-04-18  |  10.9 KB  |  299 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {             MiTeC Delphi Runtime Library              }
  5. {          Windows NT Process Status API Unit           }
  6. {           version 1.1 for Delphi 3,4,5                }
  7. {                                                       }
  8. {            Copyright ⌐ 1998 Michal Mutl               }
  9. {                                                       }
  10. {*******************************************************}
  11.  
  12.  
  13. unit MiTeC_PSAPI;
  14.  
  15. interface
  16.  
  17. uses Classes, Windows, ShellAPI, SysUtils;
  18.  
  19. type
  20.   PHInst = ^HInst;
  21.   TModuleInfo = record
  22.     lpBaseOfDll : pointer;
  23.     SizeOfImage : Integer;
  24.     EntryPoint : pointer
  25.   end;
  26.  
  27.   TPSAPIWsWatchInformation = record
  28.     FaultingPc : pointer;
  29.     FaultingVa : pointer
  30.   end;
  31.  
  32.   TProcessMemoryCounters = record
  33.     cb : Integer;
  34.     PageFaultCount : Integer;
  35.     PeakWorkingSetSize : Integer;
  36.     WorkingSetSize : Integer;
  37.     QuotaPeakPagedPoolUsage : Integer;
  38.     QuotaPagedPoolUsage : Integer;
  39.     QuotaPeakNonPagedPoolUsage : Integer;
  40.     QuotaNonPagedPoolUsage : Integer;
  41.     PagefileUsage : Integer;
  42.     PeakPagefileUsage : Integer
  43.   end;
  44.  
  45.   TaskEnumProcEx = function(threadID : DWORD; hMod16 : WORD; hTask16 : WORD; modName : PChar; fileName : PChar; param : DWORD) : BOOL; stdcall;
  46.  
  47.   function InitPSAPI: Boolean;
  48.   function FreePSAPI: Boolean;
  49.   function EnumProcesses(pidList : PInteger; cb : Integer; var cbNeeded : DWORD): boolean; stdcall;
  50.   function EnumProcessModules(hProcess : THandle; moduleList : PHInst; cb : Integer; var cbNeeded : DWORD) : boolean; stdcall;
  51.   function GetModuleBaseName(hProcess : THandle; module : HInst; BaseName : Pchar; size : Integer) : Integer; stdcall;
  52.   function GetModuleFileNameEx(hProcess : THandle; module : HInst; FileName : PChar; size : Integer) : Integer; stdcall;
  53.   function GetModuleInformation(hProcess : THandle; module : HInst; var info : TModuleInfo; size : Integer) : boolean; stdcall;
  54.   function EmptyWorkingSet(hProcess : THandle) : boolean; stdcall;
  55.   function QueryWorkingSet(hProcess : THandle; var pv; size : Integer) : boolean; stdcall;
  56.   function InitializeProcessForWsWatch(hProcess : THandle) : boolean; stdcall;
  57.   function GetWsChanges(hProcess : THandle; var WatchInfo : TPSAPIWsWatchInformation; size : Integer) : boolean; stdcall;
  58.   function GetMappedFileName(hProcess : THandle; pv : pointer; FileName : PChar; size : Integer) : Integer; stdcall;
  59.   function EnumDeviceDrivers(ImageBase : PInteger; cb : dword; var cbNeeded : dword) : boolean; stdcall;
  60.   function GetDeviceDriverBaseName(ImageBase : Integer; BaseName : PChar; size : dword) : Integer; stdcall;
  61.   function GetDeviceDriverFileName(ImageBase : Integer; FileName : PChar; size : dword) : Integer; stdcall;
  62.   function GetProcessMemoryInfo(hProcess : THandle; var ProcessMemoryCounters : TProcessMemoryCounters; size : Integer) : boolean; stdcall;
  63.  
  64.   function InitVDM: Boolean;
  65.   function FreeVDM: Boolean;
  66.   function VDMEnumTaskWOWEx(pid : DWORD; callback : TaskEnumProcEx; param : DWORD) : Integer; stdcall;
  67.  
  68. type
  69.   TVDMEnumTaskWOWEx = function (pid : DWORD; callback : TaskEnumProcEx; param : DWORD) : Integer; stdcall;
  70.  
  71.   TEnumProcesses = function (pidList : PInteger; cb : Integer; var cbNeeded : DWORD): boolean; stdcall;
  72.   TEnumProcessModules = function (hProcess : THandle; moduleList : PHInst; cb : Integer; var cbNeeded : DWORD) : boolean; stdcall;
  73.   TGetModuleBaseName = function (hProcess : THandle; module : HInst; BaseName : Pchar; size : Integer) : Integer; stdcall;
  74.   TGetModuleFileNameEx = function (hProcess : THandle; module : HInst; FileName : PChar; size : Integer) : Integer; stdcall;
  75.   TGetModuleInformation = function (hProcess : THandle; module : HInst; var info : TModuleInfo; size : Integer) : boolean; stdcall;
  76.   TEmptyWorkingSet = function (hProcess : THandle) : boolean; stdcall;
  77.   TQueryWorkingSet = function (hProcess : THandle; var pv; size : Integer) : boolean; stdcall;
  78.   TInitializeProcessForWsWatch = function (hProcess : THandle) : boolean; stdcall;
  79.   TGetWsChanges = function (hProcess : THandle; var WatchInfo : TPSAPIWsWatchInformation; size : Integer) : boolean; stdcall;
  80.   TGetMappedFileName = function (hProcess : THandle; pv : pointer; FileName : PChar; size : Integer) : Integer; stdcall;
  81.   TEnumDeviceDrivers = function (ImageBase : PInteger; cb : dword; var cbNeeded : dword) : boolean; stdcall;
  82.   TGetDeviceDriverBaseName = function (ImageBase : Integer; BaseName : PChar; size : dword) : Integer; stdcall;
  83.   TGetDeviceDriverFileName = function (ImageBase : Integer; FileName : PChar; size : dword) : Integer; stdcall;
  84.   TGetProcessMemoryInfo = function (hProcess : THandle; var ProcessMemoryCounters : TProcessMemoryCounters; size : Integer) : boolean; stdcall;
  85.  
  86. var
  87.   modulelist :PHInst;
  88.   PSAPILoaded :Boolean;
  89.  
  90. implementation
  91.  
  92. const
  93.   PSAPIDLL = 'psapi.dll';
  94.   VDMDBGDLL = 'vdmdbg.dll';
  95.  
  96. var
  97.   PSAPIHandle, VDMHandle: THandle;
  98.  
  99.   _VDMEnumTaskWOWEx :TVDMEnumTaskWOWEx;
  100.  
  101.   _EnumProcesses: TEnumProcesses;
  102.   _EnumProcessModules: TEnumProcessModules;
  103.   _GetModuleBaseName: TGetModuleBaseName;
  104.   _GetModuleFileNameEx: TGetModuleFileNameEx;
  105.   _GetModuleInformation: TGetModuleInformation;
  106.   _EmptyWorkingSet: TEmptyWorkingSet;
  107.   _QueryWorkingSet: TQueryWorkingSet;
  108.   _InitializeProcessForWsWatch: TInitializeProcessForWsWatch;
  109.   _GetWsChanges: TGetWsChanges;
  110.   _GetMappedFileName: TGetMappedFileName;
  111.   _EnumDeviceDrivers: TEnumDeviceDrivers;
  112.   _GetDeviceDriverBaseName: TGetDeviceDriverBaseName;
  113.   _GetDeviceDriverFileName: TGetDeviceDriverFileName;
  114.   _GetProcessMemoryInfo: TGetProcessMemoryInfo;
  115.  
  116. function InitPSAPI: Boolean;
  117. begin
  118.   PSAPIHandle:=GetModuleHandle(PSAPIDLL);
  119.   if PSAPIHandle = 0 then
  120.     PSAPIHandle:=loadlibrary(psapidll);
  121.   if PSAPIHandle<>0 then begin
  122.     try
  123.       @_EnumProcesses:=getprocaddress(PSAPIHandle,pchar('EnumProcesses'));
  124.       @_EnumProcessModules:=getprocaddress(PSAPIHandle,pchar('EnumProcessModules'));
  125.       @_GetModuleBaseName:=getprocaddress(PSAPIHandle,pchar('GetModuleBaseNameA'));
  126.       @_GetModuleFileNameEx:=getprocaddress(PSAPIHandle,pchar('GetModuleFileNameExA'));
  127.       @_GetModuleInformation:=getprocaddress(PSAPIHandle,pchar('GetModuleInformation'));
  128.       @_EmptyWorkingSet:=getprocaddress(PSAPIHandle,pchar('EmptyWorkingSet'));
  129.       @_QueryWorkingSet:=getprocaddress(PSAPIHandle,pchar('QueryWorkingSet'));
  130.       @_InitializeProcessForWsWatch:=getprocaddress(PSAPIHandle,pchar('InitializeProcessForWsWatch'));
  131.       @_GetWsChanges:=getprocaddress(PSAPIHandle,pchar('GetWsChanges'));
  132.       @_GetMappedFileName:=getprocaddress(PSAPIHandle,pchar('GetMappedFileNameA'));
  133.       @_EnumDeviceDrivers:=getprocaddress(PSAPIHandle,pchar('EnumDeviceDrivers'));
  134.       @_GetDeviceDriverBaseName:=getprocaddress(PSAPIHandle,pchar('GetDeviceDriverBaseNameA'));
  135.       @_GetDeviceDriverFileName:=getprocaddress(PSAPIHandle,pchar('GetDeviceDriverFileNameA'));
  136.       @_GetProcessMemoryInfo:=getprocaddress(PSAPIHandle,pchar('GetProcessMemoryInfo'));
  137.     except
  138.       if not freepsapi then
  139.         raise exception.create('Unload Error: '+psapidll+' ('+inttohex(getmodulehandle(psapidll),8)+')');
  140.     end;
  141.   end;
  142.   result:=(PSAPIHandle<>0) and assigned(_EnumProcesses);
  143. end;
  144.  
  145. function FreePSAPI: Boolean;
  146. begin
  147.   result:=freelibrary(psapihandle);
  148. end;
  149.  
  150. function InitVDM: Boolean;
  151. begin
  152.   VDMHandle:=GetModuleHandle(VDMDBGDLL);
  153.   if VDMHandle = 0 then
  154.     VDMHandle:=loadlibrary(vdmdbgdll);
  155.   if VDMHandle<>0 then begin
  156.     try
  157.       @_VDMEnumTaskWOWEx:=getprocaddress(VDMHandle,pchar('VDMEnumTaskWOWEx'));
  158.     except
  159.       if not freevdm then
  160.         raise exception.create('Unload Error: '+vdmdbgdll+' ('+inttohex(getmodulehandle(vdmdbgdll),8)+')');
  161.     end;
  162.   end;
  163.   result:=(VDMHandle<>0) and assigned(_VDMEnumTaskWOWEx);
  164. end;
  165.  
  166. function FreeVDM: Boolean;
  167. begin
  168.   result:=freelibrary(vdmhandle);
  169. end;
  170.  
  171. function VDMEnumTaskWOWEx;
  172. begin
  173.   if (vdmhandle<>0) and assigned(_VDMEnumTaskWOWEx) then
  174.     result:=_VDMEnumTaskWOWEx(pid,callback,param)
  175.   else
  176.     result:=0;
  177. end;
  178.  
  179. function EnumProcesses;
  180. begin
  181.   if (psapihandle<>0) and assigned(_EnumProcesses) then
  182.     result:=_EnumProcesses(pidList,cb,cbNeeded)
  183.   else
  184.     result:=false;
  185. end;
  186.  
  187. function EnumProcessModules;
  188. begin
  189.   if (psapihandle<>0) and assigned(_EnumProcessModules) then
  190.     result:=_EnumProcessModules(hProcess,moduleList,cb,cbNeeded)
  191.   else
  192.     result:=false;
  193. end;
  194.  
  195. function GetModuleBaseName(hProcess : THandle; module : HInst; BaseName : Pchar; size : Integer) : Integer; stdcall;
  196. begin
  197.   if (psapihandle<>0) and assigned(_GetModuleBaseName) then
  198.     result:=_GetModuleBaseName(hProcess,module,BaseName,size)
  199.   else
  200.     result:=0;
  201. end;
  202.  
  203. function GetModuleFileNameEx;
  204. begin
  205.   if (psapihandle<>0) and assigned(_GetModuleFileNameEx) then
  206.     result:=_GetModuleFileNameEx(hProcess,module,FileName,size)
  207.   else
  208.     result:=0;
  209. end;
  210.  
  211. function GetModuleInformation;
  212. begin
  213.   if (psapihandle<>0) and assigned(_GetModuleInformation) then
  214.     result:=_GetModuleInformation(hProcess,module,info,size)
  215.   else
  216.     result:=false;
  217. end;
  218.  
  219. function EmptyWorkingSet;
  220. begin
  221.   if (psapihandle<>0) and assigned(_EmptyWorkingSet) then
  222.     result:=_EmptyWorkingSet(hProcess)
  223.   else
  224.     result:=false;
  225. end;
  226.  
  227. function QueryWorkingSet;
  228. begin
  229.   if (psapihandle<>0) and assigned(_QueryWorkingSet) then
  230.     result:=_QueryWorkingSet(hProcess,pv,size)
  231.   else
  232.     result:=false;
  233. end;
  234.  
  235. function InitializeProcessForWsWatch;
  236. begin
  237.   if (psapihandle<>0) and assigned(_InitializeProcessForWsWatch) then
  238.     result:=_InitializeProcessForWsWatch(hProcess)
  239.   else
  240.     result:=false;
  241. end;
  242.  
  243. function GetWsChanges;
  244. begin
  245.   if (psapihandle<>0) and assigned(_GetWsChanges) then
  246.     result:=_GetWsChanges(hProcess,WatchInfo,size)
  247.   else
  248.     result:=false;
  249. end;
  250.  
  251. function GetMappedFileName;
  252. begin
  253.   if (psapihandle<>0) and assigned(_GetMappedFileName) then
  254.     result:=_GetMappedFileName(hProcess,pv,FileName,size)
  255.   else
  256.     result:=0;
  257. end;
  258.  
  259. function EnumDeviceDrivers;
  260. begin
  261.   if (psapihandle<>0) and assigned(_EnumDeviceDrivers) then
  262.     result:=_EnumDeviceDrivers(ImageBase,cb,cbNeeded)
  263.   else
  264.     result:=false;
  265. end;
  266.  
  267. function GetDeviceDriverBaseName;
  268. begin
  269.   if (psapihandle<>0) and assigned(_GetDeviceDriverBaseName) then
  270.     result:=_GetDeviceDriverBaseName(ImageBase,BaseName,size)
  271.   else
  272.     result:=0;
  273. end;
  274.  
  275. function GetDeviceDriverFileName;
  276. begin
  277.   if (psapihandle<>0) and assigned(_GetDeviceDriverFileName) then
  278.     result:=_GetDeviceDriverFileName(ImageBase,FileName,size)
  279.   else
  280.     result:=0;
  281. end;
  282.  
  283. function GetProcessMemoryInfo;
  284. begin
  285.   if (psapihandle<>0) and assigned(_GetProcessMemoryInfo) then
  286.     result:=_GetProcessMemoryInfo(hProcess,ProcessMemoryCounters,size)
  287.   else
  288.     result:=false;
  289. end;
  290.  
  291. initialization
  292.   PSAPILoaded:=InitPSAPI;
  293. finalization
  294.   if PSAPILoaded then
  295.     if not FreePSAPI then
  296.       Exception.Create('Unload Error: PSAPI.DLL ('+inttohex(getmodulehandle('PSAPI.DLL'),8)+')');
  297. end.
  298.  
  299.