本文整理自网络，侵删。
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.
相关阅读 >>
Delphi tdirectory.tfilterpredicate
更多相关阅读请进入《Delphi》频道 >>
