Pascal Script Examples/es: what changed

Revision 0 to 1. Removed lines have a minus sign; added lines have a plus sign.

Title: Pascal Script Examples/es

New		Line
1	+	``` pascal
2	+	program psce;
3	+	{$APPTYPE CONSOLE}
4	+
5	+	{$IFDEF FPC}
6	+	{$mode delphi}{$H+}
7	+	{$ENDIF}
8	+
9	+	uses
10	+	SysUtils,interfaces,Classes,Forms,uPSCompiler, uPSR_std, uPSC_std, uPSR_classes, uPSC_classes, uPSRuntime,
11	+	uPSComponent,uPSDisassembly,uPSR_dateutils,uPSC_dateutils,uPSC_forms,uPSR_forms,uPSC_controls,uPSR_controls,
12	+	uPSR_dll,uPSC_dll;
13	+
14	+	type
15	+	TPSCE = class
16	+	protected
17	+	FScr: TPSScript;
18	+	procedure SaveCompiled(var Data : String);
19	+	procedure SaveDissasembly(var Data : String);
20	+	procedure OnCompile(Sender: TPSScript);
21	+	procedure OnExecImport(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter);
22	+	public
23	+	constructor Create;
24	+	destructor Destroy; override;
25	+	function Compile(const FileName: string): Boolean;
26	+	function Execute: Boolean;
27	+	end;
28	+
29	+	var
30	+	aPSCE: TPSCE;
31	+	SFile,Data : String;
32	+
33	+	procedure MWritedt(d : TDateTime);
34	+	var
35	+	s : String;
36	+	begin
37	+	s := DateToStr(d) + ' ' + TimeToStr(d);
38	+	Write(s);
39	+	end;
40	+
41	+	procedure MWrites(const s: string);
42	+	begin
43	+	Write(s);
44	+	end;
45	+
46	+	procedure MWritei(const i: Integer);
47	+	begin
48	+	Write(i);
49	+	end;
50	+
51	+	procedure MWrited(const d: Double);
52	+	begin
53	+	Write(d:0:1);
54	+	end;
55	+
56	+	procedure MWriteln;
57	+	begin
58	+	Writeln;
59	+	end;
60	+
61	+	procedure MVal(const s: string; var n, z: Integer);
62	+	begin
63	+	Val(s, n, z);
64	+	end;
65	+
66	+	constructor TPSCE.Create;
67	+	begin
68	+	FScr:=TPSScript.Create(nil);
69	+	FScr.OnCompile:= OnCompile;
70	+	FScr.OnExecImport := OnExecImport;
71	+	end;
72	+
73	+	destructor TPSCE.Destroy;
74	+	begin
75	+	FScr.Free;
76	+	end;
77	+
78	+	procedure TPSCE.SaveCompiled(var Data : String);
79	+	var
80	+	OutFile: string;
81	+	Fx : Longint ;
82	+	begin
83	+	OutFile := ExtractFilePath(ParamStr(0)) + ChangeFileExt(SFile,'.out');
84	+	Fx:= FileCreate(OutFile) ;
85	+	FileWrite(Fx,Data[1],Length(Data));
86	+	FileClose (Fx) ;
87	+	end;
88	+
89	+	procedure TPSCE.SaveDissasembly(var Data : String);
90	+	var
91	+	OutFile: string;
92	+	Fx : Longint ;
93	+	begin
94	+	OutFile := ExtractFilePath(ParamStr(0)) + ChangeFileExt(SFile,'.dis');
95	+	Fx:= FileCreate(OutFile) ;
96	+	FileWrite(Fx,Data[1],Length(Data));
97	+	FileClose (Fx) ;
98	+	end;
99	+
100	+	procedure TPSCE.OnExecImport(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter);
101	+	begin
102	+	RIRegister_Std(x);
103	+	RIRegister_Classes(x,true);
104	+	RIRegister_Forms(x);
105	+	RIRegister_Controls(x);
106	+	RegisterDateTimeLibrary_R(se);
107	+	RegisterDLLRuntime(se);
108	+	end;
109	+
110	+	procedure TPSCE.OnCompile(Sender: TPSScript);
111	+	begin
112	+	RegisterDateTimeLibrary_C(Sender.Comp);
113	+	Sender.AddFunction(@MWrites, 'procedure Writes(const s: string)');
114	+	Sender.AddFunction(@MWritedt,'procedure WriteDT(d : TDateTime)');
115	+	Sender.AddFunction(@MWritei, 'procedure Writei(const i: Integer)');
116	+	Sender.AddFunction(@MWrited, 'procedure Writed(const f: Double)');
117	+	Sender.AddFunction(@MWriteln, 'procedure Writeln');
118	+	Sender.AddFunction(@MVal, 'procedure Val(const s: string; var n, z: Integer)');
119	+	SIRegister_Std(Sender.Comp);
120	+	SIRegister_Classes(Sender.Comp,true);
121	+	SIRegister_Forms(Sender.Comp);
122	+	SIRegister_Controls(Sender.Comp);
123	+	end;
124	+
125	+	function TPSCE.Compile(const FileName: string): Boolean;
126	+	var
127	+	S: TStringList;
128	+	i: Integer;
129	+	begin
130	+	Result:=False;
131	+	if FileExists(FileName) then begin
132	+	S:=TStringList.Create;
133	+	S.LoadFromFile(FileName);
134	+	FScr.Script:=S;
135	+	Result:=FScr.Compile;
136	+	S.Free;
137	+	if not Result then
138	+	if FScr.CompilerMessageCount > 0 then
139	+	for i:=0 to FScr.CompilerMessageCount-1 do
140	+	Writeln(FScr.CompilerErrorToStr(i));
141	+	end else Writeln('Archivo no encontrado: ', FileName);
142	+	end;
143	+
144	+	function TPSCE.Execute: Boolean;
145	+	begin
146	+	Result:=FScr.Execute;
147	+	if not Result then
148	+	Writeln('Run-time error:' + FScr.ExecErrorToString);
149	+	end;
150	+
151	+	begin
152	+	Application.Initialize;
153	+	aPSCE:=TPSCE.Create;
154	+	if ParamCount = 0 then
155	+	begin
156	+	Writeln('Utilización: ', ExtractFileName(ParamStr(0)), ' [--compile\|--dissasembly] <script.pss>');
157	+	Writeln('');
158	+	Writeln('--compile : Guardar el 'bytecode' del programita compilado');
159	+	Writeln('--dissasembly: Guardar el desensamblado del programita');
160	+	Exit;
161	+	end;
162	+
163	+	SFile := ParamStr(1);
164	+	if (ParamStr(1)='--compile') or (ParamStr(1)='--dissasembly') then
165	+	begin
166	+	SFile := ParamStr(2);
167	+	aPSCE.Compile(SFile);
168	+	aPSCE.FScr.GetCompiled(Data);
169	+	if Paramstr(1)='--compile' then aPSCE.SaveCompiled(Data);
170	+	if Paramstr(1)='--dissasembly' then
171	+	begin
172	+	if not IFPS3DataToText(Data,Data) then Writeln('¡No puedo crear el desensamblado!')
173	+	else
174	+	aPSCE.SaveDissasembly(Data);
175	+	end;
176	+	Exit;
177	+	end;
178	+
179	+	aPSCE.Compile(SFile);
180	+	aPSCE.Execute;
181	+	aPSCE.Free;
182	+	end.
183	+	```
184	+
185	+	---
186	+	From the Free Pascal wiki, page "Pascal Script Examples/es", as it stood on 2020-02-23 after a change by Trev, out of the wiki's dump of 2024-05-26. Copyright stays with the author who wrote it, according to the old wiki's [[Licensing]] page. If you have concerns about this material, [message the admin](/wiki-contact).

Back to history