////////////////////////////////////////////////////////////////////////////////
// CM2CMLXPlugTypes.pas
// --------------------
// This unit contains the CML Extending plugin system CoolMon 2.
//
// Last Edit: March, 10th 2005
// Certified: NA
//
// This unit is coded in : Delphi 7
//
// Unit is copyright (c) 2004 - 2005, The CoolMon Project
////////////////////////////////////////////////////////////////////////////////
unit CM2CMLXPlugTypes;

interface

Uses CM2CMLXInterface, CM2PlugInTypes, ComObj, verbose, windows, SysUtils, Dialogs, Registry, Classes;

Type
 TCMLXPlugIn = Class(TObject)
 private
  fTagName: String;
  fName: String;
  fGuid: TGUID;
  fVersion: Word;
  fRCV: word;
  FInterfaceVersion: Byte;
  Procedure InitInfoList;
  procedure SetInterfaceVersion(const Value: Byte);
 public
  PlugIn: ICM2CMLXPlug; // Lies here to allow hardcoding for various new type when available
  PlugIn2: ICM2CMLXPlug2;
  InfoList: TInfoList;
  Constructor Create(GUID: TGUID; ParentHandle: THandle);
  Destructor Destroy; override;
  Function GetLastErrorMessage: String;
  Property GUID: TGUID read fGuid;
  Property InterfaceVersion: Byte read FInterfaceVersion write SetInterfaceVersion;
  Property Name: String read fName;
  Property RequiredCoreVersion: word read fRCV;
  Procedure Setup;
  Property TagName: String read fTagName;
  Property Version: Word read fVersion;
  Function Perform(AttribList, ParameterList: String; Var ResultType: byte; Var ResultString: string): boolean;
 end;
 PCMLXPlugIn = ^TCMLXPlugIn;

 TCMLXPlugInList = Class(TObject)
 Private
  fCMLXPlugInList: Array of TCMLXPlugIn;
  fPWHandle: THandle;
  function GetCount: Integer;
  function GetCMLXPlugIn(Index: Integer): TCMLXPlugIn;
  procedure SetCMLXPlugIn(Index: Integer; const Value: TCMLXPlugIn);
 public
  Progress: TPlugInListProgress;
  Constructor Create(ParentWindowHandle: THandle);
  Destructor Destroy; override;
  Function Add(GUID: TGUID): TCMLXPlugIn; overload;
  Procedure Delete(Index: Integer);
  Property CMLXPlugIn[Index: Integer]: TCMLXPlugIn read GetCMLXPlugIn write SetCMLXPlugIn; default;
  Function CMLXPlugInAddr(Index: Integer): PCMLXPlugIn;
  Property Count: Integer read GetCount;
  Property ParentWindowHandle: THandle read fPWHandle;
  Function IndexOf(PlugName: String): Integer;
  Function GetPlugInByTag(TagName: String; Var CMLXPlugIn: PCMLXPlugIn): Boolean;
  Procedure UnloadAll;
  Procedure LoadAll;
 End;
 PCMLXPlugInList = ^TCMLXPlugInList;

Const
 rtNone = 1;
 rtSensor = 2;
 rtCML = 3;


implementation

{ TCMLXPlugIn }

constructor TCMLXPlugIn.Create(GUID: TGUID; ParentHandle: THandle);
Var
 TN, Name: PChar;
 V, RCV: Word;
 Res: HResult;
begin
 // Set Plugin active status to false
 If Debug then Form4.Add('TCMLXPlugIn.Create GUID:' + GUIDToString(GUID), dlplugins);
 fGUID := GUID;
 If Debug then Form4.Add('Create InfoList ... ', dlplugins);
 Self.InfoList := TInfoList.Create;
 If Debug then Form4.Append('done', dlcore);
 If Debug then Form4.Add('Create ComObject [' + GUIDToString(GUID) + '] (as ICM2CMLExPlug) ... ', dlplugins);
 Try
  PlugIn2 := CreateComObject (GUID) as ICM2CMLxPlug2;
  InterfaceVersion := 2;
 except
  On EIntfCastError do begin
   Try
    PlugIn := CreateComObject (GUID) as ICM2CMLXPlug;
    InterfaceVersion := 1;
   except
    On EIntfCastError do begin
     PlugIn2 := Nil;
     PlugIn := Nil;
     InterfaceVersion := 0;
    end;
   end;
  end;
 end;
 If Debug then begin
  case InterfaceVersion of
   0: Form4.Append('Unknown Interface', dlplugins);
   1: Form4.Append('ICM2CMLxPlug', dlPlugins);
   2: Form4.Append('ICM2CMLxPlug2', dlPlugins);
  end;
 End;
 If Debug then Form4.Append('done', dlcore);
 If Debug then Form4.Add('Load Plugin Name ... ', dlplugins);
 Res := E_FAIL;
 Case InterfaceVersion of
  1: Res := PlugIn.Name(Name);
  2: Res := PlugIn2.Name(Name);
 End;
 If Res = E_FAIL Then Raise EDLLError.Create('Failed to return plugin name [' + Self.GetLastErrorMessage + ']');
 If Debug then Form4.append(name, dlplugins);
 If Debug then Form4.Add('Load Plugin Version ... ', dlplugins);
 Res := E_FAIL;
 Case InterfaceVersion of
  1: Res := PlugIn.Version(V);
  2: Res := PlugIn2.Version(V);
 end;
 If Res = E_FAIL Then raise EDLLError.Create('Failed to return Version number [' + Self.GetLastErrorMessage + ']');
 If Debug then Form4.append(Inttostr(V), dlplugins);
 If Debug then Form4.Add('Load RequiredCoreVersion ... ', dlplugins);
 Res := E_FAIL;
 Case InterfaceVersion of
  1: Res := PlugIn.RequiredCoreVersion(RCV);
  2: Res := PlugIn2.RequiredCoreVersion(RCV);
 end;
 If Res = E_FAIL Then raise EDLLError.Create('Failed to return RequiredCoreVersion Number [' + Self.GetLastErrorMessage + ']');
 If Debug then Form4.append(inttostr(RCV), dlplugins);
 If Debug Then Form4.Add('Load Tag Name ... ', dlplugins);
 Res := E_FAIL;
 Case InterfaceVersion of
  1: Res := PlugIn.TagName(TN);
  2: Res := PlugIn2.TagName(TN);
 end;
 If Res = E_FAIL Then raise EDLLError.Create('Failed to return Tag Name [' + Self.GetLastErrorMessage + ']');
 If Debug Then Form4.Append(TN, dlplugins);
 If Debug then Form4.Add('Set parent Handle', dlplugins);
 Res := E_FAIL;
 Case InterfaceVersion of
  1: Res := PlugIn.SetParentHandle(ParentHandle);
  2: Res := PlugIn2.SetParentHandle(ParentHandle);
 end;
 If Res = E_FAIL Then raise EDLLError.Create('Failed to set Parent Handle [' + Self.GetLastErrorMessage + ']');
 If Debug then Form4.Add('Run plugins Init block', dlplugins);
 Res := E_FAIL;
 Case InterfaceVersion of
  1: Res := PlugIn.Init;
  2: Res := PlugIn2.Init;
 end;
 If Res = E_FAIL then raise EDLLError.Create('Failed to run init procedure properly [' + Self.GetLastErrorMessage + ']');
 fNAme := Name;
 fVersion := V;
 fRCV := RCV;
 fTagName := TN;
 InitInfoList;
end;

destructor TCMLXPlugIn.Destroy;
Var
 Res: HResult;
begin
 If Debug then Form4.Add('Run Plugins Terminate Block', dlplugins);
 Res := E_FAIL;
 Case InterfaceVersion of
  1: Res := PlugIn.Terminating;
  2: Res := PlugIn2.Terminating;
 end;
 If Res = E_FAIL then begin
  raise EDLLError.Create('Failed to run terminate procedure properly [' + Self.GetLastErrorMessage + ']');
 End;
 If Debug then Form4.Add('Free InfoList ... ', dlplugins);
 InfoList.Free;
 If Debug then Form4.Append('done', dlcore);
 inherited;
end;

function TCMLXPlugIn.GetLastErrorMessage: String;
Var
 Msg: PChar;
 Res: HResult;
begin
 If Debug then Form4.Add('GetLastErrorMessage ... ', dlerror);
 Res := E_FAIL;
 Case InterfaceVersion of
  1: Res := PlugIn.GetLastErrorMsg(Msg);
  2: Res := PlugIn2.GetLastErrorMsg(Msg);
 end;
 If Res = S_OK Then begin
  Result := Msg;
  Form4.Append(Msg, dlerror);
  exit;
 End;
 Result := 'Could not retrieve last error message';
 If Debug then Form4.Append('Failed', dlerror, mterror);
end;

procedure TCMLXPlugIn.InitInfoList;
Var
 I, Cnt: Integer;
 S1, S2: PChar;
 Res: HResult;
begin
 If Debug then Form4.Add('Initialize Info List', dlplugins);
 If Debug then Form4.Add('Get PlugIn Info Count', dlplugins);
 Res := E_FAIL;
 Case InterfaceVersion of
  1: Res := PlugIn.GetInfoCount(Cnt);
  2: Res := PlugIn2.GetInfoCount(Cnt);
 end;
 If Res = E_FAIL Then begin
  Raise EDLLError.Create('Failed to return Info count [' + Self.GetLastErrorMessage + ']');
 end;
 For I := 0 to cnt - 1 do begin
  If Debug then Form4.Add('Get PlugIn Info [#' + IntToStr(I) + ']', dlplugins);
  Res := E_FAIL;
  Case InterfaceVersion of
   1: Res := PlugIn.GetInfo(I, S1, S2);
   2: Res := PlugIn2.GetInfo(I, S1, S2);
  end;
  If Res = E_FAIL Then begin
   Raise EDLLError.Create('Failed to return Info data [' + Self.GetLastErrorMessage + ']');
  End;
  SElf.InfoList.Add(S1, S2);
 End;
end;

function TCMLXPlugIn.Perform(AttribList, ParameterList: String;
  var ResultType: byte; var ResultString: string): boolean;
Var
 PC: PChar;
 WS: WideString;
 Res: HResult;
 Msg: String;
begin
 If Debug Then Form4.Add('cmlX (' + name + ').Perform ... ', dlPlugins);
 Result := true;
 ResultType := rtNone;
 Res := E_FAIL;
 Case InterfaceVersion of
  1: Res := PlugIn.Perform(PChar(AttribList), PChar(ParameterList), PC, ResultType);
  2: Res := PlugIn2.Perform(PChar(AttribList), PChar(ParameterList), WS, ResultType);
 end;
 If Res <> S_OK Then begin
  If Debug then Form4.Append('failure', dlplugins);
  Msg := GetLastErrorMessage;
  Raise EDllError.Create('Unable to "Perform" - ErrorMsg: ' + Msg);
  Result := False;
  exit
 end;
 If Debug then Form4.Append('done', dlplugins);
 ResultString := '';
 Case InterfaceVersion of
  1: ResultString := PC;
  2: ResultString := WS;
 end;
end;

procedure TCMLXPlugIn.SetInterfaceVersion(const Value: Byte);
begin
  FInterfaceVersion := Value;
end;

procedure TCMLXPlugIn.Setup;
Var
 Res: HResult;
begin
 If Debug then Form4.Add('CMLXPlug: ' + Self.fName + '.Setup ... ', dlplugins);
 Res := E_FAIL;
 Case InterfaceVersion of
  1: Res := PlugIn.Setup;
  2: Res := PlugIn2.Setup;
 end;
 Case Res of
  E_FAIL: begin
           raise EDLLError.Create('Failed to run Setup correctly [' + Self.GetLastErrorMessage + ']');
          end;
  E_NOTIMPL: begin
              MessageDlg('Nothing to setup', mtInformation, [mbOK], 0);
             end;
 end;
 If Debug then Form4.Append('done', dlplugins);
end;

{ TCMLXPlugInList }

function TCMLXPlugInList.Add(GUID: TGUID): TCMLXPlugIn;
Var
 Index: Integer;
begin
 If Debug then Form4.Add('CMLXPlugInList.Add [' + GUIDToString(GUID) + ']', dlcore);
 Setlength(Self.fCMLXPlugInList, Length(Self.fCMLXPlugInList) + 1);               // Resize the List by adding one slot
 Index := Length(Self.fCMLXPlugInList) - 1;                                      // Set Index to be the newly added slots position
 fCMLXPlugInList[Index] := TCMLXPlugIn.Create(GUID, ParentWindowHandle);                                    // Add the VISPlugIn to the list
 Result := fCMLXPlugInList[Index];                                               // Return the Index of the newly added plugin
end;

function TCMLXPlugInList.CMLXPlugInAddr(Index: Integer): PCMLXPlugIn;
begin
 Result := nil;
 If (Index < 0) or (Index > SElf.Count - 1) then exit;
 Result := Addr(fCMLXPlugInList[Index]);
end;

constructor TCMLXPlugInList.Create(ParentWindowHandle: THandle);
begin
 Self.fPWHandle := ParentWindowHandle;
end;

procedure TCMLXPlugInList.Delete(Index: Integer);
begin
 If Debug then Form4.Add('CMLXPlugInList.Delete [' + IntToStr(Index) + '] ... ', dlcore);
 If (Index < 0) or (Index > Length(Self.fCMLXPlugInList)-1) then Begin           // verify that index isn't out of bounds
  Self.fCMLXPlugInList[Index].Free;                                              // Delete the request GenPlugInList
  If (Index < Length(Self.fCMLXPlugInList) - 1) Then begin                       // If the selected wasn't the last one ...
   Self.fCMLXPlugInList[Index] := Self.fCMLXPlugInList[Length(Self.fCMLXPlugInList)-1]; // Move the last one of the list to the newly open slot
   Self.fCMLXPlugInList[Length(Self.fCMLXPlugInList)-1].Free;                     // Delete the last GenPlugIn from the list
  End;
  SetLength(Self.fCMLXPlugInList, Length(Self.fCMLXPlugInList) - 1);              // Resize the list
 End;
 If Debug then Form4.append('done', dlcore);
end;

destructor TCMLXPlugInList.Destroy;
Var
 I: Integer;
begin
  If Length(Self.fCMLXPlugInList) > 0 Then begin                                 // If there is GenPlugIn in the list ...
   For I := 0 to Length(Self.fCMLXPlugInList)-1 do begin                         // Free them all
    Self.fCMLXPlugInList[I].Free;
   End;
   SetLength(Self.fCMLXPlugInList, 0);                                           // Set new array length to nothing
  End;
  inherited;
end;

function TCMLXPlugInList.GetCMLXPlugIn(Index: Integer): TCMLXPlugIn;
begin
 Result := fCMLXPlugInList[Index];
end;

function TCMLXPlugInList.GetCount: Integer;
begin
 Result := Length(fCMLXPlugInList);
end;

function TCMLXPlugInList.GetPlugInByTag(TagName: String;
  var CMLXPlugIn: PCMLXPlugIn): Boolean;
Var
 I: Integer;
begin
 If debug then Form4.Add('TCMLXPlugInList.GetPlugInByTag (' + tagname + ') ... ', dlplugins);
 CMLXPlugIn := nil;
 Result := False;
 For I := 0 to Self.Count - 1 do begin
  If uppercase(TagName) = uppercase(Self.fCMLXPlugInList[I].TagName) then begin
   Result := True;
   CMLXPlugIn := Self.CMLXPlugInAddr(I);
   If Debug then Form4.Append('done', dlplugins);
   exit;
  end;
 end;
 If Debug then Form4.Append('failure', dlplugins);
end;

function TCMLxPlugInList.IndexOf(PlugName: String): Integer;
Var
 I: Integer;
begin
 Result := -1;
 For I := 0 to GetCount - 1 do begin
  if Uppercase(Self.fCMLxPlugInList[I].Name) = uppercase(PlugName) Then begin
   Result := I;
   exit;                                                                        // Exit loop to speed up execution
  end;
 End;
end;

procedure TCMLxPlugInList.LoadAll;
Var
 Reg: TRegistry;
 I, I2: Integer;
 Strings: TStrings;
 S: String;
 RCV: Word;
 N: String;
 GoForLaunch: Boolean;
begin
 If Debug then Form4.Add('CMLXPlugInList.LoadAll', dlcore);
 If Self.Count > 0 Then Unloadall;
 If Debug then Form4.Add('Create TRegistry ... ', dlcore);
 Reg := Tregistry.Create;
 If Debug then Form4.Append('done', dlcore);
 If Debug then Form4.Add('Create TStringList ... ', dlcore);
 Strings := TStringlist.Create;
 If Debug then Form4.append('done', dlcore);
 If Debug then Form4.Add('Load Plugin List ... ', dlcore);
 If Reg.OpenKey(CertifiedCMLXPluginsLocation, False) Then Begin
  Reg.GetKeyNames(Strings);
  For I := 0 to Strings.Count - 1 do begin
    S := Strings[I];
    RCV := 0;
    if Reg.OpenKey(CertifiedCMLXPluginsLocation + '\' + S, false) then begin
     RCV := Reg.ReadInteger('RequiredCoreVersion');
     N := Reg.ReadString('');
    end;
    If Debug then Form4.Add('Adding ' + N + ' ... ', dlcore);
    If Assigned(Progress) then Progress(N, I - 1, strings.count);
    GoForLaunch := True;
    If RCV > CoreVersion Then begin
     GoForLaunch := False;
     messagedlg('Core outdated' + #13#10 + 'CMLX PlugIn: ' + N + #13#10 + 'requires: ' + Inttostr(RCV) + #13#10 + 'current: ' + IntToStr(CoreVersion), mtWarning, [mbOk], 0);
     If Debug then Form4.append('Core outdated', dlplugins);
    end;
    If RCV <= OutDatedCoreVersion Then begin
     GoForLaunch := False;
     messagedlg('PlugIn outdated' + #13#10 + 'CMLX PlugIn: ' + N + #13#10 + 'requires: ' + Inttostr(RCV) + #13#10 + 'current: ' + IntToStr(CoreVersion), mtWarning, [mbOk], 0);
     If Debug then Form4.append('PlugIn outdated', dlcore);
    end;
    If GoForLaunch then begin
     Self.Add(StringToGUID(S));
     For I2 := 0 to length(ReservedWordlist) - 1 do begin
      if uppercase(Self.fCMLXPlugInList[Count-1].TagName) = Uppercase(ReservedWordList[I2]) then begin
       // Plugin uses a reserved word, drop the plugin
       Self.Delete(Count-1);
       Raise EDLLError.Create('CMLx Plugin violates reserved word list.' + #13#10 + 'Plugin: ' + fCMLXPlugInList[Count-1].fName + #13#10 + 'CML Node Name: ' + fCMLXPlugInList[Count-1].TagName);
      end;
     end;
    end;
    If Assigned(Progress) then Progress(N, I, strings.count);
  End;
 End
  else
 Begin
  If Debug then Form4.Add('Failure No plugins', dlerror, mtError);
 End;
 If Debug then Form4.Add('Free StringsList ... ', dlcore);
 FreeAndNil(Strings);
 If Debug then Form4.Append('done', dlcore);
 If Debug then Form4.Add('Free Reg ... ', dlcore);
 FreeAndNil(Reg);
 If Debug then Form4.append('done', dlcore);
end;

procedure TCMLxPlugInList.SetCMLxPlugIn(Index: Integer;
  const Value: TCMLxPlugIn);
begin
 fCMLxPlugInList[Index] := Value;
end;

procedure TCMLxPlugInList.UnloadAll;
Var
 I: Integer;
begin
 If Debug then Form4.Add('Unload all plugins ... ', dlcore);
 For I := 0 to SElf.Count- 1 do begin
  fCMLxPlugInList[I].Free;
 End;
 SetLength(fCMLxPlugInList, 0);
 If Debug then form4.append('done', dlcore);
end;

end.
