{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  Author: Benny Feng (Sanmaotuo)  Created: December 2006  Version: 1.01Beta  Notes: CPU Usage Warning Thread  For CSDN  References:  [1] CPU Usage Measurement routines for Delphi and C++ Builder By Alexey A. Dynnikov  [2] Interfacing the the Native API in Windows 2000 By Sven B. Schreiber.
             
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}unit CPU.Thread;interfaceuses
   Classes, Sysutils, Windows, Forms, Messages, Types, Math;const
  WM_CPU = WM_User+100;
  WM_Warn = WM_User+200;  SystemBasicInformation = 0;
  SystemPerformanceInformation = 2;
  SystemTimeInformation = 3;type
  TPDWord = ^DWORD;  TSystemBasicInformation = packed record
    Unknowna: DWORD;
    KeMaximumIncrement: ULONG;
    PageSize: ULONG;
    MmNumberOfPhysicalPages: ULONG;
    MmLowestPhysicalPage: ULONG;
    MmHighestPhysicalPage: ULONG;
    AllocationGranularity: ULONG;
    LowestUserAddress: Pointer;
    MmHighestUserAddress: Pointer;
    KeActiveProcessors: ULONG;
    KeNumberProcessors: Byte;
    Unknownb: Byte;
    Unknownc: Word;
  end;  TSystemPerformanceInformation = packed record
    IdleTime: LARGE_INTEGER;
    Spare: array[0..75] of DWORD;
  end;  TSystemTimeInformation = packed record
    KeBootTime: LARGE_INTEGER;
    KeSystemTime: LARGE_INTEGER;
    ExpTimeZoneBias: LARGE_INTEGER;
    CurrentTimeZoneId: ULONG;
    Reserved: DWORD;
  end;  TCPUThread = class(TThread)
  private
    FTick: LongInt;
  protected
    procedure Execute; override;
  public
    constructor Create;
  end;implementationvar
  NtQuerySystemInformation: function(InfoClass: DWORD;
                                     Buffer: Pointer;
                                     BufSize: DWORD;
                                     ReturnSize: TPDword): DWORD; stdcall;
  OldIdleTime: LARGE_INTEGER;
  OldSystemTime: LARGE_INTEGER;
  
{ TCPUThread }constructor TCPUThread.Create;
begin
  FreeOnTerminate := True;
  inherited Create(True);
end;procedure TCPUThread.Execute;function Convert(LI: LARGE_INTEGER): Double;
begin
  Result := LI.HighPart*4.294967296E9 + LI.LowPart;
end;var
  SysBaseInfo: TSystemBasicInformation;
  SysPerfInfo: TSystemPerformanceInformation;
  SysTimeInfo: TSystemTimeInformation;
  SystemTime: Double;
  IdleTime: Double;
begin
  inherited;
  if @NtQuerySystemInformation = nil then
    NtQuerySystemInformation := GetProcAddress(GetModuleHandle('ntdll.dll'),
                                               'NtQuerySystemInformation');
  NtQuerySystemInformation(SystemBasicInformation,
                           @SysBaseInfo,
                           SizeOf(SysBaseInfo),
                           nil);
  FTick := GetTickCount;  while not Terminated do
  begin
    NtQuerySystemInformation(SystemTimeInformation,
                             @SysTimeInfo,
                             SizeOf(SysTimeInfo),
                             nil);
    NtQuerySystemInformation(SystemPerformanceInformation,
                             @SysPerfInfo,
                             SizeOf(SysPerfInfo),
                             nil);
    if (OldIdleTime.QuadPart <> 0) then
    begin
      IdleTime := Convert(SysPerfInfo.IdleTime) - Convert(OldIdleTime);
      SystemTime := Convert(SysTimeInfo.KeSystemTime) - Convert(OldSystemTime);
      IdleTime := IdleTime/SystemTime;
      IdleTime := 100.0 - IdleTime*100.0/SysBaseInfo.KeNumberProcessors + 0.5;      if IdleTime >= 4.0 then
      begin
        FTick := GetTickCount;
      end else
      begin
        if Integer(GetTickCount) - Integer(FTick) >= 10*1000 then
        begin
          PostMessage(Application.MainForm.Handle, WM_Warn, Floor(IdleTime), 0);
          FTick := GetTickCount;
        end;
      end;
      
      PostMessage(Application.MainForm.Handle, WM_CPU, Floor(IdleTime), 0)
    end;    OldIdleTime := SysPerfInfo.IdleTime;
    OldSystemTime := SysTimeInfo.KeSystemTime;
    Sleep(500);
  end;
end;end.
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  Author: Benny Feng (Sanmaotuo)  Created: December 2006  Version: 1.01Beta  Notes: CPU Usage Warning Test Form For CSDN* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}unit CPU.Form;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, MMSystem, CPU.Thread, Gauges, TeEngine,
  Series, TeeProcs, Chart, MXGRAPH;type
  TPlaySound = class(TThread)
  private
    FFileName: string;
  protected
    procedure Execute; override;
  public
    constructor Create(const AFileName: string); reintroduce;
  end;  TCPUForm = class(TForm)
    ButtonStart: TButton;
    PWorkArea: TPanel;
    GroupBox: TGroupBox;
    PGuage: TPanel;
    Gauge: TGauge;
    PGraph: TPanel;
    Graph: TDecisionGraph;
    Series: TLineSeries;
    procedure ButtonStartClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    FSound: string;
    FXValue: Integer;
    procedure WMCPU(var Message: TMessage); Message WM_CPU;
    procedure WMWarn(var Message: TMessage); Message WM_Warn;
  public
  end;var
  CPUForm: TCPUForm;implementation{$R *.dfm}procedure TCPUForm.FormCreate(Sender: TObject);
begin
  FSound := ExtractFilePath(Application.ExeName)+'\Warn.WAV';
  FXValue := 1;
end;procedure TCPUForm.ButtonStartClick(Sender: TObject);
begin
  ButtonStart.Enabled := False;
  with TCPUThread.Create do
    Resume;
end;procedure TCPUForm.WMCPU(var Message: TMessage);
var
  Usage: Integer;
begin
  Usage := Message.WParam;
  Gauge.Progress := Usage;
  Series.AddXY(FXValue, Usage);
  if FXValue >= 20 then Series.Delete(0);
  Inc(FXValue);
end;procedure TCPUForm.WMWarn(var Message: TMessage);
begin
  with TPlaySound.Create(FSound) do
    Resume;
end;{ TPlaySound }constructor TPlaySound.Create(const AFileName: string);
begin
  FreeOnTerminate := True;
  inherited Create(True);
  FFileName := AFileName;
end;procedure TPlaySound.Execute;
var
  Idx: Integer;
begin
  inherited;
  //Internal Speak System
  for Idx := 0 to 40 do
    Windows.Beep(1000+50*Idx, 100);
  //External Speak System
  MMSystem.PlaySound(PChar(FFileName), 0, Snd_FileName or Snd_NoDefault or SND_SYNC);
end;end.
我感觉这两段应该是两个线程,我就用就用new items ---thread object的方将建两个线程,然后将两段代码分别换天新建的两个UNIT中,又新建一个窗口,名字叫cpuform,加上BUTTON等按纽,可是并不能运行成功,提示需要什么没有发现cpu.form.dfm文件,可是窗体并不能命名为cpu.form啊,如何做出这个名字的窗体文件?小弟学DELPHI不是太久,目前一般只是看得懂通常情况下的窗口程序,这种有点钳套性的窗体实在看不懂,请大侠们指点一二,万分感谢。如能发一个完整的带所有相关文件的程序最好,再次感谢,小弟的邮箱是
  [email protected]  or [email protected]

解决方案 »

  1.   

    这上面有2个pas单元,其中的CPU.Form是个需要dfm文件的窗体单元,你可以按照单元中要求放上所必须的控件并且使控件名称对应,设计好窗口后,将CPU.Form的内容拷贝到新的单元(覆盖)就有dfm文件了。unit CPU.Form;interfaceuses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls, ExtCtrls, MMSystem, CPU.Thread, Gauges, TeEngine,
      Series, TeeProcs, Chart, MXGRAPH;type
      TPlaySound = class(TThread)
      private
        FFileName: string;
      protected
        procedure Execute; override;
      public
        constructor Create(const AFileName: string); reintroduce;
      end;  TCPUForm = class(TForm)
        ButtonStart: TButton;  // 从这里开始
        PWorkArea: TPanel;
        GroupBox: TGroupBox;
        PGuage: TPanel;
        Gauge: TGauge;
        PGraph: TPanel;
        Graph: TDecisionGraph;
        Series: TLineSeries;   // 这里结束的几个控件设计好,包括下面的2个事件挂上去 
        procedure ButtonStartClick(Sender: TObject);
        procedure FormCreate(Sender: TObject);
      private
        FSound: string;
        FXValue: Integer;
        procedure WMCPU(var Message: TMessage); Message WM_CPU;
        procedure WMWarn(var Message: TMessage); Message WM_Warn;
      public
      end;
      

  2.   

    用NT性能计数器才是好方法RegQueryValueEx( HKEY_PERFORMANCE_DATA, Processor_IDX_Str, nil, nil,
                    PByte(_PerfData), @BS )