Pascal Script Examples/es

│ English (en) │ español (es) │

<delphi> program psce;

{$APPTYPE CONSOLE}

{$IFDEF FPC}
{$mode delphi}{$H+}
{$ENDIF}

uses
  SysUtils,interfaces,Classes,Forms,uPSCompiler, uPSR_std, uPSC_std, uPSR_classes, uPSC_classes, uPSRuntime,
  uPSComponent,uPSDisassembly,uPSR_dateutils,uPSC_dateutils,uPSC_forms,uPSR_forms,uPSC_controls,uPSR_controls,
  uPSR_dll,uPSC_dll;

type
  TPSCE = class
   protected
    FScr: TPSScript;
    procedure SaveCompiled(var Data : String);
    procedure SaveDissasembly(var Data : String);
    procedure OnCompile(Sender: TPSScript);
    procedure OnExecImport(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter);
   public
    constructor Create;
    destructor Destroy; override;
    function Compile(const FileName: string): Boolean;
    function Execute: Boolean;
  end;

var
  aPSCE: TPSCE;
  SFile,Data : String;

procedure MWritedt(d : TDateTime);
var
 s : String;
begin
  s := DateToStr(d) + ' ' + TimeToStr(d);
  Write(s);
end;

procedure MWrites(const s: string);
begin
  Write(s);
end;

procedure MWritei(const i: Integer);
begin
  Write(i);
end;

procedure MWrited(const d: Double);
begin
  Write(d:0:1);
end;

procedure MWriteln;
begin
  Writeln;
end;

procedure MVal(const s: string; var n, z: Integer);
begin
  Val(s, n, z);
end;

constructor TPSCE.Create;
begin
  FScr:=TPSScript.Create(nil);
  FScr.OnCompile:= OnCompile;
  FScr.OnExecImport := OnExecImport;
end;

destructor TPSCE.Destroy;
begin
  FScr.Free;
end;

procedure TPSCE.SaveCompiled(var Data : String);
var
  OutFile: string;
  Fx : Longint ;
begin
  OutFile := ExtractFilePath(ParamStr(0)) + ChangeFileExt(SFile,'.out');
  Fx:= FileCreate(OutFile) ;
  FileWrite(Fx,Data[1],Length(Data));
  FileClose (Fx) ;
end;

procedure TPSCE.SaveDissasembly(var Data : String);
var
  OutFile: string;
  Fx : Longint ;
begin
  OutFile := ExtractFilePath(ParamStr(0)) + ChangeFileExt(SFile,'.dis');
  Fx:= FileCreate(OutFile) ;
  FileWrite(Fx,Data[1],Length(Data));
  FileClose (Fx) ;
end;

procedure TPSCE.OnExecImport(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter);
begin
 RIRegister_Std(x);
 RIRegister_Classes(x,true);
 RIRegister_Forms(x);
 RIRegister_Controls(x);
 RegisterDateTimeLibrary_R(se);
 RegisterDLLRuntime(se);
end;

procedure TPSCE.OnCompile(Sender: TPSScript);
begin
  RegisterDateTimeLibrary_C(Sender.Comp);
  Sender.AddFunction(@MWrites, 'procedure Writes(const s: string)');
  Sender.AddFunction(@MWritedt,'procedure WriteDT(d : TDateTime)');
  Sender.AddFunction(@MWritei, 'procedure Writei(const i: Integer)');
  Sender.AddFunction(@MWrited, 'procedure Writed(const f: Double)');
  Sender.AddFunction(@MWriteln, 'procedure Writeln');
  Sender.AddFunction(@MVal, 'procedure Val(const s: string; var n, z: Integer)');
  SIRegister_Std(Sender.Comp);
  SIRegister_Classes(Sender.Comp,true);
  SIRegister_Forms(Sender.Comp);
  SIRegister_Controls(Sender.Comp);
end;

function TPSCE.Compile(const FileName: string): Boolean;
var
  S: TStringList;
  i: Integer;
begin
  Result:=False;
  if FileExists(FileName) then begin
    S:=TStringList.Create;
    S.LoadFromFile(FileName);
    FScr.Script:=S;
    Result:=FScr.Compile;
    S.Free;
    if not Result then
      if FScr.CompilerMessageCount > 0 then
        for i:=0 to FScr.CompilerMessageCount-1 do
          Writeln(FScr.CompilerErrorToStr(i));
  end else Writeln('File not found: ', FileName);
end;

function TPSCE.Execute: Boolean;
begin
  Result:=FScr.Execute;
  if not Result then
    Writeln('Run-time error:' + FScr.ExecErrorToString);
end;

begin
  Application.Initialize;
  aPSCE:=TPSCE.Create;
  if ParamCount = 0 then 
  begin
    Writeln('Utilización: ', ExtractFileName(ParamStr(0)), ' [--compile|--dissasembly] <script.pss>');
    Writeln();
    Writeln('--compile : Guardar el 'bytecode' del programitia compilado');
    Writeln('--dissasembly: Guardar el desensamblado del programita');
    Exit;
  end;
 
 SFile := ParamStr(1);
 if (ParamStr(1)='--compile') or (ParamStr(1)='--dissasembly') then
  begin
   SFile := ParamStr(2);
   aPSCE.Compile(SFile);
   aPSCE.FScr.GetCompiled(Data);
   if Paramstr(1)='--compile' then aPSCE.SaveCompiled(Data);
   if Paramstr(1)='--dissasembly' then
    begin
     if not IFPS3DataToText(Data,Data) then Writeln('¡No puedo crear el desensamblado!')
   else
    aPSCE.SaveDissasembly(Data);
  end;
 Exit;
end;

 aPSCE.Compile(SFile);
 aPSCE.Execute;
 aPSCE.Free;
end.</delphi>

--Forest 23:00, 22 Oct 2005 (CEST) --Versión española: [User:iskarelectrica|iskarelectrica (jldc)]- julio 2008.