dxvisualbasicscript.pas

Well known and usefull component for delphi 7

////////////////////////////////////////////////////////////////////////////
//
//    Component: TDXVisualBasicScript
//      Authors: Alexander Baranovsky ([e-mail]),
//               G.E. Ozz Nixon Jr. ([e-mail])
// ========================================================================
// Source Owner: DX, Inc. 2002
//    Copyright: All code is the property of DX, Inc. Licensed for
//               resell by Brain Patchwork DX (tm) and part of the
//               DX (r) product lines, which are (c) 1999-2002
//               DX, Inc. Source may not be distributed without
//               written permission from both Brain Patchwork DX,
//               and DX, Inc.
//      License: (Reminder), None of this code can be added to other
//               developer products without permission. This includes
//               but not limited to DCU's, DCP's, DLL's, OCX's, or
//               any other form of merging our technologies. All of
//               your products released to a public consumer be it
//               shareware, freeware, commercial, etc. must contain a
//               license notification somewhere visible in the
//               application.
// Code Version: 0.99
// ========================================================================
//  Description:
// ========================================================================
////////////////////////////////////////////////////////////////////////////

unit DXVisualBasicScript;

interface
{$I DXJavaScript.def}

uses
  Classes,
  DXJS_MAIN;

const
  rmRun = 0;
  rmStepOver = 1;
  rmTraceInto = 2;
  rmNextSourceLine = 3;

type
  TScriptEvent = procedure(const ScriptObject: Variant) of object;

  TCallStackObject = class
    Arguments: array of Variant;
    CurrentLineNumber: Integer;
    CurrentModule: String;
    CurrentLine: String;
  end;

  TDXVisualBasicScript = class(TComponent)
  private
    { Private declarations }
    fOnLoadBeforeCompile: TNotifyEvent;
    fOnBeforeRun: TNotifyEvent;
    fOnAfterRun: TNotifyEvent;
    JavaScript: TJScript;
    fCompiled: Boolean;
    fIDCache: TStringList;
    fCallStack: TStringList;
    function GetID(const Name: String): Integer;
    procedure SetCompiled(Value: Boolean);
    function GetVariable(const Name: String): Variant;
    procedure SetVariable(const Name: String; const Value: Variant);
    procedure SetShowError(Value: TScriptEvent);
    function GetZeroBasedStringIndex: boolean;
    procedure SetZeroBasedStringIndex(Value: boolean);
    procedure ClearCallStack;
  protected
    { Protected declarations }
    function GetSourceCode: String;
    procedure SetSourceCode(Value: String);
  public
    { Public declarations }
    constructor Create(AOwner:TComponent); override; //  Creates and initializes a TDXVisualBasicScript instance.
    destructor Destroy; override; // Destroys an instance of TDXVisualBasicScript.
    procedure AddCode(Code: String; const ModuleName: String = '');
    // Adds specified code to a DXJavaScript script.
    procedure LoadFromFile(const FileName: String);
    // Loads a script from a text file
    procedure LoadFromStream(Stream: TStream);
    // Loads a script from a stream
    procedure SaveCompiledScript(Stream: TStream);
    // Saves a compiled script (binary representation) to a stream
    procedure LoadCompiledScript(Stream: TStream);
    // Loads a compiled script (binary representation) from a stream
    procedure AddRoutine(const Name:String; Address: Pointer);
    // Allows to register a host-defined routine to the DXJavaScript interpreter.
    // The host routine must has type:
    //   type THostRoutine = function (const Parameters: array of Variant): Variant;
    // For example, to add ShowMessage procedure to DXJavaScript interpreter,
    // you should wrap the procedure into the _ShowMessage:
    //
    // function _ShowMessage(const Parameters: array of Variant): Variant;
    // var S: String;
    // begin
    //   if Length(Parameters)>0 then S:= TDXVisualBasicScript.ToString(Parameters[0]) else S := '';
    //   ShowMessage(S);
    // end;
    //
    // Then use line
    //   DXJavaScript1.AddRoutine('ShowMessage', @_ShowMessage);
    // to register ShowMessage.
    procedure AddMethod(AClass:TClass; const Name: String; Address: Pointer);
    // Allows to register a host-defined method of a host-defined class to the
    // DXJavaScript interpreter.
    // You should wrap the method into a host-defined routine which has the type
    //   type THostMethod = function (Instance: TObject; const Parameters: array of Variant): Variant;
    // For example, to add Show method of TButton class to the interpreter you should
    // wrap TButton.Show method into the TButton_Show routine:
    // function TButton_Show(Instance: TObject; const Parameters: array of Variant): Variant;
   // begin
    //   TButton(Instance).Show;
    // end;
    // Then use line
    //   DXJavaScript1.AddMethod(TButton, 'Show', @TButton_Show);
    // to register TButton.Show.
    // Note, you might register (more common and flexible solution)
    // function TControl_Show(Instance: TObject; const Parameters: array of Variant): Variant;
    // begin
    //   TControl(Instance).Show;
    // end;
    // to use methods of TButton class into your DXJavaScript scripts with the same success.
    procedure AddConstructor(AClass:TClass; Address:Pointer);
    // Allows to register a host-defined constructor of a host-defined class to the
    // DXJavaScript interpreter.
    // You should wrap the constructor into a host-defined routine which has the type
    //   type THostConstructor = function (Instance: TObject; const Parameters: array of Variant): TObject;
    // For example, to add constructor of TButton class to the interpreter you should
    // wrap TButton.Create method into the TButton_Create routine:
    // function TButton_Create(const Parameters: array of Variant): TObject;
    // var Button: TButton; Owner: TWinControl;
    // begin
    //   Owner := TWinControl(TDXVisualBasicScript.VariantToDelphiObject(Parameters[0]));
    //   Button := TButton.Create(Owner);
    //   Button.Parent := Owner;
    //   result := Button;
    // end;
    // Then use line
    //   DXJavaScript1.AddConstructor(TButton, @TButton_Create);
    // to register TButton.Create.
    // Now you can create instances of TButton class into your DXJavaScriptScripts:
    //   NewForm = new DelphiObject("TButton", Form1);');
    procedure AddProperty(AClass:TClass; const Name: String; ReadAddr, WriteAddr: Pointer);
    // Allows to register a host-defined non-published property of a host-defined class to the
    // DXJavaScript interpreter.
    // You should specify READ and WRITE methods of the property as wrapper routines which have type
    //   type THostMethod = function (Instance: TObject; const Parameters: array of Variant): Variant;
    // For example, to add Canvas property of TForm class, you should specify READ method of the
    // property:
    // function TForm_GetCanvas(Instance: TObject; const Parameters: array of Variant): Variant;
    // begin
    //  result := TDXVisualBasicScript.DelphiObjectToVariant(TForm(Instance).Canvas);
    // end;
    // Then use line
    //   DXJavaScript1.AddProperty(TForm, 'Canvas', @TForm_GetCanvas, nil);
    // to register (read-only) Canvas property.
    // Note, DXJavaScript imports published properties automatically.
    procedure RemoveProperty(AClass:TClass; const Name: String);
    // Removes property of AClass
    procedure AddHostVariable(const Name: String; Address: Pointer);
    // Allows to add a host-defined variable of Variant type to the DXJavaScript interpreter
    // For example,
    // var MyVar: Variant;
    // ...........
    // DXJavaScript1.AddHostVariable('MyVar', @MyVar);
    procedure AddConstant(const Name: String; const Value: Variant);
    // Allows to add a host-defined constant to the DXJavaScript interpreter
    // For example,
    // DXJavaScript1.AddConstant('MyConst', 100);
    procedure AddObject(const Name:String; Instance: TObject);
    // Allows to add a host-defined object to the DXJavaScript interpreter
    // For example,
    // DXJavaScript1.AddObject('Form1', Form1);
    // Note, all published properties of the host object will be imported automatically.
    procedure Enum(Variables, Functions: TStringList);
    // Enumerates all variables and functions in a script
    function Compile: Boolean;
    // Compiles a script.
    function Run(RunMode: Integer = rmRun): Boolean;
    // Runs a script. If script was not compiled ealier, calls Compile method.
    // RunMode = rmRun. Run script.
    // RunMode = rmStepOver. Step over.
    // RunMode = rmTraceInto. Trace into.
    function Execute(const Source: String): Boolean;
    // Runs a script. If script was not compiled ealier, calls Compile method.
    // Source parameter specifies the script.
    class function ToBoolean(const Value: Variant): Boolean;
    // Converts Variant to JavaScript Boolean value.
    class function ToNumber(const Value: Variant): Double;
    // Converts Variant to JavaScript Number value.
    class function ToInteger(const Value: Variant): Integer;
    // Converts Variant to JavaScript Integer value.
    class function ToString(const Value: Variant): String;
    // Converts Variant to JavaScript String value.
    class function DelphiObjectToVariant(Instance: TObject): Variant;
    // Converts instance of a Delphi class to Variant.
    class function VariantToDelphiObject(const Value: Variant): TObject;
    // Converts Variant to instance of a Delphi class.
    class function GetProperty(const ScriptObject: Variant; const PropertyName: String): Variant;
    // Returns property of a script-defined object.
    class function IsPrimitive(const Value: Variant): boolean;
    // Returns true, if script-defined Value has primitive type (Boolean, Number or String).
    procedure SourceDump;
    procedure Initialize_Engine;
    // Initializes DXJavaScript engine.
    procedure Deinitialize_Engine;
    // Deinitialize DXJavaScript engine.
    function CallFunction(const Name: String; const Parameters: array of Variant): Variant;
    // Calls a script-defined function.
    function AddBreakpoint(LineNumber: Integer; const ModuleName: String = ''): boolean; // script should be compiled!
    // Adds breakpoint to a script.
    function RemoveBreakpoint(LineNumber: Integer; const ModuleName: String = ''): boolean; // script should be compiled!
    // Deletes breakpoint from a script.
    procedure RemoveAllBreakpoints;
    // Deletes all breakpoints from a script.
    function CurrentLineNumber: Integer;
    // Returns current line number (Compile-time or run-time).
    function CurrentModule: String; // compile-time or run-time
    // Returns current module (Compile-time or run-time).
    function CurrentLine: String;
    // Returns current line (Compile-time or run-time).
    function EndOfScript: boolean;
    // Returns true, if script is ended.
    // For example,
    //
    // with DXJavaScript1 do
    // repeat
    //   Run(rmStepOver);
    //   ShowMessage('Script was stopped at the line(' + CurrentLine);
    // until EndOfScript;
    function Eval(const Code: String): Variant;
    // Allows to evaluate an expression at DXJavaScript run-time.
    procedure ResetRun;
    // Terminates script running in the debug mode after Run(Mode) call,
    // where Mode is rmStepOver or rmTraceInto.
    procedure Terminate;         
    // Terminates script running after Run(rmRun).
    property CallStack: TStringList read fCallStack;
    // Returns call stack at DXJavaScript run-time.
    // TStringList.Objects property contains instances of TCallStackObject
    property Compiled: Boolean read fCompiled write SetCompiled;
    // Returns true, if script was compiled.
    property Variables[const Name: String]: Variant read GetVariable write SetVariable;
    // Allows access to script-defined variables.
    property OnShowError: TScriptEvent write SetShowError;
    // Allows to set a custom "show error" handler.
    property ZeroBasedStringIndex: boolean read GetZeroBasedStringIndex write SetZeroBasedStringIndex;
    // If ZeroBasedStringIndex is true, script-defined strings are zero-based. Default value is true.
  published
    { Published declarations }
    property OnBeforeRun:TNotifyEvent read fOnBeforeRun write fOnBeforeRun;
    // Occurs before the script running.
    property SourceCode:String read GetSourceCode write SetSourceCode;
    // Returns script lines.
    property OnLoadBeforeCompile:TNotifyEvent read fOnLoadBeforeCompile write fOnLoadBeforeCompile;
    // Occurs before the script compiling.
    property OnAfterRun:TNotifyEvent read fOnAfterRun write fOnAfterRun;
    // Occurs after the script running.
  end;

function __alert(const Parameters: array of Variant): Variant;
function __confirm(const Parameters: array of Variant): Variant;
function __prompt(const Parameters: array of Variant): Variant;

function TDXVisualBasicScript_ToBoolean(const Value: Variant): Boolean;
    // Converts Variant to JavaScript Boolean value.
function TDXVisualBasicScript_ToNumber(const Value: Variant): Double;
    // Converts Variant to JavaScript Number value.
function TDXVisualBasicScript_ToInteger(const Value: Variant): Integer;
    // Converts Variant to JavaScript Integer value.
function TDXVisualBasicScript_ToString(const Value: Variant): String;
    // Converts Variant to JavaScript String value.
function TDXVisualBasicScript_DelphiObjectToVariant(Instance: TObject): Variant;
    // Converts instance of a Delphi class to Variant.
function TDXVisualBasicScript_VariantToDelphiObject(const Value: Variant): TObject;
    // Converts Variant to instance of a Delphi class.
function TDXVisualBasicScript_GetProperty(const ScriptObject: Variant; const PropertyName: String): Variant;
    // Returns property of a script-defined object.
function TDXVisualBasicScript_IsPrimitive(const Value: Variant): boolean;
    // Returns true, if script-defined Value has primitive type (Boolean, Number or String).

function GetParamName(const FuncDecl: String; ParamNumber: Integer): String;

// Ex: S := GetParamName('function F( par1 , par2 ){}', 2);
// ( S = 'par2')

implementation

uses
  Forms, // 1-17-2003
  SysUtils,
  Dialogs,
  Windows;

const
  ModuleMain = 'Main';

var
  _Count: Integer = 5;

procedure AskToRegister;
begin
  Inc(_Count);
  if _Count mod 10 = 0 then
    ShowMessage('This is a trial version. Please register!');
end;

function __alert(const Parameters: array of Variant): Variant;
var
  Ws:String;

begin
   If Length(Parameters)>0 then Ws:=TDXVisualBasicScript.ToString(Parameters[0])
   Else Ws:='';
   While Length(Ws)<50 do Ws:=Ws+#32;
   MessageDlg(Ws,mtWarning,[mbOK],0); // v1.2
// THIS LOSES CURSOR:
//   MessageBox(0,PChar(Ws),'DXJavaScript',MB_ICONWARNING or MB_OK or MB_SYSTEMMODAL or MB_TOPMOST);
end;

function __confirm(const Parameters: array of Variant): Variant;
var
  Ws:String;

begin
   If Length(Parameters)>0 then Ws:=TDXVisualBasicScript.ToString(Parameters[0])
   Else Ws:='';
   While Length(Ws)<50 do Ws:=Ws+#32;
   Result:=MessageDlg(Ws,mtConfirmation,mbOKCancel,0)=idOK; // v1.2
// THIS LOSES CURSOR:
//   Result:=MessageBox(0,PChar(Ws),'DXJavaScript',MB_ICONQUESTION or MB_OKCANCEL or MB_SYSTEMMODAL or MB_TOPMOST)=idOK;
end;

function __prompt(const Parameters: array of Variant): Variant;
var
  Ws:String;
  Ts:String;

begin
   If Length(Parameters)>0 then Ws:=TDXVisualBasicScript.ToString(Parameters[0])
   Else Ws:='';
   If Length(Parameters)>1 then Ts:=TDXVisualBasicScript.ToString(Parameters[1])
   Else Ts:='';
   Result:=InputBox('DXJavaScript',Ws,TS); // v1.2
end;

constructor TDXVisualBasicScript.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  Initialize_Engine;
end;

destructor TDXVisualBasicScript.Destroy;
begin
  Deinitialize_Engine;
  inherited Destroy;
end;

procedure TDXVisualBasicScript.Initialize_Engine;
begin
  fIDCache := TStringList.Create;
  fCallStack := TStringList.Create;
  Compiled := false;
  JavaScript := TJScript.Create;
  JavaScript.AddRoutine('alert', @__alert);
  JavaScript.AddRoutine('confirm', @__confirm);
  JavaScript.AddRoutine('prompt', @__prompt);
end;

procedure TDXVisualBasicScript.Deinitialize_Engine;
begin
  ClearCallStack;
  fCallStack.Free;
  fIDCache.Free;
  JavaScript.Free;
end;

function TDXVisualBasicScript.GetSourceCode: String;
begin
  result := JavaScript.Modules.SourceCode;
end;

function ConvertToJavaScript(Original:String):String;
Begin
   Result:='';
End;

procedure TDXVisualBasicScript.SetSourceCode(Value: String);
begin
  JavaScript.Modules.Clear;
  // Store Original Value so GETSourceCode works
  // then Convert from VB to JavaScript on the fly:
  AddCode(ConvertToJavaScript(Value));
end;

procedure TDXVisualBasicScript.SetCompiled(Value: Boolean);
begin
  fIDCache.Clear;
  fCompiled := Value;
end;

function TDXVisualBasicScript.GetZeroBasedStringIndex: boolean;
begin
  result := JavaScript.ZeroBasedStringIndex;
end;