ufrmsysinfo.pas

系统控制程序,可以方便地调整系统分辨率及快速度开关注销系统 显示系统信息进程信息

unit uFrmSysInfo;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;

type
  TFrmSysInfo = class(TForm)
    pgInfos: TPageControl;
    tabSysInfo: TTabSheet;
    tabProcess: TTabSheet;
    lstSysInfo: TListBox;
    lstProcess: TListBox;
    btnClose: TButton;
    procedure FormCreate(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
  private
    { Private declarations }
  public
    procedure GetSysInfo();
    procedure GetProcess();
    { Public declarations }
  end;

var
  FrmSysInfo: TFrmSysInfo;

implementation

uses
  PSAPI;

{$R *.dfm}

procedure TFrmSysInfo.GetSysInfo();
var
  MS: TMemoryStatus;
  VI: TOSVersionInfo;
  SI: TSystemInfo;
  EnvPtr, TmpPtr: PChar;
begin
  MS.dwLength := SizeOf(MS);
  GlobalMemoryStatus(MS);
  with lstSysInfo.Items, MS do
  begin
    Clear;
    Add('已用内存比例：' + IntToStr(dwMemoryLoad) + ' %');
    Add('物理内存总数：' + IntToStr(dwTotalPhys div 1024) + ' KB');
    Add('物理内存剩余：' + IntToStr(dwAvailPhys div 1024) + ' KB');
    Add('内存分页总数：' + IntToStr(dwTotalPageFile div 1024) + ' KB');
    Add('内存分页剩余：' + IntToStr(dwAvailPageFile div 1024) + ' KB');
    Add('虚拟内存总数：' + IntToStr(dwTotalVirtual div 1024) + ' KB');
    Add('虚拟内存剩余：' + IntToStr(dwAvailVirtual div 1024) + ' KB');
  end;

  VI.dwOSVersionInfoSize := SizeOf(VI);
  GetVersionEx(VI);
  with lstSysInfo.Items, VI do
  begin
    Add('操作系统版本：' + IntToStr(dwMajorVersion) + '.' + IntToStr(dwMinorVersion));
    case dwPlatformID of
      VER_PLATFORM_WIN32S        : Add('操作系统平台：Windows 3.1');
      VER_PLATFORM_WIN32_WINDOWS : Add('操作系统平台：Windows 95/98');
      VER_PLATFORM_WIN32_NT      : Add('操作系统平台：Windows NT/2000 或以上');
    end;
  end;

  GetSystemInfo(SI);
  with lstSysInfo.Items , SI do
  begin
    Add(Format('内存最低地址：$%p',[lpMinimumApplicationAddress]));
    Add(Format('内存最高地址：$%p',[lpMaximumApplicationAddress]));
    Add('处理器个数：' + IntToStr(dwNumberOfProcessors));
    case wProcessorLevel of
      3: Add('处理器类型：80386');
      4: Add('处理器类型：80486');
      5: Add('处理器类型：Pentium');
      6: Add('处理器类型：Pentium Pro');
      else  Add('处理器类型：' + IntToStr(wProcessorLevel));
    end;
  end;

  EnvPtr := GetEnvironmentStrings;
  TmpPtr := EnvPtr;
  repeat
    lstSysInfo.Items.Add(StrPas(TmpPtr));
    Inc(TmpPtr, StrLen(TmpPtr) + 1);
  until TmpPtr^ = #0;
  FreeEnvironmentStrings(EnvPtr);
end;

procedure TFrmSysInfo.GetProcess();
var
  I: Integer;
  Count: DWORD;
  ProcH: THandle;
  ModuH: HMODULE;
  ModuName: array[0..255] of char;
  BigArray: array[0..255] of DWORD;
  ProcArray: array of DWORD;
begin
  if not EnumProcesses(@BigArray, SizeOf(BigArray), Count) then
    raise Exception.Create('获取进程失败');
  SetLength(ProcArray, Count div SizeOf(DWORD));
  Move(BigArray, ProcArray[0], Count);

  lstProcess.Items.Clear;
  for I := Low(ProcArray) to High(ProcArray) do
  begin
    ProcH := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, ProcArray[I]);
    if ProcH > 0 then
    try
      EnumProcessModules(ProcH, @ModuH, SizeOf(ModuH), Count);
      if GetModuleFileNameEx(ProcH, ModuH, ModuName, SizeOf(ModuName)) > 0 then
        lstProcess.Items.Add(ModuName);
    finally
      CloseHandle(ProcH);
    end
  end;
end;

procedure TFrmSysInfo.FormCreate(Sender: TObject);
begin
  GetSysInfo();
  GetProcess();
end;

procedure TFrmSysInfo.btnCloseClick(Sender: TObject);
begin
  Close;
end;

end.