多层数据库应用基于Delphi DataSnap方法调用的实现对象池技术

之前说到中间层通过向客户端暴露方法的方式提供服务，实现数据库数据的读取和更新。方法调用的方式，其潜在的意义，就是说中间层不保存客户端状态信息，就像WEB服务一样，客户端需要自己保存自己的状态信息。进一步说，就是中间层具体提供方法的业务对象实例，不是也不应该专属于某个客户端，它应该能够为不同的客户端调用提供服务。如果我们把业务对象实例放到对象池中集中存放，调用方法时随用随取，方法结束即放回池中。这样就可以实现业务对象实例服务于不同的客户端调用请求。更重要的是，利用对象池，能够最大化服务器各种资源的使用效率，而且对客户端的响应也更快了，因为业务对象实例早就创建好了，取来即用。

其实，DataSnap构架，已经为我们的这种构想提供了现实支持。简单的说，就是改造工厂类（TDSServerClass），把LifeCycle属性改为Invocation方式；在OnCreateInstance事件中从对象池中取业务类对象实例；在OnDestroyInstance事件中把业务类对象实例放回对象池。

...
procedure TsmMainForm.dssMethodsCreateInstance(
DSCreateInstanceEventObject: TDSCreateInstanceEventObject);
begin
DSCreateInstanceEventObject.ServerClassInstance := ServerMethodsPool.LockPoolObject;
end;

procedure TsmMainForm.dssMethodsDestroyInstance(
DSDestroyInstanceEventObject: TDSDestroyInstanceEventObject);
begin
ServerMethodsPool.UnlockPoolObject(TPersistent(DSDestroyInstanceEventObject.ServerClassInstance));
end;
...
当然，还有对象池类的创建和释放，也很简单，例如：
procedure TsmMainForm.FormCreate(Sender: TObject);
begin
ServerMethodsPool := ObjPoolMgr.TPoolManager.Create;
ServerMethodsPool.InstanceClass := uServerMethods.TPooledDM;
end;

procedure TsmMainForm.FormDestroy(Sender: TObject);
begin
ServerMethodsPool.Free;
end;

下面就是如何实现对象池技术的问题。实现对象池并不复杂，另有两个问题需要注意：

１、多线程。中间层TDSTCPServerTransport对象提供的是多线程服务，允许同时有多个客户端请求。所以对象池类的实现，要考虑多线程情况下公共对象或变量的访问冲突问题。

２、内存泄漏。业务类的基类，采用TDataModule、TComponent或者TPersistent都可以，但不要采用TDSServerModule，因为若采用此基类，TDSServerClass在Invocation方式下会产生内存泄漏。

下面是对象池类最基本的实现代码：

unit ObjPoolMgr;

interface

uses
Classes, SyncObjs, SysUtils, DSServer, DateUtils;

type

PServerObject = ^TServerObject;
TServerObject = record
ServerObject: TPersistent;
InUse: Boolean;
end;

TPoolManager = class
private
FCriticalSection: TCriticalSection;
FServerObjects: TList;
private
FInstanceClass: TPersistentClass;
function CreateNewInstance: TPersistent; inline;
procedure SetInstanceClass(const Value: TPersistentClass);
public
constructor Create;
destructor Destroy; override;
//从对象池中取出一个业务类实例对象
function LockPoolObject: TPersistent;
//把一个业务类实例对象放回对象池中
procedure UnlockPoolObject(var Value: TPersistent);
public
//指定放入池中的业务类。
property InstanceClass: TPersistentClass read FInstanceClass write SetInstanceClass;
end;

implementation

constructor TPoolManager.Create;
begin
FServerObjects := TList.Create;
FCriticalSection := TCriticalSection.Create;
end;

destructor TPoolManager.Destroy;
var
I: Integer;
begin
for I := 0 to FServerObjects.Count - 1 do
begin
PServerObject(FServerObjects[i]).ServerObject.Free;
FreeMem(PServerObject(FServerObjects[i]));
end;
FServerObjects.Free;
FCriticalSection.Free;
inherited Destroy;
end;

procedure TPoolManager.SetInstanceClass(const Value: TPersistentClass);
begin
FInstanceClass := Value;
end;

function TPoolManager.CreateNewInstance: TPersistent;
var
p: PServerObject;
Component: TComponent;
begin
if not Assigned(FInstanceClass) then Raise Exception.Create('Not specify class of instance!');

FCriticalSection.Enter;
try
if FInstanceClass.InheritsFrom(TComponent) then
begin
Component := FInstanceClass.NewInstance as TComponent;
Component.Create(nil);
Result := Component;
end
else
Result := FInstanceClass.Create;

New(p);
p.ServerObject := Result;
p.InUse := True;
FServerObjects.Add(p);
finally
FCriticalSection.Leave;
end;
end;

function TPoolManager.LockPoolObject: TPersistent;
var
i: Integer;
begin
FCriticalSection.Enter;
try
for i := 0 to FServerObjects.Count - 1 do
begin
if not PServerObject(FServerObjects[I]).InUse then
begin
PServerObject(FServerObjects[I]).InUse := True;
Result := PServerObject(FServerObjects[i]).ServerObject;
Exit;
end;
end;
finally
FCriticalSection.Leave;
end;
Result := CreateNewInstance;
end;

procedure TPoolManager.UnlockPoolObject(var Value: TPersistent);
var
i: Integer;
begin
FCriticalSection.Enter;
try
for i := 0 to FServerObjects.Count - 1 do
begin
if Value = PServerObject(FServerObjects[i]).ServerObject then
begin
PServerObject(FServerObjects[i]).InUse := False;
Value := nil;
Break;
end;
end;
finally
FCriticalSection.Leave;
end;
end;
...