Created
June 7, 2016 08:34
Star
You must be signed in to star a gist
Enity-Component-System ComponentClassID per VMT patching
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
program ClassIDTest1; | |
{$mode delphi} | |
{$apptype console} | |
{$m+} | |
uses Windows,SysUtils,Classes; | |
type PSupraComponentClassNameID=^TSupraComponentClassNameID; | |
TSupraComponentClassNameID=record | |
Name:shortstring; | |
ID:Int32; | |
end; | |
TSupraComponent=class | |
public | |
class function ClassID:longint; | |
class procedure SetClassID(const pID:longint); | |
end; | |
TSupraComponent2=class(TSupraComponent) | |
public | |
end; | |
class function TSupraComponent.ClassID:longint; | |
begin | |
result:=PSupraComponentClassNameID(PVMT(Self)^.vClassName)^.ID; | |
end; | |
class procedure TSupraComponent.SetClassID(const pID:longint); | |
var VMT:PVMT; | |
NewClassName:PSupraComponentClassNameID; | |
{$ifdef windows} | |
OldProtect:longword; | |
{$endif} | |
begin | |
VMT:=PVMT(Self); | |
GetMem(NewClassName,SizeOf(TSupraComponentClassNameID)); | |
NewClassName^.Name:=VMT^.vClassName^; | |
NewClassName^.ID:=pID; | |
{$ifdef windows} | |
OldProtect:=0; | |
if VirtualProtect(pointer(@VMT^.vClassName),SizeOf(VMT^.vClassName),PAGE_EXECUTE_READWRITE,OldProtect) then begin | |
VMT^.vClassName:=pointer(NewClassName); | |
FlushInstructionCache(GetCurrentProcess,pointer(@VMT^.vClassName),SizeOf(VMT^.vClassName)); | |
VirtualProtect(pointer(@VMT^.vClassName),SizeOf(VMT^.vClassName),OldProtect,@OldProtect); | |
end else begin | |
FreeMem(NewClassName); | |
Assert(false,'Ups!'); | |
end; | |
{$else} | |
{$ifdef unix} | |
if fpmprotect(pointer(@VMT^.vClassName),SizeOf(VMT^.vClassName),PROT_READ or PROT_WRITE or PROT_EXEC)=0 then begin | |
VMT^.vClassName:=pointer(NewClassName); | |
fpmprotect(pointer(@VMT^.vClassName),SizeOf(VMT^.vClassName),PROT_READ or PROT_EXEC); | |
end else begin | |
FreeMem(NewClassName); | |
Assert(false,'Ups!'); | |
end; | |
{$else} | |
{$error Unsupported system} | |
{$endif} | |
{$endif} | |
end; | |
type TSupraComponentClass=class of TSupraComponent; | |
var SupraComponentClassIDCounter:Int32=-1; | |
procedure RegisterECSComponent(const ComponentClass:TSupraComponentClass); | |
begin | |
ComponentClass.SetClassID(InterlockedIncrement(SupraComponentClassIDCounter)); | |
end; | |
procedure RegisterECSComponents(const ComponentClasses:array of TSupraComponentClass); | |
var i:Int32; | |
begin | |
for i:=0 to length(ComponentClasses)-1 do begin | |
RegisterECSComponent(ComponentClasses[i]); | |
end; | |
end; | |
var ComponentInstances:array[0..1] of TSupraComponent; | |
begin | |
RegisterECSComponent(TSupraComponent); | |
RegisterECSComponent(TSupraComponent2); | |
writeln(TSupraComponent.ClassName,' has ID ',TSupraComponent.ClassID); | |
writeln(TSupraComponent2.ClassName,' has ID ',TSupraComponent2.ClassID); | |
ComponentInstances[0]:=TSupraComponent.Create; | |
ComponentInstances[1]:=TSupraComponent2.Create; | |
writeln('A instance of ',ComponentInstances[0].ClassName,' has still ID ',ComponentInstances[0].ClassID); | |
writeln('A instance of ',ComponentInstances[1].ClassName,' has still ID ',ComponentInstances[1].ClassID); | |
ComponentInstances[0].Free; | |
ComponentInstances[1].Free; | |
readln; | |
end. |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment