home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 March / Chip_2002-03_cd1.bin / zkuste / delphi / kompon / d56 / MSYSINFO.ZIP / Demos / ResourceMeter / Main.pas < prev    next >
Pascal/Delphi Source File  |  2001-10-12  |  2KB  |  76 lines
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ExtCtrls, ComCtrls;
  8.  
  9. type
  10.   TfrmMain = class(TForm)
  11.     pbGDI: TProgressBar;
  12.     pbSystem: TProgressBar;
  13.     pbUser: TProgressBar;
  14.     lGDI: TLabel;
  15.     lSystem: TLabel;
  16.     lUser: TLabel;
  17.     Timer: TTimer;
  18.     procedure TimerTimer(Sender: TObject);
  19.   private
  20.   public
  21.  
  22.   end;
  23.  
  24. var
  25.   frmMain: TfrmMain;
  26.  
  27. implementation
  28.  
  29. {$R *.DFM}
  30.  
  31. const
  32.   cSystem = 0;
  33.   cGDI = 1;
  34.   cUSER = 2;
  35.  
  36. function LoadLibrary16(LibraryName: PChar): THandle; stdcall; external kernel32 index 35;
  37. procedure FreeLibrary16(HInstance: THandle); stdcall; external kernel32 index 36;
  38. function GetProcAddress16(Hinstance: THandle; ProcName: PChar): Pointer; stdcall; external kernel32 index 37;
  39. procedure QT_Thunk; cdecl; external kernel32 name 'QT_Thunk';
  40.  
  41. var
  42.   hInst16: THandle;
  43.   SR: Pointer;
  44.  
  45. function GetFreeSysRes(SysRes: Word): Word;
  46. var
  47.   Thunks: Array[0..$20] of Word;
  48. begin
  49.   Thunks[0]:=hInst16;
  50.   hInst16:=LoadLibrary16('user.exe');
  51.   if hInst16<32 then
  52.     raise Exception.Create('Can''t load USER.EXE!');
  53.   FreeLibrary16(hInst16);
  54.   SR:=GetProcAddress16(hInst16,'GetFreeSystemResources');
  55.   if not Assigned(SR) then
  56.     raise Exception.Create('Can''t get address of GetFreeSystemResources');
  57.   asm
  58.     push SysRes       // push arguments
  59.     mov edx, SR       // load 16-bit procedure pointer
  60.     call QT_Thunk     // call thunk
  61.     mov Result, ax    // save the result
  62.   end;
  63. end;
  64.  
  65. procedure TfrmMain.TimerTimer(Sender: TObject);
  66. begin
  67.   pbGDI.Position:=GetFreeSysRes(cGDI);
  68.   pbUser.Position:=GetFreeSysRes(cUser);
  69.   pbSystem.Position:=GetFreeSysRes(cSystem);
  70.   lGDI.Caption:=Format('GDI - %d%% free',[pbGDI.Position]);
  71.   lUser.Caption:=Format('User - %d%% free',[pbUser.Position]);
  72.   lSystem.Caption:=Format('System - %d%% free',[pbSystem.Position]);
  73. end;
  74.  
  75. end.
  76.