Club Delphi  
    Paypal   FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > OOP
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Coloboración Paypal con ClubDelphi

 
 
Herramientas Buscar en Tema Desplegado
  #6  
Antiguo 03-08-2010
Avatar de ecfisa
ecfisa ecfisa is offline
Moderador
 
Registrado: dic 2005
Ubicación: Tres Arroyos, Argentina
Posts: 10.508
Poder: 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
 



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
Algunos videos para pasar el rato Faust Humor 3 24-06-2010 05:09:49
¿como programo el puerto serial con delphi + ensamblador? candia ASM y Microcontroladores 11 23-04-2008 08:07:47
¿Como programo un boton Aceptar? Carmen Conexión con bases de datos 9 03-11-2004 22:11:32
En que programo? Caljim Varios 13 09-08-2004 20:32:05


La franja horaria es GMT +2. Ahora son las 00:35:46.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2026, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi