[ARHIIV] mängumeistrid
Pole sisse logitud. [Logi sisse ]
Mine lehekülje algusesse
Prinditav versioon | Telli teema e-mailile | Lisa lemmikutesse  
Õpetus: Tekstina kirjutatud koodi laadimine Free Pascali
gmmeiter
GlorY


Liitunud: 28.10.2005
Postitusi: 2032
[EEMAL]




smileo.gif postitati 5.7.2008 09:37 Tsiteeri
Õpetus: Tekstina kirjutatud koodi laadimine Free Pascali



Kui juhtud internetist leidma mõne pika Pascal keelse koodi, ning soovid seda ise katsetada aga juures pole näidet siis on võimalik see kood Pascali laadida Kasutades ainult notepadi.

Mina leitsin esimese asjana googlest selle koodi:

http://wiki.lazarus.freepascal.org/Pascal_Script_Examples


Kood:
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('Usage: ', ExtractFileName(ParamStr(0)), ' [--compile|--dissasembly] <script.pss>');
Writeln('');
Writeln('--compile : Save compiled script bytecode');
Writeln('--dissasembly: Save dissasembly of script');
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('Cannot create dissasembly!')
else
aPSCE.SaveDissasembly(Data);
end;
Exit;
end;


aPSCE.Compile(SFile);
aPSCE.Execute;
aPSCE.Free;
end.


Kokku on selles värgis koos tühikutega 4127 tähemärki.
Paras pikk, ning selle ümber kirjutamine on natukene ebaloogiline.

1. Kopeeri kogu kood.(mitte ühtegi välist tähemärki ega sümbolit)
2. Ava notepad, Kleebi kopeeritud kood sinna sisse.
3. Salvesta kood, koodi nimeks pane näiteks skript.BAK
Fali tüübiks: Kõik failid
Faili kodeeringuks ANSI
4. Kui on BAK failik salvestatud avada uuesti(kui sulgesid) ning vajutada uuesti salvesta nimega..

Nüüd tuleb faili nimeks panna skript.pas
Failitüüp kõik failid ning kodeering ANSI.

NB! Need failid tuleb salvestade kasuta kus asuvad kõik Teie ülejäänud tööd ja projektid.

Kui need on selles kaustas olemas.. kaust on enamasti aadressil: C:\2.2.0\bin\i386-win32

Muidugi.. oleneb kui kasutate FPC vanemat versiooni pole seal ribal kirjas C:FPCvaid siin on mõni muu arvbinja siin mingi muu lõpp, aga kindlasti leiate.

Avamine FPC's File->Open->skript.pas

Proovige järgi.. Pean vabandama.. minu arvuti ja selle skripti koos töö ei sujunud.. minu arvutil jäi midagi puudu.. Aga keegi võiks proovida ja öelda!

[Muudetud: 5-7-2008 gmmeiter]

[Muudetud: 5-7-2008 gmmeiter]


Vaata kasutaja profiili Külasta kasutaja kodulehte Otsi kasutaja postitusi Saada privaatsõnum Vaata kasutaja MSN-i
Herra_Huu
Level 7


Liitunud: 22.1.2008
Postitusi: 335
[EEMAL]




postitati 5.7.2008 12:14 Tsiteeri


ise sa oled notebad =D

Vaata kasutaja profiili Otsi kasutaja postitusi Saada privaatsõnum
gmmeiter
GlorY


Liitunud: 28.10.2005
Postitusi: 2032
[EEMAL]




postitati 5.7.2008 16:10 Tsiteeri


Tsitaat:
Tsitaat: Herra_Huu
ise sa oled notebad =D


Vot olen jah... hakkasin ennem rahus kirjutama ja hirmus kiireks läks kätte.. Eks ma nüüd parandan oma õigekirja ning teen teema nagu ette kujutasin.


Vaata kasutaja profiili Külasta kasutaja kodulehte Otsi kasutaja postitusi Saada privaatsõnum Vaata kasutaja MSN-i

Hetkel loevad seda teemat:
Mitte ühtegi - 1 külaline

Mine lehekülje lõppu





Foorumi algbaas põhineb XMB mootoril, modifitseeritud Valter Pundi poolt
Kodulehekülg on tehtud Valter Pundi poolt vpundi ät gmail punkt komm