rtcdatasrv.pas

Delphi快速开发Web Server

{
  @html(<b>)
  Data Server Components
  @html(</b>)
  - Copyright (c) Danijel Tkalcec
  @html(<br><br>)

  This unit implements a set of Server-side Data components. @Link(TRtcDataServer)
  implements a wrapper for all Request/Response based server-side connection components.
  By linking one or more @Link(TRtcDataServerLink) components, which are linked to one or
  more @Link(TRtcDataProvider) components, you add functionality to your server for
  specific Request handlers. @html(<br>)
  @Link(TRtcHttpServer) implements a HTTP-based TCP/IP server connection with uses a
  HTTP connection provider, so you can compile your DataProvider/ServerModule/Function
  components into a stand-alone HTTP server executable.
}
unit rtcDataSrv;

{$INCLUDE rtcDefs.inc}

interface

// When "UseGUIDs" is defined, CoCreateGUID() API function is used to create Session IDs.
{.$DEFINE UseGUIDs}

uses
  rtcTrashcan,
  
  Classes,
{$IFDEF useGUIDs}
  Windows, ComObj, ActiveX,
{$ENDIF}

  rtcLog,
  rtcInfo,
  rtcConn,

  rtcThrPool;

var
  { Default Session Live Time (in seconds).
    @html(<br><br>)

    Before a session defines its KeepAliveTime,
    the session will live for RTC_SESSION_TIMEOUT seconds after each call. }
  RTC_SESSION_TIMEOUT:integer=60;

{$IFNDEF UseGUIDs}
const
  // @exclude
  RTC_SESSIONID_LENGTH=28;
{$ENDIF}

type
  { @abstract(Components used in DataServer to implement server's functionality) }
  TRtcServerComponent=class(TRtcComponent)
  protected
    // @exclude
    function GetOrder: integer; virtual; abstract;
    end;

  // @exclude
  TRtcServerComponentList = class
  private
    FList:TList;

  public
    constructor Create;
    destructor Destroy; override;

    procedure Add(Value:TRtcServerComponent);
    procedure Remove(Value:TRtcServerComponent);

    procedure RemoveAll;

    function Count:integer;
    function Get(index:integer):TRtcServerComponent;
    end;

  TRtcAbsDataServerLink = class;

  // @exclude
  TRtcDataServerLinkList = class(TRtcServerComponentList)
  public
    function GetLink(index:integer):TRtcAbsDataServerLink;
    end;

  { @abstract(Server Session information) }
  TRtcServerSession=class(TRtcSession)
  private
    FLastUsed,
    FExpireTime:TDateTime;
    FFinalExpire:TDateTime;
    FKeepAlive:integer;

  protected
    // @exclude
    class function Find(const _ID:string; const _PeerAddr,_ForwardedFor:string):TRtcServerSession;
    // @exclude
    class function Have(const _ID:string; const _PeerAddr,_ForwardedFor:string):boolean;
    // @exclude
    class function Open(_LockType:TRtcSessionLockType; const _PeerAddr,_ForwardedFor:string):TRtcServerSession;
    // @exclude
    class function CloseID(const _ID:string; const _PeerAddr,_ForwardedFor:string; _Event:TRtcSimpleEvent):boolean;

    // @exclude
    procedure SetFinalExpire(const _Value:TDateTime);
    // @exclude
    procedure SetKeepAlive(const _Value:integer);

    // @exclude
    procedure LockSessionID;
    // @exclude
    procedure UnlockSession(_Event:TRtcSimpleEvent);

    // @exclude
    procedure UnLock(_Event:TRtcSimpleEvent);

    // @exclude
    function DenyAccess(const _PeerAddr,_ForwardedFor:string):boolean;

  public
    // Close session: This is same as setting "FinalExpire" to "Now".
    procedure Close;

    // Session Last used (updated after each FindSession call)
    property LastUsed:TDateTime read FLastUsed;
    // Number of seconds this session will be kept alive after each usage (renew "ExpireTime").
    property KeepAlive:integer read FKeepAlive write SetKeepAlive;
    { Time when Session will Expire.
      It is auto-maintained, using the LiveTime and FinalExpire values. }
    property ExpireTime:TDateTime read FExpireTime;
    // If not zero, defines the Time and Date when this session will Expire for good.
    property FinalExpire:TDateTime read FFinalExpire write SetFinalExpire;
    end;

  { @Abstract(Universal Data Server Connection component)

    By using methods provided by this DataProvider component, you ensure that
    your code will be compatible with different connection providers,
    which makes it possible to write your code once and use it to compile
    it for different servers. @html(<br>)

    By using methods, events and properties available from TRtcDataServer,
    you can easily respond to requests by sending an appropriate result
    which will be readable by the connected client, be it a standard Web
    Browser or any application written by using the @Link(TRtcDataClient)
    connection component.

    @Link(TRtcDataServer) also makes sure that you receive requests one by one
    and get the chance to answer them one-by-one, even if the client side
    sends all the requests at once (as one big request list), so
    you can relax and process all incomming requests, without worrying
    about overlapping your responses for different requests.
    @html(<br><br>)

    Component which calls 'Accept' will gain complete control
    over the connection, until a complete response is sent out
    (or connection is closed).

    After the response is done, DataServer again takes over and waits for the
    next request, then the process repeats itself, until all requests have been
    processed or the connection has been closed.

    Properties to check first:
    @html(<br>)
    @Link(TRtcConnection.ServerAddr) - Local Address to bind the server to (leave empty for ALL)
    @html(<br>)
    @Link(TRtcConnection.ServerPort) - Port to listen on and wait for connections
    @html(<br><br>)

    Methods to check first:
    @html(<br>)
    @Link(TRtcServer.Listen) - Start server
    @html(<br>)
    @Link(TRtcDataServer.Accept), @Link(TRtcDataServer.Request), @Link(TRtcConnection.Read) - Read and Accept client Request
    @html(<br>)
    @Link(TRtcDataServer.WriteHeader), @Link(TRtcConnection.Write) - Write result to client
    @html(<br>)
    @Link(TRtcConnection.Disconnect) - Disconnect client
    @html(<br>)
    @Link(TRtcServer.StopListen) - Stop server
    @html(<br><br>)

    Events to check first:
    @html(<br>)
    @Link(TRtcServer.OnListenStart) - Server started
    @html(<br>)
    @Link(TRtcConnection.OnConnecting) - new Client connecting
    @html(<br>)
    @Link(TRtcDataServer.OnRequestNotAccepted) - Request has been received but not accepted by any DataProvider component.
    @html(<br>)
    @Link(TRtcConnection.OnDataSent) - Data sent to client (buffer now empty)
    @html(<br>)
    @Link(TRtcConnection.OnDisconnecting) - one Client disconnecting
    @html(<br>)
    @Link(TRtcServer.OnListenStop) - Server stopped
    @html(<br><br>)

    Check @Link(TRtcServer) and @Link(TRtcConnection) for more info.
    }
  TRtcDataServer = class(TRtcServer)
  private
    FOnRequestAccepted:TRtcNotifyEvent;
    FOnRequestNotAccepted:TRtcNotifyEvent;
    FOnResponseDone:TRtcNotifyEvent;
    FOnSessionOpen:TRtcNotifyEvent;
    FOnSessionClose:TRtcNotifyEvent;

    FSession:TRtcServerSession;

    FActiveLink:TRtcAbsDataServerLink;

    FDataServerLinks:TRtcDataServerLinkList;
    FDataServerLinks_Owner:boolean;

    FMyRequest, FRequest:TRtcServerRequest;
    FMyResponse, FResponse:TRtcServerResponse;

  protected
    // @exclude
    procedure CopyFrom(Dup: TRtcServer); override;

    // @exclude
    procedure AddDataServerLink(Value:TRtcAbsDataServerLink);
    // @exclude
    procedure RemoveDataServerLink(Value:TRtcAbsDataServerLink);
    // @exclude
    procedure RemoveAllDataServerLinks;

    // @exclude
    procedure CallSessionOpen;
    // @exclude
    procedure CallSessionClose(Sender:TObject);

    // @exclude
    procedure CallListenStart; override;
    // @exclude
    procedure CallListenStop; override;

    // @exclude
    procedure CallDataReceived; override;
    // @exclude
    procedure CallDataOut; override;
    // @exclude
    procedure CallDataIn; override;
    // @exclude
    procedure CallDataSent; override;
    // @exclude
    procedure CallReadyToSend; override;
    // @exclude
    procedure CallDisconnect; override;
    // @exclude
    procedure CallLastWrite; override;

    // @exclude
    procedure SetRequest(const Value: TRtcServerRequest); virtual;
    // @exclude
    procedure SetResponse(const Value: TRtcServerResponse); virtual;

    { @exclude }
    procedure InitSession;

    { **************************************************** }

    { NEW METHODS TO BE IMPLEMENTED BY THE CONNECTION COMPONENT }

  public

    { Flush all buffered data.
      @html(<br>)
      When using 'Write' without calling 'WriteHeader' before, all data
      prepared by calling 'Write' will be buffered until your event
      returns to its caller (automatically upon your event completion) or
      when you first call 'Flush'. Flush will check if Response.ContentLength is set
      and if not, will set the content length to the number of bytes buffered.
      @html(<br>)
      Flush does nothing if WriteHeader was called for this response.

      @exclude}
    procedure Flush; virtual; abstract;

    // You can call WriteHeader to send the Response header out.
    procedure WriteHeader(SendNow:boolean=True); overload; virtual; abstract;
    { You can call WriteHeader with empty 'HeaderText' parameter to
      tell the component that you do not want any HTTP header to be sent. }
    procedure WriteHeader(const HeaderText: string; SendNow:boolean=True); overload; virtual; abstract;

    { **************************************************** }

    // @exclude
    constructor Create(AOwner: TComponent); override;
    // @exclude
    destructor Destroy; override;

    // @exclude
    class function New:TRtcDataServer;

    // @exclude
    procedure CallRequestAccepted; virtual;
    // @exclude
    procedure CallRequestNotAccepted; virtual;
    // @exclude
    procedure CallResponseDone; virtual;

    { Used by DataServerLink components to tell DataServer that
      they are currently checking the request.
      Only needs to be called from OnCheckRequest,
      before the Request has been accepted.
      Once the request is accepted, ActiveDataServerLink will be
      used to process all future Data-related events, until
      the request has been processed or connection closed.
      @exclude }
    procedure SetActiveLink(Link:TRtcAbsDataServerLink);

    { Request handler has to call Accept before it starts processing
      the request, so that all further events remain mapped to the
      active event handlers and don't switch before a reply has been sent. }
    procedure Accept;

    { Find an existing Session with this ID.
      If Session with this ID does not exist,
      or session has expired or session is currently locked,
      returns FALSE. Otherwise, prepares the Session variable
      for use and returns TRUE. }
    function FindSession(const ID:string):boolean;

    { If there is a session with this ID, returns TRUE,
      even if that session is locked. }
    function HaveSession(const ID:string):boolean;

    { If you do not need the Session anymore and do not want to keep the
      session locked until request completes, you can release the Session
      Lock by calling "UnLockSession". After this call, you will no longer
      have access to the Session object, until you lock it again using FindSession. }
    procedure UnLockSession;

    { Create a new Session, with a new and unique Session ID. }
    procedure OpenSession(LockType:TRtcSessionLockType=sesFwdLock);

    { If there is a session with this ID,
      returns TRUE and closes the session. }
    function CloseSession(const ID:string):boolean;

    { Total number of open Sessions }
    function TotalSessionsCount:cardinal;

    { Total number of Sessions currently locked.
      A session is locked after a call to FindSession() and
      unlocked after the Event is done executing. }
    function TotalSessionsLocked:cardinal;

    { Total number of Sessions currently unlocked.
      A session is locked after a call to FindSession() and
      unlocked after the Event is done executing. }
    function TotalSessionsUnlocked:cardinal;

    { Current Request's Session info.
      @html(<br>)
      Before you can access the Session for the Request,
      you have to find the appropriate Session by using the
      FindSession function or create a new session by calling the
      OpenSession method. }
    property Session:TRtcServerSession read FSession;

    { Access to current request information.
      Use Request property to read the request information received.
      Here is all the info that was available in request header.
      To read request's body, use the Read function. }
    property Request:TRtcServerRequest read FRequest write SetRequest;
    { Access to current response information.
      Use Response property to prepare the response header.
      Here you can set all header variables and parameters.
      If there is no content body to send out (only header), you will at
      least have to call 'WriteHeader', or 'Write' without parameters once. }
    property Response:TRtcServerResponse read FResponse write SetResponse;

  published
    { Called after a new request has been accepted.
      You can use this event handler to create a DataTunel and
      assign it to Tunel, in case the request has to be tunelled. }
    property OnRequestAccepted:TRtcNotifyEvent read FOnRequestAccepted write FOnRequestAccepted;
    { Called after a new request has been received, but NOT ACCEPTED.
      You can use this event handler to respond to requests with no DataProvider. }
    property OnRequestNotAccepted:TRtcNotifyEvent read FOnRequestNotAccepted write FOnRequestNotAccepted;
    { Called after a processed response was Done sending data out. }
    property OnResponseDone:TRtcNotifyEvent read FOnResponseDone write FOnResponseDone;
    { Called after a new session has been opened.
      You can use the Session property from this event to get session ID. }
    property OnSessionOpen:TRtcNotifyEvent read FOnSessionOpen write FOnSessionOpen;
    { Called before an old session has been closed.
      You can use the Session property from this event to get Session ID. }
    property OnSessionClose:TRtcNotifyEvent read FOnSessionClose write FOnSessionClose;

    { This event will be triggered every time a chunk of your data
      prepared for sending has just been sent out. To know
      exactly how much of it is on the way, use the @Link(TRtcConnection.DataOut) property.
      @html(<br><br>)