dxservercore.pas

Well known and usefull component for delphi 7

// ========================================================================
// Component: TDXServerCore, TDXServerCoreThread,
// TDXClientThread
//
// \Author: G.E. Ozz Nixon Jr. ([e-mail])
//
// ========================================================================
//
// Source Owner: DX, Inc. 1995-2005
//
// Copyright: All code is the property of DX, Inc. Licensed for
// resell by Brain Patchwork DX (tm) and part of the DX (r)
// product lines, which are (c) 1999-2005 DX, Inc. Source may
// not be distributed without written permission from both Brain
// Patchwork DX, LLC. and DX, Inc.
//
//
//
// License: (Reminder), None of this code can be added to other
// developer products without permission. This includes but not
// limited to DCU's, DCP's, DLL's, OCX's, or any other form of
// merging our technologies. All of your products released to a
// public consumer be it shareware, freeware, commercial, etc.
// must contain a license notification somewhere visible in the
// application.
//
//
//
// \Example is Internet Explorer - Help-\>About screen shows the
// licensed code contained in the application.
//
//
//
// Code Version: (5th Generation Code)
//
// ========================================================================
//
// \Description: Ancestor to all our Protocol Implementations.
//
// ========================================================================
//
// Parent Thread Object and "Defacto" Server Object.
//
// The Server Object (DXServerCore) is the heart of all
// protocols. It is used to initiate winsock listening, and
// start the Parent Thread (DXServerCoreThread). The Parent
// Thread constantly checks if the listener has received a
// connection request, accepts the connection and spawns a
// (DXClientThread) Session. And continues checking for more
// connections.
// ========================================================================
unit DXServerCore;

interface

{$I DXSock.def}

uses
{$IFNDEF LINUX}
   Windows, // InterlockedXX thanks to EYAL!
{$ENDIF}
   DXSessionTracker,
   DXSock,
   DXString,
   Classes;

type
   TWhichProtocol = (wpUDPOnly, wpTCPOnly);
   TServerType = (stNonBlocking, stThreadBlocking);

///////////////////////////////////////////////////////////////////////////////
// Events:
///////////////////////////////////////////////////////////////////////////////
   TDXClientThread = class;
   TDX_NewConnect = procedure(ClientThread: TDXClientThread) of object;
{$WARNINGS OFF}
   TDX_DestroySessionData = procedure(ClientThread: TDXClientThread; SessionData: Pointer) of object;
{$WARNINGS ON}

// =============================================================
// This thread is the spawned "Session" thread. Every connection
// detected by the "Listener" thread is created as a
// TDXClientThread, and then that new thread takes over
// communications for the client session. Even though this is a
// TThread descendant, you should always think of it as a
// container object. We handle and manage all threads
// transparent to your application.
// =============================================================
{$WARNINGS OFF}
   TDXClientThread = class(TThread)
   private
      Client: TDXSock;
      feNewConnect: TDX_NewConnect;
      feDestroySessionData: TDX_DestroySessionData;
      fBlockSizeFlags: TDXBlockSizeFlags;
      ListenerThreadObject: TThread;
   protected
      procedure Execute; override;
      function GetSessionID: Integer; // making move from INDY easier!
   public
      // =============================================================
      // A private pointer to each session (ClientThread) allowing you
      // to pass an object or structure around with information
      // directly related to this current session. A prime example of
      // using this pointer would be to track login status, default
      // paths, permissions etc. (like an FTP or EMAIL server would
      // need).
      // =============================================================
      fpSessionData: Pointer;
      constructor Create(CreateSuspended: Boolean);
      destructor Destroy; override;
      procedure SetSocketLater(Socket: TDXSock);
   published
      property SessionID: Integer read GetSessionID;
      // ====================================================
// This is the instance of TDXSock which provides all
// communications I/O to the remote client application.
// ====================================================
      property Socket: TDXSock read Client
         write Client;
      property OnNewConnect: TDX_Newconnect read feNewConnect
         write feNewConnect;
      property OnDestroySessionData: TDX_DestroySessionData read feDestroySessionData
         write feDestroySessionData;
      property Terminated;
   end;

Type
// Version 5 - an Object instead of a Thread!
   TDXClientThreadObject=class(TComponent)
   private
      Client: TDXSock;
      feNewConnect: TDX_NewConnect;
      feDestroySessionData: TDX_DestroySessionData;
      fBlockSizeFlags: TDXBlockSizeFlags;
      ListenerThreadObject: TThread;
   protected
      function GetSessionID: Integer; // making move from INDY easier!
    public
      fpSessionData: Pointer;
      constructor Create(AOwner:TComponent);
      destructor Destroy; override;
      procedure SetSocketLater(Socket: TDXSock);
   published
      property SessionID: Integer read GetSessionID;
      property Socket: TDXSock read Client
         write Client;
      property OnNewConnect: TDX_Newconnect read feNewConnect
         write feNewConnect;
      property OnDestroySessionData: TDX_DestroySessionData read feDestroySessionData
         write feDestroySessionData;
   End;
{$WARNINGS ON}

///////////////////////////////////////////////////////////////////////////////
// All protocols use this thread to listen for incoming connections. This is
// the "Listener" thread.
///////////////////////////////////////////////////////////////////////////////
Type
   TDXThreePointBoolean=(B3True,B3False,B3Other);

   TDXServerCoreThread = class; // =====================================================================
                             // Summary
                             // Definition of the OnAccept event.
                             //
                             // Parameters
                             // ipAddress :   is the ipv4 address of the client that has initiated a
                             //               connect to your server.
                             // Port :        is the port of the client connection to your server.
                             // Socket :      is a TDXSock instance allowing for communications to
                             //               happen during this event if needed.
                             // Allow :       by default is true. However, if your application wishes
                             //               to deny the connection set this to false before exiting
                             //               the event.
                             // =====================================================================
   TDX_OnAccept = procedure(ipAddress: string; Port: Integer; Socket: TDXSock; var Allow: Boolean) of object;
   TDX_ListenerFailed = procedure(ErrorCode: Integer) of object;
   TDX_MaxConnects = procedure(ServerCoreThread: TDXServerCoreThread) of object;
   TDX_Idle = procedure(ServerCoreThread: TDXServerCoreThread) of object;
   TDX_Sleep = procedure(ServerCoreThread: TDXServerCoreThread) of object;
   TDX_WakeUp = procedure(ServerCoreThread: TDXServerCoreThread) of object;
{$WARNINGS OFF}
   TDX_UDPData = procedure(Data: Pointer; PeerIP: string; PeerPort, DataLen: Integer) of object;
{$WARNINGS ON}
   // =============================================================
// This is the actual Listener Thread, responsible for accepting
// new connections, managing all TDXClientThread sessions,
// firing events reporting the status of the listener itself.
// =============================================================
   TDXServerCoreThread = class(TThread)
   private
      fbSuspend: Boolean;
      fbBufferCreates:TDXThreePointBoolean; //Boolean;
      ListenerSocket: TDXSock;
      fSessionTracker: TDXSessionTracker;
      fsBindTo: string;
      fiServerPort: Integer;
      fiMaxConn: Integer;
      fbAnnouncedIdle: Byte; // 0 active, 1 going idle, 2 asleep
      feNewConnect: TDX_NewConnect;
      feMaxConnects: TDX_MaxConnects;
      feListenerFailed: TDX_ListenerFailed;
      feIdle: TDX_Idle;
      feSleep: TDX_Sleep;
      feWakeUp: TDX_WakeUp;
      feUDPData: TDX_UDPData;
{$IFNDEF LINUX}
      fstPriority: TThreadPriority;
{$ENDIF}
      fThreadPool: TList;
      fWhichprotocol: TWhichProtocol;
      FActiveConnections: Integer;
      fBlockSizeFlags: TDXBlockSizeFlags;
      fUseBlocking: Boolean;
      fUseNagle: Boolean;
      feListenerStarted: TNotifyEvent;
      feListenerStopped: TNotifyEvent;
      fListenerQueueSize: Integer;
      fServerCore: TComponent; // to toggle active true/false on exception
      feAccept: TDX_OnAccept;
   protected
      MyCriticalSection: TDXCritical;
      procedure Execute; override;
      procedure SetBufferCreates(value: TDXThreePointBoolean{Boolean});
      procedure SetSuspend(value: Boolean);
      procedure SetBlocking(value: Boolean);
      procedure SetNagle(value: Boolean);
      function GetSocket: TDXSock;
   public
      constructor Create(CreateSuspended: Boolean);
      destructor Destroy; override;
      function ActiveNumberOfConnections: Integer;
   published
      property MainSocket: TDXSock read GetSocket;
{$IFNDEF LINUX}
      property SpawnedThreadPriority: TThreadPriority read fstPriority
         write fstPriority;
{$ENDIF}
      property BlockingListener: Boolean read fUseBlocking
         write SetBlocking;
      property NagleListener: Boolean read fUseNagle
         write SetNagle;
      property BufferCreates: TDXThreePointBoolean{Boolean} read fbBufferCreates
         write SetBufferCreates;
      property SuspendListener: Boolean read fbSuspend
         write SetSuspend;
      property BindTo: string read fsBindTo
         write fsBindTo;
      property ServerPort: Integer read fiServerPort
         write fiServerPort;
      property ThreadCacheSize: Integer read fiMaxConn
         write fiMaxConn;
      property OnNewConnect: TDX_NewConnect read feNewConnect
         write feNewConnect;
      property OnMaxConnects: TDX_MaxConnects read feMaxConnects
         write feMaxConnects;
      property OnGoingIdle: TDX_Idle read feIdle
         write feIdle;
      property OnAsleep: TDX_Sleep read feSleep
         write feSleep;
      property OnWakeUp: TDX_WakeUp read feWakeUp
         write feWakeUp;
      property OnListenerFailed: TDX_ListenerFailed read feListenerFailed
         write feListenerFailed;
      property OnListenerStarted: TNotifyEvent read feListenerStarted
         write feListenerStarted;
      property OnListenerStopped: TNotifyEvent read feListenerStopped
         write feListenerStopped;
      property OnUDPDataNoPool: TDX_UDPData read feUDPData
         write feUDPData;
      property ProtocolToBind: TWhichProtocol read fWhichprotocol
         write fWhichprotocol;
      property OnAccept: TDX_OnAccept read feAccept write feAccept;
   end;

///////////////////////////////////////////////////////////////////////////////
// All protocols are descendants of this object/component. When making changes
// that need to flow to the actual protocol, like supporting a change to the
// spawned thread. You would make the "property" in this piece of code, and
// then when this piece of code creates the listener thread you can pass the
// information to the listener. At that point, you could pass it down to the
// protocol thread TDXServerThread.
///////////////////////////////////////////////////////////////////////////////
type
   TDXServerCore = class(TDXComponent)
   private
      fbSSL: Boolean;
      fbActive: Boolean;
      fbSuspend: Boolean;
      fbBufferCreates: TDXThreePointBoolean;//Boolean;
      fsBindTo: string;
      fiServerPort: Integer;
      fiMaxConn: Integer;
      feNewConnect: TDX_NewConnect;
      feMaxConnects: TDX_MaxConnects;
      feListenerFailed: TDX_ListenerFailed;
      feIdle: TDX_Idle;
      feSleep: TDX_Sleep;
      feWakeUp: TDX_WakeUp;
      feUDPData: TDX_UDPData;
{$IFNDEF LINUX}
      fltPriority: TThreadPriority;
      fstPriority: TThreadPriority;
{$ENDIF}
      fWhichprotocol: TWhichProtocol;
      fBlockSizeFlags: TDXBlockSizeFlags;
      fServerType: TServerType;
      fDummy: string;
      fbNagle: Boolean;
      fiTimeout: Cardinal;
      fListenerStarted: TNotifyEvent;
      fListenerStopped: TNotifyEvent;
      fiListenerQueueSize: Integer;
      feAccept: TDX_OnAccept;
   protected
      fbForceAbort: Boolean;
      ListenerThread: TDXServerCoreThread;
      fEventArray: TList;
      procedure SetActive(value: boolean);
      procedure SetSuspend(value: boolean);
      function GetThreadCacheSize: Integer;
      procedure SetThreadCacheSize(value: Integer);
      function GetSocket: TDXSock;
      procedure SetfiMaxConn(Value: Integer);
   public
      constructor Create(AOwner: TComponent);
{$IFNDEF OBJECTS_ONLY}override;
{$ENDIF}
      destructor Destroy; override;
      // ============================================================
// This method allows your host application to interrogate the
// ancestor server core to know the number of concurrent client
// sessions that are currently active.
// ============================================================
      function ActiveNumberOfConnections: Integer;
      // ============================================================
// This method activates the internal listener thread, along
// with passing the properties from the visual component to the
// thread - event definitions, communication settings, etc.
// ============================================================
      procedure Start; virtual;
      // =============================================================
// This method deactivates the internal listener thread from
// accepting new connections. However, this does not terminate
// active client threads - they are still active to finish their
// processes.
// =============================================================
      procedure Stop; virtual;
      // ==========================================================================
      // This is a wrapper method for the actual .<LINK TDXServerCore.Start, Start>
      // method.
      // ==========================================================================
      procedure Open; virtual;
      // ========================================================================
// This is a wrapper method for the actual .<LINK TDXServerCore.Stop, Stop>
// method.
// ========================================================================
      procedure Close; virtual;
      // =====================================================================================
      // Instead of <LINK TDXServerCore.Close, closing> or <LINK TDXServerCore.Stop, stopping>
      // the listener, it is possible to suspend and resume the
      // listener thread. This is useful for GUI based server
      // applications, like a Peer to Peer solution, or in our case -
      // demonstrations.
      // =====================================================================================
      procedure Pause; virtual;
      // =====================================================================================
      // Instead of <LINK TDXServerCore.Close, closing> or <LINK TDXServerCore.Stop, stopping>
      // the listener, it is possible to suspend and resume the
      // listener thread. This is useful for GUI based server
      // applications, like a Peer to Peer solution, or in our case -
      // demonstrations.
      // =====================================================================================
      procedure Resume; virtual;
      procedure ForceAbort;
      // =============================================================
// For Advanced Developers. The listener thread uses an internal
// instance of TDXSock for listening and accepting new
// connections. Once the listener is started, this property
// gives you low-level access to the listeners communications
// layer.
// =============================================================
      property Socket: TDXSock read GetSocket;
      function InternalSessionTracker: TDXSessionTracker; virtual;
   published
{$IFNDEF LINUX}
      property ListenerThreadPriority: TThreadPriority read fltPriority
         write fltPriority;
      property SpawnedThreadPriority: TThreadPriority read fstPriority
         write fstPriority;
{$ENDIF}
      // ============================================================