home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 June / Chip_2002-06_cd1.bin / zkuste / delphi / kompon / d56 / MSYSINFO.ZIP / Demos / 2 / Main.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-03-01  |  2.2 KB  |  95 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. type
  25.   TQT_Thunk = procedure cdecl;
  26.  
  27. procedure QT_Thunk; cdecl;
  28.  
  29. var
  30.   frmMain: TfrmMain;
  31.  
  32. implementation
  33.  
  34. uses MiTeC_Routines;
  35.  
  36. {$R *.DFM}
  37.  
  38. var
  39.   _QT_Thunk: TQT_Thunk;
  40.  
  41.   hInst16: THandle;
  42.   SR: Pointer;
  43.  
  44. const
  45.   cSystem = 0;
  46.   cGDI = 1;
  47.   cUSER = 2;
  48.  
  49. function LoadLibrary16(LibraryName: PChar): THandle; stdcall; external kernel32 index 35;
  50. procedure FreeLibrary16(HInstance: THandle); stdcall; external kernel32 index 36;
  51. function GetProcAddress16(Hinstance: THandle; ProcName: PChar): Pointer; stdcall; external kernel32 index 37;
  52.  
  53. procedure QT_Thunk;
  54. begin
  55.   if Assigned(_QT_Thunk) then
  56.     _QT_Thunk;
  57. end;
  58.  
  59. function GetFreeSysRes(SysRes: Word): Word;
  60. var
  61.   Thunks: Array[0..$20] of Word;
  62. begin
  63.   Thunks[0]:=hInst16;
  64.   if not IsNT then begin
  65.     hInst16:=LoadLibrary16('user.exe');
  66.     if hInst16<32 then
  67.       raise Exception.Create('Can''t load USER.EXE!');
  68.     FreeLibrary16(hInst16);
  69.     SR:=GetProcAddress16(hInst16,'GetFreeSystemResources');
  70.     if not Assigned(SR) then
  71.       raise Exception.Create('Can''t get address of GetFreeSystemResources');
  72.     asm
  73.       push SysRes       // push arguments
  74.       mov edx, SR       // load 16-bit procedure pointer
  75.       call _QT_Thunk     // call thunk
  76.       mov Result, ax    // save the result
  77.     end;
  78.   end else
  79.     Result:=90;
  80. end;
  81.  
  82. procedure TfrmMain.TimerTimer(Sender: TObject);
  83. begin
  84.   pbGDI.Position:=GetFreeSysRes(cGDI);
  85.   pbUser.Position:=GetFreeSysRes(cUser);
  86.   pbSystem.Position:=GetFreeSysRes(cSystem);
  87.   lGDI.Caption:=Format('GDI - %d%% free',[pbGDI.Position]);
  88.   lUser.Caption:=Format('User - %d%% free',[pbUser.Position]);
  89.   lSystem.Caption:=Format('System - %d%% free',[pbSystem.Position]);
  90. end;
  91.  
  92. initialization
  93.   @_QT_Thunk:=GetProcAddress(GetModuleHandle('kernel32'),PChar('QT_Thunk'));
  94. end.
  95.