frmmain.pas

在delphi中实现windows核心编程.原书光盘代码核心编程.原书光盘代码

unit FrmMain;
{选择单个、本地的计数器，显示选择计数器的信息}
{ 使用函数
   PdhBrowseCounters
   PdhOpenQuery
   PdhAddCounter
   PdhCollectQueryData
   PdhGetFormattedCounterValue
   PdhGetCounterInfo
   PdhMakeCounterPath
  }
interface

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

type
  TMainForm = class(TForm)
    CmdSelectCounter: TButton;
    MmCounterDescription: TMemo;
    LblCounterValue: TLabel;
    EdiCounterValue: TEdit;
    LblDescription: TLabel;
    EdiFullPath: TEdit;
    LblFullPath: TLabel;
    CmdClose: TButton;
    procedure CmdSelectCounterClick(Sender: TObject);
    procedure CmdCloseClick(Sender: TObject);
  end;

var
  MainForm: TMainForm;

implementation

uses
  Pdh, PdhMsg, WinPerf;

{$R *.DFM}

procedure PdhCheck(const Error: Longint);
begin
  if Error <> ERROR_SUCCESS then raise Exception.Create('Error: ' + IntToHex(8, Error));
end;

procedure TMainForm.CmdSelectCounterClick(Sender: TObject);
var
  BrowseData: TPdhBrowseDlgConfig;
  Query: HQUERY;
  Counter: HCOUNTER;
  InfoSize, BufferSize: DWORD;
  CounterValue: TPdhFmtCounterValue;
  PathBuffer: array [0..MAX_PATH + 1] of Char;
  FullPath: string;
  CounterInfo: PPdhCounterInfo;
  CounterPathElem: TPdhCounterPathElements;
begin
  CounterInfo := nil;
  with BrowseData do
  begin
    dwConfigFlags := PDH_CF_SINGLECOUNTERPERADD or PDH_CF_SINGLECOUNTERPERDIALOG or PDH_CF_LOCALCOUNTERSONLY;
    hWndOwner := Handle;
    szDataSource := nil;
    szReturnPathBuffer := PathBuffer;
    cchReturnPathLength := MAX_PATH;
    pCallBack := nil;
    dwCallBackArg := 0;
    CallBackStatus := 0;
    dwDefaultDetailLevel := PERF_DETAIL_WIZARD;
    szDialogBoxCaption := 'Single Counter - Select one';
  end;
  PdhCheck(PdhBrowseCounters(BrowseData));
  PdhCheck(PdhOpenQuery(nil, 0, Query));
  try
    PdhCheck(PdhAddCounter(Query, PathBuffer, 0, Counter));
    PdhCheck(PdhCollectQueryData(Query));
    PdhCheck(PdhGetFormattedCounterValue(Counter, PDH_FMT_LARGE, nil, CounterValue));
    case CounterValue.CStatus of
      PDH_CSTATUS_NEW_DATA: EdiCounterValue.Text := 'New data: ' + IntToStr(CounterValue.LargeValue);
      PDH_CSTATUS_VALID_DATA: EdiCounterValue.Text := 'Valid data: ' + IntToStr(CounterValue.LargeValue);
    else
      EdiCounterValue.Text := 'Invalid data';
    end;
    InfoSize := 0;
    PdhGetCounterInfo(Counter, True, @InfoSize, nil);
    CounterInfo := AllocMem(InfoSize);
    PdhCheck(PdhGetCounterInfo(Counter, True, @InfoSize, CounterInfo));
    MmCounterDescription.Lines.Clear;
    MmCounterDescription.Lines.Add(CounterInfo^.szExplainText);
    CounterPathElem.szMachineName := CounterInfo^.Union.szMachineName;
    CounterPathElem.szObjectName := CounterInfo^.Union.szObjectName;
    CounterPathElem.szInstanceName := CounterInfo^.Union.szInstanceName;
    CounterPathElem.szParentInstance := CounterInfo^.Union.szParentInstance;
    CounterPathElem.dwInstanceIndex := DWORD(-1);
    CounterPathElem.szCounterName := CounterInfo^.Union.szCounterName;
    BufferSize := 0;
    PdhMakeCounterPath(@CounterPathElem, nil, BufferSize, 0);
    SetLength(FullPath, BufferSize);
    PdhCheck(PdhMakeCounterPath(@CounterPathElem, PChar(FullPath), BufferSize, 0));
    EdiFullPath.Text := FullPath;
  finally
    PdhCloseQuery(Query);
    if CounterInfo <> nil then FreeMem(CounterInfo);
  end;
end;

procedure TMainForm.CmdCloseClick(Sender: TObject);
begin
  Close;
end;

end.