- 001
- 002
- 003
- 004
- 005
- 006
- 007
- 008
- 009
- 010
- 011
- 012
- 013
- 014
- 015
- 016
- 017
- 018
- 019
- 020
- 021
- 022
- 023
- 024
- 025
- 026
- 027
- 028
- 029
- 030
- 031
- 032
- 033
- 034
- 035
- 036
- 037
- 038
- 039
- 040
- 041
- 042
- 043
- 044
- 045
- 046
- 047
- 048
- 049
- 050
- 051
- 052
- 053
- 054
- 055
- 056
- 057
- 058
- 059
- 060
- 061
- 062
- 063
- 064
- 065
- 066
- 067
- 068
- 069
- 070
- 071
- 072
- 073
- 074
- 075
- 076
- 077
- 078
- 079
- 080
- 081
- 082
- 083
- 084
- 085
- 086
- 087
- 088
- 089
- 090
- 091
- 092
- 093
- 094
- 095
- 096
- 097
- 098
- 099
- 100
// к говнокоду 7101:
interface
type TObjectAuto = class;
TSmartPtr = packed record
data: TObjectAuto;
end;
TSmartPtrA = array of TSmartPtr;
//-------------------------------------------------------------------------------------------
// класс с "авто"-деструктором
TObjectAuto = class(TObject)
n: integer; // для тестов
constructor Create(var ptr: TSmartPtrA);
destructor Destroy(); override;
end;
implementation
uses Windows;
var winheap: Cardinal;
var savedlinks: array of integer; // в тестовом примере сойдет, а вообще надо хеш-таблицу
//-------------------------------------------------------------------------------------------
constructor TObjectAuto.Create(var ptr: TSmartPtrA);
begin
inherited Create();
SetLength(ptr, 1);
ptr[0].data := self;
// сохраняем адрес выделенной памяти под массив (у него еще есть длина и счетчик ссылок)
SetLength(savedlinks, Length(savedlinks) + 1);
savedlinks[Length(savedlinks) - 1] := integer(ptr) - 2 * sizeof(integer);
end;
//-------------------------------------------------------------------------------------------
destructor TObjectAuto.Destroy();
begin
n := 0; // сюда брякпойнт поставим:)
inherited;
end;
//-------------------------------------------------------------------------------------------
function WinGetMem(Size: Integer): Pointer;
begin
Result := HeapAlloc(winheap, 0, Size);
end;
//-------------------------------------------------------------------------------------------
function WinFreeMem(P: Pointer): Integer;
var i, j: integer;
begin
// ищем адрес освобождаемой памяти среди сохраненных
i := 0; j := 0; while(i < Length(savedlinks))do begin
// если нашли, то вызываем "авто"-деструктор
if (savedlinks[i] = integer(P)) then
TSmartPtrA(integer(p) + 2 * sizeof(integer))[0].data.Free()
else begin
savedlinks[j] := savedlinks[i];
inc(j);
end;
inc(i);
end;
SetLength(savedlinks, j);
HeapFree(winheap, 0, P);
Result := 0;
end;
//-------------------------------------------------------------------------------------------
function WinReallocMem(P: Pointer; Size: Integer): Pointer;
begin
Result := HeapReAlloc(winheap, 0, P, Size);
end;
//-------------------------------------------------------------------------------------------
var winmem: TMemoryManager = (
GetMem: WinGetMem;
FreeMem: WinFreeMem;
ReallocMem: WinReallocMem);
oldmem: TMemoryManager;
//-------------------------------------------------------------------------------------------
initialization
begin
winheap := GetProcessHeap();
GetMemoryManager(oldmem);
SetMemoryManager(winmem);
SetLength(savedlinks, 0);
end;
//-------------------------------------------------------------------------------------------
finalization
begin
SetLength(savedlinks, 0);
SetMemoryManager(oldmem);
end;
//-------------------------------------------------------------------------------------------
end.
// пример использования:
procedure TfrmTest.Button1Click(Sender: TObject);
var ptr: TSmartPtrA;
obj: TObjectAuto;
begin
obj := TObjectAuto.Create(ptr);
obj.n := 222; // ptr[0].data.n := 222;
// тут obj удалится сам
end;
Follow us!