unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls;
type
TShowStatusEvent = procedure(Status: string) of object;
TDiskPerfUsedThread = class(TThread)
private
FWbemLocator: olevariant;
FWMIService: olevariant;
fStatusText: string;
FOnShowStatus: TShowStatusEvent;
function GetDiskPerfUsedPercent: integer;
procedure ShowStatus;
protected
procedure Execute; override;
public
constructor Create(CreateSuspended: boolean);
property OnShowStatus: TShowStatusEvent read FOnShowStatus write FOnShowStatus;
end;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
public
MyThread: TDiskPerfUsedThread;
procedure ShowStatus(Status: string);
end;
var
Form1: TForm1;
implementation
uses ActiveX, ComObj;
{$R *.lfm}
{ TForm1 }
constructor TDiskPerfUsedThread.Create(CreateSuspended: boolean);
begin
inherited Create(CreateSuspended);
FreeOnTerminate := True;
end;
function TDiskPerfUsedThread.GetDiskPerfUsedPercent: integer;
const
WBEM_FLAG_FORWARD_ONLY = $20;
WBEM_RETURN_IMMEDIATELY = $10;
CFlags = WBEM_FLAG_FORWARD_ONLY or WBEM_RETURN_IMMEDIATELY;
CQuery = 'select PercentIdleTime ' +
'from Win32_PerfFormattedData_PerfDisk_PhysicalDisk ' + 'where Name="_Total"';
var
Enum: IEnumVARIANT;
WbemResult: olevariant;
WbemCollection: olevariant;
begin
Result := -1;
WbemCollection := FWMIService.ExecQuery(CQuery, 'WQL', CFlags);
Enum := IUnknown(WbemCollection._NewEnum) as IEnumVariant;
if Enum.Next(1, WbemResult, PLongWord(nil)^) = 0 then
Result := 100 - WbemResult.Properties_.Item('PercentIdleTime').Value;
end;
procedure TDiskPerfUsedThread.ShowStatus;
begin
if Assigned(FOnShowStatus) then
begin
FOnShowStatus(fStatusText);
end;
end;
procedure TDiskPerfUsedThread.Execute;
begin
CoInitializeEx(nil, COINIT_MULTITHREADED);
FWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
FWMIService := FWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
fStatusText := 'TThread Starting...';
Synchronize(@Showstatus);
fStatusText := 'TThread Running...';
while (not Terminated) do
begin
fStatusText := Format('%d', [GetDiskPerfUsedPercent]);
Synchronize(@Showstatus);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
MyThread := TDiskPerfUsedThread.Create(True);
MyThread.OnShowStatus := @ShowStatus;
MyThread.Start;
end;
procedure TForm1.ShowStatus(Status: string);
begin
Label1.Caption := Status;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
MyThread.Terminate;
end;
end.