home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kompon / d2345 / MSYSINFO.ZIP / Source / MSI_Memory.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-21  |  6KB  |  185 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       MiTeC System Information Component              }
  5. {              Memory Detection Part                    }
  6. {           version 5.5 for Delphi 3,4,5                }
  7. {                                                       }
  8. {       Copyright ⌐ 1997,2001 Michal Mutl               }
  9. {                                                       }
  10. {*******************************************************}
  11.  
  12. {$INCLUDE MITEC_DEF.INC}
  13.  
  14. unit MSI_Memory;
  15.  
  16. interface
  17.  
  18. uses
  19.   SysUtils, Windows, Classes;
  20.  
  21. type
  22.   TMemory = class(TPersistent)
  23.   private
  24.     FMaxAppAddress: integer;
  25.     FVirtualTotal: integer;
  26.     FPageFileFree: integer;
  27.     FVirtualFree: integer;
  28.     FPhysicalFree: integer;
  29.     FAllocGranularity: integer;
  30.     FMinAppAddress: integer;
  31.     FMemoryLoad: integer;
  32.     FPhysicalTotal: integer;
  33.     FPageFileTotal: integer;
  34.     FPageSize: integer;
  35.     FGDIRes: Byte;
  36.     FUserRes: Byte;
  37.     FSystemRes: Byte;
  38.  
  39.     function GetSystemRes: Byte;
  40.     function GetGDIRes: Byte;
  41.     function GetUSERRes: Byte;
  42.   public
  43.     procedure GetInfo;
  44.     procedure Report(var sl :TStringList);
  45.   published
  46.     property PhysicalTotal :integer read FPhysicalTotal write FPhysicalTotal stored false;
  47.     property PhysicalFree :integer read FPhysicalFree write FPhysicalFree stored false;
  48.     property VirtualTotal :integer read FVirtualTotal write FVirtualTotal stored false;
  49.     property VirtualFree :integer read FVirtualFree write FVirtualFree stored false;
  50.     property PageFileTotal :integer read FPageFileTotal write FPageFileTotal stored false;
  51.     property PageFileFree :integer read FPageFileFree write FPageFileFree stored false;
  52.     property MemoryLoad :integer read FMemoryLoad write FMemoryLoad stored false;
  53.     property AllocGranularity :integer read FAllocGranularity write FAllocGranularity stored false;
  54.     property MaxAppAddress :integer read FMaxAppAddress write FMaxAppAddress stored false;
  55.     property MinAppAddress :integer read FMinAppAddress write FMinAppAddress stored false;
  56.     property PageSize :integer read FPageSize write FPageSize stored false;
  57. // if you want to get these values you must change conditional define ONLYWIN9X in MiTeC_Def.inc    
  58.     property Win9x_SystemRes: Byte read FSystemRes write FSystemRes stored false;
  59.     property Win9x_GDIRes: Byte read FGDIRes write FGDIRes stored false;
  60.     property Win9x_UserRes: Byte read FUserRes write FUserRes stored false;
  61.   end;
  62.  
  63. implementation
  64.  
  65. uses MiTeC_Routines;
  66.  
  67. {$IFDEF ONLYWIN9X}
  68. const
  69.   cSystem = 0;
  70.   cGDI = 1;
  71.   cUSER = 2;
  72.  
  73. function LoadLibrary16(LibraryName: PChar): THandle; stdcall; external kernel32 index 35;
  74. procedure FreeLibrary16(HInstance: THandle); stdcall; external kernel32 index 36;
  75. function GetProcAddress16(Hinstance: THandle; ProcName: PChar): Pointer; stdcall; external kernel32 index 37;
  76. procedure QT_Thunk; cdecl; external kernel32 name 'QT_Thunk';
  77.  
  78. var
  79.   hInst16: THandle;
  80.   SR: Pointer;
  81.  
  82. function GetFreeSysRes(SysRes: Word): Word;
  83. var
  84.   Thunks: Array[0..$20] of Word;
  85. begin
  86.   Thunks[0]:=hInst16;
  87.   hInst16:=LoadLibrary16('user.exe');
  88.   if hInst16<32 then
  89.     raise Exception.Create('Can''t load USER.EXE!');
  90.   FreeLibrary16(hInst16);
  91.   SR:=GetProcAddress16(hInst16,'GetFreeSystemResources');
  92.   if not Assigned(SR) then
  93.     raise Exception.Create('Can''t get address of GetFreeSystemResources');
  94.   asm
  95.     push SysRes       // push arguments
  96.     mov edx, SR       // load 16-bit procedure pointer
  97.     call QT_Thunk     // call thunk
  98.     mov Result, ax    // save the result
  99.   end;
  100. end;
  101. {$ENDIF}
  102.  
  103. { TMemory }
  104.  
  105. function TMemory.GetGDIRes: Byte;
  106. begin
  107.   {$IFDEF ONLYWIN9X}
  108.   Result:=GetFreeSysRes(cGDI)
  109.   {$ELSE}
  110.   Result:=0;
  111.   {$ENDIF}
  112. end;
  113.  
  114. function TMemory.GetSystemRes: Byte;
  115. begin
  116.   {$IFDEF ONLYWIN9X}
  117.   Result:=GetFreeSysRes(cSystem)
  118.   {$ELSE}
  119.   Result:=0;
  120.   {$ENDIF}
  121. end;
  122.  
  123. function TMemory.GetUSERRes: Byte;
  124. begin
  125.   {$IFDEF ONLYWIN9X}
  126.   Result:=GetFreeSysRes(cUser)
  127.   {$ELSE}
  128.   Result:=0;
  129.   {$ENDIF}
  130. end;
  131.  
  132. procedure TMemory.GetInfo;
  133. var
  134.   SI :TSystemInfo;
  135.   MS :TMemoryStatus;
  136. begin
  137.   try
  138.  
  139.   ZeroMemory(@MS,SizeOf(MS));
  140.   MS.dwLength:=SizeOf(MS);
  141.   GlobalMemoryStatus(MS);
  142.   MemoryLoad:=MS.dwMemoryLoad;
  143.   PhysicalTotal:=MS.dwTotalPhys;
  144.   PhysicalFree:=MS.dwAvailPhys;
  145.   VirtualTotal:=MS.dwTotalVirtual;
  146.   VirtualFree:=MS.dwAvailVirtual;
  147.   PageFileTotal:=MS.dwTotalPageFile;
  148.   PageFileFree:=MS.dwAvailPageFile;
  149.   ZeroMemory(@SI,SizeOf(SI));
  150.   GetSystemInfo(SI);
  151.   AllocGranularity:=SI.dwAllocationGranularity;
  152.   MaxAppAddress:=DWORD(SI.lpMaximumApplicationAddress);
  153.   MinAppAddress:=DWORD(SI.lpMinimumApplicationAddress);
  154.   PageSize:=DWORD(SI.dwPageSize);
  155.   FSystemRes:=GetSystemRes;
  156.   FGDIRes:=GetGDIRes;
  157.   FUserRes:=GetUserRes;
  158.  
  159.   except
  160.     on e:Exception do begin
  161.       MessageBox(0,PChar(e.message),'TMemory.GetInfo',MB_OK or MB_ICONERROR);
  162.     end;
  163.   end;
  164. end;
  165.  
  166. procedure TMemory.Report(var sl: TStringList);
  167. begin
  168.   with sl do begin
  169.     Add('[Memory]');
  170.     Add(FormatFloat('PhysMemTotal=0,##',PhysicalTotal));
  171.     Add(FormatFloat('PhysMemFree=0,##',PhysicalFree));
  172.     Add(FormatFloat('PageFileTotal=0,##',PageFileTotal));
  173.     Add(FormatFloat('PageFileFree=0,##',PageFileFree));
  174.     Add(FormatFloat('VirtMemTotal=0,##',VirtualTotal));
  175.     Add(FormatFloat('VirtMemFree=0,##',VirtualFree));
  176.     Add(FormatFloat('AllocGranularity=0,##',AllocGranularity));
  177.     Add(Format('MinAppAddress=%x',[MinAppAddress]));
  178.     Add(Format('MaxAppAddress=%x',[MaxAppAddress]));
  179.     Add(FormatFloat('PageSize=0,##',PageSize));
  180.   end;
  181. end;
  182.  
  183.  
  184. end.
  185.