{--------------------------------------------------------------------

Author: J.M.Wehlou


Description:
    Represents one counter object and a collection of counters
    There are only two types of counters implemented:
    delta counters and raw counters. I implemented those
    in two separate classes just to illustrate how to provide
    for different types, even though these particular two
    types would be trivial to implement with one and the same
    class.
    What is not implemented here are multiple instances of
    counters, for example. Most of the other types of counters
    aren't here either, but I think that the two simple types
    you do have here actually cover practically everything
    you will need to do with performance counting.

--------------------------------------------------------------------}

unit PerfCounters;

interface

uses
  Windows,
  Contnrs,
  Winperf;

type
  TPerfCounters = class;

// ------------------------------------------------------------------

TPerfCounter = class
  fParent : TPerfCounters;
  fCD : PERF_COUNTER_DEFINITION;
public
  constructor Create(parent: TPerfCounters; uCounterNameTitleIndex: DWORD;
    uCounterHelpTitleIndex: DWORD; iDefaultScale: integer;
    uDetailLevel: DWORD; uCounterType: DWORD; uCounterSize: DWORD; uCounterOffset: DWORD);
  function GetCounterBlockSize(): DWORD;
  procedure CollectDefinition(var pvData: pointer; var cbTotalBytes: DWORD);
  procedure CollectCounterValue(var pvData: pointer; var cbTotalBytes: DWORD); virtual; abstract;
  procedure SetValue(uValue: DWORD); virtual; abstract;
end;

// ------------------------------------------------------------------

TRawCounter = class(TPerfCounter)
  fValue : DWORD;
public
  constructor Create(parent: TPerfCounters; uCounterNameTitleIndex: DWORD;
    uCounterHelpTitleIndex: DWORD; iDefaultScale: integer;
    uDetailLevel: DWORD; uValue: DWORD; uCounterOffset: DWORD);
  procedure CollectCounterValue(var pvData: pointer; var cbTotalBytes: DWORD); override;
  procedure SetValue(uValue: DWORD); override;
end;

// ------------------------------------------------------------------

TDeltaCounter = class(TPerfCounter)
  fValue : DWORD;
public
  constructor Create(parent: TPerfCounters; uCounterNameTitleIndex: DWORD;
    uCounterHelpTitleIndex: DWORD; iDefaultScale: integer;
    uDetailLevel: DWORD; uValue: DWORD; uCounterOffset: DWORD);
  procedure CollectCounterValue(var pvData: pointer; var cbTotalBytes: DWORD); override;
  procedure SetValue(uValue: DWORD); override;
end;

// ------------------------------------------------------------------

TPerfCounters = class
  fl : TObjectList;
  fPOT : PERF_OBJECT_TYPE;
  fNumCounters : DWORD;
  fNextCounterOffset : DWORD;
public
  constructor Create(uObjectNameTitleIndex: DWORD; uObjectHelpTitleIndex: DWORD;
    uDetailLevel: DWORD; iDefaultCounter: longint);
  destructor Destroy; override;
  procedure AddRawCounter(uCounterNameTitleIndex: DWORD;
    uCounterHelpTitleIndex: DWORD; iDefaultScale: integer;
    uDetailLevel: DWORD; uValue: DWORD);
  procedure AddDeltaCounter(uCounterNameTitleIndex: DWORD;
    uCounterHelpTitleIndex: DWORD; iDefaultScale: integer;
    uDetailLevel: DWORD; uValue: DWORD);
  procedure SetValue(iIndex: integer; uValue: DWORD);
  function GetCounterBlockSize(): DWORD;
  function GetDefinitionSize(): DWORD;
  function GetCount(): integer;
  procedure Collect(var pvData: pointer; var cbTotalBytes: DWORD);
end;

// ==================================================================

implementation

// ------------------------------------------------------------------
// help functions

procedure WriteMemBlock(const pSrc: pointer; const uSize: DWORD; var pvData: pointer;
    var cbTotalBytes: DWORD);
begin
  copymemory(pvData, pSrc, uSize);
  pvData := ptr(cardinal(pvData) + uSize);
  cbTotalBytes := cbTotalBytes + uSize;
end;


// ==================================================================
{ TPerfCounter }

procedure TPerfCounter.CollectDefinition(var pvData: pointer;
  var cbTotalBytes: DWORD);
begin
  WriteMemBlock(@fCD, sizeof(fCD), pvData, cbTotalBytes);
end;

// ------------------------------------------------------------------

constructor TPerfCounter.Create(parent: TPerfCounters; uCounterNameTitleIndex: DWORD;
  uCounterHelpTitleIndex: DWORD; iDefaultScale: integer;
  uDetailLevel: DWORD; uCounterType: DWORD; uCounterSize: DWORD; uCounterOffset: DWORD);
begin
  fParent := parent;
  zeromemory(@fCD, sizeof(fCD));
  fCD.ByteLength := sizeof(fCD);
  fCD.CounterNameTitleIndex := uCounterNameTitleIndex;
  fCD.CounterHelpTitleIndex := uCounterHelpTitleIndex;
  fCD.DefaultScale := iDefaultScale;
  fCD.DetailLevel := uDetailLevel;
  fCD.CounterType := uCounterType;
  fCD.CounterSize := uCounterSize;
  fCD.CounterOffset := uCounterOffset;
end;

// ------------------------------------------------------------------

function TPerfCounter.GetCounterBlockSize: DWORD;
begin
  Result := fCD.CounterSize;
end;

// ==================================================================
{ TPerfCounters }

procedure TPerfCounters.AddDeltaCounter(uCounterNameTitleIndex,
  uCounterHelpTitleIndex: DWORD; iDefaultScale: integer; uDetailLevel,
  uValue: DWORD);
var
  tdc : TDeltaCounter;
begin
  tdc := TDeltaCounter.Create(self, uCounterNameTitleIndex, uCounterHelpTitleIndex,
  iDefaultScale, uDetailLevel, uValue, fNextCounterOffset);
  fNextCounterOffset := fNextCounterOffset + tdc.GetCounterBlockSize();
  fl.Add(tdc);
  Inc(fNumCounters);
end;

// ------------------------------------------------------------------

procedure TPerfCounters.AddRawCounter(uCounterNameTitleIndex: DWORD;
  uCounterHelpTitleIndex: DWORD; iDefaultScale: integer;
  uDetailLevel: DWORD; uValue: DWORD);
var
  trc : TRawCounter;
begin
  trc := TRawCounter.Create(self, uCounterNameTitleIndex, uCounterHelpTitleIndex,
  iDefaultScale, uDetailLevel, uValue, fNextCounterOffset);
  fNextCounterOffset := fNextCounterOffset + trc.GetCounterBlockSize();
  fl.Add(trc);
  Inc(fNumCounters);
end;

// ------------------------------------------------------------------

procedure TPerfCounters.Collect(var pvData: pointer; var cbTotalBytes: DWORD);
var
  i : integer;
  ctr : TPerfCounter;
  u : DWORD;
begin
  fPOT.HeaderLength := sizeof(fPOT);
  fPOT.DefinitionLength := fPOT.HeaderLength + GetDefinitionSize();
  fPOT.TotalByteLength := fPOT.DefinitionLength + GetCounterBlockSize();
  fPOT.NumCounters := fNumCounters;
  fPOT.NumInstances := -1;
  // the rest is zero

  cbTotalBytes := 0;
  WriteMemBlock(@fPOT, sizeof(fPOT), pvData, cbTotalBytes);

  for i := 0 to fl.Count - 1 do begin
    ctr := fl[i] as TPerfCounter;
    ctr.CollectDefinition(pvData, cbTotalBytes);
  end;

  u := GetCounterBlockSize();
  WriteMemBlock(@u, sizeof(u), pvData, cbTotalBytes);

  for i := 0 to fl.Count - 1 do begin
    ctr := fl[i] as TPerfCounter;
    ctr.CollectCounterValue(pvData, cbTotalBytes);
  end;

end;

// ------------------------------------------------------------------

constructor TPerfCounters.Create(uObjectNameTitleIndex: DWORD; uObjectHelpTitleIndex: DWORD;
  uDetailLevel: DWORD; iDefaultCounter: longint);
begin
  fl := TObjectList.Create(True); // owns the objects
  fNextCounterOffset := sizeof(DWORD);
  zeromemory(@fPOT, sizeof(fPOT));
  fPOT.ObjectNameTitleIndex := uObjectNameTitleIndex;
  fPOT.ObjectHelpTitleIndex := uObjectHelpTitleIndex;
  fPOT.DetailLevel := uDetailLevel;
  fPOT.DefaultCounter := iDefaultCounter;
end;

// ------------------------------------------------------------------

destructor TPerfCounters.Destroy;
begin
  fl.Free;
  inherited;
end;

// ------------------------------------------------------------------

function TPerfCounters.GetCount: integer;
begin
  Result := fl.Count;
end;

// ------------------------------------------------------------------

function TPerfCounters.GetCounterBlockSize: DWORD;
var
  i : integer;
begin
  Result := sizeof(DWORD); // the initial length value itself
  for i := 0 to fl.Count - 1 do
    Result := Result + (fl[i] as TPerfCounter).GetCounterBlockSize();
end;

// ------------------------------------------------------------------

function TPerfCounters.GetDefinitionSize: DWORD;
begin
  Result := fl.Count * sizeof(PERF_COUNTER_DEFINITION);
end;

// ------------------------------------------------------------------
procedure TPerfCounters.SetValue(iIndex: integer; uValue: DWORD);
begin
  (fl[iIndex] as TPerfCounter).SetValue(uValue);
end;

// ==================================================================
{ TRawCounter }

procedure TRawCounter.CollectCounterValue(var pvData: pointer;
  var cbTotalBytes: DWORD);
begin
  WriteMemBlock(@fValue, sizeof(fValue), pvData, cbTotalBytes);
end;

// ------------------------------------------------------------------

constructor TRawCounter.Create(parent: TPerfCounters; uCounterNameTitleIndex,
  uCounterHelpTitleIndex: DWORD; iDefaultScale: integer;
  uDetailLevel: DWORD; uValue: DWORD; uCounterOffset: DWORD);
begin
  inherited Create(parent, uCounterNameTitleIndex, uCounterHelpTitleIndex,
  iDefaultScale, uDetailLevel, PERF_COUNTER_RAWCOUNT, sizeof(DWORD), uCounterOffset);
  fValue := uValue;
end;

// ------------------------------------------------------------------

procedure TRawCounter.SetValue(uValue: DWORD);
begin
  inherited;
  fValue := uValue;
end;

// ==================================================================
{ TDeltaCounter }

procedure TDeltaCounter.CollectCounterValue(var pvData: pointer;
  var cbTotalBytes: DWORD);
begin
  WriteMemBlock(@fValue, sizeof(fValue), pvData, cbTotalBytes);
end;

// ------------------------------------------------------------------

constructor TDeltaCounter.Create(parent: TPerfCounters; uCounterNameTitleIndex,
  uCounterHelpTitleIndex: DWORD; iDefaultScale: integer;
  uDetailLevel: DWORD; uValue: DWORD; uCounterOffset: DWORD);
begin
  inherited Create(parent, uCounterNameTitleIndex, uCounterHelpTitleIndex,
  iDefaultScale, uDetailLevel, PERF_COUNTER_COUNTER, sizeof(DWORD), uCounterOffset);
  fValue := uValue;
end;

// ------------------------------------------------------------------

procedure TDeltaCounter.SetValue(uValue: DWORD);
begin
  inherited;
  fValue := uValue;
end;

// ------------------------------------------------------------------
end.