idtcpserver.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:  12002: IdTCPServer.pas
{
{   Rev 1.66    10/8/2004 10:11:02 PM  BGooijen
{ uncommented intercept code
}
{
{   Rev 1.65    2004.08.13 10:55:38  czhower
{ Removed IFDEF
}
{
{   Rev 1.64    08.08.2004 10:43:10  OMonien
{ temporary Thread.priority fix for Kylix
}
{
{   Rev 1.63    6/11/2004 12:41:52 PM  JPMugaas
{ Reuse Address now reenabled.
}
{
    Rev 1.62    6/1/2004 1:22:28 PM  DSiders
  Added TODO for TerminateWaitTimeout.
}
{
{   Rev 1.61    28/04/2004 15:54:40  HHariri
{ Changed thread priority for scheduler
}
{
{   Rev 1.60    2004.04.22 11:44:48 PM  czhower
{ Boosted thread priority of listener thread.
}
{
{   Rev 1.59    2004.03.06 10:40:34 PM  czhower
{ Changed IOHandler management to fix bug in server shutdowns.
}
{
{   Rev 1.58    2004.03.01 5:12:40 PM  czhower
{ -Bug fix for shutdown of servers when connections still existed (AV)
{ -Implicit HELP support in CMDserver
{ -Several command handler bugs
{ -Additional command handler functionality.
}
{
{   Rev 1.57    2004.02.03 4:16:56 PM  czhower
{ For unit name changes.
}
{
{   Rev 1.56    2004.01.20 10:03:36 PM  czhower
{ InitComponent
}
{
{   Rev 1.55    1/3/2004 11:49:30 PM  BGooijen
{ the server creates a default binding for IPv6 now too, if IPv6 is supported
}
{
{   Rev 1.54    2003.12.28 8:04:54 PM  czhower
{ Shutdown fix for .net.
}
{
{   Rev 1.53    2003.11.29 6:03:46 PM  czhower
{ Active = True now works when set at design time.
}
{
{   Rev 1.52    2003.10.21 12:19:02 AM  czhower
{ TIdTask support and fiber bug fixes.
}
{
{   Rev 1.51    2003.10.18 9:33:30 PM  czhower
{ Boatload of bug fixes to command handlers.
}
{
{   Rev 1.50    2003.10.18 8:04:28 PM  czhower
{ Fixed bug with setting active at design time.
}
{
    Rev 1.49    10/15/2003 11:10:00 PM  DSiders
  Added localization comments.
  Added resource srting for exception raised in TIdTCPServer.SetScheduler.
}
{
{   Rev 1.48    2003.10.15 4:34:38 PM  czhower
{ Bug fix for shutdown.
}
{
{   Rev 1.47    2003.10.14 11:18:12 PM  czhower
{ Fix for AV on shutdown and other bugs
}
{
{   Rev 1.46    2003.10.11 5:51:38 PM  czhower
{ -VCL fixes for servers
{ -Chain suport for servers (Super core)
{ -Scheduler upgrades
{ -Full yarn support
}
{
{   Rev 1.45    10/5/2003 9:55:26 PM  BGooijen
{ TIdTCPServer works on D7 and DotNet now
}
{
{   Rev 1.44    10/5/2003 03:07:48 AM  JPMugaas
{ Should compile.
}
{
{   Rev 1.43    2003.10.01 9:11:28 PM  czhower
{ .Net
}
{
{   Rev 1.42    2003.09.30 1:23:08 PM  czhower
{ Stack split for DotNet
}
{
{   Rev 1.41    2003.09.19 10:11:22 PM  czhower
{ Next stage of fiber support in servers.
}
{
{   Rev 1.40    2003.09.19 11:54:34 AM  czhower
{ -Completed more features necessary for servers
{ -Fixed some bugs
}
{
{   Rev 1.39    2003.09.18 4:43:18 PM  czhower
{ -Removed IdBaseThread
{ -Threads now have default names
}
{
    Rev 1.37    7/6/2003 8:04:10 PM  BGooijen
  Renamed IdScheduler* to IdSchedulerOf*
}
{
{   Rev 1.36    2003.06.30 9:41:06 PM  czhower
{ Fix for AV during server shut down.
}
{
    Rev 1.35    6/25/2003 3:57:58 PM  BGooijen
  Disconnecting the context is now inside try...except
}
{
    Rev 1.34    6/8/2003 2:13:02 PM  BGooijen
  Made ContextClass public
}
{
    Rev 1.33    6/5/2003 12:43:26 PM  BGooijen
  changed short circuit fix code
}
{
{   Rev 1.32    2003.06.04 10:14:08 AM  czhower
{ Removed short circuit dependency and fixed some older irrelevant code.
}
{
    Rev 1.31    6/3/2003 11:49:38 PM  BGooijen
  removed AV in TIdTCPServer.DoExecute (hopefully)
}
{
{   Rev 1.30    5/26/2003 04:29:58 PM  JPMugaas
{ Removed GenerateReply and ParseReply.  Those are now obsolete duplicate
{ functions in the new design.
}
{
{   Rev 1.29    2003.05.26 10:35:26 PM  czhower
{ Fixed spelling typo.
}
{
{   Rev 1.28    5/26/2003 12:20:00 PM  JPMugaas
}
{
{   Rev 1.27    2003.05.26 11:38:22 AM  czhower
}
{
{   Rev 1.26    5/25/2003 03:38:04 AM  JPMugaas
}
{
{   Rev 1.25    5/25/2003 03:26:38 AM  JPMugaas
}
{
    Rev 1.24    5/20/2003 12:43:52 AM  BGooijen
  changeable reply types
}
{
    Rev 1.23    5/13/2003 2:56:40 PM  BGooijen
  changed GetGreating to SendGreeting
}
{
    Rev 1.21    4/4/2003 8:09:46 PM  BGooijen
  moved some consts tidcmdtcpserver, changed DoExecute to return
  .connection.connected
}
{
    Rev 1.20    3/25/2003 9:04:06 PM  BGooijen
  Scheduler in IOHandler is now updated when the scheduler is removed
}
{
    Rev 1.19    3/23/2003 11:33:34 PM  BGooijen
  Updates the scheduler in the iohandler when scheduler/iohandler is changed
}
{
    Rev 1.18    3/22/2003 11:44:08 PM  BGooijen
  ServerIntercept now logs connects/disconnects
}
{
    Rev 1.17    3/22/2003 1:46:02 PM  BGooijen
  Better handling of exceptions in TIdListenerThread.Run (could cause mem leaks
  first (in non-paged-memory))
}
{
    Rev 1.16    3/21/2003 5:55:54 PM  BGooijen
  Added code for serverIntercept
}
{
{   Rev 1.15    3/21/2003 11:44:00 AM  JPMugaas
{ Updated with a OnBeforeConnect event for the TIdMappedPort components.
}
{
    Rev 1.14    3/20/2003 12:18:32 PM  BGooijen
  Moved ReplyExceptionCode from TIdTCPServer to TIdCmdTCPServer
}
{
    Rev 1.13    3/13/2003 10:18:26 AM  BGooijen
  Server side fibers, bug fixes
}
{
{   Rev 1.12    2003.02.18 5:52:16 PM  czhower
{ Fix for warnings and logic error.
}
{
    Rev 1.11    1/23/2003 8:33:16 PM  BGooijen
}
{
    Rev 1.10    1/23/2003 11:05:48 AM  BGooijen
}
{
    Rev 1.9    1/20/2003 12:50:44 PM  BGooijen
  Added a Contexts propperty, which contains all contexts for that server
  Moved the commandhandlers to TIdCmdTCPServer
}
{
{   Rev 1.8    1-18-2003 0:00:30  BGooijen
{ Removed TIdContext.OnCreate
{ Added ContextCreated
}
{
{   Rev 1.7    1-17-2003 23:44:32  BGooijen
{ added support code for TIdContext.OnCreate
}
{
{   Rev 1.6    1-17-2003 22:22:10  BGooijen
{ new design
}
{
{   Rev 1.5    1-10-2003 23:59:22  BGooijen
{ Connection is now freed in destructor of TIdContext
}
{
{   Rev 1.4    1-10-2003 19:46:22  BGooijen
{ The context was not freed, now it is
}
{
{   Rev 1.3    1-9-2003 11:52:28  BGooijen
{ changed construction of TIdContext to Create(AServer: TIdTCPServer)
{ added TIdContext property .Server
}
{
{   Rev 1.2    1-3-2003 19:05:56  BGooijen
{ added FContextClass:TIdContextClass to TIdTcpServer
{ added Data:TObject to TIdContext
}
{
{   Rev 1.1    1-1-2003 16:42:10  BGooijen
{ Changed TIdThread to TIdYarn
{ Added TIdContext
}
{
{   Rev 1.0    11/13/2002 09:00:42 AM  JPMugaas
}
{
Original Author and Maintainer:
 - Chad Z. Hower a.k.a Kudzu
2002-01-01 - Andrew P.Rybin
 - bug fix (MaxConnections, SetActive(FALSE)), TerminateListenerThreads, DoExecute
2002-04-17 - Andrew P.Rybin
 - bug fix: if exception raised in OnConnect, Threads.Remove and ThreadMgr.ReleaseThread are not called
}

unit IdTCPServer;

interface

uses
  Classes, SysUtils,
  IdComponent,IdContext, IdGlobal, IdException,
  IdIntercept, IdIOHandler, IdIOHandlerStack,
  IdReply, IdScheduler, IdSchedulerOfThread, IdServerIOHandler,
  IdServerIOHandlerStack, IdSocketHandle, IdStackConsts, IdTCPConnection,
  IdThread, IdYarn;

const
  IdListenQueueDefault = 15;

type
  TIdTCPServer = class;

  // This is the thread that listens for incoming connections and spawns
  // new ones to handle each one
  TIdListenerThread = class(TIdThread)
  protected
    FBinding: TIdSocketHandle;
    FServer: TIdTCPServer;
    FOnBeforeRun: TIdNotifyThreadEvent;
    //
    procedure AfterRun; override;
    procedure BeforeRun; override;
    procedure Run; override;
  public
    constructor Create(AServer: TIdTCPServer; ABinding: TIdSocketHandle); reintroduce;
    //
    property Binding: TIdSocketHandle read FBinding write FBinding;
    property Server: TIdTCPServer read FServer;
    property OnBeforeRun: TIdNotifyThreadEvent read FOnBeforeRun write FOnBeforeRun;
  End;

  TIdListenExceptionEvent = procedure(AThread: TIdListenerThread; AException: Exception) of object;
  TIdServerThreadExceptionEvent = procedure(AContext:TIdContext; AException: Exception) of object;
  TIdServerThreadEvent = procedure(AContext:TIdContext) of object;

  TIdTCPServer = class(TIdComponent)
  protected
    FActive: Boolean;
    FScheduler: TIdScheduler;
    FBindings: TIdSocketHandles;
    FContextClass: TIdContextClass;
    FImplicitScheduler: Boolean;
    FImplicitIOHandler: Boolean;
    FIntercept: TIdServerIntercept;
    FIOHandler: TIdServerIOHandler;
    FListenerThreads: TThreadList;
    FListenQueue: integer;
    FMaxConnections: Integer;
    FReuseSocket: TIdReuseSocket;
    FTerminateWaitTime: Integer;
    FContexts: TThreadList;
    FOnBeforeConnect: TIdServerThreadEvent;
    FOnConnect: TIdServerThreadEvent;
    FOnDisconnect: TIdServerThreadEvent;
    FOnException: TIdServerThreadExceptionEvent;
    FOnExecute: TIdServerThreadEvent;
    FOnListenException: TIdListenExceptionEvent;
    FOnAfterBind: TNotifyEvent;
    FOnBeforeListenerRun: TIdNotifyThreadEvent;
    //
    procedure CheckActive;
    procedure ContextCreated(AContext:TIdContext); virtual;
    procedure DoAfterBind; virtual;
    procedure DoBeforeConnect(AContext:TIdContext); virtual;
    procedure DoConnect(AContext: TIdContext); virtual;
    procedure DoDisconnect(AContext: TIdContext); virtual;
    procedure DoException(AContext: TIdContext; AException: Exception);
    function DoExecute(AContext: TIdContext): Boolean; virtual;
    procedure DoListenException(
      AThread: TIdListenerThread;
      AException: Exception);
    procedure DoMaxConnectionsExceeded(
      AIOHandler: TIdIOHandler
      ); virtual;
    function GetDefaultPort: TIdPort;
    procedure InitComponent; override;
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation);
     override;
    // This is needed for POP3's APOP authentication.  For that,
    // you send a unique challenge to the client dynamically.
    procedure SendGreeting(AContext: TIdContext; AGreeting: TIdReply); virtual;
    procedure SetActive(AValue: Boolean); virtual;
    procedure SetBindings(const AValue: TIdSocketHandles); virtual;
    procedure SetDefaultPort(const AValue: TIdPort); virtual;
    procedure SetIntercept(const AValue: TIdServerIntercept); virtual;
    procedure SetIOHandler(const AValue: TIdServerIOHandler); virtual;
    procedure SetScheduler(const AValue: TIdScheduler); virtual;
    procedure Startup; virtual;
    procedure Shutdown; virtual;
    procedure TerminateAllThreads;
    procedure TerminateListenerThreads;
  public
    destructor Destroy; override;
    //
    property Contexts: TThreadList read FContexts;
    property ContextClass:TIdContextClass read FContextClass write FContextClass;
    property ImplicitIOHandler: Boolean read FImplicitIOHandler;
    property ImplicitScheduler: Boolean read FImplicitScheduler;
  published
    property Active: Boolean read FActive write SetActive default False;
    property Bindings: TIdSocketHandles read FBindings write SetBindings;
    property DefaultPort: TIdPort read GetDefaultPort write SetDefaultPort;
    property Intercept: TIdServerIntercept read FIntercept write SetIntercept;
    property IOHandler: TIdServerIOHandler read FIOHandler write SetIOHandler;
    property ListenQueue: integer read FListenQueue write FListenQueue default IdListenQueueDefault;
    property MaxConnections: Integer read FMaxConnections write FMaxConnections default 0;
    // right after binding all sockets
    property OnAfterBind: TNotifyEvent read FOnAfterBind write FOnAfterBind;
    property OnBeforeListenerRun: TIdNotifyThreadEvent read FOnBeforeListenerRun write FOnBeforeListenerRun;
    property OnBeforeConnect: TIdServerThreadEvent read
       FOnBeforeConnect write FOnBeforeConnect;
    // Occurs in the context of the peer thread
    property OnConnect: TIdServerThreadEvent read FOnConnect write FOnConnect;
    // Occurs in the context of the peer thread
    property OnExecute: TIdServerThreadEvent read FOnExecute write FOnExecute;
    // Occurs in the context of the peer thread
    property OnDisconnect: TIdServerThreadEvent read FOnDisconnect write FOnDisconnect;
    // Occurs in the context of the peer thread
    property OnException: TIdServerThreadExceptionEvent read FOnException write FOnException;
    property OnListenException: TIdListenExceptionEvent read FOnListenException
      write FOnListenException;
    property ReuseSocket: TIdReuseSocket read FReuseSocket write FReuseSocket default rsOSDependent;
    property TerminateWaitTime: Integer read FTerminateWaitTime
     write FTerminateWaitTime default 5000;
    property Scheduler: TIdScheduler read FScheduler write SetScheduler;
  end;
  EIdTCPServerError = class(EIdException);
  EIdNoExecuteSpecified = class(EIdTCPServerError);
  EIdTerminateThreadTimeout = class(EIdTCPServerError);

implementation

uses
  IdGlobalCore,
  IdResourceStringsCore, IdReplyRFC,
  IdSchedulerOfThreadDefault, IdStack,
  IdThreadSafe;

{ TIdTCPServer }

procedure TIdTCPServer.CheckActive;
begin
  if Active and (not (csDesigning in ComponentState)) and (not (csLoading in ComponentState))
    then begin
    raise EIdTCPServerError.Create(RSCannotPerformTaskWhileServerIsActive);
  end;
end;

procedure TIdTcpServer.ContextCreated(AContext:TIdContext);
begin
//
end;

destructor TIdTCPServer.Destroy;
begin
  Active := False;