{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 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.
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.