idscheduleroffiber.pas

photo.163.com 相册下载器 多线程下载

{ $HDR$}
{**********************************************************************}
{ Unit archived using Team Coherence                                   }
{ Team Coherence is Copyright 2002 by Quality Software Components      }
{                                                                      }
{ For further information / comments, visit our WEB site at            }
{ http://www.TeamCoherence.com                                         }
{**********************************************************************}
{}
{ $Log:  56076: IdSchedulerOfFiber.pas
{
    Rev 1.2    6/11/2004 8:40:06 AM  DSiders
  Added "Do not Localize" comments.
}
{
{   Rev 1.1    2004.02.09 9:16:48 PM  czhower
{ Updated to compile and match lib changes.
}
{
{   Rev 1.0    2004.02.03 12:38:58 AM  czhower
{ Move
}
{
{   Rev 1.9    2003.10.24 1:00:06 PM  czhower
{ Name change
}
{
{   Rev 1.8    2003.10.21 12:19:20 AM  czhower
{ TIdTask support and fiber bug fixes.
}
{
{   Rev 1.7    2003.10.19 4:38:34 PM  czhower
{ Updates
}
{
{   Rev 1.6    2003.10.19 2:50:40 PM  czhower
{ Fiber cleanup
}
{
{   Rev 1.5    2003.10.19 1:04:28 PM  czhower
{ Updates
}
{
{   Rev 1.4    2003.10.14 11:17:06 PM  czhower
{ Updates to match core changes.
}
{
{   Rev 1.3    2003.10.11 5:43:48 PM  czhower
{ Chained servers now functional.
}
{
{   Rev 1.2    2003.09.19 10:09:42 PM  czhower
{ Next stage of fiber support in servers.
}
unit IdSchedulerOfFiber;

interface

uses
  Classes,
  IdFiberWeaver, IdTask, IdFiber, IdScheduler, IdYarn;

type
  TIdSchedulerOfFiber = class;

  TIdYarnOfFiber = class(TIdYarn)
  protected
    FFiber: TIdFiberWithTask;
    FScheduler: TIdScheduler;
  public
    constructor Create(
      AScheduler: TIdScheduler;
      AFiber: TIdFiberWithTask
      ); reintroduce; virtual;
    destructor Destroy;
      override;
    //
    property Fiber: TIdFiberWithTask read FFiber;
  end;

  TIdSchedulerOfFiber = class(TIdScheduler)
  protected
    FFiberWeaver: TIdFiberWeaver;
  public
    function AcquireYarn
      : TIdYarn;
      override;
    procedure StartYarn(
      AYarn: TIdYarn;
      ATask: TIdTask
      ); override;
    procedure TerminateYarn(
      AYarn: TIdYarn
      ); override;
  published
    //TODO: Need to add notification for this prop
    //TODO: Dont allow setting while active
    property FiberWeaver: TIdFiberWeaver read FFiberWeaver write FFiberWeaver;
  end;

implementation

uses
  IdGlobal,
  SysUtils;

{ TIdSchedulerOfFiber }

function TIdSchedulerOfFiber.AcquireYarn: TIdYarn;
var
  LFiber: TIdFiberWithTask;
begin
  LFiber := TIdFiberWithTask.Create(nil, nil, Format('%s User', [Name])); {do not localize}
  Result := TIdYarnOfFiber.Create(Self, LFiber);
  ActiveYarns.Add(Result);
end;

procedure TIdSchedulerOfFiber.StartYarn(
  AYarn: TIdYarn;
  ATask: TIdTask
  );
begin
  inherited;
  TIdYarnOfFiber(AYarn).Fiber.Task := ATask;
  // Last - Put it in the queue to be scheduled
  FiberWeaver.Add(TIdYarnOfFiber(AYarn).Fiber);
end;

procedure TIdSchedulerOfFiber.TerminateYarn(AYarn: TIdYarn);
begin
  // Fibers dont "run", so we dont terminate them
  FreeAndNil(AYarn);
end;

{ TIdYarnOfFiber }

constructor TIdYarnOfFiber.Create(
  AScheduler: TIdScheduler;
  AFiber: TIdFiberWithTask
  );
begin
  inherited Create;
  FScheduler := AScheduler;
  FFiber := AFiber;
  AFiber.Yarn := Self;
end;

destructor TIdYarnOfFiber.Destroy;
begin
  FScheduler.ReleaseYarn(Self);
  inherited;
end;

end.