unit1.pas

Delphi7编程80例(完全版)

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,Registry; //处理注册表必须要的pas文件

type
  TForm1 = class(TForm)
    Button2: TButton;
    Button1: TButton;
    memo1: TMemo;
    Button3: TButton;
    Button4: TButton;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Stop: Boolean;

implementation

{$R *.dfm}

procedure TForm1.Button2Click(Sender: TObject);
var SysInfo: TSYSTEMINFO;
begin
 Memo1.clear;     //清空原来的内容
 GetSystemInfo(SysInfo);//获得CPU信息
 case sysinfo.wProcessorArchitecture of
  0:    Memo1.Lines.Add('CPU是intel 结构'+#13)
  Else Memo1.Lines.Add('CPU是别的处理器结构'+#13);
 end;
 Memo1.Lines.Add('页面大小：  '+IntToStr(sysinfo.dwPageSize)+#13);
 Memo1.Lines.Add('最低内存地址：  '+IntToStr(Int64(sysinfo.lpMinimumApplicationAddress))+#13);
 Memo1.Lines.Add('最高内存地址：  '+IntToStr(Int64(sysinfo.lpMaximumApplicationAddress))+#13);
 Memo1.Lines.Add('遮罩位数：  '+IntToStr(sysinfo.dwActiveProcessorMask));
 Memo1.Lines.Add('CPU数目：  '+IntToStr(sysinfo.dwNumberOfProcessors));
 Case sysinfo.dwProcessorType of
  386:Memo1.Lines.Add('英特尔 X386系列');
  486:Memo1.Lines.Add('英特尔 X486系列');
  586:Memo1.Lines.Add('英特尔奔腾系列')
  Else Memo1.Lines.Add('别的处理器');
 end;
 Memo1.Lines.Add('系统虚拟内存的分配间隔宽度:'+IntToStr(sysinfo.dwAllocationGranularity));
 Memo1.Lines.Add('CPU级别：  '+IntToStr(sysinfo.wProcessorLevel));
 end;

procedure TForm1.Button1Click(Sender: TObject);
Var  myreg:TRegistry;
begin
  Memo1.clear;                //清空原来的内容
  myreg:=Tregistry.Create;    //建立新的TRegistry变量
  myreg.RootKey:=HKEY_LOCAL_MACHINE; //指定根键值
if myreg.OpenKey('hardware\description\system\centralprocessor\0',false) then
Begin
    //读取数据
   memo1.lines.add('中央处理器CPU标识: '+myreg.ReadString('VendorIdentifier'));
   memo1.lines.add('中央处理器CPU型号: '+myreg.ReadString('Identifier'));
end;
 myreg.closekey;
if myreg.OpenKey('hardware\description\system\FloatingPointProcessor\0',false) then
Begin
   memo1.lines.add('浮点处理CPU型号:  '+myreg.ReadString('Identifier'));
end;
 myreg.closekey; //关闭TRegistry变量
 myreg.Free;     //释放TRegistry变量
end;

function GetCPUSpeed: Double;
const
  DelayTime = 500; // 以500毫秒为记时单位
var
  TimerHi, TimerLo: DWORD;
  PriorityClass, Priority: Integer;
begin
  PriorityClass := GetPriorityClass(GetCurrentProcess);
  Priority := GetThreadPriority(GetCurrentThread);

  SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
  SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);

  Sleep(10);
  Asm
    dw 310Fh        // rdtsc
    mov TimerLo, eax
    mov TimerHi, edx
  end;
  Sleep(DelayTime);
  Asm
    dw 310Fh        // rdtsc
    sub eax, TimerLo
    sbb edx, TimerHi
    mov TimerLo, eax
    mov TimerHi, edx
  end;

  SetThreadPriority(GetCurrentThread, Priority);
  SetPriorityClass(GetCurrentProcess, PriorityClass);

  Result := TimerLo /(1000.0 * DelayTime);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  Button3.Enabled := False;
  Button4.Enabled := True;
  Stop := False;
  while not Stop do
  begin
    Caption := Format('CPU 速度: %f MHz', [GetCPUSpeed]);  //显示在窗口标题中
    Application.ProcessMessages;
  end;
  Button3.Enabled := True;
  Button4.Enabled := False;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
 Stop := True;
 Caption :='停止获取CPU 速度';
end;

end.