frmmain.pas

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

unit FrmMain;
{  列举机器( machines)、对象(objects),计数( counters)和实例(instances).
   获取缺省对象和缺省计数
   利用以下函数：
   PdhEnumMachines  列举机器
   PdhConnectMachine  连接机器
   PdhEnumObjects  列举对象
   PdhEnumObjectItems  对象列表对象
   pdhGetDefaultPerfObject  缺省计数对象
   PdhGetDefaultPerfCounter  缺省计数
 }
interface
   //      PdhEnumMachines           PdhConnectMachine
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls;

type
  TMainForm = class(TForm)
    CbMachines: TComboBox;
    LblMachines: TLabel;
    CmdConnectMachine: TButton;
    EdiMachine: TEdit;
    LbObjects: TListBox;
    LbCounters: TListBox;
    LbInstances: TListBox;
    LblObjects: TLabel;
    LblCounters: TLabel;
    LblInstances: TLabel;
    CmdClose: TButton;
    procedure CmdConnectMachineClick(Sender: TObject);
    procedure CbMachinesChange(Sender: TObject);
    procedure LbObjectsClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure CmdCloseClick(Sender: TObject);
  private
    procedure RefreshMachinesList(const SelectFirst: Boolean);
    procedure AddMachinesToCombo(const List: string);
    procedure EnumerateItems(const Obj: string);
    procedure AddObjectsToListBox(const List: string);
    procedure SelectDefaultObject;
    procedure SelectDefaultCounter;    
  end;

var
  MainForm: TMainForm;

implementation

uses
  Pdh, WinPerf;

{$R *.DFM}

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

procedure TMainForm.RefreshMachinesList(const SelectFirst: Boolean);
var
  List: string;
  ListSize: Cardinal;
  ComputerName: string;
  Size: Cardinal;
begin
  Screen.Cursor := crHourGlass;
  try
    CbMachines.Items.Clear;
    ListSize := 0;
    PdhEnumMachines(nil, nil, ListSize);
    SetLength(List, ListSize);
    PdhCheck(PdhEnumMachines(nil, PChar(List), ListSize));
    AddMachinesToCombo(List);
    if SelectFirst then
    begin
      Size := MAX_PATH;
      SetLength(ComputerName, MAX_PATH);
      GetComputerName(PChar(ComputerName), Size);
      SetLength(ComputerName, Size);

      CbMachines.Items.Insert(0,ComputerName);

      CbMachines.ItemIndex := 0;
      CbMachinesChange(Self);
    end;
  finally
    Screen.Cursor := crDefault;
  end;
end;

procedure TMainForm.FormShow(Sender: TObject);
begin
  RefreshMachinesList(True);
end;

procedure TMainForm.CmdConnectMachineClick(Sender: TObject);
begin
  Screen.Cursor := crHourGlass;
  try
    PdhCheck(PdhConnectMachine(PChar(EdiMachine.Text)));
  finally
    Screen.Cursor := crDefault;
  end;
  RefreshMachinesList(False);
end;

procedure TMainForm.AddMachinesToCombo(const List: string);
var
  P: PChar;
begin
  P := @List[1];
  while P^ <> #0 do
  begin
    CbMachines.Items.Add(P);
    Inc(P, StrLen(P) + 1);
  end;
end;

procedure TMainForm.AddObjectsToListBox(const List: string);
var
  P: PChar;
begin
  {添加对象到列表框中}
  P := @List[1];
  while P^ <> #0 do
  begin
    LbObjects.Items.Add(P);
    Inc(P, StrLen(P) + 1);
  end;
end;

procedure TMainForm.SelectDefaultObject;
var
  ObjName: string;
  ObjNameSize: Cardinal;
begin
  ObjNameSize := 0;
  PdhGetDefaultPerfObject(nil, PChar(CbMachines.Text), nil, ObjNameSize);
  SetLength(ObjName, ObjNameSize);
  PdhCheck(PdhGetDefaultPerfObject(nil, PChar(CbMachines.Text), PChar(ObjName), ObjNameSize));
  SetLength(ObjName, StrLen(PChar(ObjName)));
  LbObjects.ItemIndex := LbObjects.Items.IndexOf(ObjName);
  LbObjectsClick(Self);
end;

procedure TMainForm.CbMachinesChange(Sender: TObject);
var
  List: string;
  ListSize: Cardinal;
begin
  Screen.Cursor := crHourGlass;
  try
    ListSize := 0;
    PdhEnumObjects(nil, PChar(CbMachines.Text), nil, ListSize, PERF_DETAIL_STANDARD, True);
    SetLength(List, ListSize);
    PdhCheck(PdhEnumObjects(nil, PChar(CbMachines.Text), PChar(List), ListSize, PERF_DETAIL_STANDARD, True));
    LbObjects.Items.BeginUpdate;
    try
      LbObjects.Items.Clear;
      AddObjectsToListBox(List);
      SelectDefaultObject;
    finally
      LbObjects.Items.EndUpdate;
    end;
  finally
    Screen.Cursor := crDefault;
  end;
end;

procedure TMainForm.EnumerateItems(const Obj: string);
var
  CounterList, InstanceList: string;
  CounterListSize, InstanceListSize: Cardinal;
  P: PChar;
begin
  CounterListSize := 0;
  InstanceListSize := 0;
  PdhEnumObjectItems(nil, PChar(CbMachines.Text), PChar(Obj), nil, CounterListSize,
    nil, InstanceListSize, PERF_DETAIL_STANDARD, 0);
  SetLength(CounterList, CounterListSize);
  SetLength(InstanceList, InstanceListSize);
  PdhCheck(PdhEnumObjectItems(nil, PChar(CbMachines.Text), PChar(Obj), PChar(CounterList),
      CounterListSize, PChar(InstanceList), InstanceListSize, PERF_DETAIL_STANDARD, 0));
  LbCounters.Items.Clear;
  P := @CounterList[1];
  while P^ <> #0 do
  begin
    LbCounters.Items.Add(P);
    Inc(P, StrLen(P) + 1);
  end;
  LbInstances.Items.Clear;
  if Length(InstanceList) <= 2 then Exit;
  P := @InstanceList[1];
  while P^ <> #0 do
  begin
    LbInstances.Items.Add(P);
    Inc(P, StrLen(P) + 1);
  end;
end;

procedure TMainForm.SelectDefaultCounter;
var
  DefCounter: string;
  DefCounterSize: Cardinal;
begin
  DefCounterSize := 0;
  PdhGetDefaultPerfCounter(nil, PChar(CbMachines.Text),
     PChar(LbObjects.Items[LbObjects.ItemIndex]), nil, DefCounterSize);
  SetLength(DefCounter, DefCounterSize);

  PdhCheck(PdhGetDefaultPerfCounter(nil, PChar(CbMachines.Text),
    PChar(LbObjects.Items[LbObjects.ItemIndex]), PChar(DefCounter), DefCounterSize));
  SetLength(DefCounter, StrLen(PChar(DefCounter)));
  LbCounters.ItemIndex := LbCounters.Items.IndexOf(DefCounter);
end;

procedure TMainForm.LbObjectsClick(Sender: TObject);
begin
  Screen.Cursor := crHourGlass;
  try
    EnumerateItems(LbObjects.Items[LbObjects.ItemIndex]);
    SelectDefaultCounter;
  finally
    Screen.Cursor := crDefault;
  end;
end;

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

end.