Ver Mensaje Individual
  #6  
Antiguo 03-08-2010
Avatar de ecfisa
ecfisa ecfisa is offline
Moderador
 
Registrado: dic 2005
Ubicación: Tres Arroyos, Argentina
Posts: 10.508
Reputación: 38
ecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to behold
Hola de nuevo Julyus.

Aca esta el código no me dá errores (de compilación).
Lo reestructuré un poco para mayor legibilidad, no probé la ejecución.
En el código está la línea (1) que soluciona la referencia cruzada entre las clases FixedConnectionPool y TCleanupThread.

Código:
unit Unit2;

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;

  TFixedConnectionPool = class;  //  (1)   * LINEA ADICIONADA *

  TCleanupThread = class(TThread)
  private
    FCleanupDelay: Integer;
  protected
    CriticalSection: TCriticalSection;
    FixedConnectionPool: TFixedConnectionPool;
    procedure Execute; override;  { FALTABA IMPLEMENTAR }
    constructor Create(CreateSuspended: Boolean;
    const CleanupDelayMinutes: Integer);
  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;

  TDataModule2 = class(TDataModule, IConnection)
  private
  protected
    FRefCount: Integer;
    FLastAccess: TDateTime;
    CriticalSection: TCriticalSection;
    Semaphore: THandle;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    {IConnection methods}
    function GetLastAccess: TDateTime;   { FALTABA IMPLEMENTAR }
    function GetRefCount: Integer;       { FALTABA IMPLEMENTAR }
  public
    function Connection: TADOConnection; { FALTABA IMPLEMENTAR }
  end;

var
  DataModule2: TDataModule2;

implementation {$R *.dfm}

function TDataModule2.Connection: TADOConnection;
begin
  // IMPLEMENTAR
end;

function TDataModule2.GetLastAccess: TDateTime;
begin
  // IMPLEMENTAR
end;

function TDataModule2.GetRefCount: Integer;
begin
  // IMPLEMENTAR
end;

function TDataModule2._AddRef: Integer;
begin
  CriticalSection.Enter;
  try
   Inc(FRefCount);
   Result := FRefCount;
  finally
   CriticalSection.Leave;
  end;
end;

function TDataModule2._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
  // always create suspended
  inherited Create(True); // always create suspended
  FCleanupDelay := CleanupDelayMinutes;
  //Resume if not created suspended
  if not CreateSuspended then
    Resume;
end;

function TFixedConnectionPool.GetConnection: IConnection;
var
  i: Integer;
  DM: TDataModule2;
  WaitResult: Integer;
begin
Result := nil;
WaitResult := WaitForSingleObject(Semaphore, FTimeout);
if WaitResult <> WAIT_OBJECT_0 then
  raise Exception.Create('Connection pool timeout. '+  // EConnPoolException: Identificador desconocido
    'Cannot obtain a connection');                     // reemplazo por Exeption
CriticalSection.Enter;
try
  for i := Low(FPool) to High(FPool) do
    begin
      if FPool[i] = nil then
        begin
          DM := TDataModule2.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
  //Free any remaining connections
  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;
  //Release the semaphore
  CloseHandle(Semaphore);
  inherited;
end;

procedure TCleanupThread.Execute;
begin
  inherited;
  // IMPLEMENTAR
end;

end.
Saludos.
__________________
Daniel Didriksen

Guía de estilo - Uso de las etiquetas - La otra guía de estilo ....

Última edición por ecfisa fecha: 03-08-2010 a las 20:12:45.
Responder Con Cita