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

Author:       François PIETTE
Creation:     April 11, 2009
Description:  This source is part of SslMultiWebServ demo application.
              It contains mosdt of the pages and supporting code
              used by the sample.
              Note this unit is also used in OverbyteIcsDDWebServiceSrv.
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:
Jul 30, 2010 V1.01 F.Piette - added SaveConfig
May 20, 2022 V8.69 - Recognise more MIME types as download files, more logging.
                   Using properties from OverbyteIcsSslMultiWebDataModule so this
                     unit is not dependent upon a single application, and works in
                     DDWebService.
Mar 07, 2024 V9.1  Added OverbyteIcsSslBase which now includes TSslContext,TX509Base and TX509List.
                   Added OverbyteIcsCharsetUtils for TextToHtmlText.
                   Using Client.PostedDataStr instead of Client.PostedData to
                    avoid casting a buffer.
                   TFormDataAnalyser now decodes a form using Client.PostedDataStream
                    instead of creating a new TMemoryStream, now supports uploads
                    larger than memory, tested to 6GB. Should suggest unicode chars.
                   Added new postinfo.html page that decodes and displays any
                    parameters passed.
Apr 12, 2024 V9.2  DemoAuthAll.html is now TUrlHandlerDemoAuthAll template, to test
                     authentication for templates.
Aug 14, 2024 V9.3  Using OverbyteIcsTypes for consolidated types and constants.
                   Fixed a CopyFrom error with older compilers, thanks to Ralf.
Jun 26, 2024 V9.5  For simple POST/PUT uploads, look for Content-Disposition request header,
                     non-standard but added by ICS TSslHttpRest, that provides filename
                     instead of using URL parameters.
                   Improved error reporting for upload errors, allow zero length files.
                   TUrlHandlerPostInfo tries to report content from GET and DELETE
                     methods, as well and POST and PUT.
Aug 17, 2026 V9.8  Added ICS version to pages.
                   Link to FormData.html gone, no longer supported.
                   TUrlHandlerHead uses SslHttpRest.
                   Added TUrlIpAddrLookup to look-up IP addresses in GEO databases.
                   Added new unit OverbyteIcsSslMultiWebPages that combine all the URL
                    handlers and functions from 13 units:
                    OverbyteIcsSslMultiWebConfig, OverbyteIcsSslMultiWebCounter,
                    OverbyteIcsSslMultiWebCounterView, OverbyteIcsSslMultiWebDataModule,
                    OverbyteIcsSslMultiWebHead, OverbyteIcsSslMultiWebHelloWorld,
                    OverbyteIcsSslMultiWebHomePage, OverbyteIcsSslMultiWebHttpHandlerBase,
                    OverbyteIcsSslMultiWebLogin, OverbyteIcsSslMultiWebMailer,
                    OverbyteIcsSslMultiWebSessionData, OverbyteIcsSslMultiWebUploads,
                    OverbyteIcsSslMultiWebUrlDefs,




 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
unit OverbyteIcsSslMultiWebPages;

interface

{$I Include\OverbyteIcsDefs.inc}   { V9.1 }

uses
  {$IFDEF MSWINDOWS}
    Windows,
  {$ENDIF}
  {$IFDEF POSIX}
//    Posix.Unistd,
  {$ENDIF}
    SysUtils, Classes, Math,
  {$IFDEF FMX}        // npt supporting FMX yet, so TUrlHandlerCounterJpg will fail
    System.Types, System.UITypes, System.UIConsts, FMX.Types,
  {$IF Compilerversion >= 25}
    FMX.Graphics,
  {$IFEND}
  {$ELSE}
    Graphics, Jpeg,
  {$ENDIF}
    OverbyteIcsIniFiles,
    OverbyteIcsMailQueue,
    OverbyteIcsTypes,
    OverbyteIcsUtils,
    OverbyteIcsTicks64,
    OverbyteIcsWndControl,
    OverbyteIcsWSocket,
    OverbyteIcsSslHttpRest,
    OverbyteIcsHttpAppServer,
    OverbyteIcsHttpSrv,
    OverbyteIcsWebSession,
    OverbyteIcsFormDataDecoder,
    OverbyteIcsUrl,
    OverbyteIcsCharsetUtils,
    OverbyteIcsMD5,
{$IFDEF USE_IcsGeoTools}    { V9.5 }
    IcsGeoUtils,              { Delphi 11 and later only }
{$ENDIF USE_IcsGeoTools}
    OverbyteIcsHtmlUtils;

{ the web server URLs, used by the TUrlHandlers }
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';
    UrlIpAddrLookup            = '/IpAddrLookup.html';   { V9.8 }
    UrlPostinfo                = '/postinfo.html';       { V9.8 }

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
    TSslMultiWebDisplayEvent = procedure (Sender : TObject; const Msg : String) of object;
    TSslMultiWebDataModule = class(TComponent)  { V9.8 don't need a form TDataModule }
    private
        FIniFileName     : String;
        FDataDir         : String;
        FImagesDir       : String;
        FUploadDir       : String;      { V8.69 }
        FCounterFileName : String;
        FPort            : String;
        FOnDisplay       : TSslMultiWebDisplayEvent;
        FIcsMailQueue    : TIcsMailQueue;    { V8.69 }
        FIcsGeoTools     : TIcsGeoTools;     { V9.8 }
        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 UploadDir   : String read  FUploadDir          { V8.69 }
                                      write FUploadDir;
        property CounterFileName : String             read  FCounterFileName;
        property Port            : String             read  FPort
                                                      write FPort;
        property OnDisplay : TSslMultiWebDisplayEvent read  FOnDisplay
                                                      write FOnDisplay;
        property IcsMailQueue : TIcsMailQueue         read  FIcsMailQueue
                                                      write FIcsMailQueue;    { V8.69 }
        property IcsGeoTools : TIcsGeoTools           read  FIcsGeoTools
                                                      write FIcsGeoTools;      { V9.8 }
    end;

    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
        WSocket: TWSocket;
        AbortTimer: TIcsTimer;    { V9.8 }
        sMailBody: string ;
        sMailFrom: string ;
        sMailName: string ;
        sMailTo: string ;
        sIPAddr: string ;
        sUserIPHost: string ;
        sPageUrl: string ;
        errorMsg: string ;
        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);
    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;

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

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

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

    TUrlHandlerPostInfo = class(TUrlHandler)     { V9.1 }
    public
        procedure Execute; override;
    end;

    TUrlHandlerDemoAuthAll = class(TUrlHandler)     { V9.2 }
    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;

    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;

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


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

var
    SslMultiWebDataModule: TSslMultiWebDataModule;

implementation

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

function TSslMultiWebDataModule.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 TSslMultiWebDataModule.Display(const Msg: String);
begin
    DisplayHandler(Self, Msg);
end;

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

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

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

procedure TSslMultiWebDataModule.SetDataDir(const Value: String);
begin
    FDataDir := IncludeTrailingPathDelimiter(Value);      { V9.8 simplify }
    FCounterFileName := FDataDir + PathDelim + 'Counters.ini';
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;



// 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;

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
    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)) ;
        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) ;
    inherited Destroy;
end;

procedure TUrlHandlerMailer.TimerAbortTimer(Sender: TObject);
begin
    AbortTimer.Enabled := false ;
    Display ('DNS Lookup Timed Out') ;
    WSocket.CancelDnsLookup ;
end;

procedure TUrlHandlerMailer.DoneDnsLookup (Sender: TObject; Error: Word);
var
    AWSocket: TWSocket ;
    I, Id: integer ;
    sTemp, sTempFrom, sMagEmail: string ;
begin
    AbortTimer.Enabled := false ;
    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;
   { V8.49 ensure POST uses same protocol as original page }
    sPageUrl := Client.RequestProtocol + '://' + 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 }
        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) ;      { V9.1 }
        ExtractURLEncodedValue (Client.PostedDataStr, 'MailZName', sMailName) ;      { V9.1 }
        ExtractURLEncodedValue (Client.PostedDataStr, 'MailZTo', sMailTo) ;          { V9.1 }
        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' ;

        if (errorMsg = '') then
        begin
            if NOT SslMultiWebDataModule.IcsMailQueue.Active then begin
                if (SslMultiWebDataModule.IcsMailQueue.MailQuDir <> '') and
                    (SslMultiWebDataModule.IcsMailQueue.MailServers.Count > 0) then begin
                    SslMultiWebDataModule.IcsMailQueue.Active := True;
                end;
            end;
            if NOT SslMultiWebDataModule.IcsMailQueue.Active then
                    errorMsg := 'Sorry, unable to send email at present, please try later' ;
        end ;

    //  build form email and display content
        if (errorMsg = '') then
        begin
          // email it to hardcoded host
            try
                sMagEmail := sMailTo + DefaultEmailDomain ;
                sTempFrom := '"' + sMailName + '" <' + sMailFrom + '>' ;
                with SslMultiWebDataModule.IcsMailQueue.QuHtmlSmtp do begin
                    PlainText.Clear ;
                    PlainText.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
                                     PlainText.Add ('User Account: ' + Client.AuthUserName) ;
                    Display ('Sending Email Form to ' + sMagEmail + ' from ' + sTempFrom) ;
                    RcptName.Clear ;
                    RcptName.Add (sMagEmail) ;
                    RcptName.Add (sMailFrom) ;
                    FromName := sMailFrom ;
                    HdrTo := sMagEmail ;
                    HdrFrom := sTempFrom ;
                    HdrReplyTo := sTempFrom ;
                    HdrCc := sTempFrom ;
                    HdrSubject := 'ICS Demo Web Site Email Form - ' + sMailTo ;
                end;
                id := SslMultiWebDataModule.IcsMailQueue.QueueMail ;
                if id > 0 then begin
           // done OK
                    Display('Email Form Queued OK') ;
                    AnswerPage('', NO_CACHE, 'maildone.html', nil, []) ;
                    Finish;
                    exit ;
                end
                else
                begin
                    errorMsg := 'Failed to Queue Email Form: ' +
                                    SslMultiWebDataModule.IcsMailQueue.QuHtmlSmtp.ErrorMessage ;
                    Display (errorMsg) ;
                end ;
            except
                errorMsg := 'Failed to Start Sending Email Form: ' + IcsGetExceptMess (ExceptObject) ;
                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 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
        SslMultiWebDataModule.CounterIncrement('LoginInvalid');
        DeleteSession;
        NotLogged;
        Display ('Invalid password for ' + UserCode);   { V8.49 }
        Exit;
    end;

    SslMultiWebDataModule.CounterIncrement('LoginOK');
    SessionData.LogonTime  := Now;
    SessionData.UserCode   := UserCode;
    Display ('Login OK for ' + UserCode);   { V8.49 }
    Relocate(UrlHomePage);
    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 TUrlHandlerJavascriptErrorHtml.Execute;
begin
    AnswerPage('',
               '',
               'JavascriptError.html',
               nil,
               ['COUNTER',       UrlCounter]);
    Finish;
end;

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

procedure TUrlHandlerUploadData.Execute;
var
    Stream    : TStream;
    FileName  : String;
    FirstName : String;
    LastName  : String;
    HostName  : String;
    Buf       : String;
    Bom       : array[0..2] of Byte;
    IsUtf8    : Boolean;
    Len       : Integer;
    Utf8Str   : AnsiString;
begin
    if Client.Method = 'POST' then begin

        { Extract fields from posted data. }
        ExtractURLEncodedValue(Client.PostedDataStr, 'FirstName', FirstName);      { V9.1 }
        ExtractURLEncodedValue(Client.PostedDataStr, 'LastName',  LastName);       { V9.1 }
        { Get client IP address. We could to ReverseDnsLookup to get hostname }
        HostName := Client.PeerAddr;
        { Build the record to write to data file }
        Buf      := FormatDateTime('YYYYMMDD HHNNSS ', Now) +
                    FirstName + '.' + LastName + '@' + HostName + #13#10;

        { Save data to a text file }
        FileName := IncludeTrailingPathDelimiter(SslMultiWebDataModule.UploadDir) + 'FormHandler.txt';
        try
            if FileExists(FileName) then begin
                Stream := TFileStream.Create(FileName, fmOpenReadWrite);
                { Check whether the data file is UTF-8 encoded }
                Len := Stream.Read(Bom[0], SizeOf(Bom));
                IsUtf8 := (Len = 3) and (Bom[0] = $EF) and (Bom[1] = $BB) and (Bom[2] = $BF);
                Stream.Seek(0, soFromEnd);
            end
            else begin
                { We use UTF-8 by default for new data files }
                Stream := TFileStream.Create(FileName, fmCreate);
                IsUtf8 := TRUE;
                Bom[0] := $EF; Bom[1] := $BB; Bom[2] := $BF;
                Stream.Write(Bom[0], SizeOf(Bom));
            end;
            if IsUtf8 then begin
                Utf8Str := StringToUtf8(Buf);
                Stream.Write(PAnsiChar(Utf8Str)^, Length(Utf8Str));
            end
            else
                StreamWriteStrA(Stream, Buf);
            Stream.Destroy;
        except
            on E:Exception do
                SslMultiWebDataModule.Display('Exception Saving Posted Data - ' + E.Message) ;
        end;

        { Here is the place to check for valid input data and produce a HTML }
        { answer according to data validation.                               }
        { Here for simplicity, we don't check data and always produce the    }
        { same HTML answer.                                                  }

        AnswerString(
            '',           { Default Status '200 OK'         }
            '',           { Default Content-Type: text/html }
            '',           { Default header                  }
            '<HTML>' +
              '<HEAD>' +
                '<TITLE>ICS WebServer Form Demo</TITLE>' +
              '</HEAD>' + #13#10 +
              '<BODY>' +
                '<H2>Your data has been recorded:</H2>' + #13#10 +
                '<P>' + TextToHtmlText(FirstName) + '.' +
                        TextToHtmlText(LastName)  + '@' +
                        TextToHtmlText(HostName)  +'</P>' +
                '<P>Filename: ' + TextToHtmlText(FileName)  +'</P>' +
                '<A HREF="/form.html">More data entry</A><BR>' +
              //  '<A HREF="/FormData.html">View data file</A><BR>' +   old webserver sample, not webapp
                '<A HREF="/demo.html">Back to demo menu</A><BR>' +
              '</BODY>' +
            '</HTML>');
        Finish;
    end;
end;

// upload a file to the server

procedure TUrlHandlerUploadFile.Execute;
//const
//  MAX_UPLOAD_SIZE    = 1024 * 1024 * 60; // Accept max 60MB file
var
    sinfo1, sPageUrl, sContent: string;
    newfilename, sFileName, sfiletitle: string;
    Decoder: TFormDataAnalyser;
    Field: TFormDataItem;
    FileStream: TFileStream;
//    MemoryStream: TMemoryStream;           { V9.1 no longer needed }
    RemoteClient: THttpAppSrvConnection;
    UploadTotTicks, MaxUploadSize: Int64;
    I: Integer;

    procedure Logit (fsize: Int64);
    var
        Speed: LongWord ;
        Duration: string ;
    begin
        try
            sinfo1 :=  'Saved Uploaded File OK' + #13#10 + 'New File Name: ' + newfilename + #13#10 + 'File Size: ' + IntToKByte(fsize) ;
            if (UploadTotTicks >= 1000) then
                Duration :=  FloatToStrF (UploadTotTicks / 1000, ffFixed, 15, 2) + ' secs'
            else
                Duration := IntToStr (UploadTotTicks) + ' msecs' ;
            speed := 0 ;

        { V9.1 no speed less than five seconds }
            if (UploadTotTicks > 5000) and (UploadTotTicks < 60*60*1000) and (fsize > 1000) then
            begin
                if (UploadTotTicks > 100000) and (fsize > 1000000) then
                begin
                    UploadTotTicks := UploadTotTicks div 1000 ;  // allow for bizarre divide by zero error
                    speed := fsize div UploadTotTicks
                end
                else
                    speed := (fsize * 1000) div UploadTotTicks ;
            end;
            sinfo1 := sinfo1 + IcsCRLF + 'Upload Duration: ' + duration;
            if speed > 0 then
                sinfo1 := sinfo1 +  IcsCRLF + 'Speed: ' + IntToStr (speed) + ' chars/sec' ;
        except
        end;
    end ;

begin
    RemoteClient := THttpAppSrvConnection(Client) ;
    sinfo1 := '' ;
    sFileName := '' ;
    sfiletitle := '' ;
    UploadTotTicks := IcsElapsedTicks64 (RemoteClient.RequestStartTick) + 1 ;
    MaxUploadSize := RemoteClient.AppServer.MaxUploadMB * IcsMBYTE;                        { V9.1 }
    sPageUrl := Client.RequestProtocol + '://' + Client.RequestHost + Client.Path ;

    if RemoteClient.Method = 'GET' then  begin
        if Params <> '' then begin   // not really used !!
            ExtractURLEncodedValue (Params, 'FileName', sFileName) ;
            ExtractURLEncodedValue (Params, 'FileTitle', sfiletitle) ;
        end;
    end ;

// see if page is being POSTed by itself to upload a file
    if (RemoteClient.Method = 'POST') or (RemoteClient.Method = 'PUT')  then begin  { V6.69 added PUT }
        sContent := Lowercase(RemoteClient.RequestContentType);  { V8.69 }
        Display ('Received Post/PUT Data File, Size ' + IntToKbyte (RemoteClient.PostedDataLen) + ', Content Type: ' + sContent) ;
        if RemoteClient.PostTempName <> '' then
            Display('Temporary File Name: ' + RemoteClient.PostTempName);     { V9.1 }

        if (RemoteClient.PostedDataLen > MaxUploadSize) then begin                  { V9.1 configured in server config file  }
             sinfo1 := 'Upload File (' + IntToKbyte (RemoteClient.PostedDataLen) + ') Exceeds Maximum Size' ;
        end
        else begin
         // First we must tell the component that we've got all the data
            RemoteClient.PostedDataReceived;
            try
                // now see how the file was uploaded
                if Pos('multipart/form-data', sContent) > 0 then begin
                    Decoder := TFormDataAnalyser.Create(nil);
                    try
                        Decoder.DecodeStream (RemoteClient.PostedDataStream) ;   { V9.1 now have stream }
                        Display (Decoder.DecodeInfo);   { V9.1 log form-data }

                        // Extract file, do a minimal validity check
                        Field := Decoder.Part ('FileName');
                        if not Assigned (Field) then
                            sinfo1 := 'Upload Form Error, Missing FileName Tag'
                        else  begin
                            sFileName := ExtractFileName(Field.ContentFileName);
                            if sFileName = '' then
                                sinfo1 := 'Upload Form Error, Empty FileName, ContentFileName: ' + Field.ContentFileName // V9.5
                         //   else if Field.DataLength <= 0 then         { V9.5 may be zero, but we have a real file
                         //       sinfo1 := 'Upload Form Error, File Empty'
                            else if ((Pos('/', sFileName) > 0) or
                                       (Pos('\', sFileName) > 0) or
                                       (Pos(':', sFileName) > 0)) then
                                sinfo1 := 'Illegal Upload File Name: ' + sFileName
                            else begin
                                try
                            // create a new file name with date and time
                                    newfilename := IncludeTrailingPathDelimiter(SslMultiWebDataModule.UploadDir) +
                                                         FormatDateTime('yyyymmdd"-"hhnnss', Now) + '_' + sFileName;  { V8.69 }
                                    Display ('Saving MIME Upload File as ' + newfilename);   { V8.69 }
                                    Field.SaveToFile (newfilename);
                                    Logit (IcsGetFileSize(newfilename)) ;  // V9.5 real size
                                except
                                    on E:Exception do
                                        sinfo1 := 'Failed to Save MIME Uploaded File as ' + newfilename + ' - ' + E.Message;
                                 end;
                            end;
                        end;
 {$IFDEF COMPILER12_UP}
                        sfiletitle := Decoder.PartData ('FileTitle', CP_ACP, True, True);  { V9.1 better method }
{$ELSE}
                        sfiletitle := Decoder.PartData ('FileTitle');
{$ENDIF}
                    finally
                        FreeAndNil(Decoder);
                    end;
                end

            // simple POST/PUT binary upload, no form parameters, only URL and request
                else if (Pos('application', sContent) > 0) or (Pos('audio', sContent) > 0) or (Pos('image', sContent) > 0) then begin { V8.69 }

                 // V9.5, look for Content-Disposition request header, non-standard
                    sFileName := '';
                    if RemoteClient.RequestHeader.Count > 0 then begin
                        for I := 0 to RemoteClient.RequestHeader.Count - 1 do begin
                            if Pos('Content-Disposition:', RemoteClient.RequestHeader[I]) = 1 then begin
                                 Display ('Custom Header Found - ' + RemoteClient.RequestHeader[I]);
                                 sFileName := IcsDecHttp2Params(RemoteClient.RequestHeader[I], 'filename');   { filename*=UTF-8''file%20name.jpg   RFC5987 encoded }
                            end;
                        end;
                        if sFileName <> '' then
                            Display ('Upload file name from Requst Header: ' + sfileName);
                    end;

                // look for file name in URL parameters
                    if Params <> '' then begin
                        ExtractURLEncodedValue (Params, 'FileName', sFileName) ;
                        ExtractURLEncodedValue (Params, 'FileTitle', sfiletitle) ;
                    end;
                    if sFileName = '' then
                        sinfo1 := 'No Valid Upload Parameters, Upload Failed'     // V9.5
                    else if ((Pos('/', sFileName) > 0) or
                               (Pos('\', sFileName) > 0) or
                               (Pos(':', sFileName) > 0)) then
                        sinfo1 := 'Illegal Upload File Name: ' + sFileName
                    else begin
                   // create a new file name with date and time, since same file may be repeatedly uploaded
                        newfilename := IncludeTrailingPathDelimiter(SslMultiWebDataModule.UploadDir) +     { V8.69 }
                                            FormatDateTime('yyyymmdd"-"hhnnss', Now) + '_' + sFileName;
                        Display('Saving Simple Upload File as ' + newfilename);   { V8.69 }

                     { V9.1 if we have a temporary file, rename it instead of copying it }
                        if (RemoteClient.PostTempName <> '') and FileExists(RemoteClient.PostTempName) then begin
                            FreeAndNil(RemoteClient.PostedDataStream);
                            if (IcsRenameFile(RemoteClient.PostTempName, newfilename, False, False) <> 0) then
                                Display('Failed to rename temporary file - ' + RemoteClient.PostTempName);
                            RemoteClient.PostTempName := '' ;  // stop it being deleted
                        end;
                        if Assigned(RemoteClient.PostedDataStream) then begin
                            try
                                FileStream := TFileStream.Create (newfilename, fmCreate) ;
                                try
{$IFDEF COMPILER12_UP}
                                    FileStream.CopyFrom(RemoteClient.PostedDataStream, 0);   { V9.1 memory stream, V9.3 add count }
{$ELSE}
                                    FileStream.WriteBuffer (RemoteClient.PostedData^, RemoteClient.PostedDataLen);
{$ENDIF}
                               finally
                                    FreeAndNil(FileStream);
                                end;
                            except
                                on E:Exception do
                                 sinfo1 := 'Failed to Save Uploaded File as ' + newfilename + ' - ' + E.Message ;
                            end;
                        end;
                        if FileExists(newfilename) then
                            Logit (IcsGetFileSize(newfilename)) ;  // V9.5 real size
                    end;
                end
                else
           // We don't accept any other request
                   sinfo1 := 'Unknown Post Data Content: ' + RemoteClient.RequestContentType ;
            except
                on E:Exception do
                    Display ('Exception Saving Posted Data - ' + E.Message) ;
            end;
            sinfo1 := sinfo1 + #13#10 +
                    'Upload FileName: ' + sFileName + IcsCRLF +
                    'FileTitle: ' + sfiletitle + IcsCRLF +
                    'Post URL: ' + sPageUrl + IcsCRLF +
                    'From IP Address: ' + RemoteClient.CPeerAddr + IcsCRLF +
                    IcsVerLitRelDate + IcsCRLF;          { V9.8 }
        end;
    end;
    Display(sinfo1);
    sinfo1 := StringReplace (sinfo1, #13#10, '<br>', [rfReplaceAll]);
    AnswerPage('', '', 'uploadfile.html', nil,
             ['sinfo1', sinfo1, 'sPageUrl', sPageUrl, 'sMaxFileSize', IntToKByte(MaxUploadSize, true),   { V9.1 }
              'sFileName', TextToHtmlText(sFileName), 'sFileTitle', TextToHtmlText(sfiletitle)
               ], {$IFDEF COMPILER12_UP} CP_ACP, CP_UTF8,{$ENDIF} Now);
    Finish;
end;

// V9.1 display posted data for diagnostic purposes

procedure TUrlHandlerPostInfo.Execute;
var
    sinfo1, rawdata, sPageUrl: string ;
    Decoder: TFormDataAnalyser;
    RemoteClient: THttpAppSrvConnection;
    ParamList: TStringList;
    ParamTot, I: Integer;
    ACodePage: longword;
begin
    RemoteClient := THttpAppSrvConnection(Client) ;
    sinfo1 := 'Request Method: ' + RemoteClient.Method + IcsCRLF +    { V9.5 added method }
              'Content Size ' + IntToKbyte (RemoteClient.PostedDataLen) + IcsCRLF +
              'Content Type: ' + RemoteClient.RequestContentType + IcsCRLF + IcsCRLF + IcsCRLF;
    sPageUrl := RemoteClient.RequestProtocol + '://' + RemoteClient.RequestHost + Client.Path ;

// report URL params
    if Params <> '' then begin
        Sinfo1 := sinfo1 + 'Raw URL Params:' + IcsCRLF + IcsStrBeakup(Params, 132) + IcsCRLF;
        ParamList := TStringList.Create;
        try
            ParamTot := IcsExtractURLEncodedParamList(Params, ParamList, True) ;
            if ParamTot > 0 then begin
                for I := 0 to ParamTot - 1 do
                    Sinfo1 := sinfo1 + 'Param ' + IntToStr(I+1) + ': ' + ParamList[I] + IcsCRLF;
            end;
        finally
            ParamList.Free;
        end;
        Sinfo1 := sinfo1 + IcsCRLF;
    end;

// report POSTed content
   if RemoteClient.PostedDataLen > 0 then BEGIN   { V9.5 get, delete, post, patch, put may have content }
 //   if (RemoteClient.Method = 'POST') or (RemoteClient.Method = 'PUT') then
        if RemoteClient.PostedDataLen < 9000 then begin
            rawdata := IcsStrRemCntlsTB(RemoteClient.PostedDataTB, True);
            rawdata := IcsStrBeakup(rawdata, 132);
            sinfo1 := sinfo1 + 'Raw Upload Content:' + IcsCRLF + rawdata + IcsCRLF + IcsCRLF;
        end;

     // First we must tell the component that we've got all the data
        RemoteClient.PostedDataReceived;
        try
            // now what has been posted
            if Pos('multipart/form-data', RemoteClient.RequestContentType) > 0 then begin
                Decoder := TFormDataAnalyser.Create(nil);
                try
                    MimeCharsetToCodePage(RemoteClient.RequestContentType, ACodePage);
                    Decoder.FormCodePage := ACodePage;
                    RemoteClient.PostedDataStream.Position := 0;
                    Decoder.DecodeStream (RemoteClient.PostedDataStream) ;
                    sinfo1 := sinfo1 + Decoder.DecodeInfo;
                    // all done
                finally
                    FreeAndNil(Decoder);
                end;
            end
            else if (RemoteClient.PostedDataLen > 1000) or
               (SameText(RemoteClient.RequestContentType, 'application/binary') or
                          SameText(RemoteClient.RequestContentType, 'application/octet-stream') or
                                 SameText(RemoteClient.RequestContentType, 'application/zip')) then begin
                sinfo1 := sinfo1 + 'Unable to process content';
            end
            else
            begin
            //    Sinfo1 := sinfo1 + 'Raw Params:' + IcsCRLF +   V9.5 duplicates above
            //                    IcsStrBeakup(IcsStrRemCntls(Params), 132) + IcsCRLF + IcsCRLF;
                if Pos('json', RemoteClient.RequestContentType) = 0 then begin  { V9.5 don't attempt to parse Json }
                    ParamList := TStringList.Create;
                    try
                        ParamTot := IcsExtractURLEncodedParamList(Client.PostedDataStr, ParamList, True) ;
                        if ParamTot > 0 then begin
                            for I := 0 to ParamTot - 1 do
                                Sinfo1 := sinfo1 + 'Param ' + IntToStr(I+1) + ': ' + ParamList[I] + IcsCRLF;
                        end;
                    finally
                        ParamList.Free;
                    end;
                end;
            end;
        except
            Display ('Exception Saving Content Data - ' + IcsGetExceptMess (ExceptObject)) ;
        end;
    end;
    sinfo1 := sinfo1 + IcsCRLF + IcsCRLF +  { V9.5 for all requests }
              'Post URL: ' + sPageUrl + IcsCRLF +
              'From IP Address: ' + RemoteClient.CPeerAddr + IcsCRLF +
              IcsVerLitRelDate + IcsCRLF;          { V9.8 }
    Display (sinfo1);
    sinfo1 := TextToHtmlText (sinfo1);   // converts CRLF
    AnswerPage('', '', 'postinfo.html', nil, ['sinfo1', sinfo1, 'sPageUrl', sPageUrl],
                                                                {$IFDEF COMPILER12_UP} CP_ACP, CP_UTF8,{$ENDIF} Now);
    Finish;
end;

// V9.2 authentication test page for POST and GET

procedure TUrlHandlerDemoAuthAll.Execute;
var
    RemoteClient: THttpAppSrvConnection;
    sPageUrl: String;
begin
    RemoteClient := THttpAppSrvConnection(Client) ;
    sPageUrl := RemoteClient.Method + ' ' + RemoteClient.RequestProtocol + '://' + RemoteClient.RequestHost + Client.Path;
    if Client.PostedDataLen > 0 then
        sPageUrl := sPageUrl + ', PostParams: ' + Client.PostedDataStr;
    AnswerPage('', '', 'DemoAuthAll.html', nil, ['sPageUrl', sPageUrl, 'sAuthType', HttpAuthTypeNames[RemoteClient.AuthType]],
                                                                             {$IFDEF COMPILER12_UP} CP_ACP, CP_UTF8,{$ENDIF} Now);
    Finish;
end;

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

const
    sDefaultUrl         = 'https://www.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 := '';
        IcsExtractURLEncodedValue(Params, sHeadUrl, Url);
        IcsExtractURLEncodedValue(Params, sEquals, Equals);
        IcsExtractURLEncodedValue(Params, 'Submit', s);
        ButtonPressed := s <> '';
        IcsExtractURLEncodedValue(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;

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),
                  SslMultiWebDataModule.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(SslMultiWebDataModule.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 := SslMultiWebDataModule.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 := SslMultiWebDataModule.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;
                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',      SslMultiWebDataModule.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 := SslMultiWebDataModule.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(SslMultiWebDataModule.DataDir + TempDir);
                        // Save the logo file in the temp directory
                        // Do not use the original filename !
                        Field.SaveToFile(SslMultiWebDataModule.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 := SslMultiWebDataModule.DataDir + SessionData.ConfigTempDir +  PathDelim + SessionData.UserCode + PathDelim + 'Logo.png'
    else
        FileName := SslMultiWebDataModule.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
            SslMultiWebDataModule.Port := SessionData.ConfigPort;
            SslMultiWebDataModule.SaveConfig;
        end;
        if SessionData.ConfigHasLogo then begin
            FileName := SslMultiWebDataModule.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(SslMultiWebDataModule.ImagesDir + PathDelim + 'Logo.png');
                RenameFile(FileName, SslMultiWebDataModule.ImagesDir + PathDelim + 'Logo.png');
                ForceRemoveDir(SslMultiWebDataModule.DataDir + SessionData.ConfigTempDir);
            end;
        end;
    end;
    Relocate('/');
    Finish;
end;

{ V9.8 new page and API looking up IP addresses in our GEO database }
{ GET
https://localhost/IpAddrLookup.html?217.146.102.142      (if running on localhost )
IpAddrLookup.html?2a00:1940:2:2::142
IpAddrLookup.html?IpAddr=217.146.102.142
IpAddrLookup.html?IpAddr=217.146.102.142&mode=json       { JSON response )
QUERY
IpAddrLookup.html  content: IpAddr=217.146.102.142 or 217.146.102.142 or IpAddr=217.146.102.142&mode=json
POST
IpAddrLookup.html  content: IpAddr=217.146.102.142 or 217.146.102.142 or IpAddr=217.146.102.142&mode=json
}
{ note there is a third database looking up cities for IP addresses, but it
  currently does not work, TMMDBIPCountryCityInfoEx seems to be missing code }
procedure TUrlIpAddrLookup.Execute;
var
    sinfo1, sIpAddr, sPageUrl, sDispTable: string;
    ResultJStr, RecJStr: AnsiString;
    RemoteClient: THttpAppSrvConnection;
    ISO2A, AsnName, AsnInfo: String;
    CountryRec: TIcsCountry;
//    DBCityInfo: TDBCityInfo;
    AsnNum: Int64;
    JsonFlag: Boolean;
    ACodePage: longword;
    ASocketFamily: TSocketFamily;
    JsonResult, JsonRec: TRestParams;
begin
    RemoteClient := THttpAppSrvConnection(Client) ;
    sinfo1 := 'Request Method: ' + RemoteClient.Method + IcsCRLF +    { V9.5 added method }
              'Content Size ' + IntToKbyte (RemoteClient.PostedDataLen) + IcsCRLF;
    sPageUrl := RemoteClient.RequestProtocol + '://' + RemoteClient.RequestHost + Client.Path ;
    sIpAddr := '';
    sDispTable := '';
    RecJStr := '';
    JsonFlag := False;
    if (RemoteClient.Method = 'QUERY') then   // no page for QUERY
       JsonFlag := True;

// report URL params
    if Params <> '' then begin
        Sinfo1 := sinfo1 + 'Raw URL Params:' + Params + IcsCRLF;
        ExtractURLEncodedValue (Params, 'IpAddr', sIpAddr) ;
        if (Pos('json',  IcsLowerCase(Params)) > 0) then
            JsonFlag := True;
    // check for raw IP address
        if (sIpAddr = '') and WSocketIsIP(Trim(Params), ASocketFamily) then
            sIpAddr := Trim(Params);
    end;

// report POSTed or QUERY content
   if RemoteClient.PostedDataLen > 0 then begin   { get, delete, post, patch, put may have content }
        Sinfo1 := sinfo1 + 'Raw Content Params:' + RemoteClient.PostedDataStr + IcsCRLF;
        ExtractURLEncodedValue (RemoteClient.PostedDataStr, 'IpAddr', sIpAddr) ;
        if (Pos('json',  IcsLowerCase(RemoteClient.PostedDataStr)) > 0) then
            JsonFlag := True;
    // check for raw IP address
        if (sIpAddr = '') and WSocketIsIP(Trim(RemoteClient.PostedDataStr), ASocketFamily) then
            sIpAddr := Trim(RemoteClient.PostedDataStr);
    end;
    Display (sinfo1);

    if sIpAddr = '' then
        sIpAddr := RemoteClient.GetPeerAddr
    else begin
{$IFDEF USE_IcsGeoTools}    { V9.5 }
        try
            sIpAddr := Trim(sIpAddr);
            if NOT Assigned(SslMultiWebDataModule.IcsGeoTools) then begin
                sDispTable := 'Sorry, GEO databas not installed';
                Display (sDispTable);
            end
            else if NOT WSocketIsIP(sIpAddr, ASocketFamily) then begin
                sDispTable := 'Sorry, not a valid IP Address: ' + sIpAddr;
                Display (sDispTable);
            end
            else begin
                with SslMultiWebDataModule.IcsGeoTools do begin
                 {   if NOT IsLoadedCity then begin   // pending, handle failed load
                        LoadDBCity;
                        if NOT IsLoadedCity then
                             Display ('Failed to load GEO City Database: ' + DBCityFile);
                    end;   }
                    ISO2A := FindISOA2Code(sIpAddr);
                    CountryRec := FindNameRec(ISO2A);
                    AsnName := FindASNCode(sIpAddr, AsnNum);
                    AsnInfo := '';
                    if AsnNum > 0 then
                        AsnInfo := AsnName + ' (' + IntToStr(AsnNum) + ')';
                  //  DBCityInfo := IcsGeoTools.FindISO2ACity(sIpAddr);

              // now build text lines or Json
                    if JsonFlag then begin
                        JsonRec := TRestParams.Create(Nil);
                        JsonRec.PContent := PContJson;
                        JsonRec.AddItem('ipaddr', sIpAddr);
                        JsonRec.AddItem('iso2a', ISO2A);
                        JsonRec.AddItem('cntyname', CountryRec.Country);
                        JsonRec.AddItem('akacntyname', CountryRec.Country);
                        JsonRec.AddItem('region', CountryRec.Region);
                        JsonRec.AddItem('subregion', CountryRec.SubRegion);
                        JsonRec.AddItem('dialcode', CountryRec.DialCode);
                        JsonRec.AddItem('internet', CountryRec.Internet);
                        JsonRec.AddItem('numiso', CountryRec.NumISO);
                        JsonRec.AddItem('asnname', AsnName);
                        JsonRec.AddItem('asnnum', AsnNum);
                   //     JsonRec.AddItem('city', DBCityInfo.City);
                   //     JsonRec.AddItem('area', DBCityInfo.StateProv);
                        RecJStr := '[' + JsonRec.GetParameters + ']';  // array
                        JsonRec.Free;
                    end
                    else begin
                        sDispTable := 'IP Address: ' + sIpAddr + '<BR>' + IcsCRLF +
                            'Country ISO: ' + ISO2A + ', Name: ' + CountryRec.Country + ', Aka: ' + CountryRec.AkaCountry + '<BR>' + IcsCRLF +
                            'Region: ' + FindRegion(CountryRec.Region) + ', Sub: ' +
                                                                     FindRegion(CountryRec.SubRegion) + '<BR>' + IcsCRLF +
                            'Country DialCode: ' + CountryRec.DialCode + ', Internet: ' + CountryRec.Internet +
                                                                             ', Num ISO:' + IntToStr(CountryRec.NumISO) + '<BR>' + IcsCRLF +
                            'ASN: ' + AsnInfo + '<BR>' + IcsCRLF ;
                      // if DBCityInfo.City <> '' then
                      //    sDispTable := sDispTable + 'City: ' + DBCityInfo.City + ', Area: ' + DBCityInfo.StateProv + '<BR>' + IcsCRLF;
                     end;
                end;
             end;
        except
            Display ('Exception Reading GEO Database - ' + IcsGetExceptMess (ExceptObject)) ;
            sDispTable := 'Sorry, error reading GEO database';
        end;
 {$ELSE}
        sDispTable := 'Sorry, GEO Database not supported in this version of Delphi';
{$ENDIF USE_IcsGeoTools}
    end;
    if JsonFlag then begin
        JsonResult := TRestParams.Create(Nil);
        JsonResult.PContent := PContJson;
        if RecJStr <> '' then begin
            JsonResult.AddItem('success', true);
            JsonResult.AddItem('reccount', 1);
            JsonResult.AddItemA('records', RecJStr, True);
        end
        else begin
            JsonResult.AddItem('success', false);
            JsonResult.AddItem('reccount', 0);
            JsonResult.AddItem('errno', 8);
            JsonResult.AddItem('errdesc', sDispTable);
        end;
        ResultJStr := JsonResult.GetParameters;
        JsonResult.Free;
        Flags := hgWillSendMySelf;
        AnswerString('', 'application/json', 'Pragma: no-cache' + icsCRLF + 'Expires: -1' + icsCRLF,
           String(ResultJStr), {$IFDEF COMPILER12_UP} CP_UTF8,{$ENDIF} Now);
    end
    else
        AnswerPage('', '', 'IpAddrLookup.html', nil, ['sIpAddr', sIpAddr, 'sPageUrl', sPageUrl, 'sDispTable', sDispTable],
                                                                {$IFDEF COMPILER12_UP} CP_ACP, CP_UTF8,{$ENDIF} Now);
    Finish;
end;


initialization
    RegisterClass(TAppSrvSessionData);
    SslMultiWebDataModule := TSslMultiWebDataModule.Create(Nil);
finalization
//    FreeAndNil(SslMultiWebDataModule);
end.