unit PlugServ;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, ActiveX, Classes, ComObj, Forms,
  OleCtrls, MSScriptControl_TLB, StdCtrls, Filter, Sysutils, Variants,
  CM2GenInterface, CM2AutoUpdateInterface, CM2EditorSupportInterface;

type
  TScript = class(TComObject, ICM2GenPlug, ICM2AutoUpdate, ICM2EditorSupport10)
  private
  // Declare props
   S: String;
   FName: String;
   Func: String;
   ParentHandle: THandle;
   LastErrorMsg: String;
   Procedure parser(params: String);
  public
  // 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 Msg: 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 ShowSensor(Index: Integer; OUT ShowAt: Byte): HResult; stdcall;
   Function ObjIns(SensorIndex: Integer; ParameterName: PChar; OUT ValueType: Byte; OUT ValueRange: PChar): HResult; stdcall;

  end;

const
  Class_Script: TGUID = '{0BB27925-B9A9-4192-9E99-9B401880975F}';
  AutoUpdateFile = 'http://www.coolmon.org/update/scriptplugin.upd';


implementation

uses ComServ, Controls;

function IsStrFloatNum(s: string): Boolean;
begin
  try
    // try to convert the string into a floatnumber
    StrToFloat(s);
    // if there is no error the result is true
    Result := True;
  except
    // if there is any error the result is false
    Result := False;
  end;
end;

{ TScript }

function TScript.GetDefault(SensorIndex, Index: Integer; out Name, Value,
  Description: PChar): HResult;
begin
  Case Index of
   0: Begin Name := 'File'; Value := 'MyScript.vbs'; Description := 'Full path to the script file'; end;
   1: Begin Name := 'Func'; Value := 'TestFunc'; Description := 'The name of the function to run (casesensitive)'; end;
  end;
  Result := S_OK;
end;

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

function TScript.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 := '11 Oct. 2003';
     End;
  2: Begin
      InfoName := 'Updated'; InfoVar := 'June 30th 2004';
     End;
  3: Begin
      InfoName := 'Copyright'; InfoVar := '(c) 2003 - 2004, by C. Aaangel';
     End;
  else begin
   Result := E_FAIL;
   LastErrorMsg := 'Index out of bounds';
  End;
 End;
end;

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

function TScript.GetLastErrorMsg(OUT Msg: PChar): HResult;
begin
 If LastErrorMsg = '' Then Msg := 'No error'
  else Msg := Pchar(LastErrorMsg);
 Result := S_OK;
end;

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

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

function TScript.GetSensor(Index: Integer; Parameters: PChar;
  out SensorName: PChar; out SensorStyle: byte; out SensorString: PChar;
  out SensorValue: Double): HResult;
var
  Bounds : array [0..0] of TSafeArrayBound;
  Params : PSafeArray;
  Strings: TStrings;
  Res: Variant;
  S: String;
//  B: Byte;
  Engine: TScriptControl;
  ParentForm: TForm;
begin
 SensorStyle := 1;
 If Parameters = '' then begin
  result := S_OK;
  Exit;
 End;
// showmessage('parser');
 Parser(Parameters);
// showmessage('create string list');
 If not fileexists(fname) then begin
  result := S_OK;
  exit;
 end;
 Strings := TStringList.Create;
 Bounds[0].cElements:=0;
 Bounds[0].lLbound:=0;
 Params:=SafeArrayCreate(varVariant, 1, Bounds);
 Result := S_OK;

// showmessage('create parent form');
 Parentform := TForm.Create(nil);

// showmessage('Create engine');
 Engine := TScriptControl.Create(nil);
// showmessage('Set SitehWnd');
 Engine.SitehWnd := ParentForm.Handle;

// If GetSensornameonly(Index, SensorName, B) = E_FAIL Then Result := E_FAIL;

 Case index of
  0: Begin // JavaScript
      Try
       Engine.Language := 'JScript';
       Strings.LoadFromFile(FName);
       Engine.AddCode(Strings.Text);
       Res := Engine.Run(Func, Params);
      except
       LastErrorMsg := Engine.Error.Text;
       Result := E_FAIL;
      end;
     End;
  1: Begin // VBScript
      Try
//       showmessage('Index 1- VBScript');
       Engine.Language := 'VBScript';
//       Engine.UseSafeSubset := true;
      Except
       LastErrorMsg := 'Unable to set Engine.Language';
       Result := E_FAIL;
       Engine.Free;
       Exit;
      End;
      Try
       Strings.LoadFromFile(FName);
      Except
       LastErrorMsg := 'Couldn''t load the file [' + FName + ']';
       Result := E_FAIL;
       Engine.Free;
       Exit;
      End;
      Try
       Engine.AddCode(Strings.Text);
      Except
       on E: Exception do begin
        LastErrorMsg := 'Unable to set Engine.AddCode [Class: ' + E.ClassName + ' *** Msg: ' + E.Message + ']';
        Result := E_FAIL;
        Engine.Free;
        Exit;
       End;
      End;
      Try
       Res := Engine.Run(Func, Params);
      except
       LastErrorMsg := Engine.Error.Text;
       Result := E_FAIL;
      end;
     End;
  else Result := E_FAIL;
 end;
 Engine.Free;
 parentform.Free;
 Strings.Free;
 S := VarToStr(Res);
 SensorStyle := 1;
 If IsStrFloatNum(S) Then begin
  SensorStyle := 0;
  SensorValue := StrToFloat(S);
  SensorString := Pchar('');
 End
  else SensorString := Pchar(S);
end;

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

function TScript.GetSensorNameOnly(Index: Integer;
  out SensorName: PChar; out SensorStyle: Byte): HResult;
begin
 Result := S_OK;
 SensorStyle := 2; // Unknown
 Case Index of
  0: SensorName := 'Script Function (JavaScript)';
  1: SensorName := 'Script Function (VBScript)';
  else Begin
   LastErrorMsg := 'Index out of bounds';
   Result := E_FAIL;
  End;
 End;
end;

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

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

function TScript.ObjIns(SensorIndex: Integer; ParameterName: PChar;
  out ValueType: Byte; out ValueRange: PChar): HResult;
begin
 Result := S_OK;
 ValueType := vtUnknown;
 If uppercase(ParameterName) = 'FILE' then begin
  ValueType := vtFile;
  S := '';
  If SensorIndex = 0 then S := 'JS';
  If SensorIndex = 1 Then S := 'VBS';
  ValueRange := PChar(S);
 end;
end;

procedure TScript.parser(params: String);
Var
 I: Integer;
 N, V, S: String;
begin
 // Correct usage string ===> File=C:\script.js|Function=Test
 FName := '';
 Func := '';
 For I := 1 to countfilt(Params, '|') do begin
  S := GetFilt(Params, I, '|');
  N := GetFilt(S, 1, '=');
  V := GetFilt(S, 2, '=');
  If (uppercase(N) = 'FILE') or (Uppercase(N) = 'FILENAME') Then Fname := V;
  If (uppercase(N) = 'FUNC') or (uppercase(N) = 'FUNCTION') Then Func := V;
 end;
end;

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

function TScript.SetParentHandle(Handle: THandle): HResult;
begin
 ParentHandle := HAndle;
 If Handle = 0 then Result := E_FAIL
  else Result := S_OK;
end;

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

function TScript.ShowSensor(Index: Integer; out ShowAt: Byte): HResult;
begin
 Result := S_OK;
 ShowAt := saDesignTime;
end;

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

function TScript.UpdateFileURL(out URL: Pchar): HResult;
begin
 URL := PChar(AutoUpdateFile);
 Result := S_OK;
end;

function TScript.Version(out Version: word): HResult;
begin
 Version := 0510;
 Result := S_OK;
end;

initialization
  TComObjectFactory.Create(ComServer, TScript, Class_Script,
    'Script', 'CM2 General Plugin - Script', ciMultiInstance, tmApartment);
end.
