Chip 2001 October/Chip_2001-10_cd1.bin/zkuste/delphi/kompon/d56/MSYSINFO.ZIP/Source/MSI_Memory.pas

Pascal/Delphi Source File | 2001-07-24 | 5.8 KB | 177 lines

{*******************************************************}
{                                                       }
{       MiTeC System Information Component              }
{              Memory Detection Part                    }
{           version 6.0 for Delphi 5,6                  }
{                                                       }
{       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 {$IFNDEF D6PLUS} write FPhysicalTotal {$ENDIF} stored false;
    property PhysicalFree :integer read FPhysicalFree {$IFNDEF D6PLUS} write FPhysicalFree {$ENDIF} stored false;
    property VirtualTotal :integer read FVirtualTotal {$IFNDEF D6PLUS} write FVirtualTotal {$ENDIF} stored false;
    property VirtualFree :integer read FVirtualFree {$IFNDEF D6PLUS} write FVirtualFree {$ENDIF} stored false;
    property PageFileTotal :integer read FPageFileTotal {$IFNDEF D6PLUS} write FPageFileTotal {$ENDIF} stored false;
    property PageFileFree :integer read FPageFileFree {$IFNDEF D6PLUS} write FPageFileFree {$ENDIF} stored false;
    property MemoryLoad :integer read FMemoryLoad {$IFNDEF D6PLUS} write FMemoryLoad {$ENDIF} stored false;
    property AllocGranularity :integer read FAllocGranularity {$IFNDEF D6PLUS} write FAllocGranularity {$ENDIF} stored false;
    property MaxAppAddress :integer read FMaxAppAddress {$IFNDEF D6PLUS} write FMaxAppAddress {$ENDIF} stored false;
    property MinAppAddress :integer read FMinAppAddress {$IFNDEF D6PLUS} write FMinAppAddress {$ENDIF} stored false;
    property PageSize :integer read FPageSize {$IFNDEF D6PLUS} write FPageSize {$ENDIF} 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 {$IFNDEF D6PLUS} write FSystemRes {$ENDIF} stored false;
    property Win9x_GDIRes: Byte read FGDIRes {$IFNDEF D6PLUS} write FGDIRes {$ENDIF} stored false;
    property Win9x_UserRes: Byte read FUserRes {$IFNDEF D6PLUS} write FUserRes {$ENDIF} 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
  ZeroMemory(@MS,SizeOf(MS));
  MS.dwLength:=SizeOf(MS);
  GlobalMemoryStatus(MS);
  FMemoryLoad:=MS.dwMemoryLoad;
  FPhysicalTotal:=MS.dwTotalPhys;
  FPhysicalFree:=MS.dwAvailPhys;
  FVirtualTotal:=MS.dwTotalVirtual;
  FVirtualFree:=MS.dwAvailVirtual;
  FPageFileTotal:=MS.dwTotalPageFile;
  FPageFileFree:=MS.dwAvailPageFile;
  ZeroMemory(@SI,SizeOf(SI));
  GetSystemInfo(SI);
  FAllocGranularity:=SI.dwAllocationGranularity;
  FMaxAppAddress:=DWORD(SI.lpMaximumApplicationAddress);
  FMinAppAddress:=DWORD(SI.lpMinimumApplicationAddress);
  FPageSize:=DWORD(SI.dwPageSize);
  FSystemRes:=GetSystemRes;
  FGDIRes:=GetGDIRes;
  FUserRes:=GetUserRes;
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.