hola el problema se me presenta en las clases TFixedConnectionPool y TCleanupThread si ven una necesita de la otra y si las cambio de posicion pasa lo contrario es la otra la que no la reconoce ose ano me la deja declarar por que ????
gracias por la ayuda
Código Delphi
[-]
unit Unit1;
interface
uses
SysUtils, Classes, ADODB, syncobjs, Windows , DB, Dialogs;
type
IConnection = Interface(IInterface)
function Connection: TADOConnection;
function GetRefCount: Integer;
function GetLastAccess: TDateTime;
property LastAccess: TDateTime read GetLastAccess;
property RefCount: Integer read GetRefCount;
end;
type
TDataModule1 = class(TDataModule, IConnection)
private
protected
FRefCount: Integer;
FLastAccess: TDateTime;
CriticalSection: TCriticalSection;
Semaphore: THandle;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
function GetLastAccess: TDateTime;
function GetRefCount: Integer;
public
function Connection: TADOConnection;
end;
TFixedConnectionPool = class(TObject)
private
FPool: array of IConnection;
FPoolSize: Integer;
FTimeout: LargeInt;
CleanupThread: TCleanupThread;
Semaphore: THandle;
CriticalSection: TCriticalSection;
public
constructor Create(const PoolSize: Integer = 10;
const CleanupDelayMinutes: Integer = 5;
const Timeoutms: LargeInt = 10000); overload;
destructor Destroy; override;
function GetConnection: IConnection;
end;
type
TCleanupThread = class(TThread)
private
FCleanupDelay: Integer;
protected
CriticalSection: TCriticalSection;
FixedConnectionPool: TFixedConnectionPool;
procedure Execute; override;
constructor Create(CreateSuspended: Boolean;
const CleanupDelayMinutes: Integer);
end;
var
DataModule1: TDataModule1;
implementation
{$R *.dfm}
function TDataModule1._AddRef: Integer;
begin
CriticalSection.Enter;
try
Inc(FRefCount);
Result := FRefCount;
finally
CriticalSection.Leave;
end;
end;
function TDataModule1._Release: Integer;
begin
CriticalSection.Enter;
try
Dec(FRefCount);
Result := FRefCount;
if Result = 0 then
Destroy
else
Self.FLastAccess := Now;
finally
CriticalSection.Leave;
if FRefCount = 1 then
ReleaseSemaphore(Semaphore, 1, nil);
end;
end;
constructor TFixedConnectionPool.Create(const PoolSize: Integer = 10;
const CleanupDelayMinutes: Integer = 5;
const Timeoutms: LargeInt = 10000);
begin
FPoolSize := PoolSize;
FTimeout := Timeoutms;
Semaphore := CreateSemaphore(nil, PoolSize, PoolSize, '');
CriticalSection := TCriticalSection.Create;
SetLength(FPool, PoolSize);
CleanupThread := TCleanupThread.Create(True, CleanupDelayMinutes);
with CleanupThread do
begin
FreeOnTerminate := True;
Priority := tpLower;
FixedConnectionPool := Self;
Resume;
end;
end;
constructor TCleanupThread.Create(CreateSuspended: Boolean;
const CleanupDelayMinutes: Integer);
begin
inherited Create(True); FCleanupDelay := CleanupDelayMinutes;
if not CreateSuspended then
Resume;
end;
function TFixedConnectionPool.GetConnection: IConnection;
var
i: Integer;
DM: TDataModule1;
WaitResult: Integer;
begin
Result := nil;
WaitResult := WaitForSingleObject(Semaphore, FTimeout);
if WaitResult <> WAIT_OBJECT_0 then
raise EConnPoolException.Create('Connection pool timeout. '+
'Cannot obtain a connection');
CriticalSection.Enter;
try
for i := Low(FPool) to High(FPool) do
begin
if FPool[i] = nil then
begin
DM := TDataModule1.Create(nil);
DM.CriticalSection := Self.CriticalSection;
DM.Semaphore := Self.Semaphore;
FPool[i] := DM;
FPool[i].Connection.Connected := True;
Result := FPool[i];
Exit;
end;
if FPool[i].RefCount = 1 then
begin
Result := FPool[i];
Exit;
end;
end;
finally
CriticalSection.Leave;
end;
end;
destructor TFixedConnectionPool.Destroy;
var
i: Integer;
begin
CleanupThread.Terminate;
CriticalSection.Enter;
try
for i := Low(FPool) to High(FPool) do
FPool[i] := nil;
SetLength(FPool,0);
finally
CriticalSection.Leave;
end;
CriticalSection.Free;
CloseHandle(Semaphore);
inherited;
end;
end.