Added GetFrameworkType method

This commit is contained in:
Daniele Teti 2020-08-22 15:37:08 +02:00
parent 55c82cfafc
commit ae1eda03e1
21 changed files with 12136 additions and 35 deletions

View File

@ -2,21 +2,22 @@
![DelphiMVCFramework Logo](docs/dmvcframework_logofacebook.png) ![DelphiMVCFramework Logo](docs/dmvcframework_logofacebook.png)
![](https://img.shields.io/badge/We%20are%20working%20on%20dmvcframework%20new%20version-3.2.1--carbon-red) ![GitHub All Releases](https://img.shields.io/github/downloads/danieleteti/delphimvcframework/total?label=releases%20download) ![](https://img.shields.io/badge/We%20are%20working%20on%20dmvcframework%20new%20version-3.2.1--carbon-red) ![GitHub All Releases](https://img.shields.io/github/downloads/danieleteti/delphimvcframework/total?label=releases%20download)
# DelphiMVCFramework 3.2.0-boron is [here](https://github.com/danieleteti/delphimvcframework/releases/tag/v3_2_0_boron)! # DelphiMVCFramework 3.2.0-boron is [here](https://github.com/danieleteti/delphimvcframework/releases/tag/v3_2_0_boron)!
DMVCFramework is a very popular Delphi framework which provides an easy to use, scalable, flexible [RESTful](https://en.wikipedia.org/wiki/Representational_state_transfer), [JSON-RPC](https://en.wikipedia.org/wiki/JSON-RPC) and [ActiveRecord](https://www.martinfowler.com/eaaCatalog/activeRecord.html) framework for Delphi developers. DMVCFramework is the **most popular** Delphi project on GitHub and compiles for Windows (32 and 64bit) and Linux (64bit). DMVCFramework services can be compiled as console application, Windows Service, Linux daemon, Apache module (Windows and Linux) and IIS ISAPI (Windows). DMVCFramework is a very popular Delphi framework which provides an easy to use, scalable, flexible [RESTful](https://en.wikipedia.org/wiki/Representational_state_transfer), [JSON-RPC](https://en.wikipedia.org/wiki/JSON-RPC) and [ActiveRecord](https://www.martinfowler.com/eaaCatalog/activeRecord.html) framework for Delphi developers. DMVCFramework is the **most popular** Delphi project on GitHub and compiles for Windows (32 and 64bit) and Linux (64bit). DMVCFramework services can be compiled as console application, Windows Service, Linux daemon, Apache module (Windows and Linux) and IIS ISAPI (Windows).
DMVCFramework works with Delphi 10.4 Sydney, Delphi 10.3 Rio, Delphi 10.2 Tokyo, Delphi 10.1 Berlin, Delphi 10 Seattle. DMVCFramework works with Delphi 10.4 Sydney, Delphi 10.3 Rio, Delphi 10.2 Tokyo, Delphi 10.1 Berlin, Delphi 10 Seattle.
**Daniele Teti is working on the [DelphiMVCFramework Handbook](https://leanpub.com/delphimvcframework)! Stay tuned!** **Daniele Teti is working on the [DelphiMVCFramework - the official guide](https://leanpub.com/delphimvcframework)! Stay tuned!**
![](docs/delphimvcframework_handbook_cover.png)
![DelphiMVCFramework - the official guide](https://raw.githubusercontent.com/danieleteti/delphimvcframework/master/docs/logoproject/dmvcframework_the_official_guide_very_small.png)
**Please, if you use DMVCFramework "star" this project in GitHub! It cost nothing to you but helps other developers to reference the code.** **Please, if you use DMVCFramework "star" this project in GitHub! It cost nothing to you but helps other developers to reference the code.**
<img src="https://raw.githubusercontent.com/danieleteti/delphimvcframework/master/docs/starproject.png" alt="like" /> ![](https://raw.githubusercontent.com/danieleteti/delphimvcframework/master/docs/starproject.png")
## How to install DMVCFramework ## How to install DMVCFramework
@ -494,6 +495,8 @@ Congratulations to Daniele Teti and all the staff for the excellent work!" -- Ma
- Improved `activerecord_showcase` sample. - Improved `activerecord_showcase` sample.
- Added property `Context.HostingFrameworkType`. This property is of type `TMVCHostingFrameworkType` and can assume one of the following values: `hftIndy` (if the service is using the built-in Indy HTTP server) , `hftApache` (if the project is compiled as Apache module) or `hftISAPI` (if the project is compiled as ISAPI module).
## Roadmap ## Roadmap
DelphiMVCFramework roadmap is always updated as-soon-as the features planned are implemented. Check the roadmap [here](roadmap.md). DelphiMVCFramework roadmap is always updated as-soon-as the features planned are implemented. Check the roadmap [here](roadmap.md).

Binary file not shown.

After

Width:  |  Height:  |  Size: 334 KiB

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

Binary file not shown.

After

Width:  |  Height:  |  Size: 45 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 40 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 334 KiB

Binary file not shown.

Binary file not shown.

After

Width:  |  Height:  |  Size: 50 KiB

View File

@ -1,9 +1,10 @@
object frmDMVCNewProject: TfrmDMVCNewProject object frmDMVCNewProject: TfrmDMVCNewProject
Left = 0 Left = 0
Top = 0 Top = 0
Cursor = crHandPoint
BorderStyle = bsDialog BorderStyle = bsDialog
Caption = 'New DMVCFramework Project Wizard' Caption = 'New DMVCFramework Project Wizard'
ClientHeight = 572 ClientHeight = 582
ClientWidth = 354 ClientWidth = 354
Color = clBtnFace Color = clBtnFace
Constraints.MinHeight = 145 Constraints.MinHeight = 145
@ -18,7 +19,7 @@ object frmDMVCNewProject: TfrmDMVCNewProject
OnCreate = FormCreate OnCreate = FormCreate
DesignSize = ( DesignSize = (
354 354
572) 582)
PixelsPerInch = 96 PixelsPerInch = 96
TextHeight = 13 TextHeight = 13
object lblWbModule: TLabel object lblWbModule: TLabel
@ -41,7 +42,7 @@ object frmDMVCNewProject: TfrmDMVCNewProject
Width = 354 Width = 354
Height = 101 Height = 101
Cursor = crHandPoint Cursor = crHandPoint
Hint = 'Go to the DelphiMVCFramework developer guide' Hint = 'Go to the DelphiMVCFramework project'
Align = alTop Align = alTop
AutoSize = True AutoSize = True
Center = True Center = True
@ -386,6 +387,28 @@ object frmDMVCNewProject: TfrmDMVCNewProject
Font.Style = [fsBold] Font.Style = [fsBold]
ParentFont = False ParentFont = False
end end
object lblBook: TLabel
AlignWithMargins = True
Left = 99
Top = 522
Width = 247
Height = 19
Hint = 'Go to DMVCFramework - the official guide'
Margins.Right = 10
Alignment = taRightJustify
AutoSize = False
Caption = 'DelphiMVCFramework - the official guide'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
Layout = tlCenter
OnClick = lblBookClick
OnMouseEnter = lblBookMouseEnter
OnMouseLeave = lblBookMouseLeave
end
object gbControllerUnitOptions: TGroupBox object gbControllerUnitOptions: TGroupBox
Left = 8 Left = 8
Top = 281 Top = 281
@ -454,10 +477,10 @@ object frmDMVCNewProject: TfrmDMVCNewProject
end end
end end
object btnOK: TButton object btnOK: TButton
Left = 190 Left = 186
Top = 539 Top = 547
Width = 75 Width = 77
Height = 25 Height = 27
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
Caption = 'OK' Caption = 'OK'
Default = True Default = True
@ -465,10 +488,10 @@ object frmDMVCNewProject: TfrmDMVCNewProject
TabOrder = 6 TabOrder = 6
end end
object btnCancel: TButton object btnCancel: TButton
Left = 271 Left = 269
Top = 539 Top = 547
Width = 75 Width = 77
Height = 25 Height = 27
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
Cancel = True Cancel = True
Caption = 'Cancel' Caption = 'Cancel'

View File

@ -68,9 +68,13 @@ type
lblFrameworkVersion: TLabel; lblFrameworkVersion: TLabel;
chkCreateCRUDMethods: TCheckBox; chkCreateCRUDMethods: TCheckBox;
chkAnalyticsMiddleware: TCheckBox; chkAnalyticsMiddleware: TCheckBox;
lblBook: TLabel;
procedure chkCreateControllerUnitClick(Sender: TObject); procedure chkCreateControllerUnitClick(Sender: TObject);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure Image1Click(Sender: TObject); procedure Image1Click(Sender: TObject);
procedure lblBookMouseEnter(Sender: TObject);
procedure lblBookMouseLeave(Sender: TObject);
procedure lblBookClick(Sender: TObject);
private private
{ Private declarations } { Private declarations }
function GetAddToProjectGroup: boolean; function GetAddToProjectGroup: boolean;
@ -179,10 +183,29 @@ end;
procedure TfrmDMVCNewProject.Image1Click(Sender: TObject); procedure TfrmDMVCNewProject.Image1Click(Sender: TObject);
begin begin
ShellExecute(0, PChar('open'), ShellExecute(0, PChar('open'),
PChar('https://www.gitbook.com/book/danieleteti/delphimvcframework/details'), PChar('https://github.com/danieleteti/delphimvcframework'),
nil, nil, SW_SHOW); nil, nil, SW_SHOW);
end; end;
procedure TfrmDMVCNewProject.lblBookClick(Sender: TObject);
begin
ShellExecute(0, PChar('open'),
PChar('https://leanpub.com/delphimvcframework'),
nil, nil, SW_SHOW);
end;
procedure TfrmDMVCNewProject.lblBookMouseEnter(Sender: TObject);
begin
lblBook.Font.Color := clHighlight;
lblBook.Font.Style := lblBook.Font.Style + [fsUnderline];
end;
procedure TfrmDMVCNewProject.lblBookMouseLeave(Sender: TObject);
begin
lblBook.Font.Color := Font.Color;
lblBook.Font.Style := lblBook.Font.Style - [fsUnderline];
end;
function TfrmDMVCNewProject.GetCreateActionFiltersMethods: boolean; function TfrmDMVCNewProject.GetCreateActionFiltersMethods: boolean;
begin begin
Result := chkCreateActionFiltersMethods.Checked; Result := chkCreateActionFiltersMethods.Checked;

View File

@ -1,3 +1,27 @@
// ***************************************************************************
//
// Delphi MVC Framework
//
// Copyright (c) 2010-2020 Daniele Teti and the DMVCFramework Team
//
// https://github.com/danieleteti/delphimvcframework
//
// ***************************************************************************
//
// Licensed under the Apache License, Version 2.0 (the "License");
// you may not use this file except in compliance with the License.
// You may obtain a copy of the License at
//
// http://www.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
// See the License for the specific language governing permissions and
// limitations under the License.
//
// *************************************************************************** }
unit MainControllerU; unit MainControllerU;
interface interface
@ -10,7 +34,7 @@ type
[MVCPath('/api')] [MVCPath('/api')]
TMainController = class(TMVCController) TMainController = class(TMVCController)
public public
[MVCPath('/')] [MVCPath]
[MVCHTTPMethod([httpGET])] [MVCHTTPMethod([httpGET])]
procedure Index; procedure Index;

View File

@ -1,3 +1,27 @@
// ***************************************************************************
//
// Delphi MVC Framework
//
// Copyright (c) 2010-2020 Daniele Teti and the DMVCFramework Team
//
// https://github.com/danieleteti/delphimvcframework
//
// ***************************************************************************
//
// Licensed under the Apache License, Version 2.0 (the "License");
// you may not use this file except in compliance with the License.
// You may obtain a copy of the License at
//
// http://www.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
// See the License for the specific language governing permissions and
// limitations under the License.
//
// *************************************************************************** }
unit WebModuleU; unit WebModuleU;
interface interface
@ -89,11 +113,13 @@ begin
// Enable Server Signature in response // Enable Server Signature in response
Config[TMVCConfigKey.ExposeServerSignature] := 'false'; Config[TMVCConfigKey.ExposeServerSignature] := 'false';
end); end);
FMVC.AddController(TMainController).AddMiddleware(TMVCAnalyticsMiddleware.Create(GetLoggerForAnalytics)); FMVC.AddController(TMainController);
FMVC.AddMiddleware(TMVCAnalyticsMiddleware.Create(GetLoggerForAnalytics));
FMVC.AddMiddleware(TMVCStaticFilesMiddleware.Create( FMVC.AddMiddleware(TMVCStaticFilesMiddleware.Create(
'/', { StaticFilesPath } '/', { StaticFilesPath }
TPath.Combine(ExtractFilePath(GetModuleName(HInstance)), 'www'), { DocumentRoot } TPath.Combine(ExtractFilePath(GetModuleName(HInstance)), 'www'), { DocumentRoot }
'index.html' {IndexDocument - Before it was named fallbackresource} 'index.html', {IndexDocument - Before it was named fallbackresource}
False
)); ));
end; end;

View File

@ -0,0 +1,131 @@
// ***************************************************************************
//
// Delphi MVC Framework
//
// Copyright (c) 2010-2020 Daniele Teti and the DMVCFramework Team
//
// https://github.com/danieleteti/delphimvcframework
//
// ***************************************************************************
//
// Licensed under the Apache License, Version 2.0 (the "License");
// you may not use this file except in compliance with the License.
// You may obtain a copy of the License at
//
// http://www.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
// See the License for the specific language governing permissions and
// limitations under the License.
//
// *************************************************************************** }
unit MainControllerU;
interface
uses
MVCFramework, MVCFramework.Commons;
type
[MVCPath('/api')]
TMainController = class(TMVCController)
public
[MVCPath]
[MVCHTTPMethod([httpGET])]
procedure Index;
[MVCPath('/reversedstrings/($Value)')]
[MVCHTTPMethod([httpGET])]
procedure GetReversedString(const Value: String);
protected
procedure OnBeforeAction(Context: TWebContext; const AActionName: string; var Handled: Boolean); override;
procedure OnAfterAction(Context: TWebContext; const AActionName: string); override;
public
//Sample CRUD Actions for a "Customer" entity
[MVCPath('/customers')]
[MVCHTTPMethod([httpGET])]
procedure GetCustomers;
[MVCPath('/customers/($id)')]
[MVCHTTPMethod([httpGET])]
procedure GetCustomer(id: Integer);
[MVCPath('/customers')]
[MVCHTTPMethod([httpPOST])]
procedure CreateCustomer;
[MVCPath('/customers/($id)')]
[MVCHTTPMethod([httpPUT])]
procedure UpdateCustomer(id: Integer);
[MVCPath('/customers/($id)')]
[MVCHTTPMethod([httpDELETE])]
procedure DeleteCustomer(id: Integer);
end;
implementation
uses
System.SysUtils, MVCFramework.Logger, System.StrUtils;
procedure TMainController.Index;
begin
//use Context property to access to the HTTP request and response
Render('Hello DelphiMVCFramework World');
end;
procedure TMainController.GetReversedString(const Value: String);
begin
Render(System.StrUtils.ReverseString(Value.Trim));
end;
procedure TMainController.OnAfterAction(Context: TWebContext; const AActionName: string);
begin
{ Executed after each action }
inherited;
end;
procedure TMainController.OnBeforeAction(Context: TWebContext; const AActionName: string; var Handled: Boolean);
begin
{ Executed before each action
if handled is true (or an exception is raised) the actual
action will not be called }
inherited;
end;
//Sample CRUD Actions for a "Customer" entity
procedure TMainController.GetCustomers;
begin
//todo: render a list of customers
end;
procedure TMainController.GetCustomer(id: Integer);
begin
//todo: render the customer by id
end;
procedure TMainController.CreateCustomer;
begin
//todo: create a new customer
end;
procedure TMainController.UpdateCustomer(id: Integer);
begin
//todo: update customer by id
end;
procedure TMainController.DeleteCustomer(id: Integer);
begin
//todo: delete customer by id
end;
end.

View File

@ -0,0 +1,8 @@
object MyWebModule: TMyWebModule
OldCreateOrder = False
OnCreate = WebModuleCreate
OnDestroy = WebModuleDestroy
Actions = <>
Height = 230
Width = 415
end

View File

@ -0,0 +1,92 @@
// ***************************************************************************
//
// Delphi MVC Framework
//
// Copyright (c) 2010-2020 Daniele Teti and the DMVCFramework Team
//
// https://github.com/danieleteti/delphimvcframework
//
// ***************************************************************************
//
// Licensed under the Apache License, Version 2.0 (the "License");
// you may not use this file except in compliance with the License.
// You may obtain a copy of the License at
//
// http://www.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
// See the License for the specific language governing permissions and
// limitations under the License.
//
// *************************************************************************** }
unit WebModuleU;
interface
uses
System.SysUtils,
System.Classes,
Web.HTTPApp,
MVCFramework;
type
TMyWebModule = class(TWebModule)
procedure WebModuleCreate(Sender: TObject);
procedure WebModuleDestroy(Sender: TObject);
private
FMVC: TMVCEngine;
public
{ Public declarations }
end;
var
WebModuleClass: TComponentClass = TMyWebModule;
implementation
{$R *.dfm}
uses
MainControllerU,
System.IOUtils,
MVCFramework.Commons,
MVCFramework.Serializer.Commons,
LoggerPro.FileAppender,
LoggerPro,
System.DateUtils,
MVCFramework.Middleware.Trace;
procedure TMyWebModule.WebModuleCreate(Sender: TObject);
begin
FMVC := TMVCEngine.Create(Self,
procedure(Config: TMVCConfig)
begin
// session timeout (0 means session cookie)
Config[TMVCConfigKey.SessionTimeout] := '0';
// default content-type
Config[TMVCConfigKey.DefaultContentType] := TMVCConstants.DEFAULT_CONTENT_TYPE;
// default content charset
Config[TMVCConfigKey.DefaultContentCharset] := TMVCConstants.DEFAULT_CONTENT_CHARSET;
// unhandled actions are permitted?
Config[TMVCConfigKey.AllowUnhandledAction] := 'false';
// default view file extension
Config[TMVCConfigKey.DefaultViewFileExtension] := 'html';
// view path
Config[TMVCConfigKey.ViewPath] := 'templates';
// Enable Server Signature in response
Config[TMVCConfigKey.ExposeServerSignature] := 'false';
end);
FMVC.AddController(TMainController);
FMVC.AddMiddleware(TMVCTraceMiddleware.Create);
end;
procedure TMyWebModule.WebModuleDestroy(Sender: TObject);
begin
FMVC.Free;
end;
end.

View File

@ -0,0 +1,109 @@
program middleware_trace;
{$APPTYPE CONSOLE}
uses
System.SysUtils,
MVCFramework.Logger,
MVCFramework.Commons,
MVCFramework.REPLCommandsHandlerU,
Web.ReqMulti,
Web.WebReq,
Web.WebBroker,
IdHTTPWebBrokerBridge,
MainControllerU in 'MainControllerU.pas',
WebModuleU in 'WebModuleU.pas' {MyWebModule: TWebModule};
{$R *.res}
procedure RunServer(APort: Integer);
var
lServer: TIdHTTPWebBrokerBridge;
lCustomHandler: TMVCCustomREPLCommandsHandler;
lCmd: string;
begin
Writeln('** DMVCFramework Server ** build ' + DMVCFRAMEWORK_VERSION);
if ParamCount >= 1 then
lCmd := ParamStr(1)
else
lCmd := 'start';
lCustomHandler := function(const Value: String; const Server: TIdHTTPWebBrokerBridge; out Handled: Boolean): THandleCommandResult
begin
Handled := False;
Result := THandleCommandResult.Unknown;
// Write here your custom command for the REPL using the following form...
// ***
// Handled := False;
// if (Value = 'apiversion') then
// begin
// REPLEmit('Print my API version number');
// Result := THandleCommandResult.Continue;
// Handled := True;
// end
// else if (Value = 'datetime') then
// begin
// REPLEmit(DateTimeToStr(Now));
// Result := THandleCommandResult.Continue;
// Handled := True;
// end;
end;
LServer := TIdHTTPWebBrokerBridge.Create(nil);
try
LServer.DefaultPort := APort;
{ more info about MaxConnections
http://www.indyproject.org/docsite/html/frames.html?frmname=topic&frmfile=TIdCustomTCPServer_MaxConnections.html }
LServer.MaxConnections := 0;
{ more info about ListenQueue
http://www.indyproject.org/docsite/html/frames.html?frmname=topic&frmfile=TIdCustomTCPServer_ListenQueue.html }
LServer.ListenQueue := 200;
WriteLn('Write "quit" or "exit" to shutdown the server');
repeat
if lCmd.IsEmpty then
begin
Write('-> ');
ReadLn(lCmd)
end;
try
case HandleCommand(lCmd.ToLower, LServer, lCustomHandler) of
THandleCommandResult.Continue:
begin
Continue;
end;
THandleCommandResult.Break:
begin
Break;
end;
THandleCommandResult.Unknown:
begin
REPLEmit('Unknown command: ' + lCmd);
end;
end;
finally
lCmd := '';
end;
until false;
finally
LServer.Free;
end;
end;
begin
ReportMemoryLeaksOnShutdown := True;
IsMultiThread := True;
try
if WebRequestHandler <> nil then
WebRequestHandler.WebModuleClass := WebModuleClass;
WebRequestHandlerProc.MaxConnections := 1024;
RunServer(8080);
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -159,6 +159,8 @@ type
LoadSystemControllers = 'load_system_controllers'; LoadSystemControllers = 'load_system_controllers';
end; end;
TMVCHostingFrameworkType = (hftUnknown, hftIndy, hftApache, hftISAPI);
// http://www.w3.org/Protocols/rfc2616/rfc2616-sec10.html // http://www.w3.org/Protocols/rfc2616/rfc2616-sec10.html
HTTP_STATUS = record HTTP_STATUS = record
const const

View File

@ -30,17 +30,22 @@ interface
uses uses
MVCFramework, MVCFramework,
MVCFramework.Logger; MVCFramework.Logger,
MVCFramework.Commons;
type type
TMVCTraceMiddleware = class(TInterfacedObject, IMVCMiddleware) TMVCTraceMiddleware = class(TInterfacedObject, IMVCMiddleware)
private
fMaxBodySize: Int64;
protected protected
procedure OnAfterControllerAction(Context: TWebContext; const AActionNAme: string; procedure OnAfterControllerAction(Context: TWebContext; const AActionNAme: string;
const Handled: Boolean); const Handled: Boolean);
procedure OnBeforeRouting(Context: TWebContext; var Handled: Boolean); procedure OnBeforeRouting(Context: TWebContext; var Handled: Boolean);
procedure OnBeforeControllerAction(Context: TWebContext; procedure OnBeforeControllerAction(Context: TWebContext;
const AControllerQualifiedClassName: string; const AActionNAme: string; var Handled: Boolean); const AControllerQualifiedClassName: string; const AActionNAme: string; var Handled: Boolean);
procedure OnAfterRouting(AContext: TWebContext; const AHandled: Boolean); procedure OnAfterRouting(Context: TWebContext; const AHandled: Boolean);
public
constructor Create(const MaxBodySizeInTrace: UInt64 = 1024);
end; end;
implementation implementation
@ -49,37 +54,49 @@ uses
System.SysUtils, System.SysUtils,
System.ZLib, System.ZLib,
System.Classes, System.Classes,
MVCFramework.Commons, Web.HTTPApp; MVCFramework.Rtti.Utils,
Web.HTTPApp, System.Math;
{ TMVCSalutationMiddleware } constructor TMVCTraceMiddleware.Create(const MaxBodySizeInTrace: UInt64 = 1024);
begin
inherited Create;
fMaxBodySize := MaxBodySizeInTrace;
end;
procedure TMVCTraceMiddleware.OnAfterControllerAction(Context: TWebContext; procedure TMVCTraceMiddleware.OnAfterControllerAction(Context: TWebContext;
const AActionNAme: string; const Handled: Boolean); const AActionNAme: string; const Handled: Boolean);
var var
lContentStream: TStringStream; lContentStream: TStringStream;
begin begin
Log.Debug('[AFTER ACTION][RESPONSE][STATUS] ' +
Format('%d: %s', [Context.Response.StatusCode, Context.Response.ReasonString]),
'trace');
Log.Debug('[AFTER ACTION][RESPONSE][CUSTOM HEADERS] ' + string.Join(' | ',
Context.Response.CustomHeaders.ToStringArray), 'trace');
Log.Debug('[AFTER ACTION][RESPONSE][CONTENT-TYPE] ' + Context.Response.ContentType, 'trace');
lContentStream := TStringStream.Create; lContentStream := TStringStream.Create;
try try
Log.Debug('[RESPONSE][HEADERS] ' + string.Join(' | ', Context.Response.CustomHeaders.ToStringArray), 'trace');
if Assigned(Context.Response.RawWebResponse.ContentStream) then if Assigned(Context.Response.RawWebResponse.ContentStream) then
begin begin
lContentStream.CopyFrom(Context.Response.RawWebResponse.ContentStream, 0); lContentStream.CopyFrom(Context.Response.RawWebResponse.ContentStream,
Min(Context.Response.RawWebResponse.ContentStream.Size, fMaxBodySize));
Context.Response.RawWebResponse.ContentStream.Position := 0; Context.Response.RawWebResponse.ContentStream.Position := 0;
end end
else else
begin begin
lContentStream.WriteString(Context.Response.RawWebResponse.Content); lContentStream.WriteString(Context.Response.RawWebResponse.Content.Substring(0, fMaxBodySize));
end; end;
Log.Debug('[RESPONSE][BODY] ' + lContentStream.DataString, 'trace'); Log.Debug('[AFTER ACTION][RESPONSE][BODY] ' + lContentStream.DataString, 'trace');
finally finally
lContentStream.Free; lContentStream.Free;
end; end;
end; end;
procedure TMVCTraceMiddleware.OnAfterRouting(AContext: TWebContext; const AHandled: Boolean); procedure TMVCTraceMiddleware.OnAfterRouting(Context: TWebContext; const AHandled: Boolean);
begin begin
Log.Debug('[AFTER ROUTING][REQUESTED URL: %s][HANDLED: %s]', Log.Debug('[AFTER ROUTING][REQUESTED URL: %s][HANDLED: %s]',
[AContext.Request.PathInfo, AHandled.ToString(TUseBoolStrs.True)], 'trace'); [Context.Request.PathInfo, AHandled.ToString(TUseBoolStrs.True)], 'trace');
end; end;
procedure TMVCTraceMiddleware.OnBeforeControllerAction(Context: TWebContext; procedure TMVCTraceMiddleware.OnBeforeControllerAction(Context: TWebContext;
@ -97,8 +114,10 @@ begin
lContentStream := TStringStream.Create; lContentStream := TStringStream.Create;
try try
Context.Request.RawWebRequest.ReadTotalContent; Context.Request.RawWebRequest.ReadTotalContent;
Log.Debug('[REQUEST][URL] ' + Context.Request.RawWebRequest.PathInfo, 'trace'); Log.Debug('[BEFORE ROUTING][REQUEST][URL] ' + Context.Request.RawWebRequest.PathInfo, 'trace');
Log.Debug('[REQUEST][QUERYSTRING] ' + Context.Request.RawWebRequest.QueryFields.DelimitedText, 'trace'); Log.Debug('[BEFORE ROUTING][REQUEST][QUERYSTRING] ' + Context.Request.RawWebRequest.QueryFields.
DelimitedText, 'trace');
lContentType := Context.Request.Headers['content-type'].ToLower; lContentType := Context.Request.Headers['content-type'].ToLower;
if lContentType.StartsWith(TMVCMediaType.APPLICATION_JSON, true) or if lContentType.StartsWith(TMVCMediaType.APPLICATION_JSON, true) or
lContentType.StartsWith(TMVCMediaType.APPLICATION_XML, true) or lContentType.StartsWith(TMVCMediaType.APPLICATION_XML, true) or
@ -106,9 +125,13 @@ begin
lContentType.StartsWith('text/') then lContentType.StartsWith('text/') then
begin begin
lContentStream.WriteString(EncodingGetString(lContentType, lContentStream.WriteString(EncodingGetString(lContentType,
Context.Request.RawWebRequest.RawContent)); Context.Request.RawWebRequest.RawContent).Substring(0, fMaxBodySize));
end
else
begin
lContentStream.WriteString('<hidden non text content>');
end; end;
Log.Debug('[REQUEST][BODY] ' + lContentStream.DataString, 'trace'); Log.Debug('[BEFORE ROUTING][REQUEST][BODY] ' + lContentStream.DataString, 'trace');
finally finally
lContentStream.Free; lContentStream.Free;
end; end;

View File

@ -81,6 +81,7 @@ uses
LoggerPro, LoggerPro,
IdGlobal, IdGlobal,
IdGlobalProtocols, IdGlobalProtocols,
// IdHTTPWebBrokerBridge,
Swag.Doc, Swag.Doc,
Swag.Common.Types, Swag.Common.Types,
MVCFramework.Commons, MVCFramework.Commons,
@ -298,6 +299,15 @@ type
property Values: string read fValues write fValues; property Values: string read fValues write fValues;
end; end;
// test
// TMVCHackHTTPAppRequest = class(TIdHTTPAppRequest)
// private
// function GetHeaders: TStringList;
// public
// property Headers: TStringList read GetHeaders;
// end;
// test-end
TMVCWebRequest = class TMVCWebRequest = class
private private
FQueryParams: TDictionary<string, string>; FQueryParams: TDictionary<string, string>;
@ -401,7 +411,7 @@ type
protected protected
{ protected declarations } { protected declarations }
public public
{ public declarations } // function RawHeaders: TStrings; override;
end; end;
TMVCWebResponse = class TMVCWebResponse = class
@ -479,6 +489,7 @@ type
function GetLoggedUser: TUser; function GetLoggedUser: TUser;
function GetParamsTable: TMVCRequestParamsTable; function GetParamsTable: TMVCRequestParamsTable;
procedure SetParamsTable(const AValue: TMVCRequestParamsTable); procedure SetParamsTable(const AValue: TMVCRequestParamsTable);
function GetHostingFrameworkType: TMVCHostingFrameworkType;
protected protected
procedure Flush; virtual; procedure Flush; virtual;
procedure BindToSession(const ASessionId: string); procedure BindToSession(const ASessionId: string);
@ -498,6 +509,7 @@ type
function IsSessionStarted: Boolean; function IsSessionStarted: Boolean;
function SessionMustBeClose: Boolean; function SessionMustBeClose: Boolean;
property HostingFrameworkType: TMVCHostingFrameworkType read GetHostingFrameworkType;
property LoggedUser: TUser read GetLoggedUser; property LoggedUser: TUser read GetLoggedUser;
property Request: TMVCWebRequest read FRequest; property Request: TMVCWebRequest read FRequest;
property Response: TMVCWebResponse read FResponse; property Response: TMVCWebResponse read FResponse;
@ -1010,6 +1022,7 @@ uses
var var
_IsShuttingDown: Int64 = 0; _IsShuttingDown: Int64 = 0;
_MVCGlobalActionParamsCache: TMVCStringObjectDictionary<TMVCActionParamCacheItem> = nil; _MVCGlobalActionParamsCache: TMVCStringObjectDictionary<TMVCActionParamCacheItem> = nil;
_HostingFramework: TMVCHostingFrameworkType = hftUnknown;
function IsShuttingDown: Boolean; function IsShuttingDown: Boolean;
begin begin
@ -1833,6 +1846,36 @@ begin
FResponse.Flush; FResponse.Flush;
end; end;
function TWebContext.GetHostingFrameworkType: TMVCHostingFrameworkType;
begin
{$IFDEF WEBAPACHEHTTP}
if FRequest.ClassType = TApacheRequest then
begin
Exit(hftApache);
end
else
begin
{$IFNDEF LINUX}
if FRequest.ClassType = TISAPIRequest then
begin
Exit(hftISAPI);
end
else
{$ENDIF}
{$ENDIF}
begin
Exit(hftIndy);
end;
end;
end;
{ TMVCIndyWebRequest }
//function TMVCIndyWebRequest.RawHeaders: TStrings;
//begin
// Result := TMVCHackHTTPAppRequest(FWebRequest).GetHeaders;
//end;
function TWebContext.GetLoggedUser: TUser; function TWebContext.GetLoggedUser: TUser;
begin begin
if not Assigned(FLoggedUser) then if not Assigned(FLoggedUser) then
@ -3740,6 +3783,13 @@ begin
FFormat := AFormat; FFormat := AFormat;
end; end;
{ TMVCHackHTTPAppRequest }
//function TMVCHackHTTPAppRequest.GetHeaders: TStringList;
//begin
// Result := FRequestInfo.RawHeaders;
//end;
initialization initialization
_IsShuttingDown := 0; _IsShuttingDown := 0;