Pascal Script Examples/es
From Free Pascal wiki
Jump to navigationJump to searchThe printable version is no longer supported and may have rendering errors. Please update your browser bookmarks and please use the default browser print function instead.
│
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.