Pascal Script Examples/es

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

 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('Archivo no encontrado: ', 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 programita 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.