diff --git a/FasmOnDelphi b/FasmOnDelphi index cd49f90..62a5d17 160000 --- a/FasmOnDelphi +++ b/FasmOnDelphi @@ -1 +1 @@ -Subproject commit cd49f90470136a71d91e4339d75f873657679683 +Subproject commit 62a5d170bac13dee90ab1c59ed06f92bef27bb46 diff --git a/Source/RuntimeBuilder.Fasm.pas b/Source/RuntimeBuilder.Fasm.pas index c794304..8c1e9a1 100644 --- a/Source/RuntimeBuilder.Fasm.pas +++ b/Source/RuntimeBuilder.Fasm.pas @@ -2,7 +2,9 @@ unit RuntimeBuilder.Fasm; interface -uses RuntimeBuilder.Types,FasmOnDelphi,System.TypInfo,System.Rtti,winapi.windows; +uses + System.Classes,System.TypInfo,System.IOUtils,System.Rtti,Winapi.Windows, + RuntimeBuilder,FasmOnDelphi; type TRTBFasmCompiler=class(TRTBCompiler) @@ -18,19 +20,20 @@ type function Call(OutType:PTypeInfo;args:TArray;CallType:TRTBCallType=CRTBCallTypeDefault):TValue;override; destructor Destroy;override; end; - TRTBLib=class abstract + TRTBFasmLib=class(TRTBLib) private type TRTBFasmLibFunc=class(TRTBFasmFunc) public - //constructor Create(p:Pointer); - //destructor Destroy;override; + constructor Create(p:Pointer); + destructor Destroy;override; end; private - //function GetFuntion(Name:string):TRTBFunc;virtual;abstract; + filename:string; + Lib:NativeUInt; + function GetFuntion(Name:string):TRTBFunc;override; public - constructor Create(p:Pointer;sb:NativeUInt); - //property Funtion[Name:string]:TRTBFunc read GetFuntion; - //destructor Destroy;override; + constructor Create(Name:string); + destructor Destroy;override; end; protected FText:string; @@ -39,13 +42,16 @@ type public constructor Create(Compiler:TRTBFasmCompiler); function CompilateAsFunc:TRTBFunc;override; - function CompilateAsLib:TRTBLib;virtual;abstract; + function CompilateAsLib:TRTBLib;override; end; + protected + function GetIncLibs():string; public CompilerMem:NativeUInt; MaxSteps:word; + libs:TStringList; constructor Create(FasmPath:String=FasmPath;AsDll:boolean=false); - //function LoadLib(Name:string):TRTBLib; + function LoadLib(Name:string):TRTBLib; function GenNewSrc():TRTBSource;override; end; @@ -85,9 +91,30 @@ VirtualFree(p,sb,MEM_RELEASE); p:=nil; end; -constructor TRTBFasmCompiler.TRTBFasmSource.TRTBLib.Create(p:Pointer;sb:NativeUInt); +constructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmLib.TRTBFasmLibFunc.Create(p:Pointer); begin +Self.p:=p; +end; +destructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmLib.TRTBFasmLibFunc.Destroy; +begin +p:=nil; +end; + +function TRTBFasmCompiler.TRTBFasmSource.TRTBFasmLib.GetFuntion(Name:string):TRTBFunc; +begin +Result:=TRTBFasmLibFunc.Create(GetProcAddress(Lib,pwidechar(Name))); +end; + +constructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmLib.Create(Name:string); +begin +filename:=Name; +Lib:=LoadLibrary(pwidechar(Name)); +end; + +destructor TRTBFasmCompiler.TRTBFasmSource.TRTBFasmLib.Destroy; +begin +FreeLibrary(Lib); end; function TRTBFasmCompiler.TRTBFasmSource.GetText:string; @@ -110,17 +137,46 @@ function TRTBFasmCompiler.TRTBFasmSource.CompilateAsFunc:TRTBFunc; var Res:TFasmResult; begin -Res:=FasmAssemble(Text,(Compiler as TRTBFasmCompiler).CompilerMem,(Compiler as TRTBFasmCompiler).MaxSteps); +Res:=FasmAssemble(Text+(Compiler as TRTBFasmCompiler).GetIncLibs,(Compiler as TRTBFasmCompiler).CompilerMem,(Compiler as TRTBFasmCompiler).MaxSteps); if Res.Error<>FASM_OK then raise Exception.Create(Res.OutStr); Result:=TRTBFasmFunc.Create(Res.OutData,Res.sb); end; +function TRTBFasmCompiler.TRTBFasmSource.CompilateAsLib:TRTBLib; +var + templib:string; + Res:TFasmResult; +begin +templib:=TPath.GetTempFileName; +Res:=FasmAssembleToFile({$IFDEF CPUX64}'format PE64 DLL'{$ELSE}'format PE DLL'{$ENDIF}+ + (Compiler as TRTBFasmCompiler).GetIncLibs+sLineBreak+Text,templib, + (Compiler as TRTBFasmCompiler).CompilerMem,(Compiler as TRTBFasmCompiler).MaxSteps); +if Res.Error<>FASM_OK then + raise Exception.Create(Res.OutStr); +Result:=TRTBFasmLib.Create(templib); +end; + constructor TRTBFasmCompiler.Create(FasmPath:String=FasmPath;AsDll:boolean=false); begin CompilerMem:=1024*1024*16; MaxSteps:=65535; OpenFASM(FasmPath,AsDll); +libs:=TStringList.Create; +end; + +function TRTBFasmCompiler.LoadLib(Name:string):TRTBLib; +begin +libs.Add(Name); +end; + +function TRTBFasmCompiler.GetIncLibs():string; +var + i:integer; +begin +Result:=''; +for i:=0 to libs.count-1 do + Result:=Result+sLineBreak+'include '+#39+libs.Strings[i]+#39; end; function TRTBFasmCompiler.GenNewSrc():TRTBSource; diff --git a/Source/RuntimeBuilder.Types.pas b/Source/RuntimeBuilder.Types.pas deleted file mode 100644 index c1ba087..0000000 --- a/Source/RuntimeBuilder.Types.pas +++ /dev/null @@ -1,84 +0,0 @@ -unit RuntimeBuilder.Types; - -interface - -uses System.TypInfo,System.Rtti; - -const - CRTBCallTypeNil=$0; - CRTBCallTypeRegister=$1; - CRTBCallTypeStdCall=$2; - CRTBCallTypeCdecl=$3; - CRTBCallTypePascal=$4; - CRTBCallTypeSafeCall=$5; - CRTBCallType64Call=$40; - CRTBCallTypeDefault=$80; - -type - TRTBCompiler=class; - - TRTBCallType=CRTBCallTypeNil..CRTBCallTypeDefault; - - TRTBFunc=class abstract - public - function Call(OutType:PTypeInfo;args:TArray;CallType:TRTBCallType=CRTBCallTypeDefault):TValue;virtual;abstract; - end; - - TRTBLib=class abstract - protected - function GetFuntion(Name:string):TRTBFunc;virtual;abstract; - public - property Funtion[Name:string]:TRTBFunc read GetFuntion; - end; - - TRTBSource=class abstract - protected - Compiler:TRTBCompiler; - function GetText:string;virtual;abstract; - procedure SetText(S:string);virtual;abstract; - public - constructor Create(Compiler:TRTBCompiler); - function CompilateAsFunc:TRTBFunc;virtual;abstract; - function CompilateAsLib:TRTBLib;virtual;abstract; - procedure LoadFromFile(&File:string); - procedure SaveToFile(&File:string); - property Text:string read GetText write SetText; - end; - - TRTBCompiler=class abstract - public - function LoadLib(Name:string):TRTBLib;virtual;abstract; - function GenNewSrc():TRTBSource;virtual;abstract; - end; - -implementation - -uses - System.SysUtils,System.Classes; - -constructor TRTBSource.Create(Compiler:TRTBCompiler); -begin -Self.Compiler:=Compiler; -end; - -procedure TRTBSource.LoadFromFile(&File:string); -var - Data:TStrings; -begin -Data:=TStringList.Create; -Data.LoadFromFile(&File); -Text:=Data.Text; -FreeAndNil(Data); -end; - -procedure TRTBSource.SaveToFile(&File:string); -var - Data:TStrings; -begin -Data:=TStringList.Create; -Data.Text:=Text; -Data.SaveToFile(&File); -FreeAndNil(Data); -end; - -end. diff --git a/Source/RuntimeBuilder.pas b/Source/RuntimeBuilder.pas index fbe844d..ac4ea5e 100644 --- a/Source/RuntimeBuilder.pas +++ b/Source/RuntimeBuilder.pas @@ -2,8 +2,83 @@ unit RuntimeBuilder; interface -uses RuntimeBuilder.Types; +uses System.TypInfo,System.Rtti; + +const + CRTBCallTypeNil=$0; + CRTBCallTypeRegister=$1; + CRTBCallTypeStdCall=$2; + CRTBCallTypeCdecl=$3; + CRTBCallTypePascal=$4; + CRTBCallTypeSafeCall=$5; + CRTBCallType64Call=$40; + CRTBCallTypeDefault=$80; + +type + TRTBCompiler=class; + + TRTBCallType=CRTBCallTypeNil..CRTBCallTypeDefault; + + TRTBFunc=class abstract + public + function Call(OutType:PTypeInfo;args:TArray;CallType:TRTBCallType=CRTBCallTypeDefault):TValue;virtual;abstract; + end; + + TRTBLib=class abstract + protected + function GetFuntion(Name:string):TRTBFunc;virtual;abstract; + public + property Funtion[Name:string]:TRTBFunc read GetFuntion; + end; + + TRTBSource=class abstract + protected + Compiler:TRTBCompiler; + function GetText:string;virtual;abstract; + procedure SetText(S:string);virtual;abstract; + public + constructor Create(Compiler:TRTBCompiler); + function CompilateAsFunc:TRTBFunc;virtual;abstract; + function CompilateAsLib:TRTBLib;virtual;abstract; + procedure LoadFromFile(&File:string); + procedure SaveToFile(&File:string); + property Text:string read GetText write SetText; + end; + + TRTBCompiler=class abstract + public + function LoadLib(Name:string):TRTBLib;virtual;abstract; + function GenNewSrc():TRTBSource;virtual;abstract; + end; implementation +uses + System.SysUtils,System.Classes; + +constructor TRTBSource.Create(Compiler:TRTBCompiler); +begin +Self.Compiler:=Compiler; +end; + +procedure TRTBSource.LoadFromFile(&File:string); +var + Data:TStrings; +begin +Data:=TStringList.Create; +Data.LoadFromFile(&File); +Text:=Data.Text; +FreeAndNil(Data); +end; + +procedure TRTBSource.SaveToFile(&File:string); +var + Data:TStrings; +begin +Data:=TStringList.Create; +Data.Text:=Text; +Data.SaveToFile(&File); +FreeAndNil(Data); +end; + end. diff --git a/Tests/Project2.dpr b/Tests/Project2.dpr index 2c3a105..b8232d7 100644 --- a/Tests/Project2.dpr +++ b/Tests/Project2.dpr @@ -13,7 +13,6 @@ uses DUnitX.TestFramework, Unit1 in 'Unit1.pas', RuntimeBuilder in '..\Source\RuntimeBuilder.pas', - RuntimeBuilder.Types in '..\Source\RuntimeBuilder.Types.pas', RuntimeBuilder.Fasm in '..\Source\RuntimeBuilder.Fasm.pas', FasmOnDelphi in '..\FasmOnDelphi\Source\FasmOnDelphi.pas', Fasm4Delphi in '..\FasmOnDelphi\Fasm4Delphi\Source\Fasm4Delphi.pas'; diff --git a/Tests/Project2.dproj b/Tests/Project2.dproj index b004a11..357f874 100644 --- a/Tests/Project2.dproj +++ b/Tests/Project2.dproj @@ -97,7 +97,6 @@ - @@ -457,13 +456,13 @@ 1 - + - + False diff --git a/Tests/Unit1.pas b/Tests/Unit1.pas index e724c44..27b098b 100644 --- a/Tests/Unit1.pas +++ b/Tests/Unit1.pas @@ -3,7 +3,7 @@ unit Unit1; interface uses - System.SysUtils,DUnitX.TestFramework,RuntimeBuilder,RuntimeBuilder.Fasm,RuntimeBuilder.Types; + System.SysUtils,DUnitX.TestFramework,RuntimeBuilder,RuntimeBuilder.Fasm; type [TestFixture] @@ -11,6 +11,8 @@ type public [TestCase] procedure Test1(); + [TestCase] + procedure Test2(); end; implementation @@ -34,6 +36,28 @@ FreeAndNil(Src); FreeAndNil(Fasm); end; +procedure TRuntimeBuilderTestObject.Test2(); +var + Fasm:TRTBFasmCompiler; + Src:TRTBSource; + lib:TRTBLib; + Func1:TRTBFunc; +begin +Fasm:=TRTBFasmCompiler.Create('..\..\..\FasmOnDelphi\fasmw172\fasm'); +Src:=Fasm.GenNewSrc; +Src.LoadFromFile('..\..\testlib.fasm'); +Fasm.LoadLib('W:\RuntimeBuilder\FasmOnDelphi\fasmw172\INCLUDE\win32a.inc'); +lib:=Src.CompilateAsLib; +Func1:=lib.Funtion['MyEcho']; +if 234665<>Func1.Call(TypeInfo(integer),[234665],CRTBCallTypeStdCall).AsInteger then +begin + raise Exception.Create('Error in test2'); +end; +FreeAndNil(Func1); +FreeAndNil(Src); +FreeAndNil(Fasm); +end; + initialization TDUnitX.RegisterTestFixture(TRuntimeBuilderTestObject); end. diff --git a/Tests/testlib.fasm b/Tests/testlib.fasm new file mode 100644 index 0000000..fbc04fe --- /dev/null +++ b/Tests/testlib.fasm @@ -0,0 +1,29 @@ +entry DllEntryPoint + +section '.text' code readable executable + +proc DllEntryPoint hinstDLL,fdwReason,lpvReserved + mov eax,TRUE + ret +endp + +proc MyEcho HWnd + mov eax,[HWnd] + ret +endp + +dd GetLastError + +section '.idata' import data readable writeable + + library kernel,'KERNEL32.DLL' + + import kernel,\ + GetLastError,'GetLastError' + +section '.edata' export data readable + + export '1.DLL',\ + MyEcho,'MyEcho' + +section '.reloc' fixups data readable discardable