Chip 2001 September/Chip_2001-09_cd1.bin/zkuste/delphi/kompon/d2345/MSYSINFO.ZIP/Source/MSI_Memory.pas

Pascal/Delphi Source File | 2001-06-21 | 5.6 KB | 185 lines

{*******************************************************}
{                                                       }
{       MiTeC System Information Component              }
{              Memory Detection Part                    }
{           version 5.5 for Delphi 3,4,5                }
{                                                       }
{       Copyright ⌐ 1997,2001 Michal Mutl               }
{                                                       }
{*******************************************************}

{$INCLUDE MITEC_DEF.INC}

unit MSI_Memory;

interface

uses
  SysUtils, Windows, Classes;

type
  TMemory = class(TPersistent)
  private
    FMaxAppAddress: integer;
    FVirtualTotal: integer;
    FPageFileFree: integer;
    FVirtualFree: integer;
    FPhysicalFree: integer;
    FAllocGranularity: integer;
    FMinAppAddress: integer;
    FMemoryLoad: integer;
    FPhysicalTotal: integer;
    FPageFileTotal: integer;
    FPageSize: integer;
    FGDIRes: Byte;
    FUserRes: Byte;
    FSystemRes: Byte;

    function GetSystemRes: Byte;
    function GetGDIRes: Byte;
    function GetUSERRes: Byte;
  public
    procedure GetInfo;
    procedure Report(var sl :TStringList);
  published
    property PhysicalTotal :integer read FPhysicalTotal write FPhysicalTotal stored false;
    property PhysicalFree :integer read FPhysicalFree write FPhysicalFree stored false;
    property VirtualTotal :integer read FVirtualTotal write FVirtualTotal stored false;
    property VirtualFree :integer read FVirtualFree write FVirtualFree stored false;
    property PageFileTotal :integer read FPageFileTotal write FPageFileTotal stored false;
    property PageFileFree :integer read FPageFileFree write FPageFileFree stored false;
    property MemoryLoad :integer read FMemoryLoad write FMemoryLoad stored false;
    property AllocGranularity :integer read FAllocGranularity write FAllocGranularity stored false;
    property MaxAppAddress :integer read FMaxAppAddress write FMaxAppAddress stored false;
    property MinAppAddress :integer read FMinAppAddress write FMinAppAddress stored false;
    property PageSize :integer read FPageSize write FPageSize stored false;
// if you want to get these values you must change conditional define ONLYWIN9X in MiTeC_Def.inc
    property Win9x_SystemRes: Byte read FSystemRes write FSystemRes stored false;
    property Win9x_GDIRes: Byte read FGDIRes write FGDIRes stored false;
    property Win9x_UserRes: Byte read FUserRes write FUserRes stored false;
  end;

implementation

uses MiTeC_Routines;

{$IFDEF ONLYWIN9X}
const
  cSystem = 0;
  cGDI = 1;
  cUSER = 2;

function LoadLibrary16(LibraryName: PChar): THandle; stdcall; external kernel32 index 35;
procedure FreeLibrary16(HInstance: THandle); stdcall; external kernel32 index 36;
function GetProcAddress16(Hinstance: THandle; ProcName: PChar): Pointer; stdcall; external kernel32 index 37;
procedure QT_Thunk; cdecl; external kernel32 name 'QT_Thunk';

var
  hInst16: THandle;
  SR: Pointer;

function GetFreeSysRes(SysRes: Word): Word;
var
  Thunks: Array[0..$20] of Word;
begin
  Thunks[0]:=hInst16;
  hInst16:=LoadLibrary16('user.exe');
  if hInst16<32 then
    raise Exception.Create('Can''t load USER.EXE!');
  FreeLibrary16(hInst16);
  SR:=GetProcAddress16(hInst16,'GetFreeSystemResources');
  if not Assigned(SR) then
    raise Exception.Create('Can''t get address of GetFreeSystemResources');
  asm
    push SysRes       // push arguments
    mov edx, SR       // load 16-bit procedure pointer
    call QT_Thunk     // call thunk
    mov Result, ax    // save the result
  end;
end;
{$ENDIF}

{ TMemory }

function TMemory.GetGDIRes: Byte;
begin
  {$IFDEF ONLYWIN9X}
  Result:=GetFreeSysRes(cGDI)
  {$ELSE}
  Result:=0;
  {$ENDIF}
end;

function TMemory.GetSystemRes: Byte;
begin
  {$IFDEF ONLYWIN9X}
  Result:=GetFreeSysRes(cSystem)
  {$ELSE}
  Result:=0;
  {$ENDIF}
end;

function TMemory.GetUSERRes: Byte;
begin
  {$IFDEF ONLYWIN9X}
  Result:=GetFreeSysRes(cUser)
  {$ELSE}
  Result:=0;
  {$ENDIF}
end;

procedure TMemory.GetInfo;
var
  SI :TSystemInfo;
  MS :TMemoryStatus;
begin
  try

  ZeroMemory(@MS,SizeOf(MS));
  MS.dwLength:=SizeOf(MS);
  GlobalMemoryStatus(MS);
  MemoryLoad:=MS.dwMemoryLoad;
  PhysicalTotal:=MS.dwTotalPhys;
  PhysicalFree:=MS.dwAvailPhys;
  VirtualTotal:=MS.dwTotalVirtual;
  VirtualFree:=MS.dwAvailVirtual;
  PageFileTotal:=MS.dwTotalPageFile;
  PageFileFree:=MS.dwAvailPageFile;
  ZeroMemory(@SI,SizeOf(SI));
  GetSystemInfo(SI);
  AllocGranularity:=SI.dwAllocationGranularity;
  MaxAppAddress:=DWORD(SI.lpMaximumApplicationAddress);
  MinAppAddress:=DWORD(SI.lpMinimumApplicationAddress);
  PageSize:=DWORD(SI.dwPageSize);
  FSystemRes:=GetSystemRes;
  FGDIRes:=GetGDIRes;
  FUserRes:=GetUserRes;

  except
    on e:Exception do begin
      MessageBox(0,PChar(e.message),'TMemory.GetInfo',MB_OK or MB_ICONERROR);
    end;
  end;
end;

procedure TMemory.Report(var sl: TStringList);
begin
  with sl do begin
    Add('[Memory]');
    Add(FormatFloat('PhysMemTotal=0,##',PhysicalTotal));
    Add(FormatFloat('PhysMemFree=0,##',PhysicalFree));
    Add(FormatFloat('PageFileTotal=0,##',PageFileTotal));
    Add(FormatFloat('PageFileFree=0,##',PageFileFree));
    Add(FormatFloat('VirtMemTotal=0,##',VirtualTotal));
    Add(FormatFloat('VirtMemFree=0,##',VirtualFree));
    Add(FormatFloat('AllocGranularity=0,##',AllocGranularity));
    Add(Format('MinAppAddress=%x',[MinAppAddress]));
    Add(Format('MaxAppAddress=%x',[MaxAppAddress]));
    Add(FormatFloat('PageSize=0,##',PageSize));
  end;
end;


end.