 ////////////////////////////////////////////////////////////////////////////////
// CM2ScriptTypes.pas
// -------------------
// This unit contains the script system deployed in CoolMon 2
//
// Last Edit: 25th April 2004
// Certified: -
//
// This unit is coded in : Delphi 7
//
// Unit is copyright (c) 2004, The CoolMon Project
////////////////////////////////////////////////////////////////////////////////
// This unit uses Microsoft's Scripting Control which can be obtained here
//
// http://www.msdn.microsoft.com/scripting/
////////////////////////////////////////////////////////////////////////////////
{
This system still needs to be developed ... This unit holds the base types

Still missing is ...
* Development of the TScriptItem Class in CM2VariableManager.pas
* Creating a Sub class of TRawNode called TScriptNode that will control the
  Script tag in CML files

}
{$D+}
unit CM2ScriptTypes;

interface

Uses
 Classes,
 Forms,
 SysUtils,
 OleCtrls,
 ActiveX,
 Variants,
 MSScriptControl_TLB;

Type
 EScriptError = Exception;
 TScriptEngine = Class(Tobject)
 private
  Engine: TScriptControl;
  fLanguage: String;
  fFunc: String;
  fFilename: String;
  fFileExtension: String;
 public
  Constructor Create(Owner: TForm; Language: String; FileExtension: String);
  Destructor Destroy; override;
 published
  property Language: String read fLanguage;
  Property Filename: String read fFilename write fFilename;
  Property Func: String read fFunc write fFunc;
  Property FileExtension: String read fFileExtension;
  Function Execute(Parameters: TStrings): String;
 end;
 TScriptEngineHost = Class(TObject)
 private
  fList: Array of TScriptEngine;
  Owner: TForm;
  function getCount: Integer;
 public
  Constructor Create(aOwner: TForm);
  Property Count: Integer Read getCount;
  Procedure Add(Language: String; FileExtension: String);
  Procedure Delete(Language: String);
  Function Execute(Filename: String; Func: String; Parameters: TStrings): String;
 end;


implementation

uses Controls, Dialogs;

{ TScriptEngine }

constructor TScriptEngine.Create(Owner: TForm; Language: String; FileExtension: String);
begin
 Engine := TScriptControl.Create(Owner);
 Engine.SitehWnd := owner.handle;
 Engine.Language := Language;
 // Make script less capable, should prevent worm coding - POSSIBLE OPTION
 // Once we go modules default should be true, with the ability to turn it off
 // in script that you know are save
 Engine.UseSafeSubset := True;
 // Perhaps it might also be a good idea to set timeout - POSSIBLE OPTION

 // We need to enable the usage of MSGBOX etc. - POSSIBLE OPTION
 Engine.AllowUI := true;
 fFileExtension := FileExtension;
 // Remove the ".", if found in the FileExtension
 If fFileExtension <> '' then begin
  If fFileExtension[1] = '.' then fFileExtension := Copy(fFileExtension, 2, length(fFileExtension));
 End;
end;

destructor TScriptEngine.Destroy;
begin
 Engine.Free;
 inherited;
end;

function TScriptEngine.Execute(Parameters: TStrings): String;
Var
 Bounds : array [0..0] of TSafeArrayBound;
 Params : PSafeArray;
 V1: Variant;
 V: Variant;
 I: Integer;
 Script: TStrings;
begin
 If not fileexists(filename) then raise EScriptError.Create('File: ' + filename + ' could not be found');
 If Parameters.Count = 0 then begin
  // Without Parameters
  Bounds[0].cElements:=0;
  Bounds[0].lLbound:=0;
  Params:=SafeArrayCreate(varVariant, 1, Bounds);
 End
  Else
 Begin
  // With parameters
  v := VarArrayCreate([(Parameters.Count - 1), (Parameters.Count - 1)], varVariant);
  For I := 0 to parameters.count - 1 do begin
   v[I] := parameters[I];
  End;
  Params := PSafeArray(TVarData(v).VArray);
 End;
 // Create a strings instance of the script file
 Script := TStringList.Create;
 Script.LoadFromFile(Self.Filename);
 // add the script to the engine
 Engine.AddCode(Script.Text);
 // Run the function
 V1 := Engine.Run(Self.Func, Params);
 // Convert and save result
 Result := VarToStr(V1);
 // Free the strings instance of the script file
 Script.Free;
end;

{ TScriptEngineHost }

procedure TScriptEngineHost.Add(Language: String; FileExtension: String);
Var
 I: Integer;
begin
 // First check that the language isn't already created
 For I := 0 to Length(fList) - 1 do begin
  If uppercase(Language) = uppercase(fList[I].Language) then exit;
 End;
 // Increase Array size
 Setlength(fList, length(flist) + 1);
 // Create instance
 fList[Length(flist) - 1] := TScriptEngine.Create(Owner, Language, FileExtension);
end;

constructor TScriptEngineHost.Create(aOwner: TForm);
begin
 Owner := aOwner;
end;

procedure TScriptEngineHost.Delete(Language: String);
Var
 FoundAt, I: Integer;
begin
 // First locate the engine that serves the language we are to remove
 FoundAt := -1;
 For I := 0 to length(flist) - 1 do begin
  If uppercase(language) = uppercase(flist[I].Language) then begin
   // Found
   FoundAt := I;
  End;
 End;
 // If not found exit procedure
 If FoundAt = -1 then exit;

 // FREEING THE ENGINE WILL TRIGGER AN EXCEPTION, SO WE DON'T DO THAT
 // INSTEAD WE SIMPLE JUST REARRANGE THE fLIST AND THEN REMOVE THE LAST ENTRY

 // Rearrange fList
 For I := FoundAt to length(flist) - 2 do begin
  fList[I] := fList[I + 1];
 End;
 // Resize Array
 Setlength(fList, length(flist) - 1);
end;

function TScriptEngineHost.Execute(Filename, Func: String;
  Parameters: TStrings): String;
Var
 I: Integer;
 FoundAt: Integer;
 Ext: String;
begin
 // Isolate file extension
 Ext := Extractfileext(filename);
 // remove the "."
 Ext := Copy(Ext, 2, length(ext));
 // First find an engine to run the script
 FoundAt := -1;
 For I := 0 to count - 1 do begin
  If uppercase(Ext) = uppercase(fList[I].FileExtension) then begin
   FoundAt := I;
  End;
 end;
 // If not found
 If FoundAt = -1 then raise EScriptError.Create('No Script engine to handle "' + ext + '" files');
 fList[FoundAt].Filename := Filename;
 fList[FoundAt].Func := Func;
 Result := fList[FoundAt].Execute(Parameters);
end;

function TScriptEngineHost.getCount: Integer;
begin
 result := length(fList);
end;

end.
