DataSnap Server 对像池 .

首先要解释下对像生存期(LifeCycle)

  'Server'          对像在Server运行过程中全局存在, 对像的类成员变量都是线程不安全的, 多个客户连接都是共用它的

  'Session'        对像在一个客户连接时建立/断开时释放, 类成员变量都是线程安全的, 全局变量仍然是线程不安全的

  'Invocation'   对像在每个客户请求时建立(远程方法)/完成时释放, 线程安全性跟 'Session' 相同

用到数据库存的服务,几乎是费话,所有的中间件不用数据库的也找不出几个.

进入正题, 向导产生的 DataModule 每个都有一个连接, 连接的生存期跟远程对像相同

当开发中用到几个'Session'生存期的远程对像时, 问题产生了, 一个连接上的用户用到了几个数据库连接, 这是完全没有必要的, 大部分连接都是发呆的. 而'Invocation'每次建立数据库连接的开销是很大的,不可能都用它

这里(http://www.delphifeeds.com/go/s/74909 )提供了一种办法让用户连接的所有对像共享一个数据库连接

但, 相对于计算机的速度来说, 用户的行为仍然是长时间发呆的, 需要一种办法,当用户需要时分配一个数据库连接

对像池实现

{ TObjectPool }

  TObjectPool = class
  private type

    TPoolItem = class
    private
      Instance: TObject;
      Locked: Boolean;
    public
      constructor Create(AInstance: TObject);
      destructor Destroy; override;
    end;
  strict private
    FCachedList: TThreadList;

    // 缓冲池大小

    FCacheSize: Cardinal;

    // 缓冲池命中次数
    FCacheHit: Int64;   

    // 创建对像次数       
    FCreationCount: Int64; 

    // 收集的对像类
    FObjectClass: TClass; 

    // 请求次数  
    FRequestCount: Int64; 
  protected
    function CreateObject: TObject;
  public
    constructor Create(AClass: TClass);
    destructor Destroy; override;

    function LockObject: TObject;
    procedure UnlockObject(Instance: TObject);

    property ObjectClass: TClass read FObjectClass;
    property CacheSize: Cardinal read FCacheSize write FCacheSize default 10;
    property CacheHit: Int64 read FCacheHit write FCacheHit;
    property CreationCount: Int64 read FCreationCount;
    property RequestCount: Int64 read FRequestCount;
  end;

  { TObjectPool<T> }

  TObjectPool<T: class> = class(TObjectPool)
  public
    constructor Create;

    function LockObject: T;
  end;

implementation

{ TObjectPool.TPoolItem }

constructor TObjectPool.TPoolItem.Create(AInstance: TObject);
begin
  inherited Create;

  Assert(Assigned(AInstance));
  Instance := AInstance;
  Locked := False;
end;

destructor TObjectPool.TPoolItem.Destroy;
begin
  if Assigned(Instance) then Instance.Free;

  inherited;
end;

{ TObjectPool }

constructor TObjectPool.Create(AClass: TClass);
begin
  inherited Create;

  FObjectClass := AClass;
  FCachedList := TThreadList.Create;
  FCacheSize := 10;
end;

function TObjectPool.CreateObject: TObject;
begin
  Result := FObjectClass.NewInstance;
  if Result is TComponent then      // virtual constructor begins
    TComponent(Result).Create(nil)
  else if Result is TPersistent then
    TPersistent(Result).Create
  else Result.Create;
end;

destructor TObjectPool.Destroy;
var
  I: Integer;
  LockedList: TList;
begin
  if Assigned(FCachedList) then
  begin
    LockedList := FCachedList.LockList;
    try
      for I := 0 to LockedList.Count - 1 do
        TPoolItem(LockedList[I]).Free;
    finally
      FCachedList.Free;
    end;
  end;

  inherited;
end;

function TObjectPool.LockObject: TObject;
var
  LockedList: TList;
  I: Integer;
begin
  Result := nil;

  LockedList := FCachedList.LockList;
  try
    Inc(FRequestCount);

    for i := 0 to LockedList.Count - 1 do
    begin
      if not TPoolItem(LockedList[i]).Locked then
      begin
        Result := TPoolItem(LockedList[i]).Instance;
        TPoolItem(LockedList[i]).Locked := True;
        Inc(FCacheHit);
        Break;
      end;
    end;

    if Result = nil then
    begin
      Result := CreateObject;
      Inc(FCreationCount);

      if FCacheSize > Cardinal(LockedList.Count) then
        LockedList.Add(TPoolItem.Create(Result));
    end;
  finally
    FCachedList.UnlockList;
  end;
end;

procedure TObjectPool.UnlockObject(Instance: TObject);
var
  LockedList: TList;
  I: Integer;
  Item: TPoolItem;
begin
  LockedList := FCachedList.LockList;
  try
    Item := nil;
    for i := 0 to LockedList.Count - 1 do
    begin
      Item := TPoolItem(LockedList[i]);
      if Item.Instance = TObject(Instance) then
      begin
        Item.Locked := False;
        Break;
      end
    end;

    if not Assigned(Item) then Instance.Free;
  finally
    FCachedList.UnlockList;
  end;
end;

{ TObjectPool<T> }

constructor TObjectPool<T>.Create;
begin
  inherited Create(T);
end;

function TObjectPool<T>.LockObject: T;
begin
  Result := T(inherited LockObject);
end;