infou.pas

《Delphi开发人员指南》配书原码

unit InfoU;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  HeadList, StdCtrls, ExtCtrls, SysMain;

type
  TInfoVariety = (ivMemory, ivSystem, ivEnvironment);

  TInfoForm = class(TForm)
    InfoLB: THeaderListbox;
    Panel1: TPanel;
    OkBtn: TButton;
  private
    procedure GetOSVerInfo;
    procedure GetSysInfo;
    procedure GetDirInfo;
  public
    procedure ShowMemStatus;
    procedure ShowSysInfo;
    procedure ShowEnvironment;
  end;

procedure ShowInformation(Variety: TInfoVariety);

implementation

{$R *.DFM}

procedure ShowInformation(Variety: TInfoVariety);
begin
  with TInfoForm.Create(Application) do
    try
      Font := MainForm.Font;
      case Variety of
        ivMemory: ShowMemStatus;
        ivSystem: ShowSysInfo;
        ivEnvironment: ShowEnvironment;
      end;
      ShowModal;
    finally
      Free;
    end;
end;

const
  { Memory status strings }
  SMemUse   = 'Memory in useq%d%%';
  STotMem   = 'Total physical memoryq$%.8x bytes';
  SFreeMem  = 'Free physical memoryq$%.8x bytes';
  STotPage  = 'Total page file memoryq$%.8x bytes';
  SFreePage = 'Free page file memoryq$%.8x bytes';
  STotVirt  = 'Total virtual memoryq$%.8x bytes';
  SFreeVirt = 'Free virtual memoryq$%.8x bytes';

  { OS version info strings }
  SOSVer    = 'OS Versionq%d.%d';
  SBuildNo  = 'Build Numberq%d';
  SOSPlat   = 'Platformq%s';
  SOSWin32s = 'Windows 3.1x running Win32s';
  SOSWin95  = 'Windows 95/98';
  SOSWinNT  = 'Windows NT/2000';

  { System info strings }
  SProc     = 'Processor Arhitectureq%s';
  SPIntel   = 'Intel';
  SPageSize = 'Page Sizeq$%.8x bytes';
  SMinAddr  = 'Minimum Application Addressq$%p';
  SMaxAddr  = 'Maximum Application Addressq$%p';
  SNumProcs = 'Number of Processorsq%d';
  SAllocGra = 'Allocation Granularityq$%.8x bytes';
  SProcLevl = 'Processor Levelq%s';
  SIntel3   = '80386';
  SIntel4   = '80486';
  SIntel5   = 'Pentium';
  SIntel6   = 'Pentium Pro';
  SProcRev  = 'Processor Revisionq%.4x';

  { Directory strings }
  SWinDir   = 'Windows directoryq%s';
  SSysDir   = 'Windows system directoryq%s';
  SCurDir   = 'Current directoryq%s';

procedure TInfoForm.ShowMemStatus;
var
  MS: TMemoryStatus;
begin
  InfoLB.DelimChar := 'q';
  MS.dwLength := SizeOf(MS);
  GlobalMemoryStatus(MS);
  with InfoLB.Items, MS do
  begin
    Clear;
    Add(Format(SMemUse, [dwMemoryLoad]));
    Add(Format(STotMem, [dwTotalPhys]));
    Add(Format(SFreeMem, [dwAvailPhys]));
    Add(Format(STotPage, [dwTotalPageFile]));
    Add(Format(SFreePage, [dwAvailPageFile]));
    Add(Format(STotVirt, [dwTotalVirtual]));
    Add(Format(SFreeVirt, [dwAvailVirtual]));
  end;
  InfoLB.Sections[0].Text := 'Resource';
  InfoLB.Sections[1].Text := 'Amount';
  Caption:= 'Memory Status';
end;

procedure TInfoForm.GetOSVerInfo;
var
  VI: TOSVersionInfo;
begin
  VI.dwOSVersionInfoSize := SizeOf(VI);
  GetVersionEx(VI);
  with InfoLB.Items, VI do
  begin
    Clear;
    Add(Format(SOSVer, [dwMajorVersion, dwMinorVersion]));
    Add(Format(SBuildNo, [LoWord(dwBuildNumber)]));
    case dwPlatformID of
      VER_PLATFORM_WIN32S: Add(Format(SOSPlat, [SOSWin32s]));
      VER_PLATFORM_WIN32_WINDOWS: Add(Format(SOSPlat, [SOSWin95]));
      VER_PLATFORM_WIN32_NT: Add(Format(SOSPlat, [SOSWinNT]));
    end;
  end;
end;

procedure TInfoForm.GetSysInfo;
var
  SI: TSystemInfo;
begin
  GetSystemInfo(SI);
  with InfoLB.Items, SI do
  begin
    Add(Format(SProc, [SPIntel]));
    Add(Format(SPageSize, [dwPageSize]));
    Add(Format(SMinAddr, [lpMinimumApplicationAddress]));
    Add(Format(SMaxAddr, [lpMaximumApplicationAddress]));
    Add(Format(SNumProcs, [dwNumberOfProcessors]));
    Add(Format(SAllocGra, [dwAllocationGranularity]));
    case wProcessorLevel of
      3: Add(Format(SProcLevl, [SIntel3]));
      4: Add(Format(SProcLevl, [SIntel4]));
      5: Add(Format(SProcLevl, [SIntel5]));
      6: Add(Format(SProcLevl, [SIntel6]));
    else Add(Format(SProcLevl, [IntToStr(wProcessorLevel)]));
    end;
  end;
end;

procedure TInfoForm.GetDirInfo;
var
  S: array[0..MAX_PATH] of char;
begin
  { Get Windows directory }
  GetWindowsDirectory(S, SizeOf(S));
  InfoLB.Items.Add(Format(SWinDir, [S]));
  { Get Windows system directory }
  GetSystemDirectory(S, SizeOf(S));
  InfoLB.Items.Add(Format(SSysDir, [S]));
  { Get Current directory for current process }
  GetCurrentDirectory(SizeOf(S), S);
  InfoLB.Items.Add(Format(SCurDir, [S]));
end;

procedure TInfoForm.ShowSysInfo;
begin
  InfoLB.DelimChar := 'q';
  GetOSVerInfo;
  GetSysInfo;
  GetDirInfo;
  InfoLB.Sections[0].Text := 'Item';
  InfoLB.Sections[1].Text := 'Value';
  Caption:= 'System Information';
end;

procedure TInfoForm.ShowEnvironment;
var
  EnvPtr, SavePtr: PChar;
begin
  InfoLB.DelimChar := '=';
  EnvPtr := GetEnvironmentStrings;
  SavePtr := EnvPtr;
  InfoLB.Items.Clear;
  repeat
    InfoLB.Items.Add(StrPas(EnvPtr));
    inc(EnvPtr, StrLen(EnvPtr) + 1);
  until EnvPtr^ = #0;
  FreeEnvironmentStrings(SavePtr);
  InfoLB.Sections[0].Text := 'Environment Variable';
  InfoLB.Sections[1].Text := 'Value';
  Caption:= 'Current Environment';
end;

end.