多層資料庫應用基於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;