unit CMLxPlugServ;

interface

uses
  Windows, ActiveX, Classes, ComObj, CM2CMLXInterface, CM2MMRB, SysUtils,
   CM2AutoUpdateInterface, Filter, MSScriptControl, Variants;

type
  TCM2CMLx_Script = class(TComObject, ICM2CMLXPlug2, ICM2AutoUpdate)
  private
   lasterrorstring: String;
   ScriptControl: TScriptControl;
   sCode, sFunction, sType: String;
  protected
   Function Name(OUT Name: Pchar): HResult; stdcall;
   Function Version(OUT Version: word): HResult; stdcall; // Uses MMRB Notation
   Function RequiredCoreVersion(OUT RCV: Word): HResult; stdcall; // Uses 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 "Event" types
   Function Init: HResult; stdcall;
   Function Terminating: HResult; stdcall;
   Function Setup: HResult; stdcall;
   // Plugin Speficic
   Function TagName(OUT Tag: PChar): HResult; stdcall;
   Function Perform(Attribute: PChar; Parameters: PChar; OUT ResultString: WideString; OUT ResultType: Byte): HResult; stdcall;
   // Update API
   Function UpdateFileURL(OUT URL: Pchar): HResult; stdcall;
   // Parese API
   procedure Parser(Param: String);
   end;
const
  Class_CM2CMLx_Script: TGUID = '{07A8E46A-531B-4B34-9DFB-3785CB50B4FD}';
  AutoUpdateFile = 'http://users.skynet.be/jorge/cm2/cmlScript.upd';
  PlugInVersion: Word = 0100;

implementation

uses ComServ;

{

v 100:
- First Release

}

function TCM2CMLx_Script.GetLastErrorMsg(OUT Msg: PChar): HResult;
begin
 If LastErrorString = '' then LastErrorString := 'No error';
 Msg := PChar(LastErrorString);
 Result := S_OK;
end;

function TCM2CMLx_Script.GetInfo(Index: Integer; out InfoName,
  InfoVar: PChar): HResult;
begin
 Result := S_OK;
 Case Index of
  0: Begin
      InfoName := PChar('Programmed By');
      InfoVar := PChar('Jorge Schrauwen');
     End;
  1: Begin
      InfoName := PChar('Created');
      InfoVar := Pchar('25th March 2005');
     End;
  2: Begin
      Infoname := PChar('Updated');
      Infovar := PChar('25th March 2005');
     End;
  else begin
        Result := E_FAIL;
        LastErrorString := 'Index out of bounds';
       End;
 End;
end;

function TCM2CMLx_Script.GetInfoCount(out InfoCount: Integer): HResult;
begin
 Result := S_OK;
 InfoCount := 3; // The infolist contains 3 items
end;

function TCM2CMLx_Script.Init: HResult;
begin
 ScriptControl := TScriptControl.Create(nil);
 ScriptControl.SitehWnd := 0;
 ScriptControl.Language := 'VBScript';
 Result := S_OK;
end;

function TCM2CMLx_Script.Terminating: HResult;
begin
 Result := S_OK; // We dont need to free any memory
end;

function TCM2CMLx_Script.Setup: HResult;
begin
 Result := E_NOTIMPL; // We dont need to run a setup
end;


function TCM2CMLx_Script.Name(OUT Name: Pchar): HResult;
begin
 Name := PChar('CMLSript');
 Result := S_OK;
end;

function TCM2CMLx_Script.Version(OUT Version: word): HResult;
begin
 Version := PlugInVersion;
 Result := S_OK;
end;

function TCM2CMLx_Script.RequiredCoreVersion(out RCV: Word): HResult;
Var
 MMRB: TMMRB;
begin
 MMRB.Major := 0;
 MMRB.Minor := 6;
 MMRB.Release := 0;
 MMRB.Built := 0;
 RCV := MMRBToWord(MMRB);
 Result := S_OK;
end;

Function TCM2CMLx_Script.TagName(OUT Tag: PChar): HResult;
begin
 Tag := PChar('Script');
 Result := S_OK;
end;

Function TCM2CMLx_Script.Perform(Attribute: PChar; Parameters: PChar; OUT ResultString: WideString; OUT ResultType: Byte): HResult;
var
 sData: string;
 Params : PSafeArray;
 v : Variant;
begin
  Result := S_OK;
  Parser(Attribute);
  Parser(Parameters);
  ResultType := rtCML;
  if sType = 'text' then
    ResultType := rtSensor;

  //prepare ScriptControl
  v := VarArrayCreate([0, 0], varVariant);
  v[0] := '';
  Params := PSafeArray(TVarData(v).VArray);

  if sFunction = '' then
  begin
    lasterrorstring := 'You Did not give a function to execute!';
    Result := E_FAIL;
  End;

  if sCode <> '' then
  begin
    ScriptControl.AddCode(sCode);
    sData := ScriptControl.Run(sFunction, Params);
    sData := '<cml>' + sData + '</cml>';
    ResultString := WideString(sData);
  end
  else
  begin
    lasterrorstring := 'Did not get Code block!';
    Result := E_FAIL;
  end;
end;

function TCM2CMLx_Script.SetParentHandle(Handle: THandle): HResult;
begin
 // We don't need this handle so do nothing
 Result := S_OK;
end;

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

procedure TCM2CMLx_Script.Parser(Param: String);
var
 i: Integer;
 n, v: string;
begin
 for i := 1 to countfilt(Param, '|') do
   begin
     n := GetFilt(Param, i, '|');
     v := GetFilt(n, 2, '=');
     n := Uppercase(GetFilt(n, 1, '='));
     if n = 'LANGUAGE' then ScriptControl.Language := n;
     if n = 'CODE' then sCode := lowercase(n);
     if n = 'FUNCTION' then sFunction := lowercase(n);
     if n = 'TYPE' then sType := lowercase(n);
   end;
end;

initialization
  TComObjectFactory.Create(ComServer, TCM2CMLx_Script, Class_CM2CMLx_Script,
    'CM2CMLx_Script', 'CM2 CMLx Plugin - Script', ciMultiInstance, tmApartment);
end.                    
