Development Blog

今年の初め頃に自分のアプリケーションにスクリプト言語を組み込むために、Pascal Script と FastScript を試してみましたが、

Pascal Script はフリーだけどちょっと面倒。FastScript は有料だけど、使いやすい。

と言う結論が出たままそのままになっていましたが、ようやく作業に取りかかり。実アプリのクラスへのアクセスでいろいろと面倒だけど、これも最初だけなんで、Pascal Script を使うことにしました。

一応うまいこといきましたが、64bit プラットフォームでエラーになる。
AddFunction で戻り値が文字列の場合と RegisterPropertyHelper で登録したローカル手続きへのアクセスでエラーになります。

バグフィックスを待ってられないので、FastScript を採用することにしました。残念ながら Pascal Script 不採用となったわけですが、数日さわってみて覚えたことなどを FastScript も含めて簡単に書いてみました。

Pascal Script

スクリプトは Pascal のみサポートだが、Delphi Prism を作ってるだけあってかなり気合いが入っており、クラスを作ったりできる。伝統的に実アプリへのアクセスはコンパイル時と実行時の二回設定する必要があったりするので使い勝手はあまりよくない。

procedure TForm1.RunBtnClick(Sender: TObject);
var a: integer;
begin
  PSScript.Script.Text := Memo1.Text;
  if PSScript.Compile then begin
    MessageListBox.Items.Add('Success compiled');
    if PSScript.Execute then begin
      MessageListBox.Items.Add('Success executed');
      end else begin
      MessageListBox.Items.Add('Error: ' + PSScript.ExecErrorToString);
    end;
  end else begin
    for a := 0 to PSScript.CompilerMessageCount - 1 do
      MessageListBox.Items.Add(PSScript.CompilerMessages[a].MessageToString);
  end;
end;

// このイベントでクラス等を登録する。
procedure TForm1.PSScriptCompImport(Sender: TObject; x: TPSPascalCompiler);
var ctc: TPSCompileTimeClass;
begin
  // スクリプトに定数を追加する。
  x.AddConstantN('kTest', 'integer').Value.ts32 := 1023;

  // スクリプトに列挙型を追加する。
  x.AddTypeS('TEnum', '(eA, eB)');

  // スクリプトに集合型を追加する。
  x.AddTypeS('TSets', 'set of TEnum');

  // スクリプトにレコード型を追加する。
  x.AddTypeS('TRec', 'record x,y: integer; end;');

  // スクリプトにメソッドポインタを追加する。'of object' は不要
  // 未確認

  // スクリプトにクラスを追加する。
  ctc := x.AddClass(x.FindClass('TOBJECT'), TData);
  with ctc do begin
    RegisterMethod('Constructor Create');
    RegisterMethod('function GetValue : integer');

    // スクリプトにクラスのプロパティを追加する。
    RegisterProperty('fValue', 'integer', iptrw);
    RegisterProperty('Value',  'integer', iptrw);
    RegisterProperty('Value2', 'integer', iptrw);
  end;

  with x.AddClassN(x.FindClass('TBUTTONCONTROL'), 'TButton') do begin
    // スクリプトにクラスのプロパティを追加する。
    // 実際は SIRegisterTBUTTON(x); を呼び出すと主要なプロパティは全部登録してくれる。
    RegisterProperty('CAPTION', 'String', iptrw);
    RegisterProperty('ONCLICK', 'TNotifyEvent', iptrw);
  end;
end;

// 実アプリの変数や関数の登録。
procedure TForm1.PSScriptCompile(Sender: TPSScript);
begin
  // スクリプトにグローバル変数を追加する。
  PSScript.AddRegisteredVariable('gA',     'integer');
  PSScript.AddRegisteredVariable('Button', 'TButton');

  // 実アプリの変数をグローバル変数としてスクリプトから利用できるようにする。
  PSScript.AddRegisteredPTRVariable('gB', 'integer');

  // 実アプリの手続きあるいは関数をスクリプトから利用できるようにする。
  PSScript.AddFunction(@TestFunction, 'function TestFunction(a,b: integer) : integer;');
  PSScript.AddFunction(@GetString,    'function GetString : string;');

  // 実アプリのメソッドを手続きあるいは関数としてスクリプトから利用できるようにする。
  PSScript.AddMethod(Self, @TForm1.OutputPS,  'procedure ShowMessage(const s: string);');
  PSScript.AddMethod(Self, @TForm1.GetDataPS, 'function GetData : TData');
end;

// 実行時前に発生するイベント。クラスのメソッドやフィールドへのアクセス手段を設定。
procedure TForm1.PSScriptExecImport(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter);

  procedure TDatafValue_W(Self: TData; const T: integer);
  begin
    Self.fValue := T;
  end;

  procedure TDatafValue_R(Self: TData; var T: integer);
  begin
    T := Self.fValue;
  end;

  procedure TDataValue2_W(Self: TObject; const T: integer);
  var propInfo: PPropInfo;
  begin
    if Self is TData then begin
      TData(Self).Value := T;
    end;
  end;

  procedure TDataValue2_R(Self: TData; var T: integer);
  begin
    T := Self.fValue;
  end;

begin
  // クラスのプロパティにアクセス出来るようにする。
  with x.Add(TData) do begin
    RegisterConstructor(@TData.Create,   'Create');
    RegisterMethod     (@TData.GetValue, 'GetValue');

    RegisterPropertyHelper(@TDatafValue_R, @TDatafValue_W, 'fValue');
    //    RegisterPropertyHelper(@TDataValue_R,  @TDataValue_W,  'Value');   // published は RTTI があるので不要。
    RegisterPropertyHelper(@TDataValue2_R, @TDataValue2_W, 'Value2');
  end;

  x.Add(TButton);
end;

// 実アプリの変数等のセット。
procedure TForm1.PSScriptExecute(Sender: TPSScript);
begin
  PSScript.SetVarToInstance('Button', TestButton);
  PSScript.SetPointerToData('gB', @fB, PSScript.FindBaseType(bts32));
end;

FastScript

Pascal, C++, JScript, Basic をサポートし、動作が速いのが特徴です。実アプリの関数の呼び出しは出来ず、メソッドのみでパラメータはソースの 'Data_GetValue' の形式で固定になっています。

スクリプトの言語仕様は複数言語をサポートする関係でかなり割り切っており、type, record, class, set, as, is などが使用不可。

その他制限事項としては、実アプリの変数にアクセス不可。タイプキャスト不可。

procedure TForm1.TestButtonClick(Sender: TObject);
var fsc: TfsClassVariable;
begin
  fsScript.Clear;
  fsScript.Parent := fsGlobalUnit;

  // スクリプトに定数を追加する。
  fsScript.AddConst('kTest', 'integer', 1024);

  // スクリプトにグローバル変数を追加する。
  fsScript.AddVariable('gVar', 'integer', 0);

  // スクリプトに列挙型を追加する。
  fsScript.AddEnum('TEnum', 'eA, eB');

  // スクリプトに集合型を追加する。
  fsScript.AddEnumSet('TSets', 'eA, eB');

  // スクリプトにレコード型を追加する。
  // 未サポート

  // スクリプトにクラスを追加する。
  fsc := fsScript.AddClass(TData, 'TObject');
  with fsc do begin
    AddConstructor('constructor Create',          Data_Create);
    AddMethod     ('function GetValue : integer', Data_GetValue);

    // スクリプトにクラスのプロパティを追加する。
    AddProperty('fValue', 'integer', GetProp, SetProp);
    AddProperty('Value2', 'integer', GetProp, SetProp);
  end;

  // スクリプトにオブジェクトを登録する。
  fsScript.AddObject('Button', TestButton);

  fsScript.Lines.Assign(Memo1.Text);
  if fsScript.Compile then begin
    fsScript.Execute;
    end else begin
    Memo2.Lines.Add(Format('%s  %s', [fsScript.ErrorMsg, fsScript.ErrorPos]));
  end;
end;

function TForm1.Data_GetValue(Instance: TObject; ClassType: TClass; const MethodName: string; var Params: variant) : variant;
begin
  Result := TData(Instance).fValue1;
end;

function TForm1.GetProp(Instance: TObject; ClassType: TClass; const PropName: String): Variant;
begin
  Result := 0;
  if PropName = 'FVALUE'
  then Result := TData(Instance).fValue1
  else if PropName = 'VALUE2' then Result := TData(Instance).fValue1
end;

procedure TForm1.SetProp(Instance: TObject; ClassType: TClass; const PropName: String; Value: Variant);
begin
  if PropName = 'FVALUE'
  then TData(Instance).fValue1 := Value
  else if PropName = 'VALUE2' then TData(Instance).fValue1 := Value;
end;

Development Blog

2017/11/24

SmartGit から Beyond Compare(3-way Marge) の呼び出し

2014/07/18

TFileStream でファイルを開く場合の例外処理

2014/01/05

ExpressBars - カスタムダイアログのフォント設定(スキン対応)

2013/01/03

FastScript でスクリプトの実行制御

2012/12/28

Pascal Script, FastScript の比較

Pascal Script

FastScript