Using HTTP. sys, let Delphi's multi-tier services really fly.

Original Delphi Cave Cave main Xalion on his blog posted an article:
"Using HTTP. Sys to let Delphi's multi-layered service fly up"
Http://www.cnblogs.com/xalion/p/6219515.html
Here the side mentioned how to Mormot httpserver out, grafting to webbroker, very good ideas.
Unfortunately Xalion did not post all the source code.

Recently did some in-depth research to webbroker, gave the realization of C5soft, put out all source code.
Currently 0.0.0.1 version, only a frame, but discerning eye a look at the realization of ideas, step by step can fill the entire framework.
The source code was compiled by Delphi7 and Delphi 10.2.

The original code is downloaded here: https://wedelphi.com/t/419364/

The core of the framework is Synwebapp.pas, which is then posted. First look at SYNBROKERTEST.DPR.

···
Program Synbrokertest;

{$APPTYPE CONSOLE}

Uses
{$IFNDEF UNICODE}
FastMM4,
{$ENDIF}
WebBroker,
Synwebapp in ' Synwebapp.pas ',
Uwebmodule in ' Uwebmodule.pas ' {webmodule1:twebmodule};

{$R *.res}

Begin
{$IFDEF Unicdoe}
Reportmemoryleaksonshutdown: = True;
{$ENDIF}
Application.initialize;
Application.createform (TWebModule1, WebModule1);
Application.Run;
End.
···

Here is the framework's core file Synwebapp.pas
···
{ *************************************************************************** }
{Mormot httpserver WebBroker Bridge}
{by [email protected] Version 0.0.0.1 2018-5-20}
{ *************************************************************************** }

{$DENYPACKAGEUNIT}

Unit Synwebapp;

Interface

Uses Classes, Sysutils, WebBroker, Httpapp, Syncommons, Syncrtsock;

Const
Request Header String
Cstinheadermethod = 0; String
Cstinheaderprotocolversion = 1; String
Cstinheaderurl = 2; String
Cstinheaderquery = 3; String
Cstinheaderpathinfo = 4; String
cstinheaderpathtranslated = 5; String
Cstinheadercachecontrol = 6; String
Cstinheaderaccept = 8; String
Cstinheaderfrom = 9; String
Cstinheaderhost = 10; String
Cstinheaderreferer = 12; String
Cstinheaderuseragent = 13; String
cstinheadercontentencoding = 14; String
Cstinheadercontenttype = 15; String
Cstinheadercontentversion = 17; String
Cstinheaderderivedfrom = 18; String
Cstinheadertitle = 20; String
CSTINHEADERREMOTEADDR = 21; String
Cstinheaderremotehost = 22; String
Cstinheaderscriptname = 23; String
Cstinheadercontent = 25; String
Cstinheaderconnection = 26; String
Cstinheadercookie = 27; String
Cstinheaderauthorization = 28; String
Request Header Integer
Cstinheadercontentlength = 16; Integer
Cstinheaderserverport = 24; Integer
Request Header DateTime
Cstinheaderdate = 7; Tdatetime
Cstinheaderifmodifiedsince = 11; Tdatetime
Cstinheaderexpires = 19; Tdatetime

Response Header String
cstoutheaderversion = 0; String
cstoutheaderreasonstring = 1; String
Cstoutheaderserver = 2; String
Cstoutheaderwwwauthenticate = 3; String
Cstoutheaderrealm = 4; String
Cstoutheaderallow = 5; String
Cstoutheaderlocation = 6; String
cstoutheadercontentencoding = 7; String
Cstoutheadercontenttype = 8; String
Cstoutheadercontentversion = 9; String
Cstoutheaderderivedfrom = 10; String
Cstoutheadertitle = 11; String
Response Header Integer
cstoutheadercontentlength = 0; Integer
Response Header DateTime
cstoutheaderdate = 0; Tdatetime
Cstoutheaderexpires = 1; Tdatetime
cstoutheaderlastmodified = 2; Tdatetime

Type

Tsynwebreqest = Class (Twebrequest)
Private
function GetHeader (const AUPKEY:RAWUTF8; const ASOURCE:RAWUTF8 = "; Const SEP:ANSICHAR = #13): RawUTF8;
Protected
Fcontext:thttpserverrequest;
function getstringvariable (Index:integer): string; Override
function getdatevariable (Index:integer): Tdatetime; Override
function getintegervariable (Index:integer): Integer; Override
function getinternalpathinfo:string; Override
function getinternalscriptname:string; Override
Public
Constructor Create (const acontext:thttpserverrequest);
Read Count bytes from client
function ReadClient (var Buffer; Count:integer): Integer; Override
Read count characters as a string from client
function ReadString (Count:integer): string; Override
Translate a relative URI to a local absolute path
function Translateuri (const uri:string): string; Override
Write count bytes back to client
function WriteClient (var Buffer; Count:integer): Integer; Override
Write string contents back to Client
function writestring (const astring:string): Boolean; Override
Write HTTP Header string
function Writeheaders (statuscode:integer; const reasonstring, headers:string): Boolean; Override
function Getfieldbyname (const name:string): string; Override
Property Context:thttpserverrequest read Fcontext;
End

Tsynwebresponse = Class (Twebresponse)
Private
Fstatuscode:integer;
function getcontext:thttpserverrequest;
Protected
function getstringvariable (Index:integer): string; Override
Procedure setstringvariable (Index:integer; const value:string); Override
function getdatevariable (Index:integer): Tdatetime; Override
Procedure setdatevariable (Index:integer; const value:tdatetime); Override
function getintegervariable (Index:integer): Integer; Override
Procedure Setintegervariable (Index:integer; Value:integer); Override
function getcontent:string; Override
Procedure SetContent (const value:string); Override
Procedure Setcontentstream (Value:tstream); Override
function Getstatuscode:integer; Override
Procedure Setstatuscode (Value:integer); Override
function getlogmessage:string; Override
Procedure Setlogmessage (const value:string); Override
Public
Procedure Sendresponse; Override
Procedure Sendredirect (const uri:string); Override
Procedure Sendstream (Astream:tstream); Override
Property Context:thttpserverrequest read GetContext;
End

Tsynwebapplication = Class (Twebapplication)
Private
Froot, fport:sockstring;
Fserver:thttpapiserver;
function Process (fcontext:thttpserverrequest): Cardinal;
Public
Property port:sockstring read FPort;
Constructor Create (aowner:tcomponent); Override
destructor Destroy; Override
Procedure Run; Override
End

Implementation

Uses Windows, Brkrconst, Inifiles, Synzip;

{Tsynwebapplication}

Constructor Tsynwebapplication.create;
Begin
inherited;
Froot: = ";
FPort: = ' 8080 ';
Fserver: = Thttpapiserver.create (false);
Fserver.addurl (Froot, FPort, False, ' + ', true);
Fserver.registercompress (compressdeflate); Our server would deflate HTML:)
Fserver.onrequest: = Process;
Fserver.clone (31); Would use a thread pool of threads
End

destructor Tsynwebapplication.destroy;
Begin
Fserver.removeurl (Froot, FPort, False, ' + ');
Fserver.free;
inherited;
End

Procedure Waitforesckey;
Var
Linputrecord:tinputrecord;
Levent:dword;
Lhandle:thandle;
Begin
Lhandle: = GetStdHandle (Std_input_handle);
While True does begin
Win32check (Readconsoleinput (Lhandle, Linputrecord, 1, LEvent));
if (Linputrecord.eventtype = key_event) and
LInputRecord.Event.KeyEvent.bKeyDown and
(LInputRecord.Event.KeyEvent.wVirtualKeyCode = vk_escape) Then
Break
End
End

Procedure Tsynwebapplication.run;
Begin
Writeln (' Server Listening on http://localhost: ' +port+ ' ... ');
Writeln (' Press ESC to quit ');
Waitforesckey;
End

function Tsynwebapplication.process (fcontext:thttpserverrequest): Cardinal;
Var
Httprequest:tsynwebreqest;
Httpresponse:tsynwebresponse;
Begin
Result: = 200;
Try
HttpRequest: = Tsynwebreqest.create (Fcontext);
Try
HttpResponse: = Tsynwebresponse.create (HttpRequest);
Httpresponse.statuscode: = 200;
Try
HandleRequest (HttpRequest, HttpResponse);
Result: = Httpresponse.statuscode;
Finally
Httpresponse.free;
End
Finally
Httprequest.free;
End
Except
Handleserverexception (Exceptobject, Output);
End
End

Procedure InitApplication;
Begin
Application: = Tsynwebapplication.create (nil);
End

{Tsynwebreqest}

function Tsynwebreqest.getheader (const AUPKEY:RAWUTF8; const ASOURCE:RAWUTF8 = "; Const SEP:ANSICHAR = #13):
RawUTF8;
Var
P, Pupkey, Psource:putf8char;
Cval:rawutf8;
Begin
Pupkey: = Putf8char (Aupkey);
If Asource = "Then
Psource: = Putf8char (fcontext.inheaders)
Else
Psource: = Putf8char (Asource);
P: = Strposi (Pupkey, Psource);
If Idempcharandgetnextitem (P, Pupkey, Cval, SEP) Then
Result: = Trim (Cval)
Else
Result: = ';
End

Constructor Tsynwebreqest.create (const acontext:thttpserverrequest);
Begin
Fcontext: = Acontext;
End

function tsynwebreqest.getdatevariable (Index:integer): Tdatetime;
Begin
Result: = Now;
End

function Tsynwebreqest.getfieldbyname (const name:string): string;
Begin
Result: = ';
End

function tsynwebreqest.getintegervariable (Index:integer): Integer;
Begin
If Index = Cstinheadercontentlength Then
Result: = Strtointdef (utf8tostring (GetHeader (' content-length ')), 0)
else if Index = Cstinheaderserverport Then
Result: = 80
Else
Result: = 0;
End

function TSynWebReqest.GetInternalPathInfo:string;
Begin
Result: = ';
End

function TSynWebReqest.GetInternalScriptName:string;
Begin
Result: = ';
End

function tsynwebreqest.getstringvariable (Index:integer): string;
Begin
If Index = Cstinheadermethod THEN BEGIN
Result: = utf8tostring (Context.method);
End else If Index = Cstinheaderprotocolversion THEN BEGIN
Result: = ';
End else If Index = Cstinheaderurl THEN BEGIN
Result: = utf8tostring (Context.url);
End else If Index = Cstinheaderquery THEN BEGIN
Result: = ';
End else If Index = Cstinheaderpathinfo THEN BEGIN
Result: = ';
End else If Index = cstinheaderpathtranslated THEN BEGIN
Result: = ';
End else If Index = Cstinheadercachecontrol THEN BEGIN
Result: = ';
End else If Index = Cstinheaderaccept THEN BEGIN
Result: = utf8tostring (GetHeader (' ACCEPT: '));
End else If Index = Cstinheaderfrom THEN BEGIN
Result: = utf8tostring (GetHeader (' From: '));
End else If Index = Cstinheaderhost THEN BEGIN
Result: = utf8tostring (GetHeader (' HOST: '));
End else If Index = Cstinheaderreferer THEN BEGIN
Result: = utf8tostring (GetHeader (' REFERER: '));
End else If Index = Cstinheaderuseragent THEN BEGIN
Result: = utf8tostring (GetHeader (' user-agent: '));
End else If Index = Cstinheadercontentencoding THEN BEGIN
Result: = utf8tostring (GetHeader (' content-encoding: '));
End else If Index = Cstinheadercontenttype THEN BEGIN
Result: = utf8tostring (GetHeader (' Content-type: '));
End else If Index = Cstinheadercontentversion THEN BEGIN
Result: = ';
End else If Index = Cstinheaderderivedfrom THEN BEGIN
Result: = ';
End else If Index = Cstinheadertitle THEN BEGIN
Result: = ';
End else If Index = Cstinheaderremoteaddr THEN BEGIN
Result: = utf8tostring (GetHeader (' Remoteip: '));
End else If Index = Cstinheaderremotehost THEN BEGIN
Result: = ';
End else If Index = Cstinheaderscriptname THEN BEGIN
Result: = ';
End else If Index = Cstinheadercontent THEN BEGIN
Result: = ';
End else If Index = Cstinheaderconnection THEN BEGIN
Result: = utf8tostring (GetHeader (' CONNECTION: '));
End else If Index = Cstinheadercookie THEN BEGIN
Result: = utf8tostring (GetHeader (' COOKIE: '));
End else If Index = Cstinheaderauthorization THEN BEGIN
Result: = ';
End
End

function Tsynwebreqest.readclient (var Buffer; Count:integer): Integer;
Begin
Result: = 0;
End

function tsynwebreqest.readstring (Count:integer): string;
Begin
Result: = ';
End

function Tsynwebreqest.translateuri (const uri:string): string;
Begin
Result: = ';
End

function Tsynwebreqest.writeclient (var Buffer; Count:integer): Integer;
Begin
Result: = 0;
End

function Tsynwebreqest.writeheaders (Statuscode:integer;
Const reasonstring, headers:string): Boolean;
Begin
Result: = False;
End

function tsynwebreqest.writestring (const astring:string): Boolean;
Begin
Result: = False;
End

{Tsynwebresponse}

function TSynWebResponse.GetContent:string;
Begin
Result: = context.incontent;
End

function TSynWebResponse.GetContext:THttpServerRequest;
Begin
Result: = Tsynwebreqest (fhttprequest). Fcontext;
End

function tsynwebresponse.getdatevariable (Index:integer): Tdatetime;
Begin
Result: = Now;
End

function tsynwebresponse.getintegervariable (Index:integer): Integer;
Begin
Result: = 0;
End

function TSynWebResponse.GetLogMessage:string;
Begin
Result: = ';
End

function TSynWebResponse.GetStatusCode:Integer;
Begin
Result: = Fstatuscode;
End

function tsynwebresponse.getstringvariable (Index:integer): string;
Begin
Result: = ';
If Index = Cstoutheadercontenttype Then
Result: = utf8tostring (Context.outcontenttype);
End

Procedure Tsynwebresponse.sendredirect (const uri:string);
Begin

End

Procedure Tsynwebresponse.sendresponse;
Begin

End

Procedure Tsynwebresponse.sendstream (Astream:tstream);
Begin

End

Procedure Tsynwebresponse.setcontent (const value:string);
Begin
Context.outcontent: = StringToUTF8 (Value);
End

Procedure Tsynwebresponse.setcontentstream (Value:tstream);
Begin

End

Procedure Tsynwebresponse.setdatevariable (Index:integer;
Const value:tdatetime);
Begin

End

Procedure tsynwebresponse.setintegervariable (Index, Value:integer);
Begin

End

Procedure Tsynwebresponse.setlogmessage (const value:string);
Begin

End

Procedure Tsynwebresponse.setstatuscode (Value:integer);
Begin
Fstatuscode: = Value;
End

Procedure Tsynwebresponse.setstringvariable (Index:integer;
Const value:string);
Begin
If Index = Cstoutheadercontenttype Then
Context.outcontenttype: = StringToUTF8 (Value);
End

Initialization
InitApplication;
End.
···

Using HTTP. sys, let Delphi's multi-tier services really fly.