unit PlugServ;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, ActiveX, Classes, ComObj,
   CM2GenInterface, CM2AutoUpdateInterface, CM2EditorSupportInterface,
   xmldom, XMLIntf, msxmldom, XMLDoc, forms;

type
  TDXR = class(TComObject, ICM2GenPlug, ICM2AutoUpdate, ICM2EditorSupport20)
  private
   Val: String;
   SensorRes, LastErr: String;
   Function GetLoggedSensor(FileName: string; SensorID: String; Var Style: Byte; Var Res: String): Boolean;
  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;
   // Auto Update
   Function UpdateFileURL(OUT URL: Pchar): HResult; stdcall;
   // Editor Support
   Function ObjIns(SensorIndex: Integer; ParameterName: PChar; OUT ValueType: Byte; OUT ValueRange: PChar): HResult; stdcall;
   Function OnEditor(SensorIndex: Integer; ParameterName: PChar; FullParameterValues: PChar; OUT Value: PChar): HResult; stdcall;
   Function GetMenuCount(SensorIndex: Integer; OUT MenuCount: Byte): HResult; stdcall;
   Function GetMenuItem(SensorIndex: Integer; Index: Byte; OUT MenuTitle: PChar; OUT MenuHint: PChar): HResult; stdcall;
   Function OnMenu(SensorIndex: Integer; Index: Byte; OUT ResultString: PChar): HResult; stdcall;
   Function ShowSensor(Index: Integer; OUT ShowAt: Byte): HResult; stdcall;
  end;

const
  Class_DXR: TGUID = '{0D0173A1-4846-4A13-BDEE-5CE551F3B97D}';
  Ver = 0301;
  RCVersion = 0800;
  Updfile = 'http://coolmon.blackstar.solar/update/plugins/general/remote.upd';

implementation

uses ComServ, SysUtils, Filter, Dialogs, ESSensorDialog;

{ TDXR }

function TDXR.GetDefault(SensorIndex, Index: Integer; out Name, Value,
  Description: PChar): HResult;
begin
 Result := S_OK;
 Case SensorIndex of
  0: begin
      Case Index of
       0: begin
           Name := 'Filename';
           Value := '';
           Description := 'The file you want to add data from';
          end;
       1: Begin
           Name := 'SensorID';
           value := '';
           Description := 'The ID of the sensor you want to retrieve (As defined by the CML on the computer where it was dumped, THIS IS NOT THE SENSOR NAME';
          end;
      end;
     end;
 end;
end;

function TDXR.GetDefaultCount(SensorIndex: Integer;
  out DefaultCount: Integer): HResult;
begin
 Case SensorIndex of
  0: DefaultCount := 2;
 end;
 result := S_OK;
end;

function TDXR.GetInfo(Index: Integer; out InfoName,
  InfoVar: PChar): HResult;
begin
 Result := S_OK;
 Case Index of
  0: Begin InfoName := 'Programmed by'; InfoVar := 'C. Aaangel'; end;
  1: Begin InfoName := 'Created'; InfoVar := '19th May 2006'; end;
  2: Begin InfoName := 'Updated'; InfoVar := '19th September 2019'; end;
  3: Begin InfoName := 'Copyright (c)'; InfoVar := '2006 - 2019, by The CoolMon Project'; end;
 end;
end;

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

function TDXR.GetLastErrorMsg(out ErrMsg: PChar): HResult;
begin
 If LastErr <> '' then ErrMsg := PChar(LastErr)
  else ErrMsg := 'No Error logged';
 Result := S_OK;
end;

function TDXR.GetLoggedSensor(FileName, SensorID: String; var Style: Byte;
  var Res: String): Boolean;
Var
 XML: TXmlDocument;
 Form: TForm;
 I, II: Integer;
 N: IXMLNode;
begin
 Style := ssUnknown;
 Res := '';
 Form := TForm.Create(nil);
 Form.Visible := false;
 XML := TXMLDocument.Create(form);
 If not IsFileInUse(Filename) then begin
  XML.FileName := Filename;
  Result := True;
  Try
   XML.Active := true;
  except
   Result := False;
  end;
  If Result then begin
   N := nil;
   For I:= 0 to XML.ChildNodes.Count - 1 do begin
    If uppercase(XML.ChildNodes[I].NodeName) = 'ROOT' then begin
     N := XML.ChildNodes[I];
    end;
   end;
   If N <> Nil then begin
    For I := 0 to N.ChildNodes.Count - 1 do begin
     If uppercase(N.ChildNodes[I].NodeName) = uppercase(SensorID) then begin
      For II := 0 to N.ChildNodes[I].AttributeNodes.Count - 1 do begin
       If uppercase(N.ChildNodes[I].AttributeNodes[II].NodeName) = 'SENSORSTYLE' then begin
        Style := StrToInt(N.ChildNodes[I].AttributeNodes[II].NodeValue);
       end;
      end;
      Res := N.ChildNodes[I].NodeValue;
     end;
    end;
   end;
  end;
 end
  else
 begin
  // File is locked, return true but polled is dropped until next cycle
  Result := true;
 end;
 XML.Active := false;
 FreeAndNil(XML);
 FreeAndNil(Form);
end;

function TDXR.GetMenuCount(SensorIndex: Integer; out MenuCount: Byte): HResult;
begin
 MenuCount := 0;
 Result := S_OK;
end;

function TDXR.GetMenuItem(SensorIndex: Integer; Index: Byte; out MenuTitle,
  MenuHint: PChar): HResult;
begin
 MenuTitle := '';
 MenuHint := '';
 Result := S_OK;
end;

function TDXR.GetOptional(SensorIndex, Index: Integer; out Name, Value,
  Description: PChar): HResult;
begin
 Result := S_OK;
 // No optional parameters as of now
end;

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

function TDXR.GetSensor(Index: Integer; Parameters: PChar;
  out SensorName: PChar; out SensorStyle: byte; out SensorString: PChar;
  out SensorValue: Double): HResult;
Var
 FName: String;
 N, V, ID, S: String;
 I: Integer;
 SS: byte;
begin
 FName := ''; ID := '';
 For I := 1 to countfilt(Parameters, '|') do begin
  N := GetFilT(Parameters, I, '|');
  V := GetFilt(N, 2, '=');
  N := GetFilt(N, 1, '=');
  If uppercase(N) = 'FILENAME' then begin
   FName := V;
  end;
  If uppercase(N) = 'SENSORID' then begin
   ID := V;
  end;
 end;
 Case Index of
  0: begin
      If fileexists(FName) then begin
       If GetLoggedSensor(FName, ID, SS, SensorRes) then begin
        SensorStyle := SS;
        Case SS of
         ssNumeric: begin
                     SensorValue := StrToFloat(Sensorres);
                    end;
         ssNonNumeric: Begin
                        SensorString := Pchar(SensorRes);
                       end;
         ssUnknown: Begin
                     S := Pchar(SensorRes);
                     Try
                      SensorValue := StrToFloat(S);
                      SensorStyle := ssNumeric;
                     except
                      on EConvertError do begin
                       SensorString := Pchar(SensorRes);
                       SensorStyle := ssNonNumeric;
                      end;
                     end;
                    end;
        end;
       end
        else
       begin
        SensorStyle := ssNonNumeric;
        SensorString := 'No such Sensor';
       end;
      end
       else
      begin
       SensorStyle := ssNonNumeric;
       SensorString := 'File not found';
      end;
     end;
 end;
 Result := S_OK;
end;

function TDXR.GetSensorCount(out SensorCount: Integer): HResult;
begin
 Sensorcount := 1;
 Result := S_OK;
end;

function TDXR.GetSensorNameOnly(Index: Integer; out SensorName: PChar;
  out SensorStyle: Byte): HResult;
begin
 Result := S_OK;
 Case Index of
  0: begin
      SensorName := 'Get Logged Sensor';
      SensorStyle := ssUnknown;
     end;
 end;
end;

function TDXR.Init: HResult;
begin
 Result := S_OK;
end;

function TDXR.Name(out Name: Pchar): HResult;
begin
 Name := 'Remote';
 Result := S_OK;
end;

function TDXR.ObjIns(SensorIndex: Integer; ParameterName: PChar;
  out ValueType: Byte; out ValueRange: PChar): HResult;
begin
 Case SensorIndex of
  0: begin
      If uppercase(ParameterName) = 'FILENAME' then begin
       ValueType := 5;
       ValueRange := 'xml';
      end;
      If uppercase(ParameterName) = 'SENSORID' then begin
       ValueType := vtEditor;
       ValueRange := '';
      end;
     end;
 end;
 Result := S_OK;
end;

function TDXR.OnEditor(SensorIndex: Integer; ParameterName: PChar; FullParameterValues: PChar; OUT Value: PChar): HResult;
Var
 esSensors: TesSensors;
 I: Integer;
 FName, N, V: string;
begin
 Result := S_OK;
 Case SensorIndex of
  0: begin
      If uppercase(ParameterName) = 'SENSORID' then begin
       FName := '';
       For I := 1 to countFilt(FullParameterValues, '|') do begin
        N := GetFilt(FullParameterValues, I, '|');
        V := GetFilt(N, 2, '=');
        N := GetFilt(N, 1, '=');
        If uppercase(N) = 'FILENAME' then begin
         FName := V;
        end;
       end;
       esSensors := TEssensors.Create(nil);
       Val := Value;
       If esSensors.Execute(FName, Val) then begin
        Value := Pchar(Val);
       end;
      end;
     end;
 end;
end;

function TDXR.OnMenu(SensorIndex: Integer; Index: Byte; out ResultString: PChar): HResult;
begin
 Result := S_OK;
end;

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

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

function TDXR.Setup: HResult;
begin
 Result := E_NOTIMPL;
end;

function TDXR.ShowSensor(Index: Integer; out ShowAt: Byte): HResult;
begin
 Case Index of
  0: Begin
      ShowAt := saDesignTime;
     end;
 end;
 Result := S_OK;
end;

function TDXR.Terminating: HResult;
begin
 Result := S_OK;
end;

function TDXR.UpdateFileURL(out URL: Pchar): HResult;
begin
 URL := UPDFile;
 Result := S_OK;
end;

function TDXR.Version(out Version: word): HResult;
begin
 Version := Ver;
 Result := S_OK;
end;

initialization
  TComObjectFactory.Create(ComServer, TDXR, Class_DXR,
    'DXR', '', ciMultiInstance, tmApartment);
end.
