Italian community of Lazarus and Free Pascal

Se vi è mai capitata la necessità di eseguire del codice pascal arbitrario in un vostro eseguibile Free Pascal la soluzione a tale problema si chiama Pascal Script

Questa è il wiki di Lazarus: http://wiki.freepascal.org/Pascal_Script

E' possibile scaricare il pacchetto da SVN al seguente indirizzo http://code.remobjects.com/svn/pascalscript (informazioni più approfondite nel wiki sopramenzionato)

Dopo l'installazione si dovrebbe trovare una nuova tab col nome "Pascal Script".

L'uso di tale oggetto è davvero molto semplice ed intuitivo. Vediamo ora un esempio di come si usa.


unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  StdCtrls, uPSComponent, uPSCompiler, uPSRuntime,

  uPSR_std,
  uPSC_std,
  uPSR_stdctrls,
  uPSC_stdctrls,
  uPSR_forms,
  uPSC_forms,
  uPSC_graphics,
  uPSC_controls,
  uPSC_classes,
  uPSR_graphics,
  uPSR_controls,
  uPSR_classes;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    lblStatus: TLabel;
    ListBox1: TListBox;
    List_Debug: TListBox;
    memScript: TMemo;
    PSScript1: TPSScript;
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure PSScript1Compile(Sender: TPSScript);
    procedure PSScript1CompImport(Sender: TObject; x: TPSPascalCompiler);
    procedure PSScript1ExecImport(Sender: TObject; se: TPSExec;
      x: TPSRuntimeClassImporter);
    procedure PSScript1Execute(Sender: TPSScript);
    procedure EseguiCodicePas();
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
     EseguiCodicePas();
end;

procedure TForm1.EseguiCodicePas();
var
   i: integer;
begin
     List_Debug.Clear;
     PSScript1.Script := memScript.Lines;
     if PSScript1.Compile then
     begin
     if PSScript1.Execute then
        //Edit1.Text:=Self.Caption;
        lblStatus.Caption := 'Esecuzione avvenuta';
     end
     else
     begin
          Edit1.Text:='Errore:';
          for i:=0 to PSScript1.CompilerMessageCount-1 do
              List_Debug.Items.Add(PSScript1.CompilerMessages[i].MessageToString);
          lblStatus.Caption := 'Errorore';
     end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
     Listbox1.Items.LoadFromFile(Application.Location + 'prog.txt');
     Form1.memScript.Lines:=Listbox1.Items;
end;

procedure TForm1.PSScript1Compile(Sender: TPSScript);
begin
  Sender.AddRegisteredVariable('Application', 'TApplication');
  Sender.AddRegisteredVariable('Self', 'TForm');
  Sender.AddRegisteredVariable('Edit', 'TEdit');
end;

procedure TForm1.PSScript1CompImport(Sender: TObject; x: TPSPascalCompiler);
begin
  SIRegister_Std(x);
  SIRegister_Classes(x, true);
  SIRegister_Graphics(x, true);
  SIRegister_Controls(x);
  SIRegister_stdctrls(x);
  SIRegister_Forms(x);
end;

procedure TForm1.PSScript1ExecImport(Sender: TObject; se: TPSExec;
  x: TPSRuntimeClassImporter);
begin
  RIRegister_Std(x);
  RIRegister_Classes(x, True);
  RIRegister_Graphics(x, True);
  RIRegister_Controls(x);
  RIRegister_stdctrls(x);
  RIRegister_Forms(x);
end;

procedure TForm1.PSScript1Execute(Sender: TPSScript);
begin
   PSScript1.SetVarToInstance('APPLICATION', Application);
   PSScript1.SetVarToInstance('SELF', Self);
   PSScript1.SetVarToInstance('Edit', Edit1);
end;

end.


Analizziamo ora alcune parti di questo codice, per esempio queste sono unit che ho aggiunto manualmente al progetto.

  uPSR_std,
  uPSC_std,
  uPSR_stdctrls,
  uPSC_stdctrls,
  uPSR_forms,
  uPSC_forms,
  uPSC_graphics,
  uPSC_controls,
  uPSC_classes,
  uPSR_graphics,
  uPSR_controls,
  uPSR_classes;


Anche il seguente codice va impostato a mano negli eventi dell'oggetto TPSScript di nome PSScript1. Questo va fatto assolutamente per poter ottenere un risultato dello script eseguito run-time all'interno della nostra applicazione principale.


procedure TForm1.PSScript1Compile(Sender: TPSScript);
begin
  Sender.AddRegisteredVariable('Application', 'TApplication');
  Sender.AddRegisteredVariable('Self', 'TForm');
  Sender.AddRegisteredVariable('Edit', 'TEdit');
end;

procedure TForm1.PSScript1CompImport(Sender: TObject; x: TPSPascalCompiler);
begin
  SIRegister_Std(x);
  SIRegister_Classes(x, true);
  SIRegister_Graphics(x, true);
  SIRegister_Controls(x);
  SIRegister_stdctrls(x);
  SIRegister_Forms(x);
end;

procedure TForm1.PSScript1ExecImport(Sender: TObject; se: TPSExec;
  x: TPSRuntimeClassImporter);
begin
  RIRegister_Std(x);
  RIRegister_Classes(x, True);
  RIRegister_Graphics(x, True);
  RIRegister_Controls(x);
  RIRegister_stdctrls(x);
  RIRegister_Forms(x);
end;

procedure TForm1.PSScript1Execute(Sender: TPSScript);
begin
   PSScript1.SetVarToInstance('APPLICATION', Application);
   PSScript1.SetVarToInstance('SELF', Self);
   PSScript1.SetVarToInstance('Edit', Edit1);
end;


Poi arriviamo al cuore dell'esempio, guardare i commenti in maiuscolo nel codice

procedure TForm1.EseguiCodicePas();
var
   i: integer;
begin
     List_Debug.Clear;
     PSScript1.Script := memScript.Lines; {INSERISCO IL CODICE PASCAL NELL'OGGETTO}
     if PSScript1.Compile then {DICO ALL'OGGETTO DI COMPILARE TALE CODICE SORGENTE}
     begin
     if PSScript1.Execute then {ORA DICO ALL'OGGETTO DI ESEGUIRE IL CODICE SORGENTE}
        //Edit1.Text:=Self.Caption;
        lblStatus.Caption := 'Esecuzione avvenuta';
     end
     else
     begin
          Edit1.Text:='Errore:';
          for i:=0 to PSScript1.CompilerMessageCount-1 do
              List_Debug.Items.Add(PSScript1.CompilerMessages[i].MessageToString);
          lblStatus.Caption := 'Errorore';
     end;
end;


Da qui potete scaricare il progetto completo: www.lazaruspascal.it/esempi/ExecuteFPScript.zip