class operator OnesComplement ? o.O

[Stevie]

Nur mal kurz zusammengeschludert:

Delphi-Quellcode:

program RecordFinalizer;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  Generics.Collections,
  SysUtils,
  TypInfo,
  DDetours;

type
  TFinalizer = procedure (Self: Pointer);
  TCopyOperator = procedure (Dest, Source: Pointer);

var
  Finalizers: TDictionary<PTypeInfo,TFinalizer>;
  CopyOperators: TDictionary<PTypeInfo,TCopyOperator>;

type
  TMyRecord = record
  private
    s: string;
  public
    procedure Destroy;
    class procedure Copy(var dest, source: TMyRecord); static;
  end;

{ TMyRecord }

class procedure TMyRecord.Copy(var dest, source: TMyRecord);
begin
  dest.s := 'Copy: ' + source.s;
end;

procedure TMyRecord.Destroy;
begin
  Writeln(s);
  Writeln('TMyRecord.Destroy');
end;

procedure Main;
var
  r, r2: TMyRecord;
begin
  r.s := 'Hello World';
  r2 := r;
end;


function GetFinalizeRecord: Pointer;
asm
  mov @Result, offset System.@FinalizeRecord
end;

function GetCopyRecord: Pointer;
asm
  mov @Result, offset System.@CopyRecord
end;

var
  FinalizeRecord: function(p: Pointer; typeInfo: Pointer): Pointer;
  CopyRecord: procedure (Dest, Source, TypeInfo: Pointer);

function FinalizeRecordHook(p: Pointer; typeInfo: Pointer): Pointer;
var
  finalizer: TFinalizer;
begin
  if Finalizers.TryGetValue(typeInfo, finalizer) then
    finalizer(p);
  if Assigned(FinalizeRecord) then
    Result := FinalizeRecord(p, typeInfo);
end;

procedure CopyRecordHook(Dest, Source, TypeInfo: Pointer);
var
  copyOperator: TCopyOperator;
begin
  if CopyOperators.TryGetValue(TypeInfo, copyOperator) then
    copyOperator(Dest, Source)
  else
    CopyRecord(Dest, Source, TypeInfo);
end;

begin
  Finalizers := TDictionary<PTypeInfo,TFinalizer>.Create;
  Finalizers.Add(TypeInfo(TMyRecord), @TMyRecord.Destroy);

  CopyOperators := TDictionary<PTypeInfo,TCopyOperator>.Create;
  CopyOperators.Add(TypeInfo(TMyRecord), @TMyRecord.Copy);

  FinalizeRecord := InterceptCreate(GetFinalizeRecord, @FinalizeRecordHook);
  CopyRecord := InterceptCreate(GetCopyRecord, @CopyRecordHook);

  try
    Main;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  Readln;
  ReportMemoryLeaksOnShutdown := True;

  InterceptRemove(@FinalizeRecord);
  InterceptRemove(@CopyRecord);
  Finalizers.Free;
  CopyOperators.Free;
end.