{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

Author:       François PIETTE
Creation:     April 11, 2009
Description:  This source is part of WebAppServer demo application.
              It contains mosdt of the pages and supporting code
              used by the sample.
Version:      V9.8
EMail:        francois.piette@overbyte.be  http://www.overbyte.be
Support:      https://en.delphipraxis.net/forum/37-ics-internet-component-suite/
Legal issues: Copyright (C) 2009-2026 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.

History:
Aug 12, 2026 V9.8  Added ICS version to pages.
                   TUrlHandlerHead uses SslHttpRest.
                   Added new unit OverbyteWebAppServerPages that combine all the URL
                    handlers and functions from 12 units:
                  OverbyteIcsWebAppServerConfig, OverbyteIcsWebAppServerCounter,
                  OverbyteIcsWebAppServerCounterView, OverbyteIcsWebAppServerDataModule,
                  OverbyteIcsWebAppServerHead, OverbyteIcsWebAppServerHelloWorld,
                  OverbyteIcsWebAppServerHomePage, OverbyteIcsWebAppServerHttpHandlerBase,
                  OverbyteIcsWebAppServerLogin, OverbyteIcsWebAppServerMailer,
                  OverbyteIcsWebAppServerSessionData, OverbyteIcsWebAppServerUrlDefs


 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
unit OverbyteIcsWebAppServerPages;

interface

uses
  {$IFDEF MSWINDOWS}
    Windows,
  {$ENDIF}
    Classes, SysUtils, Math,
 {$IFDEF FMX}
    System.Types, System.UITypes, System.UIConsts, FMX.Types,
  {$IF Compilerversion >= 25}
    FMX.Graphics,
  {$IFEND}
  {$ELSE}
    Graphics, Jpeg,
  {$ENDIF}
    OverbyteIcsTypes,
    OverbyteIcsHttpSrv,
    OverbyteIcsHttpAppServer,
    OverbyteIcsUtils,
    OverbyteIcsMD5,
    OverbyteIcsSmtpProt,
    OverbyteIcsWndControl,
    OverbyteIcsWSocket,
    OverbyteIcsSslHttpRest,
    OverbyteIcsFormDataDecoder,
    OverbyteIcsCharsetUtils,
    OverbyteIcsHtmlUtils,
     OverbyteIcsIniFiles,
    OverbyteIcsWebSession;


const
    UrlLogin                   = '/login/loginform.html';
    UrlDoLoginSecure           = '/DoLoginSecure.Html';
    UrlHomePage                = '/HomePage.html';
    UrlCounter                 = {$IFDEF FMX}'/Counter.png'{$ELSE}'/Counter.jpg'{$ENDIF};
    UrlConfigForm              = '/ConfigForm.html';
    UrlDoConfigHtml            = '/DoConfig.html';
    UrlConfigLogoPng           = '/ConfigLogo.png';
    UrlDoConfigConfirmSaveHtml = '/ConfigConfirmSave.html';
    UrlCounterViewHtml         = '/CounterView.html';
    UrlJavascriptErrorHtml     = '/JavascriptError.html';
    UrlAjaxFetchCounter        = '/Ajax/FetchCounter';
    UrlHeadForm                = '/HeadForm.html';

const
    CounterSection = 'Counter';
    SectionConfig  = 'Config';
    KeyPort        = 'Port';
    DftPort        = '20105';

{ note the email host is deliberately hardcoded in this form, to prevent it being
  supplied as a form parameter, which is how spammers abuse email forms.
  The account may be passed as a parameter with the form, but sending the form will
  fail unless it's another valid account at ftptest.org }

const
    DefaultEmailDomain = '@ftptest.org' ;
    DefaultEmailAccount = 'testing' ;

type
    TAppSrvSessionData = class(TWebSessionData)
    protected
       FUserCode       : String;
       FLogonTime      : TDateTime;
       FLastRequest    : TDateTime; // Last request time stamp
       FRequestCount   : Integer;   // Count the requests
       FIP             : String;    // Client IP Adress (beware of proxies)
       FLoginChallenge : String;    // Used for secure login
       FConfigPort     : String;    // Used for configuration process
       FConfigTempDir  : String;    // Used for configuration process
       FConfigHasLogo  : Boolean;   // Used for configuration process
       FTempVar        : Integer;   // Currently used for anti-spam
    public
       constructor Create(AOwner: TComponent); override;
    published
       property UserCode       : String     read  FUserCode
                                            write FUserCode;
       property LogonTime      : TDateTime  read  FLogonTime
                                            write FLogonTime;
       property RequestCount   : Integer    read  FRequestCount
                                            write FRequestCount;
       property LastRequest    : TDateTime  read  FLastRequest
                                            write FLastRequest;
       property IP             : String     read  FIP
                                            write FIP;
       property LoginChallenge : String     read  FLoginChallenge
                                            write FLoginChallenge;
       property ConfigPort     : String     read  FConfigPort
                                            write FConfigPort;
       property ConfigTempDir  : String     read  FConfigTempDir
                                            write FConfigTempDir;
       property ConfigHasLogo  : Boolean    read  FConfigHasLogo
                                            write FConfigHasLogo;
       property TempVar        : Integer    read  FTempVar
                                            write FTempVar;
    end;

    TUrlHandlerBase = class(TUrlHandler)
    protected
        function  NotLogged: Boolean;
        function  GetSessionData : TAppSrvSessionData;
        procedure Relocate(const Location: String);
        property  SessionData    : TAppSrvSessionData read GetSessionData;
    end;

   TUrlHandlerMailer = class(TUrlHandler)
    private
        SmtpClient: TSmtpCli;
        WSocket: TWSocket;
        AbortTimer: TIcsTimer;      { V9.8 }
        EmailBody: TStringList;
        sMailBody: string ;
        sMailFrom: string ;
        sMailName: string ;
        sMailTo: string ;
        sIPAddr: string ;
        sUserIPHost: string ;
        sPageUrl: string ;
        errorMsg: string ;
        CurSmtpServer: integer ;
        procedure HandleBackgroundExceptions(Sender: TObject; E: Exception; var CanClose : Boolean);
    public
        destructor  Destroy; override;
        procedure Execute; override;
        procedure DoneDnsLookup (Sender: TObject; Error: Word);
        procedure TimerAbortTimer(Sender: TObject);
        procedure SmtpClientGetData(Sender: TObject; LineNum: Integer;
              MsgLine: Pointer; MaxLen: Integer; var More: Boolean);
        procedure SmtpClientRequestDone(Sender: TObject; RqType: TSmtpRequest;
             ErrorCode: Word);
        procedure SmtpClientDisplay(Sender: TObject; Msg: String);
    end;

    TUrlHandlerLoginFormHtml = class(TUrlHandlerBase)
    public
        procedure Execute; override;
    end;

    TUrlHandlerDoLoginSecureHtml = class(TUrlHandlerBase)
    public
        procedure Execute; override;
    end;

    TUrlHandlerJavascriptErrorHtml = class(TUrlHandlerBase)
    public
        procedure Execute; override;
    end;

    TUrlHandlerDefaultDoc = class(TUrlHandlerBase)
    public
        procedure Execute; override;
    end;

    TUrlHandlerHomePageHtml = class(TUrlHandlerBase)
    public
        procedure Execute; override;
    end;

    TUrlHandlerHelloWorld = class(TUrlHandler)
    public
        procedure Execute; override;
    end;

    THeadOperator = (opAdd, opMinus);
    TUrlHandlerHead = class(TUrlHandlerBase)
    private
        FN1, FN2: Integer;
        FOp: THeadOperator;
        Url, Equals, Response: String;
        Cli : TSslHttpRest;    { V9.8 }
        AllHdrs: Boolean;
        function GenerateMath: String;
        function VerifyMath(const S: String): Boolean;
        procedure HeadRequestDone(Sender  : TObject;
                                  RqType  : THttpRequest;
                                  ErrCode : Word);
        procedure HeadRequestTimeout(Sender: TObject; Reason: TTimeoutReason);
    public
        procedure Execute; override;
    end;

    TWebAppSrvDisplayEvent = procedure (Sender : TObject;
                                        const Msg : String) of object;
    TWebAppSrvDataModule = class(TComponent)     { V9.8 was TDataModule }
    private
        FIniFileName     : String;
        FDataDir         : String;
        FImagesDir       : String;
        FCounterFileName : String;
        FPort            : String;
        FOnDisplay       : TWebAppSrvDisplayEvent;
        procedure SetDataDir(const Value: String);
    public
        function  CounterValue(const CounterName : String;
                               DefaultValue      : Integer) : Integer;
        function  CounterIncrement(const CounterRef: String) : Integer;
        procedure LoadConfig;
        procedure SaveConfig;
        procedure Display(const Msg : String);
        procedure DisplayHandler(Sender : TObject; const Msg : String);
        property IniFileName : String read  FIniFileName
                                      write FIniFileName;
        property DataDir     : String read  FDataDir
                                      write SetDataDir;
        property ImagesDir   : String read  FImagesDir
                                      write FImagesDir;
        property CounterFileName : String             read  FCounterFileName;
        property Port            : String             read  FPort
                                                      write FPort;
        property OnDisplay   : TWebAppSrvDisplayEvent read  FOnDisplay
                                                      write FOnDisplay;
    end;

    TUrlHandlerCounterViewHtml = class(TUrlHandlerBase)
    private
        FNames            : TStringList;
        FCounters         : TStringList;
        FCountersSelected : TStringList;
        FTags             : TArrayOfConstBuilder;
    public
        constructor Create(AOwner : TComponent); override;
        destructor Destroy; override;
        procedure Execute; override;
        procedure GetRowData(Sender: TObject; const TableName: String;
                             Row: Integer; TagData: TStringIndex;
                             var More: Boolean; UserData: TObject);
    end;

    TUrlHandlerAjaxFetchCounter = class(TUrlHandlerBase)
    public
        procedure Execute; override;
    end;

    TUrlHandlerCounterJpg = class(TUrlHandlerBase)
    public
        procedure Execute; override;
    end;

    TUrlHandlerConfigFormHtml = class(TUrlHandlerBase)
    public
        procedure Execute; override;
    end;

    TUrlHandlerDoConfigHtml = class(TUrlHandlerBase)
    public
        procedure Execute; override;
    end;

    TUrlHandlerConfigLogoPng = class(TUrlHandlerBase)
    public
        procedure Execute; override;
    end;

    TUrlHandlerDoConfigConfirmSaveHtml = class(TUrlHandlerBase)
    public
        procedure Execute; override;
    end;

{ the magsys SMTP servers host the ftptest.org domain and may be used for testing
  this email form.  You won't be able to access this mailbox, but will get a CC
  of the email to your mailbox }

  procedure ForceRemoveDir(const Dir : String);
  procedure CleanupTimeStampedDir(const Dir : String);

var
    SmtpServerList: array [0..1] of string =
        ('mail.magsys.co.uk',
         'mail3.magsys.co.uk') ;

    WebAppSrvDataModule: TWebAppSrvDataModule;


implementation

constructor TAppSrvSessionData.Create(AOwner: TComponent);
begin
    inherited;
    FTempVar := -1;
end;

function TUrlHandlerBase.NotLogged: Boolean;
begin
    Result := not ValidateSession;
    if Result then begin
        AnswerPage('', NO_CACHE, 'NotLogged.html', nil,
                   ['LOGIN', UrlLogin]);
        Finish;
    end;
end;

function TUrlHandlerBase.GetSessionData: TAppSrvSessionData;
begin
    if Assigned(WSession) then
        Result := WSession.SessionData as TAppSrvSessionData
    else
        Result := nil;
end;

procedure TUrlHandlerBase.Relocate(
    const Location : String);
begin
    AnswerPage('302 moved',
               'Location: ' + Location + IcsCRLF + NO_CACHE,
               'Moved.html', nil,
               ['LOCATION', Location]);
end;

function GetTempLastMod (Client: THttpAppSrvConnection; const FName: string): string ;
var
    FileDT: TDateTime ;
    FSize: Int64 ;
    FullName: string ;
const
    DateMmmMask = 'dd mmm yyyy' ;
begin
    FullName := Client.TemplateDir + '/' + Fname ;
    if IcsGetUAgeSizeFile (FullName, FileDT, FSize) then
        DateTimeToString (Result, DateMmmMask, FileDT)
    else
        Result := 'Page not found' ;
end ;

// does a string contain any common HTML tags, used for email body validation to stop spammers using HTML

function IsHtmlTags (const S: string): boolean ;
var
    S2: string ;
begin
    result := false ;
    S2 := Lowercase (S) ;
    if Pos ('<a', S2) > 0 then result := true
    else if Pos ('</a', S2) > 0 then result := true
    else if Pos ('href', S2) > 0 then result := true
    else if Pos ('<img', S2) > 0 then result := true
    else if Pos ('[/url]', S2) > 0 then result := true ;
end;

function IsValidEmail(const Value: String): Boolean;
var
    I : Integer;
    NamePart, ServerPart: String;

    function CheckAllowed(const S: String): Boolean;
    var i: Integer;
    begin
        Result:= false;
        for I := 1 to Length(S) do
          case S[I] of
              'a'..'z', 'A'..'Z', '0'..'9', '_', '-', '.' : {continue};
            else
                Exit;
          end;
        Result:= true;
    end;

begin
    Result := False;
    I := Pos('@', Value);
    if I = 0 then Exit;
    NamePart := Copy(Value, 1, I - 1);
    ServerPart := Copy(Value, I + 1, Length(Value));
    if (Length(NamePart) = 0) or ((Length(ServerPart) < 5)) then
        Exit;
    I := Pos('.', ServerPart);
    if (I = 0) or (I > (Length(ServerPart) - 2)) then
        Exit;
    Result:= CheckAllowed(NamePart) and CheckAllowed(ServerPart);
end;


procedure TUrlHandlerMailer.Execute;
begin
    WSocket := TWSocket.Create (self) ;
    WSocket.OnDnsLookupDone := DoneDnsLookup ;
    WSocket.OnBgException := HandleBackgroundExceptions;
    AbortTimer := TIcsTimer.Create (WSocket) ;
    AbortTimer.OnTimer := TimerAbortTimer ;
    AbortTimer.Interval := 5000 ;     // five second timeout for DNS
// SmtpClient.RcptName.Clear ; // deliberate exception
    try
//  get user IP address and lookup host name
        sIPAddr := Client.GetPeerAddr ;
        sUserIPHost := '' ;
        WSocket.ReverseDnsLookup (sIPAddr) ;
        AbortTimer.Enabled := true ;
    except
        Display ('Exception Looking up DNS - ' + IcsGetExceptMess (ExceptObject)) ;  { V9.1 clean up }
        DoneDnsLookup (Self, 999) ; // continue to use form
    end;
end;

procedure TUrlHandlerMailer.HandleBackgroundExceptions(Sender: TObject;
  E: Exception; var CanClose: Boolean);
begin
  Display('Exception processing page - ' + E.ClassName + ': ' + E.Message);
  CanClose := True;
end;

destructor TUrlHandlerMailer.Destroy;
begin
    if Assigned (AbortTimer) then
    begin
        AbortTimer.Enabled := false ;
        FreeAndNil (AbortTimer) ;
    end ;
    FreeAndNil (WSocket) ;
    FreeAndNil (SmtpClient) ;
    FreeAndNil (EmailBody) ;
    inherited Destroy;
end;

procedure TUrlHandlerMailer.DoneDnsLookup (Sender: TObject; Error: Word);
var
    AWSocket: TWSocket ;
    I: integer ;
    sTemp, sTempFrom, sMagEmail: string ;
begin
    AbortTimer.Enabled := false ;
    AbortTimer.Interval := 60000 ;     // 60 second timeout for SMTP
    sTemp := '' ;
    AWSocket:= Sender as TWSocket ;
    if Error = 0 then
    begin
        if AWSocket.DnsResultList.Count <> 0 then
        begin
            for I := 0 to Pred (AWSocket.DnsResultList.Count) do
            begin
                if I <> 0 then sTemp := sTemp + ', ' ;
                sTemp := sTemp + AWSocket.DnsResultList [I] ;
            end
        end
        else
            sTemp := AWSocket.DnsResult ;
        sUserIPHost := sTemp + ' (' + sIPAddr + ')' ;
    end
    else
    begin
        Display ('DNS Lookup Failed - ' + WSocketErrorDesc (Error)) ;
        sUserIPHost := sIPAddr ;
    end;
    sPageUrl := 'http://' + Client.RequestHost + Client.Path ;  // used for POST URL
    errorMsg := '' ;

// see if to email account passed as query - no domain
    if Client.Method = 'GET' then
    begin
  //      ExtractURLEncodedValue (Params, 'EmailTo', sMailTo) ;
        sMailTo := Params ;
//  SmtpClient.RcptName.Clear ; // deliberate exception
    end ;

// see if page is being POSTed by itself to send and email
    if Client.Method = 'POST' then
    begin
        ExtractURLEncodedValue (Client.PostedDataStr, 'MailZBody', sMailBody) ;     { V9.1 was cast PostedData }
        if IsHtmlTags (sMailBody) then
        begin
            errorMsg := 'Please specify valid content' ; // spammers use HTML tags in the body
            Display ('Email validation error: ' + errorMsg + ' - ' + sMailBody) ;
        end
        else if (Length (sMailBody) < 40) then
        begin
            errorMsg := 'Please specify your full message' ;
            Display ('Email validation error: ' + errorMsg + ' - ' + sMailBody) ;
        end;
        ExtractURLEncodedValue (Client.PostedDataStr, 'MailZFrom', sMailFrom) ;
        ExtractURLEncodedValue (Client.PostedDataStr, 'MailZName', sMailName) ;
        ExtractURLEncodedValue (Client.PostedDataStr, 'MailZTo', sMailTo) ;
        if Length (sMailTo) < 4 then sMailTo := DefaultEmailAccount ;  // no account passed, use default
        if NOT IsValidEmail (sMailFrom) then
        begin
            errorMsg := 'Please specify a valid email address' ;
            Display ('Email validation error: ' + errorMsg + ' - ' + sMailFrom) ;
        end;
     // the IP check is to stop spammers POSTing this page without having GET it first, they have to know the IP and host name
        ExtractURLEncodedValue (Client.PostedDataStr, 'MailZIp', sTemp) ;
        if sUserIPHost <> sTemp then
        begin
            errorMsg := 'Please specify your message again, internal error' ;
            Display ('Email validation error: ' + errorMsg + ' - IP Address ' + sTemp) ;
        end;
        if Length (sMailName) < 5 then
            errorMsg := 'Please specify your full name'
        else if NOT IsUsAscii (sMailName) then errorMsg := 'Your full name can not contain punctuation' ;

    //  build form email and display content
        if (errorMsg = '') then
        begin
          // email it to hardcoded host
            try
                sMagEmail := sMailTo + DefaultEmailDomain ;
                sTempFrom := '"' + sMailName + '" <' + sMailFrom + '>' ;
                if NOT Assigned (EmailBody) then EmailBody := TStringList.Create ;
                if NOT Assigned (SmtpClient) then SmtpClient := TSmtpCli.Create (self) ;
                SmtpClient.OnBgException := HandleBackgroundExceptions;
                SmtpClient.OnDisplay := SmtpClientDisplay ;
                SmtpClient.OnGetData := SmtpClientGetData ;
                SmtpClient.OnRequestDone := SmtpClientRequestDone ;
                EmailBody.Text := RemoveHtmlSpecialChars (sMailBody) +  #13#10 +  #13#10 +
                        'User Address: ' + sUserIPHost +  #13#10 +
                        'Email Sent from Web Site Response Form: ' + sPageUrl +  #13#10 ;
                if Client.AuthUserName <> '' then
                                 EmailBody.Add ('User Account: ' + Client.AuthUserName) ;
                Display ('Sending Email Form to ' + sMagEmail + ' from ' + sTempFrom) ;
                SmtpClient.RcptName.Clear ;
                SmtpClient.RcptName.Add (sMagEmail) ;
                SmtpClient.RcptName.Add (sMailFrom) ;
                SmtpClient.FromName := sMailFrom ;
                SmtpClient.HdrTo := sMagEmail ;
                SmtpClient.HdrFrom := sTempFrom ;
                SmtpClient.HdrReplyTo := sTempFrom ;
                SmtpClient.HdrCc := sTempFrom ;
                SmtpClient.HdrSubject := 'ICS Demo Web Site Email Form - ' + sMailTo ;
                SmtpClient.Host := SmtpServerList [0] ;
                CurSmtpServer := 0 ;
                SmtpClient.Open ;  // connect, then helo
                AbortTimer.Enabled := true ;
                exit ; // wait for events to send response
            except
                errorMsg := 'Failed to Start Sending Email Form: ' + IcsGetExceptMess (ExceptObject) ; { V9.1 clean up }
                Display (errorMsg) ;
            end;
        end ;
    end ;

    AnswerPage('', NO_CACHE, 'mailer.html', nil,
             ['PageLastMod', GetTempLastMod (Client, 'mailer.html'),
              'sPageUrl', sPageUrl, 'sMailTo', sMailTo, 'sMailName', sMailName,
              'sUserIPHost', sUserIPHost, 'sMailFrom', sMailFrom,
              'sMailBody', sMailBody, 'errorMsg', errorMsg
               ]);
    Finish;
end;

procedure TUrlHandlerMailer.SmtpClientGetData(Sender: TObject; LineNum: Integer;
      MsgLine: Pointer; MaxLen: Integer; var More: Boolean);
begin
    try
        if NOT Assigned (EmailBody) then
            More := false
        else begin
            if LineNum > EmailBody.Count then
                More := false
            else
                IcsStrPCopy(PAnsiChar(MsgLine), AnsiString(EmailBody[Pred(LineNum)]));
        end;
    except
    end;
end;

procedure TUrlHandlerMailer.TimerAbortTimer(Sender: TObject);
begin
    AbortTimer.Enabled := false ;
    if sUserIPHost = '' then
    begin
        Display ('DNS Lookup Timed Out') ;
        WSocket.CancelDnsLookup ;
    end
    else
    begin
        Display ('SMTP Send Timed Out') ;
        SmtpClient.Quit ;
    end ;
end;

procedure TUrlHandlerMailer.SmtpClientRequestDone(Sender: TObject; RqType: TSmtpRequest;
      ErrorCode: Word);
begin
    if not Assigned(Client) then begin
        // Client is gone, abort everything
        SmtpClient.Abort;
        Finish;
        Exit;
    end;

    AbortTimer.Enabled := false ;
    try
        if RqType = smtpOpen then
        begin
            if ErrorCode = 0 then
            begin
                Display ('Connected to SMTP Server: ' + SmtpClient.Host) ;
                SmtpClient.Mail ;  // headers then data
                AbortTimer.Enabled := true ;
                exit ;
            end ;
            errorMsg := 'Failed to Send Email Form, SMTP Server: ' + SmtpClient.Host +
                                                ', Open Error - ' + SmtpClient.ErrorMessage ;
            Display (errorMsg) ;

          // see if trying second server
            inc (CurSmtpServer) ;
            if CurSmtpServer < Length (SmtpServerList) then
            begin
                Display ('Trying Alternate SMTP Server') ;
                SmtpClient.Host := SmtpServerList [CurSmtpServer] ;
                SmtpClient.Open ;
                AbortTimer.Enabled := true ;
                exit ;
            end ;
            SmtpClient.Quit ;
        end
        else if RqType = smtpQuit then
        begin
            errorMsg := 'Quit Send Email Form - ' + SmtpClient.ErrorMessage ;
        end
        else if RqType = smtpMail then
        begin
            SmtpClient.Quit ;
            if ErrorCode = 0 then
            begin
                Display ('Sent Email Form OK') ;
                AnswerPage('', NO_CACHE, 'maildone.html', nil, []) ;
                Finish;
                exit ;
            end
            else
            begin
                errorMsg := 'Failed to Send Email Form, Mail Error - ' + SmtpClient.ErrorMessage ;
            end ;
        end
        else
        begin
            SmtpClient.Quit ;
            errorMsg := 'Unexpected Email Form Request Done: ' + IntToStr (Ord (RqType)) ;
        end ;
    except
        errorMsg := '!! Error Sending Email - ' + IcsGetExceptMess (ExceptObject) +         { V9.1 clean up }
                                                     ' - ' + SmtpClient.ErrorMessage ;
    end ;
    Display (errorMsg) ;
    AnswerPage('', NO_CACHE, 'mailer.html', nil,
             ['PageLastMod', GetTempLastMod (Client, 'mailer.html'),
              'sPageUrl', sPageUrl, 'sMailTo', sMailTo, 'sMailName', sMailName,
              'sUserIPHost', sUserIPHost, 'sMailFrom', sMailFrom,
              'sMailBody', sMailBody, 'errorMsg', errorMsg
               ]);
    Finish;
end;

procedure TUrlHandlerMailer.SmtpClientDisplay(Sender: TObject; Msg: String);
begin
    Display ('Smtp:' + Msg) ;
end;

procedure TUrlHandlerLoginFormHtml.Execute;
var
    MySessionData : TAppSrvSessionData;
    Headers       : String;
begin
    if not ValidateSession then begin
//        Inc(GSessionDataCount);
        MySessionData := TAppSrvSessionData.Create(nil);
//        MySessionData.Name := 'MySessionData' + IntToStr(GSessionDataCount);
        MySessionData.AssignName;  // Angus
        Headers       := NO_CACHE + CreateSession('', 0, MySessionData);
    end
    else begin
        MySessionData := SessionData;
        Headers       := NO_CACHE;
    end;

    MySessionData.LastRequest    := Now;
    MySessionData.RequestCount   := MySessionData.RequestCount + 1;
    MySessionData.LoginChallenge := StrMD5(IntToHex(GetTickCount, 8));  { V8.71 was Ics }
    AnswerPage('',
               Headers,
               'LoginForm.html',
               nil,
               ['Challenge',     MySessionData.LoginChallenge,
                'DoLoginSecure', UrlDoLoginSecure,
                'COUNTER',       UrlCounter]);
    Finish;
end;

procedure TUrlHandlerDoLoginSecureHtml.Execute;
var
    Challenge     : String;
    UserCode      : String;
    PasswordHash  : String;
    Password      : String;
begin
    if NotLogged then
        Exit;

    Challenge    := SessionData.LoginChallenge;
    ExtractURLEncodedValue(Params, 'PasswordHash', PasswordHash);
    ExtractURLEncodedValue(Params, 'UserCode',     UserCode);
    // In this demo we use an hardcode password.
    // In a real world application, you should use a database of
    // usercode/password and associated permissions !
    Password := 'admin';

    if  (UserCode = '') or
        (not SameText(PasswordHash,
                      StrMD5(Challenge + Trim(UpperCase(Password))))) then begin
        WebAppSrvDataModule.CounterIncrement('LoginInvalid');
        DeleteSession;
        NotLogged;
        Exit;
    end;

    WebAppSrvDataModule.CounterIncrement('LoginOK');
    SessionData.LogonTime  := Now;
    SessionData.UserCode   := UserCode;
    Relocate(UrlHomePage);
    Finish;
end;


procedure TUrlHandlerJavascriptErrorHtml.Execute;
begin
    AnswerPage('',
               '',
               'JavascriptError.html',
               nil,
               ['COUNTER',       UrlCounter]);
    Finish;
end;

procedure TUrlHandlerDefaultDoc.Execute;
begin
    if NotLogged then
        Exit;
    Relocate(UrlHomePage);
end;

procedure TUrlHandlerHomePageHtml.Execute;
begin
    if NotLogged then
        Exit;
    AnswerPage('', NO_CACHE, 'HomePage.html', nil,
               ['LOGIN',       UrlLogin,
                'COUNTER',     UrlCounter,
                'CONFIG',      UrlConfigForm,
                'COUNTERVIEW', UrlCounterViewHtml,
                'USERCODE',    SessionData.UserCode,
                'LOGINTIME',   DateToStr(SessionData.LogonTime)]);
    Finish;
end;

procedure TUrlHandlerHelloWorld.Execute;
begin
    AnswerString('', '', '', '<HTML><BODY>Hello World !</BODY></HTML>');
    Finish;
end;

const
    sDefaultUrl         = 'http://ipv6.google.com';
    sDoCalc             = 'Please try to calculate the correct value';
    sHeadUrl            = 'HeadUrl';
    sEquals             = 'Equals';
    sResponse           = 'Response';
    sAnswerThisQuestion = 'Please answer this question: <br>';

procedure TUrlHandlerHead.HeadRequestDone(
    Sender  : TObject;
    RqType  : THttpRequest;
    ErrCode : Word);
var
    I : Integer;
begin
    try
        if Cli.RcvdHeader.Count > 0 then begin
            if not AllHdrs then
                Response := Response + Cli.RcvdHeader[0]
            else
                for I := 0 to Cli.RcvdHeader.Count - 1 do
                    Response := Response +
                                Cli.RcvdHeader[I] + '<br>' + IcsCRLF;
        end
        else if ErrCode <> 0 then
            Response := Response + 'error #' + IntToStr(ErrCode)
        else
            Response := Response + 'Unknown error';

        AnswerPage('', NO_CACHE, UrlHeadForm, nil,
                  [sHeadUrl, sDefaultUrl,
                  sEquals, GenerateMath,
                  sResponse, Response]);
    finally
        Finish;
    end;
end;

procedure TUrlHandlerHead.HeadRequestTimeout(Sender: TObject;
  Reason: TTimeoutReason);
begin
    try
        Cli.OnRequestDone := nil;
        Cli.Abort;
        Response := Response + ' Request timeout';
        AnswerPage('', NO_CACHE, UrlHeadForm, nil,
                  [sHeadUrl, sDefaultUrl,
                  sEquals, GenerateMath,
                  sResponse, Response]);
    finally
        Finish;
    end;
end;

procedure TUrlHandlerHead.Execute;
var
    s : String;
    ButtonPressed : Boolean;
    FinishFlag : Boolean;
begin
    if NotLogged then  // Frees this object if not logged in.
        Exit;
    FinishFlag := True;
    try
        Response := '';
        ExtractURLEncodedValue(Params, sHeadUrl, Url);
        ExtractURLEncodedValue(Params, sEquals, Equals);
        ExtractURLEncodedValue(Params, 'Submit', s);
        ButtonPressed := s <> '';
        ExtractURLEncodedValue(Params, 'AllHeaders', s);
        AllHdrs := s <> '';
        if Url = '' then
            Url := sDefaultUrl;
        if (SessionData.TempVar >= 0) and ButtonPressed and
           (Equals <> '') then begin
            if not VerifyMath(Equals) then begin
                AnswerPage('', NO_CACHE, UrlHeadForm, nil,
                          [sHeadUrl, Url,
                          sEquals, GenerateMath,
                          sResponse, sDoCalc]);
            end
            else begin
                try
                    Cli := TSslHttpRest.Create(Self);   { V9.8 rest component }
                    Response := 'Response from "' + Url + '":<br>';
                    { IPv6 and IPv4, prefer IPv4 }
                    Cli.SocketFamily              := sfAnyIPv4;
                    Cli.RequestVer                := '1.1';
            //        Cli.URL                       := Url;
                    Cli.CtrlSocket.TimeoutConnect := 5 * 1000;
                    Cli.CtrlSocket.TimeoutIdle    := 10 * 1000;
                    Cli.CtrlSocket.OnTimeout      := HeadRequestTimeout;
                    Cli.OnRequestDone             := HeadRequestDone;
                ///    Cli.HeadAsync;
                    Cli.RestRequest(httpHEAD, Url, True, '');    { V9.8 }
                    FinishFlag := False;
                    Exit;
                except
                    Response := Response + ' Internal server error';
                end;
                AnswerPage('', NO_CACHE, UrlHeadForm, nil,
                          [sHeadUrl, sDefaultUrl,
                          sEquals, GenerateMath,
                          sResponse, Response]);
            end;
        end
        else begin
            if ButtonPressed and (Equals = '') then
                Response := sDoCalc;
            AnswerPage('', NO_CACHE, UrlHeadForm, nil,
                      [sHeadUrl, Url,
                      sEquals, GenerateMath,
                      sResponse, Response]);
        end;
    finally
        if FinishFlag then
            Finish; { Make sure this object is freed }
    end;
end;

function TUrlHandlerHead.GenerateMath: String;
begin
    if not Assigned(SessionData) then
        Result := ''
    else begin
        FN1 := Random(10);
        FN2 := Random(10);
        FOp := THeadOperator(Random(2));
        if FOp = opAdd then begin
            Result := sAnswerThisQuestion +
                      IntToStr(FN1) + ' + ' + IntToStr(FN2) + ' equals ?';
            SessionData.TempVar := FN1 + FN2;
        end
        else begin
            Result := sAnswerThisQuestion +
                      IntToStr(Max(FN1, FN2)) + ' - ' +
                      IntToStr(Min(FN1,FN2)) + ' equals ?';
            SessionData.TempVar := Max(FN1, FN2) - Min(FN1, FN2);
        end;
    end;
end;

function TUrlHandlerHead.VerifyMath(const S: String): Boolean;
begin
    Result := Assigned(SessionData) and (StrToIntDef(S, 0) = SessionData.TempVar);
end;

{ TWebAppSrvDataModule }
function TWebAppSrvDataModule.CounterValue(
    const CounterName : String;
    DefaultValue      : Integer) : Integer;
var
    IniFile     : TIcsIniFile;
begin
    IniFile := TIcsIniFile.Create(WebAppSrvDataModule.CounterFileName);
    try
        Result := IniFile.ReadInteger(CounterSection,
                                      CounterName,
                                      DefaultValue);
    finally
        FreeAndNil(IniFile);
    end;
end;

function TWebAppSrvDataModule.CounterIncrement(
    const CounterRef: String): Integer;
var
    IniFile     : TIcsIniFile;
begin
    // Open the ini file (will be created if doesn't exists)
    IniFile := TIcsIniFile.Create(FCounterFileName);
    try
        // Read the counter value and increment it
        Result := IniFile.ReadInteger(CounterSection, CounterRef, 0) + 1;
        // Write the new value back to the inifile
        IniFile.WriteInteger(CounterSection, CounterRef, Result);
        IniFile.UpdateFile;
    finally
        IniFile.Destroy;
    end;
end;

procedure TWebAppSrvDataModule.Display(const Msg: String);
begin
    DisplayHandler(Self, Msg);
end;

procedure TWebAppSrvDataModule.DisplayHandler(
    Sender : TObject; const Msg: String);
begin
    if Assigned(FOnDisplay) then
        FOnDisplay(Sender, Msg);
end;

procedure TWebAppSrvDataModule.LoadConfig;
var
    IniFile : TIcsIniFile;
begin
    IniFile := TIcsIniFile.Create(FIniFileName);
    try
        FPort := IniFile.ReadString(SectionConfig, KeyPort, DftPort);
    finally
        FreeAndNil(IniFile);
    end;
end;

procedure TWebAppSrvDataModule.SaveConfig;
var
    IniFile : TIcsIniFile;
begin
    IniFile := TIcsIniFile.Create(FIniFileName);
    try
        IniFile.WriteString(SectionConfig, KeyPort, FPort);
        IniFile.UpdateFile;
    finally
        FreeAndNil(IniFile);
    end;
end;

procedure TWebAppSrvDataModule.SetDataDir(const Value: String);
begin
    FDataDir         := Value;
    FCounterFileName := FDataDir + PathDelim + 'Counters.ini';
end;

// Delete a directory, all files it contains as well as all subdirectories
// recursively
procedure ForceRemoveDir(const Dir : String);
var
    F      : TSearchRec;
    Status : Integer;
begin
    Status := FindFirst(IncludeTrailingPathDelimiter(Dir) + '*.*',
                        faAnyFile, F);
    try
        while Status = 0 do begin
            if (F.Attr and faDirectory) <> 0 then begin
                // We have a subdirectory
                if (F.Name <> '.') and (F.Name <> '..') then
                    ForceRemoveDir(Dir + PathDelim + F.Name)
            end
            else
                DeleteFile(Dir + PathDelim + F.Name);
            Status := FindNext(F);
        end;
    finally
        FindClose(F);
    end;
    RemoveDir(Dir);
end;

// Check is a string begins by at least L digits
function IsNumeric(const S : String; L : Integer) : Boolean;
var
    I : Integer;
begin
    Result := TRUE;
    for I := 1 to L do begin
        if I > Length(S) then
            break;
        if not ((S[I] >= '0') and (S[I] <= '9')) then begin
            Result := FALSE;
            break;
        end;
    end;
end;

// Cleanup a directory of his subdirectories having a name which starts by
// a timestamp YYYYMMDDHHNNSS. The cleanup occurs as soon as the timestamp
// if in the past.
procedure CleanupTimeStampedDir(const Dir : String);
var
    TimeStamp : String;
    F      : TSearchRec;
    Status : Integer;
begin
    TimeStamp := FormatDateTime('YYYYMMDDHHNNSS', Now);
    Status := FindFirst(IncludeTrailingPathDelimiter(Dir) + '*.*',
                        faAnyFile, F);
    try
        while Status = 0 do begin
            if (F.Attr and faDirectory) <> 0 then begin
                // We have a subdirectory
                if (F.Name <> '.') and (F.Name <> '..') and
                   (Length(F.Name) >= 14) and
                   (IsNumeric(F.Name, 14)) and
                   (Copy(F.Name, 1, 14) <= TimeStamp) then begin
                    ForceRemoveDir(Dir + PathDelim + F.Name)
                end;
            end;
            Status := FindNext(F);
        end;
    finally
        FindClose(F);
    end;
end;

const
    PleaseSelect = 'Please select';

constructor TUrlHandlerCounterViewHtml.Create(AOwner: TComponent);
begin
    inherited Create(AOwner);
    FCounters         := TStringList.Create;
    FNames            := TStringList.Create;
    FCountersSelected := TStringList.Create;
    FTags             := TArrayOfConstBuilder.Create;
end;

destructor TUrlHandlerCounterViewHtml.Destroy;
begin
    FreeAndNil(FCounters);
    FreeAndNil(FNames);
    FreeAndNil(FCountersSelected);
    FreeAndNil(FTags);
    inherited;
end;

procedure TUrlHandlerCounterViewHtml.Execute;
var
    I           : Integer;
    CounterName : String;
begin
    if NotLogged then
        Exit;

    ExtractURLEncodedParamList(Params, FNames);

    FTags.Add('LOGIN',     UrlLogin);
    FTags.Add('COUNTER',   UrlCounter);
    FTags.Add('USERCODE',  SessionData.UserCode);
    FTags.Add('LOGINTIME', DateToStr(SessionData.LogonTime));
    for I := 0 to FNames.Count - 1 do begin
        ExtractURLEncodedValue(Params, FNames[I], CounterName);
        FCountersSelected.Add(CounterName);
        FTags.Add('CounterValue' + IntToStr(I + 1),
                  WebAppSrvDataModule.CounterValue(CounterName, 0));
    end;

    OnGetRowData := GetRowData;
    AnswerPage('', NO_CACHE, '/CounterView.html', nil, FTags.Value);
    OnGetRowData := nil;
    Finish;
end;

procedure TUrlHandlerCounterViewHtml.GetRowData(
    Sender          : TObject;
    const TableName : String;
    Row             : Integer;
    TagData         : TStringIndex;
    var More        : Boolean;
    UserData        : TObject);
var
    IniFile : TIcsIniFile;
    NoTable : Integer;
begin
    NoTable := StrToIntDef(TableName, 0);
    if Row = 1 then begin
        IniFile := TIcsIniFile.Create(WebAppSrvDataModule.CounterFileName);
        try
            FCounters.Clear;
            IniFile.ReadSection(CounterSection, FCounters);
            FCounters.Sort;
        finally
            FreeAndNil(IniFile);
        end;
        TagData.Add('CounterItem', PleaseSelect);
        if FCountersSelected.Count = 0 then
            TagData.Add('CounterSelected', 'SELECTED');
        More := TRUE;
        Exit;
    end;

    More := Row <= FCounters.Count;
    if More then begin
        TagData.Add('CounterItem',     FCounters[Row - 2]);
        if (NoTable <= FCountersSelected.Count) and
           SameText(FCountersSelected[NoTable - 1], FCounters[Row - 2])  then
            TagData.Add('CounterSelected', 'SELECTED');
    end;
end;

procedure TUrlHandlerAjaxFetchCounter.Execute;
var
    CounterName  : String;
    CounterValue : Integer;
begin
    if not ValidateSession then begin
        AnswerString('500', 'text/plain', NO_CACHE, 'Invalid login');
        Finish;
    end;

    ExtractURLEncodedValue(Params, 'counter', CounterName);
    CounterName := Trim(CounterName);

    if (CounterName = PleaseSelect) or (CounterName = '') then
        CounterValue := 0
    else
        CounterValue := WebAppSrvDataModule.CounterValue(CounterName, 0);

    AnswerString('', 'text/plain', NO_CACHE, IntToStr(CounterValue));
    Finish;
end;

procedure TUrlHandlerCounterJpg.Execute;
var
    BitMapImg     : TBitMap;
    CounterString : String;
    Counter       : Integer;
    CounterRef    : String;
  {$IFNDEF FMX}
    JpegImg       : TJPEGImage;
  {$ENDIF}
begin
    ExtractURLEncodedValue(Params, 'Ref', CounterRef);
    if CounterRef = '' then
        CounterRef := 'Counter';   // Not found, use default value 'Counter'

    // Use a separate counter for not logged access
    if not ValidateSession then
        CounterRef := 'NotLogged_' + CounterRef;

    Counter := WebAppSrvDataModule.CounterIncrement(CounterRef);

    // We only display text. Convert the counter value to text
    CounterString := IntToStr(Counter);

    // Now build the JPEG image
    if Assigned(DocStream) then
        DocStream.Free;
    DocStream := TMemoryStream.Create;
  {$IFDEF FMX}
    BitMapImg := TBitmap.Create(64, 32);
    try
        with BitMapImg.Canvas do begin
            BeginScene;
            try
          //      StrokeThickness := 2;      { V8.65 no longer in FMX }
                Fill.Color      := claGray;
                FillRect(RectF(0, 0, BitMapImg.Width, BitMapImg.Height),
                         16, 16, AllCorners, 1.0);
                DrawRect(RectF(1, 1, BitMapImg.Width -1, BitMapImg.Height -1),
                         16, 16, AllCorners, 1.0);
                Font.Family := 'Arial';
                Font.Size   := 16;
                Fill.Color  := claWhite;
                FillText(RectF(1, 1, BitMapImg.Width -1, BitMapImg.Height -1),
                         CounterString, False, 1.0, [], TTextAlign.taCenter,
                         TTextAlign.taCenter);
            finally
                EndScene;
            end;
        end;
        {with DefaultBitmapCodecClass.Create do begin
            try
                SaveToStream(DocStream, BitMapImg, 'jpeg');
            finally
                Free;
            end;
        end;}
        BitMapImg.SaveToStream(DocStream); // defaults to png
    finally
        BitMapImg.Free;
    end;
    AnswerStream('', 'image/png', NO_CACHE);
  {$ELSE}
    JpegImg := TJPEGImage.Create;
    try
        BitMapImg := TBitMap.Create;
        try
            BitMapImg.Width  := 64;
            BitMapImg.Height := 32;
            BitMapImg.Canvas.Pen.Color   := clBlack;
            BitMapImg.Canvas.Brush.Color := clGray;
            BitMapImg.Canvas.RoundRect(0, 0,
                BitMapImg.Width - 1, BitMapImg.Height - 1, 16, 16);
            BitMapImg.Canvas.Font.Name  := 'arial';
            BitMapImg.Canvas.Font.Size  := 14;
            BitMapImg.Canvas.Font.Color := clWhite;
            BitMapImg.Canvas.TextOut(
                  (BitMapImg.Width  - BitMapImg.Canvas.TextWidth(CounterString))  div 2 - 1,
                  (BitMapImg.Height - BitMapImg.Canvas.TextHeight(CounterString)) div 2 - 1,
                  CounterString);
            JpegImg.Assign(BitMapImg);
            JpegImg.SaveToStream(DocStream);
        finally
            BitMapImg.Destroy;
        end;
    finally
        JpegImg.Destroy;
    end;
    AnswerStream('', 'image/jpeg', NO_CACHE);
  {$ENDIF FMX}
    Finish;
end;

procedure TUrlHandlerConfigFormHtml.Execute;
begin
    if NotLogged then
        Exit;
    AnswerPage('', NO_CACHE, 'Config.html', nil,
               ['LOGIN',     UrlLogin,
                'COUNTER',   UrlCounter,
                'USERCODE',  SessionData.UserCode,
                'DOCONFIG',  UrlDoConfigHtml,
                'PORT',      WebAppSrvDataModule.Port,
                'LOGINTIME', DateToStr(SessionData.LogonTime)]);
    Finish;
end;

procedure TUrlHandlerDoConfigHtml.Execute;
var
    Stream   : TMemoryStream;
    Decoder  : TFormDataAnalyser;
    Field    : TFormDataItem;
    FileName : String;
    FileExt  : String;
    ErrMsg   : String;
    TempDir  : String;
begin
    if NotLogged then
        Exit;
    ErrMsg := '';
    SessionData.ConfigPort := '';
    SessionData.ConfigTempDir := '';
    Stream := TMemoryStream.Create;
    try
        Stream.WriteBuffer(Client.PostedData^, Client.PostedDataLen);
        Stream.Seek(0, 0);
        Decoder := TFormDataAnalyser.Create(nil);
        try
            //Decoder.OnDisplay := WebAppSrvDataModule.DisplayHandler;
            Decoder.DecodeStream(Stream);

            if not SameText(Decoder.Part('submit').AsString, 'Save') then
                ErrMsg := 'canceled'
            else begin
                // Extract Port field. Do a minimal verification for validity
                // A port is either a positive 16 bits décimal number, or
                // a well known "service name" such as "http".
                Field := Decoder.Part('port');
                if (Field.DataLength > 0) and (Field.DataLength < 100) then
                    SessionData.ConfigPort := Trim(Field.AsString);

                // Extract logo image file, do a minimal validity check
                Field    := Decoder.Part('logo');
                FileName := ExtractFileName(Field.ContentFileName);
                SessionData.ConfigHasLogo := (FileName <> '');
                if SessionData.ConfigHasLogo then begin
                    FileExt  := ExtractFileExt(FileName);
                    if (not SameText(FileExt, '.png')) or
                       (not (SameText(Field.ContentType, 'image/png') or
                             SameText(Field.ContentType, 'image/x-png')))
                    then
                        ErrMsg := 'Only PNG file accepted for logo'
                    else if Field.DataLength > (50 * 1024) then
                        ErrMsg := 'Logo image file must be < 50KB'
                    else begin
                        // Create a temp dir
                        // The server will delete any tempdir after the datetime
                        // included in the name has expired
                        SessionData.ConfigTempDir := PathDelim +
                                   FormatDateTime('YYYYMMDDHHNNSSZZZ',
                                                  Now + EncodeTime(0, 15, 0, 0));
                        TempDir := SessionData.ConfigTempDir +
                                   PathDelim + SessionData.UserCode;
                        ForceDirectories(WebAppSrvDataModule.DataDir +
                                         TempDir);
                        // Save the logo file in the temp directory
                        // Do not use the original filename !
                        Field.SaveToFile(WebAppSrvDataModule.DataDir +
                                         TempDir + PathDelim + 'Logo.png');
                    end;
                end;
            end;
        finally
            FreeAndNil(Decoder);
        end;
    finally
        FreeAndNil(Stream);
    end;
    if ErrMsg <> '' then
        AnswerString('', '', '',
                     '<html><body><a href="' + UrlConfigForm + '">' +
                     ErrMsg + '</a></body></html>')
    else begin
        AnswerPage('', NO_CACHE, 'ConfigConfirm.html', nil,
                   ['PORT',   SessionData.ConfigPort,
                    'LOGO',   'ConfigLogo.png',
                    'ACTION', UrlDoConfigConfirmSaveHtml]);
    end;
    Finish;
end;

procedure TUrlHandlerConfigLogoPng.Execute;
var
    FileName : String;
begin
    if NotLogged then
        Exit;
    if SessionData.ConfigHasLogo then
        FileName := WebAppSrvDataModule.DataDir +
                    SessionData.ConfigTempDir +
                    PathDelim + SessionData.UserCode +
                    PathDelim + 'Logo.png'
    else
        FileName := WebAppSrvDataModule.ImagesDir +
                    PathDelim + 'Logo.png';

    DocStream.Free;
    DocStream := TFileStream.Create(FileName, fmOpenRead);
    AnswerStream('', 'image/png', NO_CACHE);
    Finish;
end;

procedure TUrlHandlerDoConfigConfirmSaveHtml.Execute;
var
    Submit   : String;
    FileName : String;
begin
    if NotLogged then
        Exit;
    ExtractURLEncodedValue(Params, 'submit', Submit);
    if SameText(Submit, 'OK') then begin
        // We have a new configuration confirmed
        if SessionData.ConfigPort <> '' then begin
            WebAppSrvDataModule.Port := SessionData.ConfigPort;
            WebAppSrvDataModule.SaveConfig;
        end;
        if SessionData.ConfigHasLogo then begin
            FileName := WebAppSrvDataModule.DataDir + SessionData.ConfigTempDir +
                        PathDelim + SessionData.UserCode + PathDelim + 'Logo.png';
            if (SessionData.ConfigTempDir <> '') and (FileExists(FileName)) then begin
                // Replace the existant logo image with the new one
                DeleteFile(WebAppSrvDataModule.ImagesDir + PathDelim + 'Logo.png');
                RenameFile(FileName,
                           WebAppSrvDataModule.ImagesDir + PathDelim + 'Logo.png');
                ForceRemoveDir(WebAppSrvDataModule.DataDir + SessionData.ConfigTempDir);
            end;
        end;
    end;
    Relocate('/');
    Finish;
end;


initialization
    RegisterClass(TAppSrvSessionData);
    WebAppSrvDataModule := TWebAppSrvDataModule.Create(Nil);

end.