unit GenPlugServ;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, ActiveX, Classes, ComObj, extctrls, CM2GenInterface, SysUtils, NISetup;

type
  TRandomer = Class(TObject)
  private
    FNumber: Integer;
    procedure SetNumber(const Value: Integer);
    Constructor create;
  public
   Property Number: Integer read FNumber write SetNumber;
   Procedure GenerateRandom;
  end;
  TTLeakTester = class(TComObject, ICM2GenPlug)
  private
   Rn: Integer;
   Timer: TTimer;
   ParentHandle: THandle;
   Procedure OnTimer(Sender: TObject);
  protected
  // Declare Basics
   Function Name(OUT Name: Pchar): HResult; stdcall;
   Function Version(OUT Version: word): HResult; stdcall; // Using MMRB Notation
   Function RequiredCoreVersion(OUT RCV: Word): HResult; stdcall; // Using MMRB Notation - Please refer to CM2Plugtypes for details
   Function SetParentHandle(Handle: THandle): HResult; stdcall;
  // Declare Error commands
   Function GetLastErrorMsg(OUT ErrMsg: PChar): HResult; stdcall;
  // Declare Info system
   Function GetInfoCount(OUT InfoCount: Integer): HResult; stdcall;
   Function GetInfo(Index: Integer; OUT InfoName: PChar; OUT InfoVar: PChar): HResult; stdcall;
  // Declare Sensor system
   Function GetSensorCount(OUT SensorCount: Integer): HResult; stdcall;
   Function GetSensorNameOnly(Index: Integer; OUT SensorName: PChar; OUT SensorStyle: Byte): HResult; stdcall; // Designed for speed polling at startup
   Function GetSensor(Index: Integer; Parameters: PChar; OUT SensorName: PChar; OUT SensorStyle: byte; OUT SensorString: PChar; OUT SensorValue: Double): HResult; stdcall;
  // Declare "Event" functions
   Function Init: HResult; stdcall;
   Function Terminating: HResult; stdcall;
   Function Setup: HResult; stdcall;
  // Declare Support types
   // Default (Required)
   Function GetDefaultCount(SensorIndex: Integer; OUT DefaultCount: Integer): HResult; stdcall;
   Function GetDefault(SensorIndex: Integer; Index: Integer; OUT Name: Pchar; OUT Value: PChar; OUT Description: PChar): HResult; stdcall;
   // Optional
   Function GetOptionalCount(SensorIndex: Integer; OUT OptionalCount: Integer): HResult; stdcall;
   Function GetOptional(SensorIndex: Integer; Index: Integer; OUT Name: Pchar; OUT Value: PChar; OUT Description: PChar): HResult; stdcall;
  end;

const
  Class_TLeakTester: TGUID = '{C2CC9C8A-03FB-447E-A973-75AFFCBEDF12}';

implementation

uses ComServ, Forms, Controls;

{ TTLeakTester }

function TTLeakTester.GetDefault(SensorIndex, Index: Integer; out Name,
  Value, Description: PChar): HResult;
begin
 result := S_OK;
end;

function TTLeakTester.GetDefaultCount(SensorIndex: Integer;
  out DefaultCount: Integer): HResult;
begin
 DefaultCount := 0;
 Result := S_OK;
end;

function TTLeakTester.GetInfo(Index: Integer; out InfoName,
  InfoVar: PChar): HResult;
begin
 Result := S_OK;
end;

function TTLeakTester.GetInfoCount(out InfoCount: Integer): HResult;
begin
 InfoCount := 0;
 Result := S_OK;
end;

function TTLeakTester.GetLastErrorMsg(out ErrMsg: PChar): HResult;
begin
 ErrMsg := 'This plugin doesn''t support GetLastErrorMsg';
 result := S_OK;
end;

function TTLeakTester.GetOptional(SensorIndex, Index: Integer; out Name,
  Value, Description: PChar): HResult;
begin
 Result := S_OK;
end;

function TTLeakTester.GetOptionalCount(SensorIndex: Integer;
  out OptionalCount: Integer): HResult;
begin
 OptionalCount := 0;
 Result := S_OK;
end;

function TTLeakTester.GetSensor(Index: Integer; Parameters: PChar;
  out SensorName: PChar; out SensorStyle: byte; out SensorString: PChar;
  out SensorValue: Double): HResult;
Var
 RND: TRandomer;
begin
 Result := S_OK;
 GetSensorNameOnly(Index, SensorName, SensorStyle);
 Case Index of
  0: Begin
      SensorStyle := ssNumeric;
      SensorValue := rn;
     End;
  1: Begin
      SensorStyle := ssNumeric;
      RND := TRandomer.create;
      RND.GenerateRandom;
      SensorValue := RND.Number;
//      FreeAndNil(RND);
//      RND.Free;  
     End;
 end;
end;

function TTLeakTester.GetSensorCount(out SensorCount: Integer): HResult;
begin
 SensorCount := 2;
 Result := S_OK;
end;

function TTLeakTester.GetSensorNameOnly(Index: Integer;
  out SensorName: PChar; out SensorStyle: Byte): HResult;
begin
 Case Index of
  0: Begin
      SensorName := 'TIMER (Global)';
      SensorStyle := ssUnknown;
     end;
  1: begin
      SensorName := 'RND NUMBER (Locally)';
      SensorStyle := ssUnknown;
     end;
 end;
 Result := S_OK;
end;

function TTLeakTester.Init: HResult;
begin
 RN := 0;
 Timer := TTImer.Create(nil);
 Timer.OnTimer := OnTimer;
 Timer.Interval := 1000;
 Timer.Enabled := true;
 Result := S_OK;
end;

function TTLeakTester.Name(out Name: Pchar): HResult;
begin
 Name := 'Leak Tester';
 Result := S_OK;
end;

procedure TTLeakTester.OnTimer(Sender: TObject);
begin
 RN := Random(256);
end;

function TTLeakTester.RequiredCoreVersion(out RCV: Word): HResult;
begin
 RCV := 0480;
 Result := S_OK;
end;

function TTLeakTester.SetParentHandle(Handle: THandle): HResult;
begin
 ParentHandle := Handle;
 Result := S_OK;
end;

function TTLeakTester.Setup: HResult;
Var
 NIS: TNetworkSetupDlg;
begin
 Result := S_OK;
 Try
  NIS := TNetworkSetupDlg.CreateParented(ParentHandle);
  NIS.Execute;
  FreeAndNil(NIS);
 except
  Result := E_FAIL;
 end;
end;

function TTLeakTester.Terminating: HResult;
begin
 FreeAndNil(Timer);
 Result := S_OK;
end;

function TTLeakTester.Version(out Version: word): HResult;
begin
 Version := 0010;
 Result := S_OK;
end;

{ TRandomer }

constructor TRandomer.create;
begin
 randomize;
end;

procedure TRandomer.GenerateRandom;
begin
 fNumber := random(256);
end;

procedure TRandomer.SetNumber(const Value: Integer);
begin
  FNumber := Value;
end;

initialization
  TComObjectFactory.Create(ComServer, TTLeakTester, Class_TLeakTester,
    'TLeakTester', '', ciMultiInstance, tmApartment);
end.
