{*_* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

Author:       François PIETTE
Description:  THttpAppSrv is a specialized THttpServer component to ease
              his use for writing application servers.
Creation:     Dec 20, 2003
Version:      8.58
EMail:        francois.piette@overbyte.be         http://www.overbyte.be
Support:      Use the mailing list twsocket@elists.org
              Follow "support" link at http://www.overbyte.be for subscription.
Legal issues: Copyright (C) 2003-2018 by François PIETTE
              Rue de Grady 24, 4053 Embourg, Belgium.
              <francois.piette@overbyte.be>

              This software is provided 'as-is', without any express or
              implied warranty.  In no event will the author be held liable
              for any  damages arising from the use of this software.

              Permission is granted to anyone to use this software for any
              purpose, including commercial applications, and to alter it
              and redistribute it freely, subject to the following
              restrictions:

              1. The origin of this software must not be misrepresented,
                 you must not claim that you wrote the original software.
                 If you use this software in a product, an acknowledgment
                 in the product documentation would be appreciated but is
                 not required.

              2. Altered source versions must be plainly marked as such, and
                 must not be misrepresented as being the original software.

              3. This notice may not be removed or altered from any source
                 distribution.

              4. You must register this software by sending a picture postcard
                 to the author. Use a nice stamp and mention your name, street
                 address, EMail address and any comment you like to say.

Quick User Guide:
At the start of your program, you must call THttpAppSrv.AddGetHandler and
THttpAppSrv.AddPostHandler for each URL you want to handle by code, that is
each URL which has a dynamic page generated by your code.

You must also derive your own class from THttpAppSrvConnection and feed
THttpAppSrv.ClientClass with his class name so that the component instanciate
your class to handle each client connection. You will place your database
stuff in your THttpAppSrvConnection derived class, as well as anything else
is needed to handle the client connection.

Usually you also need "session data", that is data which is persitant across
several HTTP connections. HTTP is a stateless protocol, so client connect and
disconnect at will and at moment independent of the application state. You
maintain application data in "session data". For Session data, you have to
derive your own class from TWebSessionData with whatever properties you like
for your data. You must define published properties so that they are properly
serialized and deserialized when using SaveSessionsToFile and
LoadSessionsFromFile. You create an instance of your session data within the
dynamic page that is the answer for the login form. Once initialized, you
link your instance to the session by calling THttpAppSrv.CreateSession

History:
16/09/2006 V1.01 Added THttpAppSrvConnection.BeforeGetHandler
11/04/2009 V1.02 Added runtime readonly property THttpAppsrv.WSessions
                 Added overloaded CheckSession.
Jun 12, 2009 V7.03 don't ignore event Flags in TriggerGetDocument otherwise
                    authentication fails
Jul 14, 2009 V7.04 F. Piette added THttpAppSrvConnection.OnDestroying and
                   related processing.
Sept 1, 2009 V7.05 Angus added TriggerHeadDocument, can not ignore HEAD
                     command for virtual pages else 404 returned
                   Added OnVirtualException event to report exceptions
                     creating virtual pages
Feb 05, 2010 V7.06 F. Piette added overloaded AnswerPage to get template from
                   resource.
Feb 08, 2010 V7.07 F. Piette fixed a bug introduced in 7.06 with ResType
                   (Need to be PChar instead of PAnsiChar).
Jan 27, 2010 V7.08 Arno - TUrlHandler.AnswerPage and TUrlHandler.AnswerString
                   take optional code page parameter (D2009+ only).
Dec 18, 2011 V7.09 F. Piette fixed THttpAppSrv.GetDispatchVirtualDocument so
                   that OnDestroying is correct initialized. This prevent
                   crashing when defered answer is used and client is gone at
                   the time the answer is sent.
May 2012 - V8.00 - Arno added FireMonkey cross platform support with POSIX/MacOS
                   also IPv6 support, include files now in sub-directory
                   New SocketFamily property (sfAny, sfAnyIPv4, sfAnyIPv6, sfIPv4, sfIPv6)
                   New MultiListenSockets property to add extra listening sockets,
                     each with Addr/Port/SocketFamily/SslEnable properties
                     in events check MultiListenIndex, -1 is main socket, >=0 is
                     index into MultiListenSockets[] for socket raising event
Aug 17, 2012 V8.02 Angus added TSslHttpAppSrv
                   SslEnable specifies if SSL is used and defaults to FALSE
                   added MaxSessions to allow more than 100 web sessions
Jun 09, 2013 V8.03 FPiette added TUrlHandler destructor to clear OnDestroying
                   event handler in client's connection
Nov 16, 2013 V8.04 Arno - Added property AppServer to the THttpAppSrvConnection.
                   Added an OnDisplay event and a public method Display to THttAppSrv.
                   Added a method Display to TUrlHandler.
Mar 24, 2015 V8.05 Angus onSslServerName event added
Apr 26, 2016 V8.06 Angus added OverbyteIcsFormDataDecoder to uses
Apr 03, 2017       F. Piette made some THttpAppSrvConnection methods vitual:
                   CancelSession, CheckSession and ValidateSession.
                   TUrlHandler.ValidateSession is made virtual.
Apr 11, 2017 V8.45 Added SSL IcsHosts property
May 24, 2017 V8.48 Added HostTag parameter to AddGetHandler, AddPostHandler and
                     AddGetAllowedPath which will cause that handler to be
                     matched against an IcsHosts HostTag to support multiple
                     hosts per server.
                   Added IcsLoadTHttpAppSrvFromIni function which loads
                     HttpAppSrv from an open INI file to simplify application
                     creation.
May 30, 2017 V8.48 PostDispatchVirtualDocument was broken in last update
Jul 5, 2017  V8.49 Start is now a function, see HttpSrv
Aug 10, 2017 V8.50 Corrected onSslServerName to OnSslServerName to keep C++ happy
Jul 6, 2018  V8.56 Added OnSslAlpnSelect called after OnSslServerName for HTTP/2.
Oct 10, 2018 V8.57 INI file now reads Options as enumerated type literals,
                     ie Options=[hoContentEncoding,hoAllowDirList,hoSendServerHdr,hoAllowPut]
                   INI file reads SslCliCertMethod, SslCertAutoOrder, CertExpireDays.
                   FSessionTimer is now TIcsTimer so Vcl.ExtCtrls can disappear
Oct 19, 2018 V8.58 INI file reads ListenBacklog.


[WebAppServer]
MaxClients=200
MaxSessions=
SessionTimeout=14400
; CA root bundle to validate certificates and local chains
RootCA=c:\certificates\RootCaCertsBundle.pem
; needed for DH and DHE ciphers
DHParams=c:\certificates\dhparams2048.pem
; should maximum speed limit be imposed
BandwidthLimitKB=0
; how long idle clients should remain open
KeepAliveTimeSec=60
; how long active but stalled clients should remain open
KeepAliveTimeXferSec=300
; minimum and maxmum sized content to GZIP compress , no point in compressing
;  small files, very large ones can take a long time and block server.
SizeCompressMin=5000
SizeCompressMax=5000000
; Header items that should be included in any response header
PersistentHeader=
; multiple server Options: hoAllowDirList, hoAllowOutsideRoot, hoContentEncoding, hoAllowOptions,
;   hoAllowPut, hoAllowDelete, hoAllowTrace, hoAllowPatch, hoAllowConnect, hoSendServerHdr, hoIgnoreIfModSince
Options=[hoContentEncoding,hoSendServerHdr,hoAllowPut]
; should browser send certificate: sslCliCertNone, sslCliCertOptional, sslCliCertRequire
SslCliCertMethod=sslCliCertNone
; should server automatically order and install SSL certificates, also needs CertSupplierProto specified
; also needs a Certificate Supplier Account to be created first
SslCertAutoOrder=True
; how many days before expiry of SSL certificates should warnings and AutoOrder start
CertExpireDays=30
; how many new connections should be queued before rejecting new connections
ListenBacklog=25

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *_*}
{$IFNDEF ICS_INCLUDE_MODE}
unit OverbyteIcsHttpAppServer;
{$ENDIF}

{$B-}           { Enable partial boolean evaluation   }
{$T-}           { Untyped pointers                    }
{$X+}           { Enable extended syntax              }
{$H+}           { Use long strings                    }
{$J+}           { Allow typed constant to be modified }
{$I Include\OverbyteIcsDefs.inc}
{$IFDEF COMPILER14_UP}
  {$IFDEF NO_EXTENDED_RTTI}
    {$RTTI EXPLICIT METHODS([]) FIELDS([]) PROPERTIES([])}
  {$ENDIF}
{$ENDIF}
{$IFDEF DELPHI6_UP}
    {$WARN SYMBOL_PLATFORM   OFF}
    {$WARN SYMBOL_LIBRARY    OFF}
    {$WARN SYMBOL_DEPRECATED OFF}
{$ENDIF}

interface

uses
{$IFDEF MSWINDOWS}
    {$IFDEF RTL_NAMESPACES}Winapi.Windows{$ELSE}Windows{$ENDIF},
    {$IFDEF RTL_NAMESPACES}Winapi.Messages{$ELSE}Messages{$ENDIF},
{$ENDIF}
{$IFDEF POSIX}
    Ics.Posix.WinTypes,
    Ics.Posix.Messages,
{$ENDIF}
    {$IFDEF RTL_NAMESPACES}System.SysUtils{$ELSE}SysUtils{$ENDIF},
    {$IFDEF RTL_NAMESPACES}System.TypInfo{$ELSE}TypInfo{$ENDIF},
    {$IFDEF RTL_NAMESPACES}System.IniFiles{$ELSE}IniFiles{$ENDIF},
{$IFDEF COMPILER7_UP}
    {$IFDEF RTL_NAMESPACES}System.StrUtils{$ELSE}StrUtils{$ENDIF},
{$ENDIF}
  OverbyteIcsSSLEAY, OverbyteIcsLIBEAY,
{$IFDEF FMX}
    FMX.Types,
    Ics.Fmx.OverbyteIcsWndControl,
    Ics.Fmx.OverbyteIcsWSocket,
    Ics.Fmx.OverbyteIcsHttpSrv,
{$ELSE}
//    {$IFDEF RTL_NAMESPACES}Vcl.ExtCtrls{$ELSE}ExtCtrls{$ENDIF},  { V8.57 }
    OverbyteIcsWndControl,       { V8.57 }
    OverbyteIcsWSocket,
    OverbyteIcsHttpSrv,
{$ENDIF}
    {$IFDEF RTL_NAMESPACES}System.Classes{$ELSE}Classes{$ENDIF},
    OverbyteIcsWebSession,
    OverbyteIcsUtils,
    OverbyteIcsFormDataDecoder;

type
    THttpAppSrvDisplayEvent = procedure(Sender    : TObject;
                                        const Msg : String) of object;

    TVirtualExceptionEvent = procedure (Sender : TObject;
                                  E          : Exception;
                                  Method     : THttpMethod;
                                  const Path : string) of object;  { V7.05 }
    TMyHttpHandler        = procedure (var Flags: THttpGetFlag) of object;
    TUrlHandler           = class;
    THttpAppSrv           = class;
    THttpAppSrvConnection = class(THttpConnection)
    protected
        FOnDestroying  : TNotifyEvent;
        FAppServer     : THttpAppSrv;
        function GetHostName: String;
    public
        PostedData     : PAnsiChar; // Will hold dynamically allocated buffer
        PostedDataLen  : Integer;   // Keep track of received byte count.
        WSessions      : TWebSessions;
        WSession       : TWebSession;
        WSessionID     : String;
        WSessionCookie : String;
        destructor Destroy; override;
        function   CreateSession(const Params : String;
                                 Expiration   : TDateTime;
                                 SessionData  : TWebSessionData) : String;
        function   CancelSession : String; virtual;
        function   CheckSession(var Flags                : THttpGetFlag;
                                const NegativeAnswerHtml : String) : Boolean; overload; virtual;
        function   CheckSession(var   Flags              : THttpGetFlag;
                                const Status             : String;
                                const Header             : String;
                                const NegativeAnswerHtml : String;
                                UserData                 : TObject;
                                Tags                     : array of const) : Boolean; overload; virtual;
        function   ValidateSession: Boolean; virtual;
        procedure  BeforeGetHandler(Proc   : TMyHttpHandler;
                                    var OK : Boolean); virtual;
        procedure  BeforeObjGetHandler(SObj   : TUrlHandler;
                                       var OK : Boolean); virtual;
        procedure  BeforePostHandler(Proc   : TMyHttpHandler;
                                     var OK : Boolean); virtual;
        procedure  BeforeObjPostHandler(SObj   : TUrlHandler;
                                        var OK : Boolean); virtual;
        procedure  NoGetHandler(var OK : Boolean); virtual;
        property HostName : String read GetHostName;
        property OnDestroying  : TNotifyEvent read  FOnDestroying
                                              write FOnDestroying;
        property AppServer : THttpAppSrv      read  FAppServer
                                              write FAppServer;
    end;

    THttpAllowedFlag = (afBeginBy, afExactMatch, afDirList);

    THttpAllowedElement = class
        Path     : String;
        HostTag  : String;      { V8.48 }
        Flags    : THttpAllowedFlag;
    end;

    THttpAllowedPath = class(TStringList)
    protected
        function GetElem(NItem: Integer): THttpAllowedElement;
    public
        destructor Destroy; override;
        property Elem[NItem: Integer] : THttpAllowedElement read GetElem;
    end;

    TUrlHandler = class(TComponent)
    protected
        FClient          : THttpAppSrvConnection;
        FFlags           : THttpGetFlag;
        FMsg_WM_FINISH   : UINT;
        FWndHandle       : HWND;
        FMethod          : THttpMethod;
        function  GetWSession: TWebSession;
        function  GetDocStream: TStream;
        procedure setDocStream(const Value: TStream);
        function  GetOnGetRowData: THttpGetRowDataEvent;
        procedure SetOnGetRowData(const Value: THttpGetRowDataEvent);
        procedure ClientDestroying(Sender : TObject); virtual;
    public
        destructor Destroy; override;
        procedure Execute; virtual;
        procedure Finish; virtual;
        procedure Display(const AMsg: String); virtual;
        function  CreateSession(const Params : String;
                                Expiration   : TDateTime;
                                SessionData  : TWebSessionData) : String;
        function  ValidateSession: Boolean; virtual;
        procedure DeleteSession;
        function  CheckSession(const NegativeAnswerHtml : String) : Boolean; overload;
        function  CheckSession(const Status             : String;
                               const Header             : String;
                               const NegativeAnswerHtml : String;
                               UserData                 : TObject;
                               Tags                     : array of const) : Boolean; overload;
        // Answer a page from a template file
        procedure AnswerPage(
            const Status   : String;   // if empty, default to '200 OK'
            const Header   : String;   // Do not use Content-Length nor Content-Type
            const HtmlFile : String;
            UserData       : TObject;
            Tags           : array of const
        {$IFDEF COMPILER12_UP};
            FileCodepage   : LongWord = CP_ACP;
            DstCodepage    : LongWord = CP_ACP
        {$ENDIF}
            ); overload;
        // Answer a page from a template resource
        procedure AnswerPage(
            const Status   : String;    // if empty, default to '200 OK'
            const Header   : String;    // Do not use Content-Length nor Content-Type
            const ResName  : String;    // Resource name
            const ResType  : PChar;     // Resource type
            UserData       : TObject;
            Tags           : array of const
        {$IFDEF COMPILER12_UP};
            ResCodepage    : LongWord = CP_ACP;
            DstCodepage    : LongWord = CP_ACP
        {$ENDIF}
            ); overload;
        procedure AnswerStream(const Status   : String;
                               const ContType : String;
                               const Header   : String);
        procedure AnswerString(const Status   : String;
                               const ContType : String;
                               const Header   : String;
                               const Body     : String
                           {$IFDEF COMPILER12_UP};
                               BodyCodepage   : LongWord = CP_ACP
                           {$ENDIF}
                               ); virtual;
        function  GetParams: String;
        procedure SetParams(const Value: String);
        property Client : THttpAppSrvConnection     read  FClient;
        property Flags  : THttpGetFlag              read  FFlags
                                                    write FFlags;
        property Params         : String            read  GetParams
                                                    write SetParams;
        property WSession : TWebSession             read  GetWSession;
        property DocStream                 : TStream
                                                     read  GetDocStream
                                                     write setDocStream;
        property  OnGetRowData   : THttpGetRowDataEvent
                                                    read  GetOnGetRowData
                                                    write SetOnGetRowData;
    end;

    THttpHandlerClass = class of TUrlHandler;

    THttpDispatchElement = class
        Path      : String;
        HostTag   : String;      { V8.48 }
        FLags     : THttpGetFlag;
        Proc      : Pointer;
        SObjClass : THttpHandlerClass;
    end;

    THttpHandlerList = class(TStringList)
    protected
        function GetDisp(NItem: Integer): THttpDispatchElement;
    public
        destructor Destroy; override;
        property Disp[NItem: Integer] : THttpDispatchElement read GetDisp;
    end;

    ArrayOfTVarRec = array of TVarRec;

    TArrayOfConstBuilder = class(TObject)
    protected
        FArray : ArrayOfTVarRec;
    public
        destructor Destroy; override;
        procedure Add(const Value : String); overload;
        procedure Add(const Value : Integer); overload;
        procedure Add(const Value1, Value2 : String); overload;
        procedure Add(const Value1 : String; const Value2 : Integer); overload;
        property Value : ArrayOfTVarRec read FArray;
    end;

    TDeleteSessionEvent = procedure (Sender : TObject;
                                     Session : TWebSession) of object;

{$IFDEF USE_SSL}
    THttpAppSrv = class(TCustomSslHttpServer)              //  V8.02 Angus
{$ELSE}
    THttpAppSrv = class(THttpServer)
{$ENDIF USE_SSL}
    protected
        FGetHandler      : THttpHandlerList;
        FPostHandler     : THttpHandlerList;
        FGetAllowedPath  : THttpAllowedPath;
        FWSessions       : TWebSessions;
        FSessionTimer    : TIcsTimer;  { V8.57 }
        FMsg_WM_FINISH   : UINT;
        FHasAllocateHWnd : Boolean;
        FOnDeleteSession : TDeleteSessionEvent;
        FOnVirtualExceptionEvent : TVirtualExceptionEvent;      { V7.05 }
        FOnDisplay       : THttpAppSrvDisplayEvent;
        procedure AllocateMsgHandlers; override;
        procedure FreeMsgHandlers; override;
        function  MsgHandlersCount: Integer; override;
        procedure WndProc(var MsgRec: TMessage); override;
        procedure WMFinish(var msg: TMessage);
        function GetDispatchVirtualDocument(ClientCnx: THttpAppSrvConnection;
                                            var Flags: THttpGetFlag): Boolean;
        function GetDispatchNormalDocument(ClientCnx: THttpConnection;
                                           var Flags: THttpGetFlag): Boolean;
        function PostDispatchVirtualDocument(ClientCnx : THttpAppSrvConnection;
                                             var Flags : THttpGetFlag;
                                             ExecFlag  : Boolean): Boolean;
        procedure TriggerPostDocument(Sender    : TObject;
                                      var Flags : THttpGetFlag); override;
        procedure TriggerGetDocument(Sender    : TObject;
                                     var Flags : THttpGetFlag); override;
        procedure TriggerHeadDocument(       { V7.05 can not ignore HEAD command }
                                     Sender     : TObject;
                                     var Flags  : THttpGetFlag); override;
        procedure TriggerPostedData(Sender: TObject; ErrCode: WORD); override;
        procedure TriggerClientConnect(Client : TObject; ErrCode : WORD); override;
        function  GetSessions(nIndex: Integer): TWebSession;
        function  GetSessionsCount: Integer;
        function  GetSessionTimeout: Integer;
        procedure SetSessionTimeout(const Value: Integer);
        function  GetMaxSessions: Integer;               { V8.02 }
        procedure SetMaxSessions(const Value: Integer);  { V8.02 }
        procedure DeleteSessionHandler(Sender: TObject; Session: TWebSession);
        procedure SessionTimerHandler(Sender: TObject);
    public
        constructor Create(AOwner : TComponent); override;
        destructor  Destroy; override;
        function    Start(ReturnErrs: Boolean = false): String; override; { V8.49 made function }
        procedure   Stop; override;
        procedure   SaveSessionsToFile(const FileName : String);
        procedure   LoadSessionsFromFile(const FileName : String);
        procedure   ClearSessions;
        procedure   Display(Sender: TObject; const AMsg: String);
        procedure   AddGetHandler(const Path : String;
                                  Proc       : Pointer;
                                  FLags      : THttpGetFlag = hgWillSendMySelf;
                                  HostTag    : String = '');      { V8.48 }
                                  overload;
        procedure   AddGetHandler(const Path : String;
                                  SObjClass  : THttpHandlerClass;
                                  FLags      : THttpGetFlag = hgWillSendMySelf;
                                  HostTag    : String = '');      { V8.48 }
                                  overload;
        procedure   AddGetAllowedPath(const Path : String;
                                      Flags      : THttpAllowedFlag;
                                      HostTag    : String = '');      { V8.48 }
        procedure   AddPostHandler(const Path : String;
                                   Proc       : Pointer;
                                   FLags      : THttpGetFlag = hgWillSendMySelf;
                                   HostTag    : String = '');      { V8.48 }
                                   overload;
        procedure   AddPostHandler(const Path : String;
                                   SObjClass  : THttpHandlerClass;
                                   FLags      : THttpGetFlag = hgWillSendMySelf;
                                   HostTag    : String = '');      { V8.48 }
                                   overload;
        property SessionsCount              : Integer     read GetSessionsCount;
        property Sessions[nIndex : Integer] : TWebSession read GetSessions;
        property WSessions : TWebSessions read FWSessions;
    published
        property SessionTimeout  : Integer                read  GetSessionTimeout
                                                          write SetSessionTimeout;
        property MaxSessions  : Integer                   read  GetMaxSessions         { V8.02 }
                                                          write SetMaxSessions;
        property OnDeleteSession : TDeleteSessionEvent    read  FOnDeleteSession
                                                          write FOnDeleteSession;
        property OnVirtualException : TVirtualExceptionEvent read  FOnVirtualExceptionEvent
                                                             write FOnVirtualExceptionEvent;      { V7.05 }
        property OnDisplay : THttpAppSrvDisplayEvent      read  FOnDisplay
                                                          write FOnDisplay;
    end;

{$IFDEF USE_SSL}
    TSslHttpAppSrv = class(THttpAppSrv)     //  V8.02 Angus
    published
        property SslEnable;
        property SslContext;
        property IcsHosts;                      { V8.45 }
        property RootCA;                        { V8.45 }
        property DHParams;                      { V8.45 }
        property SslCliCertMethod;              { V8.57 }
        property SslCertAutoOrder;              { V8.57 }
        property CertExpireDays;                { V8.57 }
        property SslX509Certs;                  { V8.57 }
        property OnSslVerifyPeer;
        property OnSslSetSessionIDContext;
        property OnSslSvrNewSession;
        property OnSslSvrGetSession;
        property OnSslHandshakeDone;
        property OnSslServerName;                 { V8.50 }
        property OnSslAlpnSelect;                 { V8.56 }
    end;

procedure IcsLoadTHttpAppSrvFromIni(MyIniFile: TCustomIniFile; HttpAppSrv:
                THttpAppSrv; const Section: String = 'HttpAppSrv');      { V8.48 }

{$ENDIF} // USE_SSL

{$IFDEF MSWINDOWS} // todo: make it POSIX compatible
function ReverseTextFileToHtmlToString(
    const LogViewURL : String;
    const TextFont   : String;
    const LinksFont  : String;
    const FirstText  : String;
    const NextText   : String;
    const PrevText   : String;
    const LastText   : String;
    const FileName   : String;
    const APageSize  : Integer;           // 0 is default page size
    const APosInt    : Integer) : String; // Start position, 0 is end of file
procedure ReverseTextFileToHtmlToStream(
    Stream           : TStream;
    const LogViewURL : String;
    const TextFont   : String;
    const LinksFont  : String;
    const FirstText  : String;
    const NextText   : String;
    const PrevText   : String;
    const LastText   : String;
    const FileName   : String;
    const APageSize  : Integer;      // 0 is default page size
    const APosInt    : Integer);     // Start position, 0 is end of file
{$ENDIF}
const
    NO_CACHE       = 'Pragma: no-cache' + #13#10 + 'Expires: -1' + #13#10;


implementation


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
constructor THttpAppSrv.Create(AOwner: TComponent);
begin
    inherited Create(AOwner);
    // At time of writing, the ancestor class do not call AllocateHWnd, so
    // we must do it. Just chech Window Handle to avoid allocating twice...
    if FHandle = 0 then begin
        FHasAllocateHWnd := TRUE;
        AllocateHWnd;
    end;
    FGetHandler                := THttpHandlerList.Create;
    FGetAllowedPath            := THttpAllowedPath.Create;
    FPostHandler               := THttpHandlerList.Create;
    FWSessions                 := TWebSessions.Create(nil);
    FWSessions.OnDeleteSession := DeleteSessionHandler;
    FClientClass               := THttpAppSrvConnection;
    FSessionTimer              := TIcsTimer.Create(Self);    { V8.57 }
    FSessionTimer.Enabled      := FALSE;
    FSessionTimer.OnTimer      := SessionTimerHandler;
{$IFDEF USE_SSL}
    FHttpSslEnable             := FALSE;  // V8.02, renamed V8.50 
    FWSocketServer.SslEnable   := FALSE;  // V8.02
{$ENDIF}
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
destructor THttpAppSrv.Destroy;
begin
    FreeAndNil(FSessionTimer);
    FreeAndNil(FGetHandler);
    FreeAndNil(FGetAllowedPath);
    FreeAndNil(FPostHandler);
    FreeAndNil(FWSessions);
    inherited;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpAppSrv.Display(Sender: TObject; const AMsg: String);
begin
    if Assigned(FOnDisplay) then
        FOnDisplay(Sender, AMsg);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function THttpAppSrv.MsgHandlersCount : Integer;
begin
    Result := 1 + inherited MsgHandlersCount;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpAppSrv.AllocateMsgHandlers;
begin
    inherited AllocateMsgHandlers;
    FMsg_WM_FINISH := FWndHandler.AllocateMsgHandler(Self);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpAppSrv.FreeMsgHandlers;
begin
    if Assigned(FWndHandler) then
        FWndHandler.UnregisterMessage(FMsg_WM_FINISH);
    inherited FreeMsgHandlers;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpAppSrv.WndProc(var MsgRec: TMessage);
begin
    with MsgRec do begin
        { We *MUST* handle all exception to avoid application shutdown }
        if Msg = FMsg_WM_FINISH then begin
            try
                WMFinish(MsgRec)
            except
                on E:Exception do
                    HandleBackGroundException(E);
            end;
        end
        else
            inherited WndProc(MsgRec);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpAppSrv.WMFinish(var Msg: TMessage);
var
    SObj : TUrlHandler;
    I    : Integer;
begin
    SObj := TUrlHandler(Msg.LParam);
    if Assigned(SObj) then begin
        for I := 0 to ComponentCount - 1 do begin
            if SObj = Components[I] then begin
                SObj.Free;
                Exit;
            end;
        end;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function THttpAppSrv.Start(ReturnErrs: Boolean = false): String;  { V8.49 made function }
begin
    FSessionTimer.Interval     := 15000;
    FSessionTimer.Enabled      := TRUE;
    Result := inherited Start(ReturnErrs);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpAppSrv.Stop;
begin
    FSessionTimer.Enabled      := FALSE;
    inherited Stop;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpAppSrv.AddGetHandler(
    const Path : String;
    Proc       : Pointer;
    FLags      : THttpGetFlag = hgWillSendMySelf;
    HostTag    : String = '');      { V8.48 }
var
    Disp  : THttpDispatchElement;
    Index : Integer;
    Key   : String;
begin
    Key := {$IFDEF POSIX}Path{$ELSE}IcsUpperCase(Path){$ENDIF} + '|' + HostTag;  { V8.48 }
    Index := FGetHandler.IndexOf(Key);   { V8.48 }
    if Index >= 0 then begin
        // Already exists, update
        Disp           := THttpDispatchElement(FGetHandler.Objects[Index]);
        Disp.FLags     := Flags;
        Disp.Proc      := Proc;
        Disp.SObjClass := nil;
    end
    else begin
        // Add a new entry
        Disp           := THttpDispatchElement.Create;
        Disp.Path      := Path;
        Disp.HostTag   := HostTag;  { V8.48 }
        Disp.FLags     := Flags;
        Disp.Proc      := Proc;
        Disp.SObjClass := nil;
        FGetHandler.AddObject(Key, Disp);   { V8.48 }
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpAppSrv.AddGetHandler(
    const Path : String;
    SObjClass  : THttpHandlerClass;
    FLags      : THttpGetFlag = hgWillSendMySelf;
    HostTag    : String = '');      { V8.48 }
var
    Disp  : THttpDispatchElement;
    Index : Integer;
    Key   : String;
begin
    Key := {$IFDEF POSIX}Path{$ELSE}IcsUpperCase(Path){$ENDIF} + '|' + HostTag;  { V8.48 }
    Index := FGetHandler.IndexOf(Key);
    if Index >= 0 then begin
        // Already exists, update
        Disp           := THttpDispatchElement(FGetHandler.Objects[Index]);
        Disp.FLags     := Flags;
        Disp.Proc      := nil;
        Disp.SObjClass := SObjClass;
    end
    else begin
        // Add a new entry
        Disp           := THttpDispatchElement.Create;
        Disp.Path      := Path;
        Disp.HostTag   := HostTag;  { V8.48 }
        Disp.FLags     := Flags;
        Disp.Proc      := nil;
        Disp.SObjClass := SObjClass;
        FGetHandler.AddObject(Key, Disp);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpAppSrv.AddPostHandler(
    const Path : String;
    SObjClass  : THttpHandlerClass;
    FLags      : THttpGetFlag = hgWillSendMySelf;
    HostTag    : String = '');      { V8.48 }
var
    Disp  : THttpDispatchElement;
    Index : Integer;
    Key   : String;
begin
    Key := {$IFDEF POSIX}Path{$ELSE}IcsUpperCase(Path){$ENDIF} + '|' + HostTag;  { V8.48 }
    Index := FPostHandler.IndexOf(Key);
    if Index >= 0 then begin
        // Already exists, update
        Disp           := THttpDispatchElement(FPostHandler.Objects[Index]);
        Disp.FLags     := Flags;
        Disp.Proc      := nil;
        Disp.SObjClass := SObjClass;
    end
    else begin
        // Add a new entry
        Disp           := THttpDispatchElement.Create;
        Disp.Path      := Path;
        Disp.FLags     := Flags;
        Disp.HostTag   := HostTag;  { V8.48 }
        Disp.Proc      := nil;
        Disp.SObjClass := SObjClass;
        FPostHandler.AddObject(Key, Disp);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpAppSrv.AddPostHandler(
    const Path : String;
    Proc       : Pointer;
    FLags      : THttpGetFlag = hgWillSendMySelf;
    HostTag    : String = '');      { V8.48 }
var
    Disp  : THttpDispatchElement;
    Index : Integer;
    Key   : String;
begin
    Key := {$IFDEF POSIX}Path{$ELSE}IcsUpperCase(Path){$ENDIF} + '|' + HostTag;  { V8.48 }
    Index := FPostHandler.IndexOf(Key);
    if Index >= 0 then begin
        // Already exists, update
        Disp           := THttpDispatchElement(FPostHandler.Objects[Index]);
        Disp.FLags     := Flags;
        Disp.Proc      := Proc;
        Disp.SObjClass := nil;
    end
    else begin
        // Add a new entry
        Disp           := THttpDispatchElement.Create;
        Disp.Path      := Path;
        Disp.HostTag   := HostTag;  { V8.48 }
        Disp.FLags     := Flags;
        Disp.Proc      := Proc;
        Disp.SObjClass := nil;
        FPostHandler.AddObject(Key, Disp);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{$IFNDEF COMPILER7_UP}
function AnsiStartsText(const ASubText, AText: string): Boolean;
var
  P: PChar;
  L, L2: Integer;
begin
  P := PChar(AText);
  L := Length(ASubText);
  L2 := Length(AText);
  if L > L2 then
    Result := False
  else
    Result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE,
      P, L, PChar(ASubText), L) = 2;
end;
{$ENDIF}


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function THttpAppSrv.PostDispatchVirtualDocument(
    ClientCnx : THttpAppSrvConnection;
    var Flags : THttpGetFlag;
    ExecFlag  : Boolean): Boolean;
var
    Proc     : TMethod;
    OK       : Boolean;
    Disp     : THttpDispatchElement;
    SObj     : TUrlHandler;
    I, J     : Integer;
    PathBuf  : String;
    Status   : Boolean;
begin
    for I := 0 to FPostHandler.Count - 1 do begin
        Disp := FPostHandler.Disp[I];  { V8.48 }
        PathBuf := Disp.Path;          { V8.48 }
        J       := Length(PathBuf);
        if PathBuf[J] = '*' then begin
            SetLength(PathBuf, J - 1);
            Status := AnsiStartsText(PathBuf, ClientCnx.Path);
        end
        else
            Status := (CompareText(PathBuf, ClientCnx.Path) = 0);

      { V8.48 if HostTag specified, match it }
        if Status and (ClientCnx.HostTag <> '') and (Disp.HostTag <> '') then begin
            if (Disp.HostTag <> ClientCnx.HostTag) then Status := False;
        end;

        if Status then begin
            Result    := TRUE;
            if ExecFlag then begin
                Disp      := FPostHandler.Disp[I];
                Flags     := Disp.FLags;
                OK        := TRUE;
                if Disp.Proc <> nil then begin
                    Proc.Code := Disp.Proc;
                    Proc.Data := ClientCnx;
                    ClientCnx.BeforePostHandler(TMyHttpHandler(Proc), OK);
                    if OK and (Proc.Code <> nil) then
                        TMyHttpHandler(Proc)(Flags);
                end
                else if Disp.SObjClass <> nil then begin
                    SObj := Disp.SObjClass.Create(Self);
                    try
                        SObj.FClient           := ClientCnx;
                        SObj.FFlags            := Disp.FLags;
                        SObj.FMsg_WM_FINISH    := FMsg_WM_FINISH;
                        SObj.FWndHandle        := FHandle;
                        SObj.FMethod           := httpMethodPost;
                        ClientCnx.OnDestroying := SObj.ClientDestroying;
                        ClientCnx.BeforeObjPostHandler(SObj, OK);
                        if OK then begin
                            SObj.Execute;
                            Flags := SObj.FFlags;
                        end
                        else begin
                            Flags := SObj.FFlags;
                            FreeAndNil(SObj);
                        end;
                    except
                        on E:Exception do
                        begin
                            FreeAndNil(SObj);
                            if Assigned (FOnVirtualExceptionEvent) then  { V7.05 }
                                FOnVirtualExceptionEvent (Self, E, httpMethodPost, ClientCnx.Path);
                        end;
                    end;
                end;
            end
            else begin
                ReallocMem(ClientCnx.PostedData,
                           ClientCnx.RequestContentLength + 1);
                ClientCnx.PostedDataLen  := 0;
                ClientCnx.FLineMode      := FALSE;
                Flags                    := hgAcceptData;
            end;
            Exit;
        end;
    end;

    Result := FALSE;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function THttpAppSrv.GetDispatchVirtualDocument(
    ClientCnx : THttpAppSrvConnection;
    var Flags : THttpGetFlag) : Boolean;
var
    I, J    : Integer;
    PathBuf : String;
    Status  : Boolean;
    Proc    : TMethod;
    OK      : Boolean;
    Disp    : THttpDispatchElement;
    SObj    : TUrlHandler;
begin
    for I := 0 to FGetHandler.Count - 1 do begin
        Disp := FGetHandler.Disp[I];  { V8.48 }
        PathBuf := Disp.Path;         { V8.48 }
        J := Length(PathBuf);
        if PathBuf[J] = '*' then begin
            SetLength(PathBuf, J - 1);
            Status := AnsiStartsText(PathBuf, ClientCnx.Path);
        end
        else
            Status := (CompareText(PathBuf, ClientCnx.Path) = 0);

      { V8.48 if HostTag specified, match it }
        if Status and (ClientCnx.HostTag <> '') and (Disp.HostTag <> '') then begin
            if (Disp.HostTag <> ClientCnx.HostTag) then Status := False;
        end;

        if Status then begin
            Result    := TRUE;
            Disp      := FGetHandler.Disp[I];
            Flags     := Disp.FLags;
            OK        := TRUE;
            if Disp.Proc <> nil then begin
                Proc.Code := Disp.Proc;
                Proc.Data := ClientCnx;
                ClientCnx.BeforeGetHandler(TMyHttpHandler(Proc), OK);
                if OK and (Proc.Code <> nil) then
                    TMyHttpHandler(Proc)(FLags);
            end
            else if Disp.SObjClass <> nil then begin
                SObj := Disp.SobjClass.Create(Self);
                try
                    SObj.FClient        := ClientCnx;
                    SObj.FFlags         := Disp.FLags;
                    SObj.FMsg_WM_FINISH := FMsg_WM_FINISH;
                    SObj.FWndHandle     := FHandle;
                    SObj.FMethod        := httpMethodGet;
                    ClientCnx.OnDestroying := SObj.ClientDestroying;
                    ClientCnx.BeforeObjGetHandler(SObj, OK);
                    if OK then begin
                        SObj.Execute;
                        Flags := SObj.FFlags;
                    end
                    else begin
                        Flags := SObj.FFlags;
                        FreeAndNil(SObj);
                    end;
                except
                    on E:Exception do
                    begin
                        FreeAndNil(SObj);
                        if Assigned (FOnVirtualExceptionEvent) then  { V7.05 }
                            FOnVirtualExceptionEvent (Self, E, httpMethodGet, ClientCnx.Path);
                    end;
                end;
            end;
            Exit;
        end;
    end;
    Result := FALSE;
    ClientCnx.NoGetHandler(Result);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function THttpAppSrv.GetDispatchNormalDocument(
    ClientCnx : THttpConnection;
    var Flags : THttpGetFlag) : Boolean;
var
    I    : Integer;
    Elem : THttpAllowedElement;
begin
    for I := 0 to FGetAllowedPath.Count - 1 do begin
        Elem := FGetAllowedPath.Elem[I];

       { V8.48 if HostTag specified, match it }
        if (ClientCnx.HostTag <> '') and (Elem.HostTag <> '') then begin
            if (Elem.HostTag <> ClientCnx.HostTag) then Continue;
        end;

        case Elem.Flags of
        afBeginBy:
            begin
                if AnsiStartsText(Elem.Path, ClientCnx.Path) then begin
                    Flags  := hgSendDoc;
                    Result := TRUE;
                    Exit;
                end;
            end;
        afExactMatch:
            begin
                if CompareText(Elem.Path, ClientCnx.Path) = 0 then begin
                    Flags  := hgSendDoc;
                    Result := TRUE;
                    Exit;
                end;
            end;
        afDirList:
            begin
                if CompareText(Elem.Path, ClientCnx.Path) = 0 then begin
                    Flags  := hgSendDirList;
                    Result := TRUE;
                    Exit;
                end;
            end;
        end;
    end;
    Result := FALSE;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpAppSrv.TriggerGetDocument(
     Sender     : TObject;
     var Flags  : THttpGetFlag);
begin
//OutputDebugString(PChar('HTTP_GET  ' + (Sender as THttpAppSrvConnection).Path));
    inherited TriggerGetDocument(Sender, Flags);
    if Flags in [hgWillSendMySelf, hg404, hg403, hg401, hgAcceptData,   { V7.03 don't ignore Flags }
                                                        hgSendDirList] then
        Exit ;

    // Handle all virtual documents. Returns TRUE if document handled.
    if GetDispatchVirtualDocument(Sender as THttpAppSrvConnection, Flags) then
        Exit;

    // Handle all normal (static) documents. Returns TRUE if document handled.
    if GetDispatchNormalDocument(Sender as THttpConnection, Flags) then
        Exit;

    // Reject anything else
    Flags := hg404;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpAppSrv.TriggerHeadDocument(       { V7.05 can not ignore HEAD command }
     Sender     : TObject;
     var Flags  : THttpGetFlag);
begin
//OutputDebugString(PChar('HTTP_HEAD  ' + (Sender as THttpAppSrvConnection).Path));
    inherited TriggerHeadDocument(Sender, Flags);
    if Flags in [hgWillSendMySelf, hg404, hg403, hg401, hgAcceptData,
                                                        hgSendDirList] then
        Exit ;

    // Handle all virtual documents. Returns TRUE if document handled.
    if GetDispatchVirtualDocument(Sender as THttpAppSrvConnection, Flags) then
        Exit;

    // Handle all normal (static) documents. Returns TRUE if document handled.
    if GetDispatchNormalDocument(Sender as THttpConnection, Flags) then
        Exit;

    // Reject anything else
    Flags := hg404;
end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpAppSrv.TriggerPostDocument(
    Sender    : TObject;
    var Flags : THttpGetFlag);
begin
//OutputDebugString(PChar('HTTP_POST ' + (Sender as THttpAppSrvConnection).Path));
    inherited TriggerPostDocument(Sender, Flags);

    // Handle all virtual documents. Returns TRUE if document handled.
    if PostDispatchVirtualDocument(Sender as THttpAppSrvConnection, Flags, FALSE) then
        Exit;

    // Reject anything else
    Flags := hg404;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
destructor THttpHandlerList.Destroy;
var
    I : Integer;
begin
    for I := Count - 1 downto 0 do begin
        if Assigned(Objects[I]) then begin
            Objects[I].Free;
            Objects[I] := nil;
        end;
        Self.Delete(I);
    end;
    inherited Destroy;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function THttpHandlerList.GetDisp(NItem: Integer): THttpDispatchElement;
begin
    Result := Objects[NItem] as THttpDispatchElement;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpAppSrv.AddGetAllowedPath(
    const Path : String;
    Flags      : THttpAllowedFlag;
    HostTag    : String = '');      { V8.48 }
var
    Item  : THttpAllowedElement;
    Index : Integer;
    Key   : String;
begin
    Key := {$IFDEF POSIX}Path{$ELSE}IcsUpperCase(Path){$ENDIF} + '|' + HostTag;
    Index := FGetAllowedPath.IndexOf(Key);  { V8.48 }
    if Index >= 0 then begin
        // Update the element if the path already exists
        Item       := THttpAllowedElement(FGetAllowedPath.Objects[Index]);
        Item.Flags := Flags;
    end
    else begin
        // Create a new element if path doesn't exist yet
        Item         := THttpAllowedElement.Create;
        Item.Path    := Path;
        Item.HostTag := HostTag;  { V8.48 }
        Item.Flags   := Flags;
        FGetAllowedPath.AddObject(Key, Item);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
destructor THttpAllowedPath.Destroy;
var
    I : Integer;
begin
    for I := Count - 1 downto 0 do begin
        if Assigned(Objects[I]) then begin
            Objects[I].Free;
            Objects[I] := nil;
        end;
        Self.Delete(I);
    end;
    inherited Destroy;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function THttpAllowedPath.GetElem(NItem: Integer): THttpAllowedElement;
begin
    Result :=  Objects[NItem] as THttpAllowedElement;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpAppSrv.TriggerPostedData(
    Sender     : TObject;
    ErrCode    : WORD);
var
    Len        : Integer;
    Remains    : Integer;
    Junk       : array [0..255] of char;
    ClientCnx  : THttpAppSrvConnection;
    Dummy      : THttpGetFlag;
begin
    ClientCnx := Sender as THttpAppSrvConnection;

    { How much data do we have to receive ? }
    Remains := ClientCnx.RequestContentLength - ClientCnx.PostedDataLen;
    if Remains <= 0 then begin
        { We got all our data. Junk anything else ! }
        Len := ClientCnx.Receive(@Junk, SizeOf(Junk) - 1);
        if Len >= 0 then
            Junk[Len] := #0;
        Exit;
    end;
    { Receive as much data as we need to receive. But warning: we may       }
    { receive much less data. Data will be split into several packets we    }
    { have to assemble in our buffer.                                       }
    Len := ClientCnx.Receive(ClientCnx.PostedData + ClientCnx.PostedDataLen, Remains);
    { Sometimes, winsock doesn't wants to givve any data... }
    if Len <= 0 then
        Exit;

    { Add received length to our count }
    Inc(ClientCnx.PostedDataLen, Len);
    { Add a nul terminating byte (handy to handle data as a string) }
    ClientCnx.PostedData[ClientCnx.PostedDataLen] := #0;
    { Display receive data so far }
    //Display('Data: ''' + StrPas(ClientCnx.PostedData) + '''');

    { When we received the whole thing, we can process it }
    if ClientCnx.PostedDataLen = ClientCnx.RequestContentLength then begin
        { First we must tell the component that we've got all the data }
        ClientCnx.PostedDataReceived;
        // Execute the request
        if PostDispatchVirtualDocument(ClientCnx, Dummy, TRUE) then
            Exit;
        ClientCnx.Answer404;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
destructor THttpAppSrvConnection.Destroy;
begin
    if Assigned(FOnDestroying) then
        FOnDestroying(Self);

    if Assigned(PostedData) then begin
        FreeMem(PostedData);
        PostedData := nil;
        PostedDataLen    := 0;
    end;
    inherited Destroy;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// CreateSession is intented to create a new session and return a cookie with
// the session ID. Usually CreateSession is called to provide third argument
// to AnswerPage when login user/pass are correct. See CancelSession for the
// case where user/pass is invalid.
function THttpAppSrvConnection.CreateSession(
    const Params : String;                    // Used to create the SessionID
    Expiration   : TDateTime;                 // Cookie expiration
    SessionData  : TWebSessionData) : String; // Optional session data
begin
    WSession             := WSessions.CreateSession(Params, WSessionID);
    WSession.SessionData := SessionData;
    WSessions.ReleaseSession(@WSession);
    if Expiration <> 0 then                          { 26/08/04 }
        Expiration := Expiration + Now;
    Result := NO_CACHE +
              MakeCookie(WSessionCookie, WSessionID, Expiration, '/')
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// CancelSession is intended to delete an existing session and create an
// expired cookie to be sent back to the client. CancelSession is usually
// called to provide third argument to AnswerPage when login user/pass are
// not correct. See CreateSession for the case where user/pass are correct.
function THttpAppSrvConnection.CancelSession : String;
begin
    GetCookieValue(RequestCookies, WSessionCookie, WSessionID);
    WSessions.DeleteSession(WSessionID);
    WSession := nil;
    Result := NO_CACHE +
              MakeCookie(WSessionCookie, '0', EncodeDate(2000, 1, 1), '/');
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Extract session ID information from cookie
// Validate session ID again session list
// Return TRUE is valid session found
// ValidateSession is normally called from the login processor to delete any
// existing session before creating a new one.
function THttpAppSrvConnection.ValidateSession : Boolean;
begin
    GetCookieValue(FRequestCookies, WSessionCookie, WSessionID);
    WSession := WSessions.FindSession(WSessionID);
    // FindSession will check if session is expired and return nil if so
    Result   := Assigned(WSession);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Same as ValidateSession except it will send a reply when session is
// invalid. Usually the reply is a page telling telling the user to logon.
// CheckSession is normally called in the very beginning of processing for
// all pages that must be protected by a valid session.
function THttpAppSrvConnection.CheckSession(
    var Flags                : THttpGetFlag;
    const NegativeAnswerHtml : String): Boolean;
begin
    Result := ValidateSession;
    if (not Result) and (NegativeAnswerHtml <> '') then
        AnswerPage(Flags, '', NO_CACHE, NegativeAnswerHtml, nil, []);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Same as ValidateSession except it will send a reply when session is
// invalid. Usually the reply is a page telling telling the user to logon.
// CheckSession is normally called in the very beginning of processing for
// all pages that must be protected by a valid session.
function THttpAppSrvConnection.CheckSession(
    var   Flags              : THttpGetFlag;
    const Status             : String;   { if empty, default to '200 OK'              }
    const Header             : String;   { Do not use Content-Length nor Content-Type }
    const NegativeAnswerHtml : String;
    UserData                 : TObject;
    Tags                     : array of const) : Boolean;
begin
    Result := ValidateSession;
    if (not Result) and (NegativeAnswerHtml <> '') then
        AnswerPage(Flags, Status, Header, NegativeAnswerHtml, UserData, Tags);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpAppSrv.TriggerClientConnect(Client: TObject; ErrCode: WORD);
begin
   (Client as THttpAppSrvConnection).WSessions := FWSessions;
   (Client as THttpAppSrvConnection).WSessionCookie := 'IcsWebCookie' + Port;
   (Client as THttpAppSrvConnection).AppServer := Self;
   inherited TriggerClientConnect(Client, ErrCode);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function THttpAppSrvConnection.GetHostName: String;
begin
    Result := AnsiToUnicode(WSocketResolveIp(AnsiString(PeerAddr)));
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpAppSrv.SaveSessionsToFile(const FileName: String);
begin
    if Assigned(FWSessions) then
        FWSessions.SaveToFile(FileName);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpAppSrv.LoadSessionsFromFile(const FileName: String);
begin
    if Assigned(FWSessions) then
        FWSessions.LoadFromFile(FileName);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpAppSrv.ClearSessions;
begin
    if Assigned(FWSessions) then
        FWSessions.Clear;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function THttpAppSrv.GetSessions(nIndex: Integer): TWebSession;
begin
    if not Assigned(FWSessions) then
        Result := nil
    else begin
        if (nIndex < 0) or (nIndex >= FWSessions.Count) then
            raise ERangeError.Create('THttpAppSrv.Sessions[' +
                                     IntToStr(nIndex) +
                                     ']: Index out of range');
        Result := FWSessions.Sessions[nIndex];
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function THttpAppSrv.GetSessionsCount: Integer;
begin
    if not Assigned(FWSessions) then
        Result := 0
    else
        Result := FWSessions.Count;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function THttpAppSrv.GetSessionTimeout: Integer;
begin
    if not Assigned(FWSessions) then
        Result := 0
    else
        Result := FWSessions.MaxAge;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpAppSrv.SetSessionTimeout(const Value: Integer);
begin
    if Assigned(FWSessions) then
        FWSessions.MaxAge := Value;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function THttpAppSrv.GetMaxSessions: Integer;
begin
    if not Assigned(FWSessions) then
        Result := 0
    else
        Result := FWSessions.MaxSessions;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpAppSrv.SetMaxSessions(const Value: Integer);
begin
    if Assigned(FWSessions) then
        FWSessions.MaxSessions := Value;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// DeleteSessionHandler is called when FTimeList delete a session, for example
// when a session has expired or when the component is destroyed while sessions
// are still active
procedure THttpAppSrv.DeleteSessionHandler(
    Sender  : TObject;
    Session : TWebSession);
begin
    if Assigned(FOnDeleteSession) then
        FOnDeleteSession(Self, Session);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpAppSrv.SessionTimerHandler(Sender : TObject);
begin
    if Assigned(FWSessions) then
        FWSessions.RemoveAged;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{$IFDEF MSWINDOWS}
function ReverseTextFileToHtmlToString(
    const LogViewURL : String;
    const TextFont   : String;
    const LinksFont  : String;
    const FirstText  : String;
    const NextText   : String;
    const PrevText   : String;
    const LastText   : String;
    const FileName   : String;
    const APageSize  : Integer;           // 0 is default page size
    const APosInt    : Integer) : String; // Start position, 0 is end of file
var
    Stream : TMemoryStream;
begin
    Stream := TMemoryStream.Create;
    try
        ReverseTextFileToHtmlToStream(Stream, LogViewURL,
                                      TextFont, LinksFont,
                                      FirstText, NextText, PrevText, LastText,
                                      FileName,
                                      APageSize, APosInt);
        SetLength(Result, Stream.Size);
        Stream.Seek(0, 0);
        Stream.Read(Result[1], Stream.Size);
    finally
        Stream.Free;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure ReverseTextFileToHtmlToStream(
    Stream           : TStream;
    const LogViewURL : String;
    const TextFont   : String;
    const LinksFont  : String;
    const FirstText  : String;
    const NextText   : String;
    const PrevText   : String;
    const LastText   : String;
    const FileName   : String;
    const APageSize  : Integer;      // 0 is default page size
    const APosInt    : Integer);     // Start position, 0 is end of file
var
    Line        : String;
    PageSize    : Integer;
    PosInt      : Integer;
    PosNext     : Integer;
    PosPrev     : Integer;
    FileHdl     : THANDLE;
//  OpenBuf     : _OFSTRUCT;
    MapHdl      : THandle;
    MapAddr     : PChar;
    FSize       : Integer;
    P, Q        : PChar;
    R, S        : PChar;
    Count       : Integer;
    PageSizeStr : String;
    Links       : String;
begin
    if APageSize > 0 then begin
        PageSizeStr := '&pagesize=' + IntToStr(APageSize);
        PageSize    := APageSize;
    end
    else begin
        PageSizeStr := '';
        PageSize    := 25;
    end;

//  FileHdl := OpenFile(PChar(FileName), OpenBuf, OF_READ);
    FileHdl := IcsFileCreateW(FileName, OPEN_EXISTING);
    if FileHdl = HFILE_ERROR then begin
        Line := 'Unable to open file';
        Stream.Write(Line[1], Length(Line));
        Exit;
    end;
    FSize := GetFileSize(FileHdl, nil);
    if FSize <= 0 then begin
        CloseHandle(FileHdl);
        Line := 'File is empty';
        Stream.Write(Line[1], Length(Line));
        Exit;
    end;

    MapHdl := CreateFileMapping(FileHdl, nil, PAGE_READONLY, 0, 0, nil);
    if MapHdl = 0 then begin
        CloseHandle(FileHdl);
        Line := 'Unable to create file mapping';
        Stream.Write(Line[1], Length(Line));
        Exit;
    end;

    MapAddr := MapViewOfFile(MapHdl, FILE_MAP_READ, 0, 0, 0);
    if MapAddr = nil then begin
        CloseHandle(MapHdl);
        CloseHandle(FileHdl);
        Line := 'Unable to map view of file';
        Stream.Write(Line[1], Length(Line));
        Exit;
    end;

    if (APosInt = 0) or (APosInt >= FSize) then
        PosInt := FSize - 1
    else
        PosInt := APosInt;

    if PosInt < 0 then begin
        // Start with last page, that is start of file
        P       := MapAddr;
        PosNext := 0;
        // Go forward PAGE_SIZE lines
        R     := MapAddr;
        Count := PageSize - 1;
        while (R < (MapAddr + FSize)) and (Count >= 0) do begin
            while (R < (MapAddr + FSize)) and (R^ <> #10) do
                Inc(R);
            Inc(R);
            Dec(Count);
        end;
        Q := R - 1;
        Count := PageSize - 1;
    end
    else begin
        Q := MapAddr + PosInt;
        // Go back PAGE_SIZE lines
        P     := Q;
        Count := PageSize;
        while (P > MapAddr) and (Count >= 0) do begin
            while (P > MapAddr) and (P^ <> #10) do
                Dec(P);
            if P^ <> #10 then
                break;
            Dec(P);
            Dec(Count);
        end;
        PosNext := P - MapAddr;
        if P^ = #10 then
            Inc(PosNext);
        if (P < Q) and (P^ = #13) then
            Inc(P);
        if (P < Q) and (P^ = #10) then
            Inc(P);
        R     := Q + 1;
        Count := PageSize;
    end;

    // Go forward PAGE_SIZE lines
    while (R < (MapAddr + FSize)) and (Count >= 0) do begin
        while (R < (MapAddr + FSize)) and (R^ <> #10) do
            Inc(R);
        Inc(R);
        Dec(Count);
    end;
    PosPrev := R - MapAddr;
    if PosPrev >= FSize then
        PosPrev := FSize - 1;

    try
        Links := LinksFont;

        if PageSizeStr = '' then
            Links := Links + '<A HREF="' + LogViewUrl + '">' +
                             FirstText + '</A>  '
        else
            Links := Links + '<A HREF="' + LogViewUrl + '?' +
                             Copy(PageSizeStr, 2, 20) + '">' +
                             FirstText + '</A>  ';

        if PosNext > 0 then
            Links := Links + '<A HREF="' + LogViewUrl + '?'  +
                             'pos=' + IntToStr(PosNext) + PageSizeStr +
                             '">' + NextText + '</A>  '
        else
            Links := Links + NextText + ' ';

        if PosPrev > PosInt  then
            Links := Links + '<A HREF="' + LogViewUrl + '?pos=' +
                             IntToStr(PosPrev) + PageSizeStr + '">' + PrevText + '</A>  '
        else
            Links := Links + PrevText + ' ';

        Links := Links + '<A HREF="' + LogViewUrl + '?'  +
                         'pos=%2D1' + PageSizeStr + '">' + LastText + '</A>  ';
        Stream.Write(Links[1], Length(Links));

        Line := '<BR><BR>' + TextFont;
        Stream.Write(Line[1], Length(Line));
        S := Q;
        while (S >= P) do begin
            R := S;
            while (S > P) and (S^ <> #10) do
                Dec(S);
            if S^ = #10 then
                Inc(S);
            if R > S then begin
                SetString(Line, S, R - S);
                Line := TextToHtmlText(Line) + '<BR>' + #13#10;
                Stream.Write(Line[1], Length(Line));
            end;
            Dec(S, 2);
        end;

        Line := '<BR>';
        Stream.Write(Line[1], Length(Line));
        Stream.Write(Links[1], Length(Links));
    finally
        UnmapViewOfFile(MapAddr);
        CloseHandle(MapHdl);
        CloseHandle(FileHdl);
    end;
end;
{$ENDIF}

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpAppSrvConnection.BeforeGetHandler(
    Proc   : TMyHttpHandler;
    var OK : Boolean);
begin
     // Nothing to do here, just to allow overriden method
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpAppSrvConnection.BeforeObjGetHandler(
    SObj   : TUrlHandler;
    var OK : Boolean);
begin
     // Nothing to do here, just to allow overriden method
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpAppSrvConnection.BeforePostHandler(
    Proc   : TMyHttpHandler;
    var OK : Boolean);
begin
     // Nothing to do here, just to allow overriden method
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpAppSrvConnection.BeforeObjPostHandler(
    SObj   : TUrlHandler;
    var OK : Boolean);
begin
     // Nothing to do here, just to allow overriden method
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpAppSrvConnection.NoGetHandler(var OK : Boolean);
begin
     // Nothing to do here, just to allow overriden method
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TUrlHandler.Execute;
begin
     // Nothing to do here, just to allow overriden method
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TUrlHandler.Finish;
begin
    // We need to destroy the server object, but we can't do it safely from
    // one of his methods. Delaying the detroy until all queued events are
    // processed is better. This is why we use an intermediate message.
    if (FWndHandle <> 0) and (FMsg_WM_FINISH > 0) then
        PostMessage(FWndHandle, FMsg_WM_FINISH, 0, LPARAM(Self));
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TUrlHandler.ClientDestroying(Sender : TObject);
begin
    if FClient = Sender then
        FClient := nil;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TUrlHandler.GetDocStream: TStream;
begin
    if Assigned(Client) then
        Result := Client.DocStream
    else
        Result := nil;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TUrlHandler.GetOnGetRowData: THttpGetRowDataEvent;
begin
    if Assigned(Client) then
        Result := Client.OnGetRowData
    else
        Result := nil;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TUrlHandler.SetOnGetRowData(const Value: THttpGetRowDataEvent);
begin
    if Assigned(Client) then
        Client.OnGetRowData := Value;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TUrlHandler.SetDocStream(const Value: TStream);
begin
    if Assigned(Client) then
        Client.DocStream := Value;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TUrlHandler.GetWSession: TWebSession;
begin
    if Assigned(Client) then
        Result := Client.WSession
    else
        Result := nil;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TUrlHandler.GetParams: String;
begin
    if Assigned(Client) then
        Result := Client.Params
    else
        Result := '';
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TUrlHandler.SetParams(const Value: String);
begin
    if Assigned(Client) then
        Client.Params := Value;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TUrlHandler.AnswerPage(
    const Status, Header, HtmlFile: String;
    UserData: TObject; Tags: array of const
{$IFDEF COMPILER12_UP};
    FileCodepage   : LongWord = CP_ACP;
    DstCodepage    : LongWord = CP_ACP
{$ENDIF}
    );
begin
    if Assigned(Client) then
        Client.AnswerPage(FFlags, Status, Header, HtmlFile, UserData, Tags
                      {$IFDEF COMPILER12_UP},
                          FileCodepage, DstCodepage
                      {$ENDIF}
                          );
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TUrlHandler.AnswerPage(
    const Status   : String;    // if empty, default to '200 OK'
    const Header   : String;    // Do not use Content-Length nor Content-Type
    const ResName  : String;    // Resource name
    const ResType  : PChar;     // Resource type
    UserData       : TObject;
    Tags           : array of const
{$IFDEF COMPILER12_UP};
    ResCodepage    : LongWord = CP_ACP;
    DstCodepage    : LongWord = CP_ACP
{$ENDIF}
    );
begin
    if Assigned(Client) then
        Client.AnswerPage(FFlags, Status, Header,
                          ResName, ResType, UserData, Tags
                      {$IFDEF COMPILER12_UP},
                          ResCodepage, DstCodepage
                      {$ENDIF}
                          );
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TUrlHandler.AnswerStream(const Status, ContType, Header: String);
begin
    if Assigned(Client) then
        Client.AnswerStream(FFlags, Status, ContType, Header);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TUrlHandler.AnswerString(
    const Status, ContType, Header, Body: String
{$IFDEF COMPILER12_UP};
    BodyCodepage : LongWord = CP_ACP
{$ENDIF}
    );
begin
    if Assigned(Client) then
    {$IFDEF COMPILER12_UP}
        Client.AnswerStringEx(FFlags, Status, ContType, Header, Body, BodyCodepage);
    {$ELSE}
        Client.AnswerString(FFlags, Status, ContType, Header, Body);
    {$ENDIF}
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TUrlHandler.CheckSession(const NegativeAnswerHtml: String): Boolean;
begin
    if Assigned(Client) then
        Result := Client.CheckSession(FFlags, NegativeAnswerHtml)
    else
        Result := FALSE;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TUrlHandler.CheckSession(
    const Status, Header, NegativeAnswerHtml: String;
    UserData: TObject; Tags: array of const): Boolean;
begin
    if Assigned(Client) then
        Result := Client.CheckSession(FFlags, Status, Header,
                                      NegativeAnswerHtml, UserData, Tags)
    else
        Result := FALSE;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TUrlHandler.CreateSession(
    const Params: String; Expiration: TDateTime;
    SessionData: TWebSessionData): String;
begin
    if Assigned(Client) then
        Result := Client.CreateSession(Params, Expiration, SessionData)
    else
        Result := NO_CACHE;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TUrlHandler.DeleteSession;
begin
    if Assigned(Client) then
        Client.WSessions.DeleteSession(Client.WSessionID);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
destructor TUrlHandler.Destroy;
var
    T1 : TNotifyEvent;
    T2 : TNotifyEvent;
begin
    if Assigned(FClient) then begin              { V8.03 }
        // Clear client's connection event handler if it points to us
        T1 := FClient.OnDestroying;              { V8.03 }
        T2 := ClientDestroying;                  { V8.03 }
        if @T1 = @T2 then                        { V8.03 }
            FClient.OnDestroying := nil;         { V8.03 }
    end;                                         { V8.03 }

    inherited  Destroy;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TUrlHandler.Display(const AMsg: String);
begin
    if Assigned(FClient) and Assigned(FClient.AppServer) then
        FClient.AppServer.Display(Self, AMsg);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TUrlHandler.ValidateSession: Boolean;
begin
    if Assigned(Client) then
        Result := Client.ValidateSession
    else
        Result := FALSE;
end;


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

{ TArrayOfConstBuilder }

procedure TArrayOfConstBuilder.Add(const Value: String);
var
    L : Integer;
    P : PChar;
begin
    GetMem(P, SizeOf(Char) * (Length(Value) + 1));
    StrCopy(P, PChar(Value));

    L := Length(FArray);
    SetLength(FArray, L + 1);
{$IF SizeOf(Char) = 2}
    FArray[L].VType          := vtUnicodeString;
    FArray[L].VUnicodeString := P;
{$ELSE}
    FArray[L].VType          := vtPChar;
    FArray[L].VPChar         := P;
{$IFEND}
end;

procedure TArrayOfConstBuilder.Add(const Value: Integer);
begin
    Add(IntToStr(Value));
end;

procedure TArrayOfConstBuilder.Add(const Value1, Value2: String);
begin
    Add(Value1);
    Add(Value2);
end;

procedure TArrayOfConstBuilder.Add(const Value1: String; const Value2: Integer);
begin
    Add(Value1);
    Add(Value2);
end;

destructor TArrayOfConstBuilder.Destroy;
var
    I : Integer;
    P : PChar;
begin
    for I := 0 to Length(FArray) - 1 do begin
{$IF SizeOf(Char) = 2}
        if FArray[I].VType = vtUnicodeString then begin
            P := FArray[I].VUnicodeString;
            if Assigned(P) then begin
                FreeMem(P);
                FArray[I].VUnicodeString := nil;
            end;
        end;
{$ELSE}
        if FArray[I].VType = vtPChar then begin
            P := FArray[I].VPChar;
            if Assigned(P) then begin
                FreeMem(P);
                FArray[I].VPChar := nil;
            end;
        end;
{$IFEND}
    end;

    inherited Destroy;
end;


{$IFDEF USE_SSL}

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure IcsLoadTHttpAppSrvFromIni(MyIniFile: TCustomIniFile; HttpAppSrv:
                THttpAppSrv; const Section: String = 'HttpAppSrv');
begin
    if NOT Assigned (MyIniFile) then
        raise ESocketException.Create('Must open and assign INI file first');
    if NOT Assigned (HttpAppSrv) then
        raise ESocketException.Create('Must assign HttpAppSrv first');

    with HttpAppSrv do begin
        MaxClients := MyIniFile.ReadInteger(Section, 'MaxClients', MaxClients);
        DocDir := IcsTrim(MyIniFile.ReadString(Section, 'DocDir', DocDir));
        TemplateDir := IcsTrim(MyIniFile.ReadString(Section, 'TemplateDir', TemplateDir));
        DefaultDoc := IcsTrim(MyIniFile.ReadString(Section, 'DefaultDoc', DefaultDoc));
        KeepAliveTimeSec := MyIniFile.ReadInteger(Section, 'KeepAliveTimeSec', KeepAliveTimeSec);
        KeepAliveTimeXferSec := MyIniFile.ReadInteger(Section, 'KeepAliveTimeXferSec',KeepAliveTimeXferSec);
        MaxRequestsKeepAlive := MyIniFile.ReadInteger(Section, 'MaxRequestsKeepAlive', MaxRequestsKeepAlive);
        SizeCompressMin := MyIniFile.ReadInteger(Section, 'SizeCompressMin', SizeCompressMin);
        SizeCompressMax := MyIniFile.ReadInteger(Section, 'SizeCompressMax', SizeCompressMax);
        PersistentHeader := IcsTrim(MyIniFile.ReadString(Section, 'PersistentHeader', PersistentHeader));
        MaxBlkSize := MyIniFile.ReadInteger(Section, 'MaxBlkSize', MaxBlkSize);
        BandwidthLimit := MyIniFile.ReadInteger(Section, 'BandwidthLimit',  BandwidthLimit);
        BandwidthSampling := MyIniFile.ReadInteger(Section, 'BandwidthSampling', BandwidthSampling);
        ServerHeader := IcsTrim(MyIniFile.ReadString(Section, 'ServerHeader', ServerHeader));
        RootCA := IcsTrim(MyIniFile.ReadString(Section, 'RootCA', ''));
        DHParams := IcsTrim(MyIniFile.ReadString(Section, 'DHParams', ''));
        SessionTimeout := MyIniFile.ReadInteger(Section, 'SessionTimeout', SessionTimeout);
        MaxSessions := MyIniFile.ReadInteger(Section, 'MaxSessions', MaxSessions);
        SslCliCertMethod := TSslCliCertMethod(GetEnumValue (TypeInfo (TSslCliCertMethod),
                        IcsTrim(MyIniFile.ReadString(section, 'SslCliCertMethod', 'sslCliCertNone'))));     { V8.57 }
        SslCertAutoOrder := IcsCheckTrueFalse(MyIniFile.ReadString (section, 'SslCertAutoOrder', 'False')); { V8.57 }
        CertExpireDays := MyIniFile.ReadInteger(Section, 'CertExpireDays', CertExpireDays);                 { V8.57 }
        IcsStrToSet(TypeInfo (THttpOption), MyIniFile.ReadString (section, 'Options', '[]'), FOptions, SizeOf(Options)); { V8.57 }
     // ie Options=[hoContentEncoding,hoAllowDirList,hoSendServerHdr,hoAllowPut]
        ListenBacklog := MyIniFile.ReadInteger(Section, 'ListenBacklog', ListenBacklog);  { V8.57 }
    end;
end;
{$ENDIF}



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

end.
