简单的Delphi对象管理器

发布 by 猛禽 需要5分钟读完

《掺和比试》时得到的一个副产品。

原 理很简单，就是创建的对象放到一个池里，暂时不释放，再分配的时候可以重用。对于需要反复大量创建删除同一个类的对象时，或是创建对象成本很高的情况下， 这个东东有一定的作用。另外还弄了一个通用的对象管理，不提供POOL的缓冲，仅提供自动释放，纯粹是为了方便，这个可以不针对特定对象。

使用方法：

uses objmngr;
...
Type
  TDummy = Class(....
    Constructor Create(...);
    Function Init(...) : TDummy;
    ...
  End;
...
Var
  DummyPool : TMObjPool;
...
Function TDummy.Init(...) : TDummy;
Begin
  ...
  Result := Self;
End;
...
// Pool
Var
  om : IMObjPoolManager;
Begin
  om := TMObjPoolManager.Create(DummyPool, 50);
  d1 := (om.New As TDummy).Init(...);  //  Create new dummy object
  ...
End;  //  om and all new dummy objects will be released automatically
...
// Nopool
Var
  om : IMObjManager;
Begin
  om := TMObjManager.Create(50);
  d1 := om.New(TDummy.Create(...)) As TDummy;
  d2 := om.New(TOther.Create(...)) As TOther;
  ...
End; // om and all managed objects will be release automatically
...
Initialization
  DummyPool := TMObjPool.Create(TDummy, 5000);
...
Finallization
  DummyPool.Free;

注意：因为自动创建对象时无法确定构造函数参数，所以只能调用无参数的构造函数，如需初始化对象，则需要再定义一个Init函数供调用。因为Init函数取代了构造函数的功能，所以还需要它返回Self给调用者。

管理单元objmngr.pas源码：

unit objmngr;

{$IFDEF FPC}{$mode objfpc}{$H+}{$ENDIF}


interface


uses
Classes, SysUtils;


Type


TMBucket = Record
Key : TObject;
Value : TObject;
end;


PMBucket = ^TMBucket;


TMHashMap = Class(TObject)
Private
FSize  : Integer;
FItems : Array Of TMBucket;
Protected
Function HashFunc(Key : TObject) : Integer;
Function FindKey(Key : TObject) : Integer;
Function FindEmpty(Key : TObject) : Integer;
Function GetItem(Key : TObject) : TObject;
Public
Constructor Create(ASize : Integer);
Destructor Destroy; Override;


Procedure AddItem(Key, Value : TObject);
Procedure DelItem(Key : TObject);
Function PopItem(Key : TObject) : TObject;

Property Items[Key : TObject] : TObject Read GetItem;



End;


TMStack = Class(TObject)
Private
FData : Array Of TObject;
FTop  : Integer;
Public
Constructor Create(ASize : Integer);
Destructor Destroy; Override;
Procedure Push(AObj : TObject);
Function Pop : TObject;
Function IsEmpty : Boolean;
End;


TMObjPool = Class(TObject)
Private
FMeta  : TClass;
FPool  : Array Of TObject;
FIndex : Integer;
FMap   : TMHashMap;
FFree  : TMStack;
Public
Constructor Create(AMeta : TClass; ASize : Integer);
Destructor Destroy; Override;


Function NewObj : TObject;
Procedure FreeObj(AObj : TObject);



End;


IMObjPoolManager = Interface
    Function New : TObject;
End;


TMObjPoolManager = Class(TInterfacedObject, IMObjPoolManager)
Private
    FPool : TMObjPool;
    FObjs : TMStack;
Public
    Function New : TObject; Overload;


    Constructor Create(APool : TMObjPool; ASize : Integer = 1000);
    Destructor Destroy; Override;
End;


IMObjManager = Interface
    Function New(AObj : TObject) : TObject;
End;


TMObjManager = Class(TInterfacedObject, IMObjManager)
Private
    FObjs : TMStack;
Public
    Function New(AObj : TObject) : TObject; Overload;


    Constructor Create(ASize : Integer = 1000);
    Destructor Destroy; Override;
End;


implementation


{ TMHashMap }


Constructor TMHashMap.Create(ASize : Integer);
Begin
FSize := ASize;
SetLength(FItems, FSize);
FillChar(FItems[0], FSize * SizeOf(TMBucket), 0);
End;


Destructor TMHashMap.Destroy;
Begin
SetLength(FItems, 0);
Inherited;
End;


Function TMHashMap.HashFunc(Key : TObject) : Integer;
Begin
Result := Integer(Key) Mod FSize;
End;


Function TMHashMap.FindKey(Key : TObject) : Integer;
Var
i, n : Integer;
Begin
n := HashFunc(Key);
Result := -1;
If FItems[n].Key = Key Then
Result := n
Else
Begin
i := n;
Repeat
i := (i + 1) Mod FSize;
If FItems[i].Key = Key Then
Begin
Result := i;
Break;
End;
Until i = n;
End;
End;


Function TMHashMap.FindEmpty(Key : TObject) : Integer;
Var
i, n : Integer;
Begin
n := HashFunc(Key);
If Integer(FItems[n].Key) = 0 Then
Result := n
Else
Begin
i := n;
Repeat
i := (i + 1) Mod FSize;
If Integer(FItems[i].Key) = 0 Then
Begin
Result := i;
Exit;
End;
Until i = n;
Raise Exception.Create('Map is full!');
End;
End;


Function TMHashMap.GetItem(Key : TObject) : TObject;
Var
i : Integer;
Begin
i := FindKey(Key);
If i >= 0 Then
Result := FItems[i].Value
Else
Result := Nil;
End;


Procedure TMHashMap.AddItem(Key, Value : TObject);
Var
i : Integer;
Begin
i := FindEmpty(Key);
FItems[i].Key   := Key;
FItems[i].Value := Value;
End;


Procedure TMHashMap.DelItem(Key : TObject);
Var
i : Integer;
Begin
i := FindKey(Key);
If i >= 0 Then
Begin
FItems[i].Key   := TObject(0);
FItems[i].Value := Nil;
End;
End;


Function TMHashMap.PopItem(Key : TObject) : TObject;
Var
i : Integer;
Begin
i := FindKey(Key);
If i >= 0 Then
Begin
Result := FItems[i].Value;
FItems[i].Key   := TObject(0);
FItems[i].Value := Nil;
End
Else
Result := Nil;
End;


{ TMStack }


Constructor TMStack.Create(ASize : Integer);
Begin
SetLength(FData, ASize);
FTop := 0;
end;


Destructor TMStack.Destroy;
Begin
SetLength(FData, 0);
Inherited;
end;


Procedure TMStack.Push(AObj : TObject);
Begin
FData[FTop] := AObj;
Inc(FTop);
If FTop >= Length(FData) Then
Raise Exception.Create('Queue is full!');
end;


Function TMStack.Pop : TObject;
Begin
If FTop = 0 Then
Raise Exception.Create('Queue is empty!');
Dec(FTop);
Result := FData[FTop];
end;


Function TMStack.IsEmpty : Boolean;
Begin
Result := (FTop = 0);
end;


{ TMObjPool }


Constructor TMObjPool.Create(AMeta : TClass; ASize : Integer);
Begin
FMeta  := AMeta;
SetLength(FPool, ASize);
FIndex := 0;
FMap   := TMHashMap.Create(ASize * 4);
FFree  := TMStack.Create(ASize);
End;


Destructor TMObjPool.Destroy;
Var
i : Integer;
Begin
FFree.Free;
FMap.Free;
For i := 0 To FIndex - 1 Do
FPool[i].Free;
Inherited;
End;


Function TMObjPool.NewObj : TObject;
Var
i : Integer;
Begin
If FFree.IsEmpty Then
Begin
Result := FMeta.Create;
FPool[FIndex] := Result;
i := FIndex;
Inc(FIndex);
End
Else
Begin
i := Integer(FFree.Pop);
Result := FPool[i];
End;
FMap.AddItem(Result, TObject(i));
End;


Procedure TMObjPool.FreeObj(AObj : TObject);
Var
i : Integer;
Begin
i := Integer(FMap.PopItem(AObj));
FFree.Push(TObject(i));
End;


{ TMObjPoolManager }


Constructor TMObjPoolManager.Create(APool : TMObjPool; ASize : Integer);
Begin
    FPool := APool;
    FObjs := TMStack.Create(ASize);
End;


Destructor TMObjPoolManager.Destroy;
Begin
    While Not FObjs.IsEmpty Do
        FPool.FreeObj(FObjs.Pop);
    FObjs.Free;
    Inherited;
end;


Function TMObjPoolManager.New : TObject;
Begin
    Result := FPool.NewObj;
    FObjs.Push(Result);
end;


{ TMObjManager }


constructor TMObjManager.Create(ASize: Integer);
begin
    FObjs := TMStack.Create(ASize);
end;


destructor TMObjManager.Destroy;
begin
    While Not FObjs.IsEmpty Do
        FObjs.Pop.Free;
    FObjs.Free;
    Inherited;
end;


function TMObjManager.New(AObj: TObject): TObject;
begin
    FObjs.Push(AObj);
    Result := AObj;
end;


end.

草草写就，应该还有优化的余地。

推送到[go4pro.org]