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

Author:       François PIETTE
Description:  THttpAppSrv is a specialized THttpServer component to ease
              his use for writing application servers.
Creation:     Dec 20, 2003
Version:      1.02
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-2009 by François PIETTE
              Rue de Grady 24, 4053 Embourg, Belgium. Fax: +32-4-365.74.56
              <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.


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *_*}
unit HttpAppServer;

{$B-}           { Enable partial boolean evaluation   }
{$T-}           { Untyped pointers                    }
{$X+}           { Enable extended syntax              }
{$H+}           { Use long strings                    }
{$J+}           { Allow typed constant to be modified }
{$I ICSDEFS.INC}
{$IFDEF DELPHI6_UP}
    {$WARN SYMBOL_PLATFORM   OFF}
    {$WARN SYMBOL_LIBRARY    OFF}
    {$WARN SYMBOL_DEPRECATED OFF}
{$ENDIF}

interface

uses
    Windows, SysUtils, Messages,
{$IFDEF DELPHI7_UP}
    StrUtils,
{$ENDIF}
    Classes, ExtCtrls,
    HttpSrv, WebSession, WSocket;

const
    WM_FINISH = WM_USER + 15;

type
    TMyHttpHandler        = procedure (var Flags: THttpGetFlag) of object;
    TUrlHandler          = class;
    THttpAppSrvConnection = class(THttpConnection)
    protected
        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;
        function   CheckSession(var Flags                : THttpGetFlag;
                                const NegativeAnswerHtml : String) : Boolean; overload;
        function   CheckSession(var   Flags              : THttpGetFlag;
                                const Status             : String;
                                const Header             : String;
                                const NegativeAnswerHtml : String;
                                UserData                 : TObject;
                                Tags                     : array of const) : Boolean; overload;
        function   ValidateSession: Boolean;
        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;
    end;

    THttpAllowedFlag = (afBeginBy, afExactMatch, afDirList);

    THttpAllowedElement = class
        Path  : String;
        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);
    public
        procedure Execute; virtual;
        procedure Finish; virtual;
        function  CreateSession(const Params : String;
                                Expiration   : TDateTime;
                                SessionData  : TWebSessionData) : String;
        function  ValidateSession: Boolean;
        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;
        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);
        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); 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;
        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;

    THttpAppSrv = class(THttpServer)
  private
    procedure HandleBackGroundException(E: Exception);
    protected
        FGetHandler      : THttpHandlerList;
        FPostHandler     : THttpHandlerList;
        FGetAllowedPath  : THttpAllowedPath;
        FWSessions       : TWebSessions;
        FSessionTimer    : TTimer;
        FWindowHandle    : HWND;
        FMsg_WM_FINISH   : UINT;
        FHasAllocateHWnd : Boolean;
        FOnDeleteSession : TDeleteSessionEvent;
        FOnBgException   : TBgExceptionEvent;
        procedure WndProc(var MsgRec: TMessage);
        procedure WMFinish(var msg: TMessage); message WM_FINISH;
        function  HttpAppSrvAllocateHWnd(Method: TWndMethod): HWND;
        procedure HttpAppSrvDeallocateHWnd(WHandle: Cardinal);
        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 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);
        procedure DeleteSessionHandler(Sender: TObject; Session: TWebSession);
        procedure SessionTimerHandler(Sender: TObject);
    public
        constructor Create(AOwner : TComponent); override;
        destructor  Destroy; override;
        procedure   Start; override;
        procedure   Stop; override;
        procedure   SaveSessionsToFile(const FileName : String);
        procedure   LoadSessionsFromFile(const FileName : String);
        procedure   ClearSessions;
        procedure   AddGetHandler(const Path : String;
                                  Proc       : Pointer;
                                  FLags      : THttpGetFlag = hgWillSendMySelf);
                                  overload;
        procedure   AddGetHandler(const Path : String;
                                  SObjClass  : THttpHandlerClass;
                                  FLags      : THttpGetFlag = hgWillSendMySelf);
                                  overload;
        procedure   AddGetAllowedPath(const Path : String;
                                      Flags      : THttpAllowedFlag);
        procedure   AddPostHandler(const Path : String;
                                   Proc       : Pointer;
                                   FLags      : THttpGetFlag = hgWillSendMySelf);
                                   overload;
        procedure   AddPostHandler(const Path : String;
                                   SObjClass  : THttpHandlerClass;
                                   FLags      : THttpGetFlag = hgWillSendMySelf);
                                   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 OnDeleteSession : TDeleteSessionEvent    read  FOnDeleteSession
                                                          write FOnDeleteSession;
    end;

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

const
    NO_CACHE       = 'Pragma: no-cache' + #13#10 + 'Expires: -1' + #13#10;

procedure Register;

implementation


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure Register;
begin
    RegisterComponents('FPiette', [THttpAppSrv]);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
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 FWindowHandle = 0 then begin
        FHasAllocateHWnd := TRUE;
        FWindowHandle    := HttpAppSrvAllocateHWnd(WndProc);
    end;
    FGetHandler                := THttpHandlerList.Create;
    FGetAllowedPath            := THttpAllowedPath.Create;
    FPostHandler               := THttpHandlerList.Create;
    FWSessions                 := TWebSessions.Create(nil);
    FWSessions.OnDeleteSession := DeleteSessionHandler;
    FClientClass               := THttpAppSrvConnection;
    FSessionTimer              := TTimer.Create(nil);
    FSessionTimer.Enabled      := FALSE;
    FSessionTimer.OnTimer      := SessionTimerHandler;
end;


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


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{$IFDEF NOFORMS}
{ This function is a callback function. It means that it is called by       }
{ windows. This is the very low level message handler procedure setup to    }
{ handle the message sent by windows (winsock) to handle messages.          }
function HttpAppSrvWindowProc(
    ahWnd   : HWND;
    auMsg   : Integer;
    awParam : WPARAM;
    alParam : LPARAM): Integer; stdcall;
var
    Obj    : TObject;
    MsgRec : TMessage;
begin
    { At window creation asked windows to store a pointer to our object     }
    Obj := TObject(GetWindowLong(ahWnd, 0));

    { If the pointer doesn't represent a Tftpserver, just call the default procedure}
    if not (Obj is Tftpserver) then
        Result := DefWindowProc(ahWnd, auMsg, awParam, alParam)
    else begin
        { Delphi use a TMessage type to pass parameter to his own kind of   }
        { windows procedure. So we are doing the same...                    }
        MsgRec.Msg    := auMsg;
        MsgRec.wParam := awParam;
        MsgRec.lParam := alParam;
        { May be a try/except around next line is needed. Not sure ! }
        TFtpServer(Obj).WndProc(MsgRec);
        Result := MsgRec.Result;
    end;
end;
{$ENDIF}


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function THttpAppSrv.HttpAppSrvAllocateHWnd(Method: TWndMethod) : HWND;
begin
{$IFDEF NOFORMS}
    Result := XSocketAllocateHWnd(Self);
    SetWindowLong(Result, GWL_WNDPROC, LongInt(@HttpAppSrvWindowProc));
{$ELSE}
     { If you have AllocateHWnd undefined, then your last project was }
     { compiled with NOFORMS defined. Just recompile everything for   }
     { the new project. This will recompile wsocket.pas according to  }
     { this project settings.                                         }
     Result := WSocket.AllocateHWnd(Method);
{$ENDIF}
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpAppSrv.HttpAppSrvDeallocateHWnd(WHandle : Cardinal);
begin
{$IFDEF NOFORMS}
    XSocketDeallocateHWnd(WHandle);
{$ELSE}
    WSocket.DeallocateHWnd(WHandle);
{$ENDIF}
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ All exceptions *MUST* be handled. If an exception is not handled, the     }
{ application will be shut down !                                           }
procedure THttpAppSrv.HandleBackGroundException(E: Exception);
var
    CanAbort : Boolean;
begin
    CanAbort := TRUE;
    { First call the error event handler, if any }
    if Assigned(FOnBgException) then begin
        try
            FOnBgException(Self, E, CanAbort);
        except
        end;
    end;
    { Then abort the socket }
    if CanAbort then begin
        try
            Abort;
        except
        end;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpAppSrv.WndProc(var MsgRec: TMessage);
begin
    with MsgRec do begin
        { We *MUST* handle all exception to avoid application shutdown }
        if Msg = WM_FINISH then begin
            try
                WMFinish(MsgRec)
            except
                on E:Exception do
                    HandleBackGroundException(E);
            end;
        end
(* At this time, the ancestor class has no message handler
        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;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpAppSrv.Start;
begin
    FSessionTimer.Interval     := 15000;
    FSessionTimer.Enabled      := TRUE;
    inherited Start;
end;


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


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpAppSrv.AddGetHandler(
    const Path : String;
    Proc       : Pointer;
    FLags      : THttpGetFlag = hgWillSendMySelf);
var
    Disp  : THttpDispatchElement;
    Index : Integer;
begin
    Index := FGetHandler.IndexOf(UpperCase(Path));
    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.FLags     := Flags;
        Disp.Proc      := Proc;
        Disp.SObjClass := nil;
        FGetHandler.AddObject(UpperCase(Path), Disp);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpAppSrv.AddGetHandler(
    const Path : String;
    SObjClass  : THttpHandlerClass;
    FLags      : THttpGetFlag = hgWillSendMySelf);
var
    Disp  : THttpDispatchElement;
    Index : Integer;
begin
    Index := FGetHandler.IndexOf(UpperCase(Path));
    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.FLags     := Flags;
        Disp.Proc      := nil;
        Disp.SObjClass := SObjClass;
        FGetHandler.AddObject(UpperCase(Path), Disp);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpAppSrv.AddPostHandler(
    const Path : String;
    SObjClass  : THttpHandlerClass;
    FLags      : THttpGetFlag);
var
    Disp  : THttpDispatchElement;
    Index : Integer;
begin
    Index := FPostHandler.IndexOf(UpperCase(Path));
    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.Proc      := nil;
        Disp.SObjClass := SObjClass;
        FPostHandler.AddObject(UpperCase(Path), Disp);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpAppSrv.AddPostHandler(
    const Path : String;
    Proc       : Pointer;
    FLags      : THttpGetFlag = hgWillSendMySelf);
var
    Disp  : THttpDispatchElement;
    Index : Integer;
begin
    Index := FPostHandler.IndexOf(UpperCase(Path));
    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.FLags     := Flags;
        Disp.Proc      := Proc;
        Disp.SObjClass := nil;
        FPostHandler.AddObject(UpperCase(Path), Disp);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{$IFNDEF DELPHI7_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
        PathBuf := FPostHandler.Strings[I];
        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);

        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     := FWindowHandle;
                        SObj.FMethod        := httpMethodPost;
                        ClientCnx.BeforeObjPostHandler(SObj, OK);
                        if OK then begin
                            SObj.Execute;
                            Flags := SObj.FFlags;
                        end
                        else begin
                            Flags := SObj.FFlags;
                            FreeAndNil(SObj);
                        end;
                    except
                        FreeAndNil(SObj);
                    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
        PathBuf := FGetHandler.Strings[I];
        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);

        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     := FWindowHandle;
                    SObj.FMethod        := httpMethodGet;
                    ClientCnx.BeforeObjGetHandler(SObj, OK);
                    if OK then begin
                        SObj.Execute;
                        Flags := SObj.FFlags;
                    end
                    else begin
                        Flags := SObj.FFlags;
                        FreeAndNil(SObj);
                    end;
                except
                    FreeAndNil(SObj);
                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];
        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);

    // 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);
var
    Item  : THttpAllowedElement;
    Index : Integer;
begin
    Index := FGetAllowedPath.IndexOf(UpperCase(Path));
    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  := UpperCase(Path);
        Item.Flags := Flags;
        FGetAllowedPath.AddObject(Item.Path, 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(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;
   inherited TriggerClientConnect(Client, ErrCode);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function THttpAppSrvConnection.GetHostName: String;
begin
    Result := WSocketResolveIp(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;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// 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;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
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;
    OpenBuf     : _OFSTRUCT;
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);
    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;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
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, Cardinal(Self));
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TUrlHandler.GetDocStream: TStream;
begin
    Result := Client.DocStream;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TUrlHandler.GetOnGetRowData: THttpGetRowDataEvent;
begin
    Result := Client.OnGetRowData;
end;


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


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


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TUrlHandler.GetWSession: TWebSession;
begin
    Result := Client.WSession;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TUrlHandler.GetParams: String;
begin
    Result := Client.Params;
end;


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


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TUrlHandler.AnswerPage(
    const Status, Header, HtmlFile: String;
    UserData: TObject; Tags: array of const);
begin
    Client.AnswerPage(FFlags, Status, Header, HtmlFile, UserData, Tags);
end;


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


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TUrlHandler.AnswerString(
    const Status, ContType, Header, Body: String);
begin
    Client.AnswerString(FFlags, Status, ContType, Header, Body);
end;


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


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


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


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


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TUrlHandler.ValidateSession: Boolean;
begin
    Result := Client.ValidateSession;
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;

end.
