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

Author: J.M.Wehlou

Description:
    Output to performance monitor in Win

    Note: you'll find the counter titles and help under:

    \HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Perflib\009

    This unit has a memory mapped file open and writes values to it. It also
    takes care of installing and uninstalling our performance monitoring
    to the registry, which turns out to be the major part of the code.

    Two header files are needed during installation: symfile.h and symfile.ini.
    That's what Windows expects. These files are normally header files in
    your app. That is, if you're writing apps in C/C++, which you obviously aren't.
    So I have to create these files. I could've included the files as a text
    files to distribute with the app, but that only makes one more thing
    to go wrong, so I chose to write them on the fly instead.

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

unit PerfMonLib;

interface

uses
  Windows,
  PerfMonClientDefIf;


type
  IPerfMonClientCb = interface
    procedure PerfMonIsRunning(bRunning: boolean);
  end;

// this is the interface implemented in this unit that
// actually outputs the data to the performance monitor
  IPerfMonLib = interface
    procedure InstallPerfMon();
    procedure UninstallPerfMon();
    function IsInstalled(): boolean;
    procedure SetValue(uOffs: cardinal; uVal: cardinal);
  end;

function getPerfMonLib(pmcd: IPerfMonClientDef; pmc: IPerfMonClientCb): IPerfMonLib;

function LoadPerfCounterTextStrings(cmdLine: LPWSTR; bQuietMode: BOOL): DWORD; stdcall;
function UnloadPerfCounterTextStrings(cmdLine: LPWSTR; bQuietMode: BOOL): DWORD; stdcall;

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

implementation

uses
  SysUtils,
  Registry,
  Classes,
  MemMappedFile;

const
  cHFILENAME = 'symfile.h';
  cINIFILENAME = 'symfile.ini';

type
  // singelton class
  TPerfMonLib = class(TInterfacedObject, IPerfMonLib)
    fPMCD : IPerfMonClientDef;
    fPMC : IPerfMonClientCb;
    fsKeyName : string; // registry key
    fsPerfKey : string; // same + '\Performance'
    fMMF : TMemMappedFile;
    constructor Create(pmcd: IPerfMonClientDef; pmc: IPerfMonClientCb);
    destructor Destroy; override;
    procedure InstallPerfMon();
    procedure UninstallPerfMon();
    procedure StartPerfMon();
    procedure StopPerfMon();
    function IsInstalled(): boolean;
    procedure CreateHFile();
    procedure CreateINIFile();
    procedure SetRegEntries(const sDLL: string);
    procedure SetValue(uOffs: cardinal; uVal: cardinal);
    function FileNameInModPath(const sFileName: string): string;
  end;

var
  s_pm : IPerfMonLib;

// externals

function LoadPerfCounterTextStrings; external 'loadperf.dll' name 'LoadPerfCounterTextStringsW';
function UnloadPerfCounterTextStrings; external 'loadperf.dll' name 'UnloadPerfCounterTextStringsW';

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

function getPerfMonLib(pmcd: IPerfMonClientDef; pmc: IPerfMonClientCb): IPerfMonLib;
begin
  if not assigned(s_pm) then
    s_pm := TPerfMonLib.Create(pmcd, pmc);
  Result := s_pm;
end;

// ==================================================================
{ TPerfMonLib }
constructor TPerfMonLib.Create(pmcd: IPerfMonClientDef; pmc: IPerfMonClientCb);
begin
  fPMCD := pmcd;
  fPMC := pmc;
  fsKeyName := fPMCD.ServiceKey();
  fsPerfKey := fsKeyName + '\Performance';
  StartPerfMon();
end;

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

{ Reads data from the PerfMonClientDef unit and uses that to create
  one of the text files Windows needs to install the performance counters
  for our app. Since the file isn't removed after installation, you can
  find it in your program folder if you're interested in how it actually
  looks. }

procedure TPerfMonLib.CreateHFile;
var
  iObj : integer;
  sl : TStringList;
begin
  sl := TStringList.Create();
  try
    try
      sl.Add('#define OBJECT_1 0');
      for iObj := 1 to fPMCD.NbOfObjects() do begin
        sl.Add('#define DEVICE_COUNTER_' + IntToStr(iObj) + ' ' + IntToStr(2 * iObj));
      end;
      sl.SaveToFile(FilenameInModPath(cHFILENAME));
    finally
      sl.Free;
    end;
  except
    on e: Exception do begin
      raise Exception.Create('CreateHFile: ' + e.Message);
    end;
  end;
end;

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

{ Reads data from the PerfMonClientDef unit and uses that to create
  the other of the text files Windows needs to install the performance counters
  for our app. }

procedure TPerfMonLib.CreateINIFile;
var
  iObj : integer;
  sl : TStringList;
begin
  sl := TStringList.Create;
  try
    try
      sl.Add('[info]');
      sl.Add('drivername=' + fPMCD.DriverName());
      sl.Add('symbolfile=' + cHFILENAME);
      sl.Add('[languages]');
      sl.Add('009=English');
      sl.Add('[text]');
      sl.Add('OBJECT_1_009_NAME=' + fPMCD.MainName);
      sl.Add('OBJECT_1_009_HELP=' + fPMCD.MainHelp);
      for iObj := 1 to fPMCD.NbOfObjects do begin
        sl.Add('DEVICE_COUNTER_' + IntToStr(iObj) + '_009_NAME=' + fPMCD.ObjectName(iObj - 1));
        sl.Add('DEVICE_COUNTER_' + IntToStr(iObj) + '_009_HELP=' + fPMCD.ObjectHelp(iObj - 1));
      end;
      sl.SaveToFile(FilenameInModPath(cINIFILENAME));
    finally
      sl.Free;
    end;
  except
    on e: Exception do begin
      raise Exception.Create('CreateINIFile: ' + e.Message);
    end;
  end;
end;

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

procedure TPerfMonLib.InstallPerfMon;
var
  sDLL : string;
  ws : widestring;
begin
  try
    if not IsInstalled() then begin
      sDLL := fPMCD.DLLPath;
      if not FileExists(sDLL) then
        raise Exception.Create('File not found: ' + sDLL);
      CreateHFile();
      CreateINIFile();
      SetRegEntries(sDLL);

    { The LoadPerfCounterTextStrings() function takes a funny parameter,
      namely something looking like a commandline. It disregards the
      first parameter, which normally would be the name of the executable
      and goes for the second. So I fake the first with the 'xxx', which in
      fact could be anything. }

      ws := 'xxx ' + FilenameInModPath(cINIFILENAME);
      if ERROR_SUCCESS <> LoadPerfCounterTextStrings(PWideChar(ws), False) then
        raise Exception.Create(SysErrorMessage(GetLastError()));
      StartPerfMon();
    end;
  except
    on e: Exception do begin
      raise Exception.Create('InstallPerfMon: ' + e.Message);
    end;
  end;
end;

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

{ These registry entries you have to set yourself; the system
  does not do it for you. }

procedure TPerfMonLib.SetRegEntries(const sDLL: string);
var
  reg : TRegistry;
begin
  reg := TRegistry.Create();
  try
    reg.RootKey := HKEY_LOCAL_MACHINE;
    reg.OpenKey(fsKeyName, True);
    reg.OpenKey(fsPerfKey, True);
    reg.WriteString('Library', sDLL);
    reg.WriteString('Open', fPMCD.FuncName_Open());
    reg.WriteString('Close', fPMCD.FuncName_Close());
    reg.WriteString('Collect', fPMCD.FuncName_Collect());
  finally
    reg.Free;
  end;
end;

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

{ I use the presence of the performance registry entries
  as a flag to determine if the thing is installed or not }

function TPerfMonLib.IsInstalled: boolean;
var
  reg : TRegistry;
begin
  reg := TRegistry.Create();
  try
    reg.RootKey := HKEY_LOCAL_MACHINE;
    Result := reg.OpenKey(fsPerfKey, False);
  finally
    reg.Free;
  end;
end;

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

procedure TPerfMonLib.StartPerfMon;
var
  sName : string;
  uSize : cardinal;
begin
  if IsInstalled() then begin
    try
      sName := fPMCD.MemMappedFileName;
      uSize := fPMCD.TotalSize();
      fMMF := TMemMappedFile.Create(sName, uSize);
      fPMC.PerfMonIsRunning(True);
    except
      on e: Exception do begin
        // failed to start perfmon; you should report that somehow,
        // depending on how you do error logging
        fMMF := nil;
      end;
    end;
  end;
end;

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

procedure TPerfMonLib.StopPerfMon;
begin
  if IsInstalled() then begin
    // tell the client we're stopping
    fPMC.PerfMonIsRunning(False);
    fMMF.Free;
    fMMF := nil;
  end;
end;

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

procedure TPerfMonLib.UninstallPerfMon;
var
  reg : TRegistry;
  ws : WideString;
begin
  if IsInstalled() then begin
    StopPerfMon();

  { Just as mentioned above, this function also looks for the second
    parameter in the string, so I have to put in a fake first param,
    for instance 'xxx', but it could be anything. }

    ws := 'xxx ' + fPMCD.DriverName();
    if ERROR_SUCCESS <> UnloadPerfCounterTextStrings(PWideChar(ws), True) then
      raise Exception.Create(SysErrorMessage(GetLastError()));
    reg := TRegistry.Create;
    try
      reg.RootKey := HKEY_LOCAL_MACHINE;
      if not reg.DeleteKey(fsPerfKey) then
        raise Exception.Create('Could not remove registry key: ' + fsPerfKey);
    finally
      reg.Free;
    end;
  end;
end;

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

{ If performance monitoring is running, the memory mapped file object
  is allocated. }

procedure TPerfMonLib.SetValue(uOffs, uVal: cardinal);
begin
  if assigned(fMMF) then
    fMMF.WriteDWORD(uOffs, uVal);
end;

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

{ constructs a fully qualified path consisting of the path to the
  executable with the filename as given in the parameter }

function TPerfMonLib.FileNameInModPath(const sFileName: string): string;
begin
  SetLength(Result , MAX_PATH);
  SetLength(Result, GetModuleFileName(0, PChar(Result), MAX_PATH));
  Result := ExtractFileDir(Result);
  Result := IncludeTrailingPathDelimiter(Result) + sFileName;
end;

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

destructor TPerfMonLib.Destroy;
begin
  fPMC := nil;

{ The client def instance is not reference counted and is freed
  as soon as that unit finalizes, which may very well occur before
  this unit finalizes. So to avoid an unhandled exception box
  popping up, we suppress the possible exception here. }
  try
    fPMCD := nil;
  except
  end;

  inherited;
end;

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

end.