delphi 数据模块池

unit untDMPool;
 
interface
 
uses
 Classes, SyncObjs, SysUtils,
 DateUtils, untData;
 
type
 
PServerObject = ^TServerObject;
 
TServerObject = record
 ServerObject: TdmData;
 InUse: Boolean;
 end;
 
TDMPool = class
 private
 FCriticalSection: TCriticalSection;
 FServerObjects: TList;
 FPoolSize: integer;
 
public
 constructor Create; overload;
 destructor Destroy; override;
 function Lock: TdmData;
 procedure Unlock(Value: TdmData);
 procedure Init;
 property PoolSize: integer read FPoolSize write FPoolSize;
 end;
 
var
 G_DMPool: TDMPool;
 
implementation
Uses
 untCommonFun;
 
constructor TDMPool.Create;
begin
 FPoolSize := 20;
 FServerObjects := TList.Create;
 FCriticalSection := TCriticalSection.Create;
end;
 
destructor TDMPool.Destroy;
begin
 while FServerObjects.Count > 0 do
 begin
 PServerObject(FServerObjects[0])^.ServerObject.Free;
 Dispose(PServerObject(FServerObjects[0]));
 FServerObjects.Delete(0);
 end;
 FreeAndNil(FServerObjects);
 FreeAndNil(FCriticalSection);
 inherited Destroy;
end;
 
procedure TDMPool.Init;
var
 i: integer;
 p: PServerObject;
begin
 if not Assigned(FServerObjects) then exit;
 try
 for i := 1 to FPoolSize do
 begin
 New(p);
 if Assigned(p) then
 begin
 p^.ServerObject := TdmData.Create(nil);
 p^.InUse := False;
 FServerObjects.Add(p);
 end;
 end;
 except
 On E:Exception do
 begin
 SysLog.WriteLog(e.Message);
 Exit;
 end;
 end;
end;
 
function TDMPool.Lock: TdmData;
var
 i: integer;
 bFound: Boolean;
begin
 Result := nil;
 try
 FCriticalSection.Enter;
 try
 bFound := False;
 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;
 bFound := True;
 Break;
 end;
 end;
 if (FServerObjects.Count = PoolSize) and (not bFound) then
 begin
 Result := TdmData.Create(nil);
 Result.tag := 5;
 end;
 finally
 FCriticalSection.Leave;
 end;
 except
 on e:Exception do
 begin
 SysLog.WriteLog(e.Message);
 Exit;
 end;
 end;
end;
 
procedure TDMPool.Unlock(Value: TdmData);
var
 i: integer;
begin
 if not Assigned(Value) then
 exit;
 try
 FCriticalSection.Enter;
 try
 if Value.tag = 5 then
 begin
 FreeAndNil(Value);
 end
 else
 begin
 for i := 0 to FServerObjects.Count - 1 do
 begin
 if Value = PServerObject(FServerObjects[i])^.ServerObject then
 begin
 PServerObject(FServerObjects[i])^.InUse := False;
 Break;
 end;
 end;
 end;
 finally
 FCriticalSection.Leave;
 end;
 except
 On E:Exception do
 begin
 SysLog.WriteLog(e.Message);
 Exit;
 end;
 end;
end;
 
end.