多层数据库应用基于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;
...

上面的基本实现稍加修改，就可以完善更多的功能，比如设定实例数上限、定时清除超过某个时间未被使用的实例、查询当前池中对象实例数量等。