2019-09-25 16:41:11 +02:00
// ***************************************************************************
2016-06-22 17:49:16 +02:00
//
// Delphi MVC Framework
//
2019-01-08 12:48:27 +01:00
// Copyright (c) 2010-2019 Daniele Teti and the DMVCFramework Team
2016-06-22 17:49:16 +02:00
//
// https://github.com/danieleteti/delphimvcframework
//
2019-10-10 00:59:04 +02:00
// Collaborators on this file:
// Ezequiel Juliano Müller (ezequieljuliano@gmail.com)
// João Antônio Duarte (https://github.com/joaoduarte19)
2017-03-13 20:52:11 +01:00
//
2016-06-22 17:49:16 +02:00
// ***************************************************************************
//
// 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.
//
// *************************************************************************** }
2013-10-30 00:48:23 +01:00
unit MVCFramework;
2017-01-18 21:53:53 +01:00
{$I dmvcframework.inc}
2019-05-02 17:38:57 +02:00
{$IF IOS}
{$MESSAGE Fatal 'This unit is not compilable on iOS'}
2017-01-18 21:53:53 +01:00
{$ENDIF}
2013-10-30 00:48:23 +01:00
{ $ RTTI EXPLICIT
2018-08-08 17:11:45 +02:00
METHODS( DefaultMethodRttiVisibility)
FIELDS( DefaultFieldRttiVisibility)
PROPERTIES( DefaultPropertyRttiVisibility) }
2013-11-09 14:22:11 +01:00
{$WARNINGS OFF}
2013-10-30 00:48:23 +01:00
interface
uses
2015-12-02 04:14:15 +01:00
System. Classes,
System. SysUtils,
2017-03-13 20:52:11 +01:00
System. TypInfo,
System. IOUtils,
System. SyncObjs,
System. DateUtils,
System. Generics. Collections,
System. Rtti,
Data. DB,
2015-12-02 04:14:15 +01:00
MVCFramework. Session,
2017-03-13 20:52:11 +01:00
MVCFramework. DuckTyping,
MVCFramework. Logger,
MVCFramework. ApplicationSession,
MVCFramework. Serializer. Intf,
2018-08-08 17:11:45 +02:00
{$IFDEF WEBAPACHEHTTP}
2019-02-24 20:43:06 +01:00
Web. ApacheHTTP,
// Apache Support since XE6 http://docwiki.embarcadero.com/Libraries/XE6/de/Web.ApacheHTTP
2017-03-13 20:52:11 +01:00
2018-08-08 17:11:45 +02:00
{$ENDIF}
2017-03-13 20:52:11 +01:00
2017-10-16 22:57:27 +02:00
// Delphi XE4 (all update) and XE5 (with no update) don't contains this unit. Look for the bug in QC
2017-04-14 16:43:31 +02:00
// https://quality.embarcadero.com/browse/RSP-17216
2019-05-09 20:53:52 +02:00
{$IFNDEF MOBILE} // file upload is not supported on mobile
2019-08-02 12:32:23 +02:00
{$IF Defined(SeattleOrBetter)}
2017-04-14 16:43:31 +02:00
Web. ReqMulti,
2019-08-02 12:32:23 +02:00
{$ELSE}
ReqMulti,
{$ENDIF}
2018-08-08 17:11:45 +02:00
{$ENDIF}
2017-03-13 20:52:11 +01:00
Web. HTTPApp,
2017-04-14 16:43:31 +02:00
2019-05-02 17:38:57 +02:00
{$IFDEF MSWINDOWS}
2017-03-13 20:52:11 +01:00
Web. Win. IsapiHTTP,
2018-08-08 17:11:45 +02:00
{$ENDIF}
2017-03-13 20:52:11 +01:00
Web. WebReq,
LoggerPro,
IdGlobal,
IdGlobalProtocols,
2019-05-09 20:53:52 +02:00
IdURI,
2019-09-25 16:41:11 +02:00
Swag. Doc,
Swag. Common. Types,
2019-09-01 20:35:19 +02:00
MVCFramework. Commons,
MVCFramework. Serializer. Commons;
2013-10-30 00:48:23 +01:00
type
2017-03-13 20:52:11 +01:00
2016-08-09 13:08:17 +02:00
TSessionData = TDictionary< string , string > ;
2017-07-05 00:17:46 +02:00
TMVCCustomData = TSessionData;
2017-04-14 16:43:31 +02:00
TMVCBaseViewEngine = class ;
TMVCViewEngineClass = class of TMVCBaseViewEngine;
2015-12-02 04:14:15 +01:00
2017-03-13 20:52:11 +01:00
MVCBaseAttribute = class( TCustomAttribute)
private
{ private declarations }
protected
{ protected declarations }
public
{ public declarations }
end ;
2015-12-02 04:14:15 +01:00
2019-10-30 00:21:13 +01:00
MVCRequiresAuthenticationAttribute = class( MVCBaseAttribute)
end ;
2017-03-13 20:52:11 +01:00
MVCHTTPMethodsAttribute = class( MVCBaseAttribute)
2015-12-02 04:14:15 +01:00
private
FMVCHTTPMethods: TMVCHTTPMethods;
function GetMVCHTTPMethodsAsString: string ;
2017-03-13 20:52:11 +01:00
protected
{ protected declarations }
2015-12-02 04:14:15 +01:00
public
2017-03-13 20:52:11 +01:00
constructor Create( const AMVCHTTPMethods: TMVCHTTPMethods) ;
2015-12-02 04:14:15 +01:00
property MVCHTTPMethods: TMVCHTTPMethods read FMVCHTTPMethods;
property MVCHTTPMethodsAsString: string read GetMVCHTTPMethodsAsString;
end ;
2017-03-13 20:52:11 +01:00
MVCHTTPMethodAttribute = MVCHTTPMethodsAttribute;
2015-12-02 04:14:15 +01:00
MVCStringAttribute = class( MVCBaseAttribute)
private
FValue: string ;
2017-03-13 20:52:11 +01:00
protected
{ protected declarations }
2015-12-02 04:14:15 +01:00
public
2017-03-13 20:52:11 +01:00
constructor Create( const AValue: string ) ;
2015-12-02 04:14:15 +01:00
property Value: string read FValue;
end ;
2019-09-25 16:41:11 +02:00
MVCIntegerAttribute = class( MVCBaseAttribute)
private
FValue: Int64 ;
protected
{ protected declarations }
public
constructor Create( const AValue: Int64 ) ;
property Value: Int64 read FValue;
end ;
2015-12-02 04:14:15 +01:00
MVCConsumesAttribute = class( MVCStringAttribute)
2017-03-13 20:52:11 +01:00
private
{ private declarations }
protected
{ protected declarations }
public
{ public declarations }
2015-12-02 04:14:15 +01:00
end ;
2017-03-13 20:52:11 +01:00
MVCProducesAttribute = class( MVCStringAttribute)
private
2017-09-08 16:59:02 +02:00
FCharset: string ;
2017-03-13 20:52:11 +01:00
protected
{ protected declarations }
public
constructor Create( const AValue: string ) ; overload ;
2017-09-08 16:59:02 +02:00
constructor Create( const AValue: string ; const ACharset: string ) ; overload ;
property Charset: string read FCharset;
2015-12-16 15:57:20 +01:00
end ;
2017-03-13 20:52:11 +01:00
MVCDocAttribute = class( MVCStringAttribute)
2015-12-02 04:14:15 +01:00
private
2017-03-13 20:52:11 +01:00
{ private declarations }
protected
{ protected declarations }
2015-12-02 04:14:15 +01:00
public
2017-03-13 20:52:11 +01:00
{ public declarations }
2015-12-02 04:14:15 +01:00
end ;
2019-09-25 16:41:11 +02:00
MVCFormatAttribute = class( MVCStringAttribute)
private
{ private declarations }
protected
{ protected declarations }
public
{ public declarations }
end ;
MVCMaxLengthAttribute = class( MVCIntegerAttribute)
private
{ private declarations }
protected
{ protected declarations }
public
{ public declarations }
end ;
MVCMinimumAttribute = class( MVCIntegerAttribute)
private
{ private declarations }
protected
{ protected declarations }
public
{ public declarations }
end ;
MVCMaximumAttribute = class( MVCIntegerAttribute)
private
{ private declarations }
protected
{ protected declarations }
public
{ public declarations }
end ;
MVCInheritableAttribute = class( MVCBaseAttribute)
private
{ private declarations }
protected
{ protected declarations }
public
{ public declarations }
end ;
2015-12-02 04:14:15 +01:00
MVCPathAttribute = class( MVCBaseAttribute)
private
FPath: string ;
2017-03-13 20:52:11 +01:00
protected
{ protected declarations }
2015-12-02 04:14:15 +01:00
public
2017-03-13 20:52:11 +01:00
constructor Create( const APath: string ) ; overload ;
2015-12-02 04:14:15 +01:00
property Path: string read FPath;
end ;
2019-09-25 16:41:11 +02:00
MVCResponseAttribute = class( MVCBaseAttribute)
2019-07-26 13:51:11 +02:00
private
2019-09-25 16:41:11 +02:00
FStatusCode: Integer ;
FDescription : string ;
FResponseClass : TClass;
2019-07-26 13:51:11 +02:00
protected
{ protected declarations }
public
2019-09-25 16:41:11 +02:00
constructor Create( inStatusCode: Integer ; const inDescription: string ; inResponseClass : TClass = nil ) ; overload ;
property StatusCode: Integer read FStatusCode;
property Description: string read FDescription;
property ResponseClass: TClass read FResponseClass;
end ;
MVCResponseListAttribute = class( MVCBaseAttribute)
private
FStatusCode: Integer ;
FDescription : string ;
FResponseClass : TClass;
protected
{ protected declarations }
public
constructor Create( inStatusCode: Integer ; const inDescription: string ; inResponseClass : TClass = nil ) ; overload ;
property StatusCode: Integer read FStatusCode;
property Description: string read FDescription;
property ResponseClass: TClass read FResponseClass;
end ;
MVCPathParamAttribute = class( MVCBaseAttribute)
private
FType : TSwagTypeParameter;
FFormat : string ;
FValue : string ;
public
constructor Create( AType : TSwagTypeParameter; APattern: string = '' ; AFormat: string = '' ) ;
property ParamType: TSwagTypeParameter read FType;
property Format: string read FFormat;
property Pattern: string read FValue;
end ;
MVCParamAttribute = class( MVCStringAttribute)
private
FName : string ;
FLocation : TSwagRequestParameterInLocation;
FType : TSwagTypeParameter;
FClassType : TClass;
FPattern : string ;
FFormat : string ;
public
property Name : string read FName write FName;
property Location: TSwagRequestParameterInLocation read FLocation write FLocation;
property ParamType: TSwagTypeParameter read FType write Ftype;
property ClassType: TClass read FClassType write FClassType;
property Pattern: string read FPattern write FPattern;
property Format: string read FFormat write FFormat;
constructor Create( name : string ; location: TSwagRequestParameterInLocation; AType : TSwagTypeParameter; APattern: string = '' ; AFormat: string = '' ) ; overload ;
constructor Create( name : string ; location: TSwagRequestParameterInLocation; AType : TClass; APattern: string = '' ; AFormat: string = '' ) ; overload ;
end ;
MVCPatternAttribute = class( MVCStringAttribute)
end ;
MVCStringEnumAttribute = class( MVCBaseAttribute)
private
fValues : String ;
public
constructor Create( const enumValue: String ) ;
property Values : string read FValues write FValues;
2019-04-03 09:42:15 +02:00
end ;
2015-12-02 04:14:15 +01:00
TMVCWebRequest = class
private
2019-08-23 13:42:20 +02:00
FQueryParams: TDictionary< string , string > ;
2019-07-26 19:28:45 +02:00
FContentFields: TDictionary< string , string > ;
2015-12-02 04:14:15 +01:00
FWebRequest: TWebRequest;
2017-03-13 20:52:11 +01:00
FSerializers: TDictionary< string , IMVCSerializer> ;
FBody: string ;
2015-12-02 04:14:15 +01:00
FContentType: string ;
FCharset: string ;
2017-03-13 20:52:11 +01:00
FParamsTable: TMVCRequestParamsTable;
2017-09-08 16:59:02 +02:00
FContentMediaType: string ;
procedure DefineContentType;
2019-07-26 18:59:07 +02:00
function GetContentFields: TDictionary< string , string > ;
2019-08-23 13:42:20 +02:00
function GetQueryParams: TDictionary< string , string > ;
2017-03-13 20:52:11 +01:00
function GetHeader( const AName: string ) : string ;
2015-12-02 04:14:15 +01:00
function GetPathInfo: string ;
2017-03-13 20:52:11 +01:00
function GetParams( const AParamName: string ) : string ;
2016-06-22 17:49:16 +02:00
function GetIsAjax: Boolean ;
2015-12-02 04:14:15 +01:00
function GetHTTPMethod: TMVCHTTPMethodType;
function GetHTTPMethodAsString: string ;
2017-03-13 20:52:11 +01:00
function GetParamAsInteger( const AParamName: string ) : Integer ;
function GetParamAsInt64( const AParamName: string ) : Int64 ;
2015-12-02 04:14:15 +01:00
function GetFiles: TAbstractWebRequestFiles;
2017-03-13 20:52:11 +01:00
function GetParamNames: TArray< string > ;
2017-05-18 00:02:22 +02:00
function GetParamsMulti( const AParamName: string ) : TArray< string > ;
2017-03-13 20:52:11 +01:00
protected
{ protected declarations }
2015-12-02 04:14:15 +01:00
public
2017-03-13 20:52:11 +01:00
constructor Create( const AWebRequest: TWebRequest; const ASerializers: TDictionary< string , IMVCSerializer> ) ;
2015-12-02 04:14:15 +01:00
destructor Destroy; override ;
2017-03-13 20:52:11 +01:00
function ClientIp: string ;
function ClientPrefer( const AMediaType: string ) : Boolean ;
2017-03-20 19:08:01 +01:00
function ClientPreferHTML: Boolean ;
2019-05-10 00:46:03 +02:00
function GetOverwrittenHTTPMethod: TMVCHTTPMethodType;
2017-03-13 20:52:11 +01:00
function SegmentParam( const AParamName: string ; out AValue: string ) : Boolean ;
function SegmentParamsCount: Integer ;
2016-06-22 17:49:16 +02:00
function ThereIsRequestBody: Boolean ;
2017-03-13 20:52:11 +01:00
procedure EnsureQueryParamExists( const AName: string ) ;
function QueryStringParam( const AName: string ) : string ;
function QueryStringParamExists( const AName: string ) : Boolean ;
2016-06-23 12:11:01 +02:00
function QueryStringParams: TStrings;
2017-03-13 20:52:11 +01:00
function Accept: string ;
function ContentParam( const AName: string ) : string ;
function Cookie( const AName: string ) : string ;
2015-12-02 04:14:15 +01:00
function Body: string ;
2017-03-13 20:52:11 +01:00
function BodyAs< T: class , constructor > : T;
function BodyAsListOf< T: class , constructor > : TObjectList< T> ;
procedure BodyFor< T: class , constructor > ( const AObject: T) ;
procedure BodyForListOf< T: class , constructor > ( const AObjectList: TObjectList< T> ) ;
property RawWebRequest: TWebRequest read FWebRequest;
2017-09-08 16:59:02 +02:00
property ContentMediaType: string read FContentMediaType;
2017-03-13 20:52:11 +01:00
property ContentType: string read FContentType;
2017-09-08 16:59:02 +02:00
property ContentCharset: string read FCharset;
2019-07-26 18:59:07 +02:00
property ContentFields: TDictionary< string , string > read GetContentFields;
2019-08-23 13:42:20 +02:00
property QueryParams: TDictionary< string , string > read GetQueryParams;
2017-03-13 20:52:11 +01:00
property Headers[ const AHeaderName: string ] : string read GetHeader;
property PathInfo: string read GetPathInfo;
property ParamsTable: TMVCRequestParamsTable read FParamsTable write FParamsTable;
property ParamNames: TArray< string > read GetParamNames;
property Params[ const AParamName: string ] : string read GetParams;
2017-05-18 00:02:22 +02:00
property ParamsMulti[ const AParamName: string ] : TArray< string > read GetParamsMulti;
2017-03-13 20:52:11 +01:00
property ParamsAsInteger[ const AParamName: string ] : Integer read GetParamAsInteger;
property ParamsAsInt64[ const AParamName: string ] : Int64 read GetParamAsInt64;
2016-06-22 17:49:16 +02:00
property IsAjax: Boolean read GetIsAjax;
2015-12-02 04:14:15 +01:00
property HTTPMethod: TMVCHTTPMethodType read GetHTTPMethod;
property HTTPMethodAsString: string read GetHTTPMethodAsString;
property Files: TAbstractWebRequestFiles read GetFiles;
end ;
2013-10-30 00:48:23 +01:00
2018-08-08 17:11:45 +02:00
{$IFDEF WEBAPACHEHTTP}
2014-10-03 11:40:57 +02:00
2015-12-02 04:14:15 +01:00
TMVCApacheWebRequest = class( TMVCWebRequest)
2017-03-13 20:52:11 +01:00
private
{ private declarations }
protected
{ protected declarations }
2015-12-02 04:14:15 +01:00
public
2017-03-13 20:52:11 +01:00
{ public declarations }
2015-12-02 04:14:15 +01:00
end ;
2017-03-13 20:52:11 +01:00
2018-08-08 17:11:45 +02:00
{$ENDIF}
2014-05-14 15:55:41 +02:00
2015-12-02 04:14:15 +01:00
TMVCISAPIWebRequest = class( TMVCWebRequest)
2017-03-13 20:52:11 +01:00
private
{ private declarations }
protected
{ protected declarations }
2015-12-02 04:14:15 +01:00
public
2017-03-13 20:52:11 +01:00
{ public declarations }
2015-12-02 04:14:15 +01:00
end ;
2013-10-30 00:48:23 +01:00
2017-03-13 20:52:11 +01:00
TMVCIndyWebRequest = class( TMVCWebRequest)
private
{ private declarations }
protected
{ protected declarations }
2015-12-02 04:14:15 +01:00
public
2017-03-13 20:52:11 +01:00
{ public declarations }
2015-12-02 04:14:15 +01:00
end ;
2013-10-30 00:48:23 +01:00
2015-12-02 04:14:15 +01:00
TMVCWebResponse = class
private
2017-03-13 20:52:11 +01:00
FWebResponse: TWebResponse;
FFlushOnDestroy: Boolean ;
function GetCustomHeaders: TStrings;
function GetReasonString: string ;
2015-12-02 04:14:15 +01:00
function GetStatusCode: Integer ;
function GetCookies: TCookieCollection;
function GetContentType: string ;
function GetLocation: string ;
2017-03-13 20:52:11 +01:00
function GetContent: string ;
procedure SetReasonString( const AValue: string ) ;
procedure SetStatusCode( const AValue: Integer ) ;
procedure SetContentType( const AValue: string ) ;
procedure SetLocation( const AValue: string ) ;
procedure SetContent( const AValue: string ) ;
2015-12-02 04:14:15 +01:00
public
2017-03-13 20:52:11 +01:00
constructor Create( const AWebResponse: TWebResponse) ;
2015-12-02 04:14:15 +01:00
destructor Destroy; override ;
2017-03-13 20:52:11 +01:00
2015-12-02 04:14:15 +01:00
procedure Flush;
2017-03-13 20:52:11 +01:00
procedure SetCustomHeader( const AName, AValue: string ) ;
procedure SetContentStream( const AStream: TStream; const AContentType: string ) ;
2015-12-02 04:14:15 +01:00
property StatusCode: Integer read GetStatusCode write SetStatusCode;
property ReasonString: string read GetReasonString write SetReasonString;
property ContentType: string read GetContentType write SetContentType;
2017-03-13 20:52:11 +01:00
property CustomHeaders: TStrings read GetCustomHeaders;
property Cookies: TCookieCollection read GetCookies;
2015-12-02 04:14:15 +01:00
property Location: string read GetLocation write SetLocation;
property RawWebResponse: TWebResponse read FWebResponse;
2017-03-13 20:52:11 +01:00
property Content: string read GetContent write SetContent;
2016-06-22 17:49:16 +02:00
property FlushOnDestroy: Boolean read FFlushOnDestroy write FFlushOnDestroy;
2015-12-02 04:14:15 +01:00
end ;
TUser = class
private
FUserName: string ;
2017-03-13 20:52:11 +01:00
FRoles: TList< string > ;
2015-12-02 04:14:15 +01:00
FLoggedSince: TDateTime;
FRealm: string ;
2017-09-07 00:10:21 +02:00
FCustomData: TMVCCustomData;
2017-03-13 20:52:11 +01:00
procedure SetLoggedSince( const AValue: TDateTime) ;
2017-09-07 00:10:21 +02:00
procedure SetCustomData( const Value: TMVCCustomData) ;
2015-12-02 04:14:15 +01:00
public
2017-03-13 20:52:11 +01:00
constructor Create;
destructor Destroy; override ;
function IsValid: Boolean ;
2015-12-02 04:14:15 +01:00
procedure Clear;
2017-03-13 20:52:11 +01:00
procedure SaveToSession( const AWebSession: TWebSession) ;
function LoadFromSession( const AWebSession: TWebSession) : Boolean ;
property UserName: string read FUserName write FUserName;
2015-12-02 04:14:15 +01:00
property Roles: TList< string > read FRoles;
property LoggedSince: TDateTime read FLoggedSince write SetLoggedSince;
2017-03-13 20:52:11 +01:00
property Realm: string read FRealm write FRealm;
2017-09-07 00:10:21 +02:00
property CustomData: TMVCCustomData read FCustomData write SetCustomData;
2015-12-02 04:14:15 +01:00
end ;
TWebContext = class
private
FRequest: TMVCWebRequest;
FResponse: TMVCWebResponse;
FConfig: TMVCConfig;
2017-03-13 20:52:11 +01:00
FSerializers: TDictionary< string , IMVCSerializer> ;
2016-06-22 17:49:16 +02:00
FIsSessionStarted: Boolean ;
FSessionMustBeClose: Boolean ;
2017-03-13 20:52:11 +01:00
FLoggedUser: TUser;
FData: TDictionary< string , string > ;
FWebSession: TWebSession;
2016-04-03 22:35:27 +02:00
function GetWebSession: TWebSession;
2015-12-02 04:14:15 +01:00
function GetLoggedUser: TUser;
2017-03-13 20:52:11 +01:00
function GetParamsTable: TMVCRequestParamsTable;
procedure SetParamsTable( const AValue: TMVCRequestParamsTable) ;
protected
procedure Flush; virtual ;
procedure BindToSession( const ASessionId: string ) ;
function SendSessionCookie( const AContext: TWebContext) : string ;
2019-02-24 20:43:06 +01:00
function AddSessionToTheSessionList( const ASessionType, ASessionId: string ; const ASessionTimeout: Integer )
: TWebSession;
2015-12-02 04:14:15 +01:00
public
2018-08-08 17:11:45 +02:00
constructor Create( const ARequest: TWebRequest; const AResponse: TWebResponse; const AConfig: TMVCConfig;
const ASerializers: TDictionary< string , IMVCSerializer> ) ;
2015-12-02 04:14:15 +01:00
destructor Destroy; override ;
2017-03-13 20:52:11 +01:00
procedure SessionStart; virtual ;
procedure SessionStop( const ARaiseExceptionIfExpired: Boolean = True ) ; virtual ;
2016-06-28 13:42:14 +02:00
function SessionStarted: Boolean ;
2017-03-13 20:52:11 +01:00
function SessionId: string ;
function IsSessionStarted: Boolean ;
function SessionMustBeClose: Boolean ;
2015-12-02 04:14:15 +01:00
property LoggedUser: TUser read GetLoggedUser;
property Request: TMVCWebRequest read FRequest;
property Response: TMVCWebResponse read FResponse;
2016-04-03 22:35:27 +02:00
property Session: TWebSession read GetWebSession;
2015-12-02 04:14:15 +01:00
property Config: TMVCConfig read FConfig;
2017-03-13 20:52:11 +01:00
property Data: TDictionary< string , string > read FData;
property ParamsTable: TMVCRequestParamsTable read GetParamsTable write SetParamsTable;
2015-12-02 04:14:15 +01:00
end ;
2017-03-13 20:52:11 +01:00
TMVCEngine = class ;
2015-12-02 04:14:15 +01:00
2017-03-13 20:52:11 +01:00
TMVCBase = class
2015-12-02 04:14:15 +01:00
private
2017-03-13 20:52:11 +01:00
FEngine: TMVCEngine;
2015-12-02 04:14:15 +01:00
FApplicationSession: TWebApplicationSession;
2017-03-13 20:52:11 +01:00
function GetEngine: TMVCEngine;
function GetConfig: TMVCConfig;
function GetApplicationSession: TWebApplicationSession;
procedure SetApplicationSession( const AValue: TWebApplicationSession) ;
procedure SetEngine( const AValue: TMVCEngine) ;
2015-12-02 04:14:15 +01:00
protected
2017-03-13 20:52:11 +01:00
class function GetApplicationFileName: string ; static ;
class function GetApplicationFileNamePath: string ; static ;
2015-12-02 04:14:15 +01:00
public
2017-03-13 20:52:11 +01:00
property Engine: TMVCEngine read GetEngine write SetEngine;
property Config: TMVCConfig read GetConfig;
property ApplicationSession: TWebApplicationSession read GetApplicationSession write SetApplicationSession;
2015-12-02 04:14:15 +01:00
end ;
2018-10-23 16:18:34 +02:00
TMVCResponse = class ;
2017-03-13 20:52:11 +01:00
TMVCErrorResponse = class ;
2018-10-14 18:23:20 +02:00
IMVCRenderer = interface
[ '{2FF6DAC8-2F19-4C78-B9EC-A86296847D39}' ]
2019-02-24 20:43:06 +01:00
procedure Render( const AContent: string ) ; overload ;
2018-10-14 18:23:20 +02:00
procedure Render( const AObject: TObject) ; overload ;
procedure Render( const AObject: TObject; const AOwns: Boolean ) ; overload ;
procedure Render( const AObject: TObject; const AOwns: Boolean ; const AType: TMVCSerializationType) ; overload ;
2019-08-23 12:16:25 +02:00
procedure Render( const AStatusCode: Integer ; AObject: TObject; const AOwns: Boolean ;
const ASerializationAction: TMVCSerializationAction = nil ) ; overload ;
2018-10-14 18:23:20 +02:00
procedure Render( const ACollection: IMVCList) ; overload ;
procedure Render( const ACollection: IMVCList; const AType: TMVCSerializationType) ; overload ;
2019-03-10 16:29:18 +01:00
procedure Render(
const ADataSet: TDataSet;
const ASerializationAction: TMVCDatasetSerializationAction = nil
) ; overload ;
procedure Render(
const ADataSet: TDataSet;
const AOwns: Boolean ;
const ASerializationAction: TMVCDatasetSerializationAction = nil ) ; overload ;
procedure Render(
const ADataSet: TDataSet;
const AOwns: Boolean ;
const ASerializationType: TMVCDatasetSerializationType;
const ASerializationAction: TMVCDatasetSerializationAction = nil ) ; overload ;
procedure Render(
const ADataSet: TDataSet;
const AOwns: Boolean ;
const AIgnoredFields: TMVCIgnoredList;
const ASerializationType: TMVCDatasetSerializationType;
const ASerializationAction: TMVCDatasetSerializationAction = nil ) ; overload ;
procedure Render(
const ADataSet: TDataSet;
const AOwns: Boolean ;
const AIgnoredFields: TMVCIgnoredList;
const ANameCase: TMVCNameCase;
const ASerializationType: TMVCDatasetSerializationType;
const ASerializationAction: TMVCDatasetSerializationAction = nil ) ; overload ;
2018-10-14 18:23:20 +02:00
procedure Render( const ATextWriter: TTextWriter; const AOwns: Boolean = True ) ; overload ;
procedure Render( const AStream: TStream; const AOwns: Boolean = True ) ; overload ;
2019-02-24 20:43:06 +01:00
procedure Render( const AErrorCode: Integer ; const AErrorMessage: string ;
const AErrorClassName: string = '' ) ; overload ;
procedure Render( const AException: Exception; AExceptionItems: TList< string > = nil ;
const AOwns: Boolean = True ) ; overload ;
2018-10-23 16:18:34 +02:00
procedure Render( const AResponse: TMVCResponse; const AOwns: Boolean = True ) ; overload ;
2018-10-14 18:23:20 +02:00
// SSE Support
procedure RenderSSE( const EventID: string ; const EventData: string ; EventName: string = '' ;
const Retry: Integer = TMVCConstants. SSE_RETRY_DEFAULT) ;
procedure SendStream( const AStream: TStream; const AOwns: Boolean = True ; const ARewind: Boolean = False ) ;
procedure SendFile( const AFileName: string ) ;
procedure RenderResponseStream;
function ResponseStream: TStringBuilder;
procedure Redirect( const AUrl: string ) ;
procedure ResponseStatus( const AStatusCode: Integer ; const AReasonString: string = '' ) ;
2019-08-28 00:18:30 +02:00
procedure ResponseCreated( const Location: String = '' ) ;
2018-10-14 18:23:20 +02:00
// Serializer access
function Serializer: IMVCSerializer; overload ;
2019-05-09 20:53:52 +02:00
function Serializer( const AContentType: string ; const ARaiseExcpIfNotExists: Boolean = True )
: IMVCSerializer; overload ;
2018-10-14 18:23:20 +02:00
end ;
2018-12-09 23:03:06 +01:00
IMVCAuthenticationHandler = interface
[ '{19B580EA-8A47-4364-A302-EEF3C6207A9F}' ]
2019-02-24 20:43:06 +01:00
procedure OnRequest( const AContext: TWebContext; const AControllerQualifiedClassName, AActionName: string ;
var AAuthenticationRequired: Boolean ) ;
procedure OnAuthentication( const AContext: TWebContext; const AUserName, APassword: string ;
AUserRoles: TList< string > ; var AIsValid: Boolean ; const ASessionData: TDictionary< string , string > ) ;
procedure OnAuthorization( const AContext: TWebContext; AUserRoles: TList< string > ;
const AControllerQualifiedClassName: string ; const AActionName: string ; var AIsAuthorized: Boolean ) ;
2018-12-09 23:03:06 +01:00
end ;
2018-10-14 18:23:20 +02:00
TMVCRenderer = class( TMVCBase)
protected
2015-12-02 04:14:15 +01:00
FContext: TWebContext;
FContentCharset: string ;
2017-03-13 20:52:11 +01:00
FResponseStream: TStringBuilder;
2019-10-10 20:16:20 +02:00
function ToMVCList( const AObject: TObject; AOwnsObject: Boolean = False ) : IMVCList;
2018-10-14 18:23:20 +02:00
public
2015-12-02 04:14:15 +01:00
function GetContentType: string ;
2017-03-13 20:52:11 +01:00
function GetStatusCode: Integer ;
procedure SetContentType( const AValue: string ) ;
procedure SetStatusCode( const AValue: Integer ) ;
2018-10-14 18:23:20 +02:00
function GetContext: TWebContext;
procedure Redirect( const AUrl: string ) ; virtual ;
procedure ResponseStatus( const AStatusCode: Integer ; const AReasonString: string = '' ) ; virtual ;
2019-09-01 20:35:19 +02:00
/// <summary>
/// HTTP Status 201 indicates that as a result of HTTP POST request, one or more new resources have been successfully created on server.
/// The response may contain URI in Location header field in HTTP headers list, which can have reference to the newly created resource. Also, response payload also may include an entity containing a list of resource characteristics and location(s) from which the user or user agent can choose the one most appropriate.
/// WARNING: The origin server MUST create the resource before returning the 201 status code. If the action cannot be carried out immediately, the server SHOULD respond with 202 (Accepted) response instead.
/// </summary>
/// <remarks>
/// https://restfulapi.net/http-status-201-created/
/// </remarks>
procedure ResponseCreated( const Location: String = '' ; const Reason: String = 'Created' ) ; virtual ;
/// <summary>
2019-09-25 16:41:11 +02:00
/// Allow a server to accept a request for some other process (perhaps a batch-oriented process that is only run once per day) without requiring that the user agent s connection to the server persist until the process is completed.
/// The entity returned with this response SHOULD describe the request s current status and point to (or embed) a status monitor that can provide the user with (or without) an estimate of when the request will be fulfilled.
2019-09-01 20:35:19 +02:00
/// </summary>
/// <remarks>
/// https://restfulapi.net/http-status-202-accepted/
/// </remarks>
procedure ResponseAccepted( const HREF: String ; const ID: String ; const Reason: String = 'Accepted' ) ; virtual ;
/// <summary>
2019-09-25 16:41:11 +02:00
/// HTTP Status 204 (No Content) indicates that the server has successfully fulfilled the request and that there is no content to send in the response payload body. The server might want to return updated meta information in the form of entity-headers, which if present SHOULD be applied to current document s active view if any.
2019-09-01 20:35:19 +02:00
/// The 204 response MUST NOT include a message-body and thus is always terminated by the first empty line after the header fields.
/// </summary>
procedure ResponseNoContent( const Reason: String = 'No Content' ) ; virtual ;
2018-10-14 18:23:20 +02:00
function Serializer: IMVCSerializer; overload ;
2019-05-09 20:53:52 +02:00
function Serializer( const AContentType: string ; const ARaiseExceptionIfNotExists: Boolean = True )
: IMVCSerializer; overload ;
2018-10-14 18:23:20 +02:00
procedure SendStream( const AStream: TStream; const AOwns: Boolean = True ; const ARewind: Boolean = False ) ; virtual ;
procedure SendFile( const AFileName: string ) ; virtual ;
procedure RenderResponseStream; virtual ;
function ResponseStream: TStringBuilder;
procedure Render( const AContent: string ) ; overload ;
2019-05-09 20:53:52 +02:00
// PODO renders
2019-08-23 12:16:25 +02:00
procedure Render( const AStatusCode: Integer ; const AObject: TObject;
const ASerializationAction: TMVCSerializationAction = nil ) ; overload ;
2019-03-10 16:29:18 +01:00
procedure Render( const AObject: TObject; const ASerializationAction: TMVCSerializationAction = nil ) ; overload ;
2019-05-09 20:53:52 +02:00
procedure Render( const AObject: TObject; const AOwns: Boolean ;
const ASerializationAction: TMVCSerializationAction = nil ) ; overload ;
procedure Render( const AObject: TObject; const AOwns: Boolean ; const AType: TMVCSerializationType;
const ASerializationAction: TMVCSerializationAction = nil ) ; overload ;
2019-08-23 12:16:25 +02:00
procedure Render( const AStatusCode: Integer ; AObject: TObject; const AOwns: Boolean ;
const ASerializationAction: TMVCSerializationAction = nil ) ; overload ;
2019-09-18 16:53:54 +02:00
procedure Render( const AObject: IInterface; const ASerializationAction: TMVCSerializationAction = nil ) ; overload ;
2019-05-09 20:53:52 +02:00
// PODOs Collection render
2019-03-08 09:33:41 +01:00
procedure Render< T: class > ( const ACollection: TObjectList< T> ;
const ASerializationAction: TMVCSerializationAction< T> = nil ) ; overload ;
2019-02-24 20:43:06 +01:00
procedure Render< T: class > ( const ACollection: TObjectList< T> ; const AOwns: Boolean ;
2019-03-08 09:33:41 +01:00
const ASerializationAction: TMVCSerializationAction< T> = nil ) ; overload ;
procedure Render< T: class > ( const ACollection: TObjectList< T> ; const AOwns: Boolean ;
const AType: TMVCSerializationType; const ASerializationAction: TMVCSerializationAction< T> = nil ) ; overload ;
2018-10-14 18:23:20 +02:00
procedure Render( const ACollection: IMVCList) ; overload ;
procedure Render( const ACollection: IMVCList; const AType: TMVCSerializationType) ; overload ;
procedure Render( const ATextWriter: TTextWriter; const AOwns: Boolean = True ) ; overload ;
procedure Render( const AStream: TStream; const AOwns: Boolean = True ) ; overload ;
2019-07-26 14:42:57 +02:00
procedure Render( const AErrorCode: Integer ; const AErrorMessage: string = '' ; const AErrorClassName: string = '' ;
2018-10-23 16:18:34 +02:00
const ADataObject: TObject = nil ) ; overload ;
2019-02-24 20:43:06 +01:00
procedure Render( const AException: Exception; AExceptionItems: TList< string > = nil ;
const AOwns: Boolean = True ) ; overload ;
2018-10-23 16:18:34 +02:00
procedure Render( const AResponse: TMVCResponse; const AOwns: Boolean = True ) ; overload ;
2019-05-09 20:53:52 +02:00
// Dataset support
2019-03-10 16:29:18 +01:00
procedure Render(
const ADataSet: TDataSet;
const ASerializationAction: TMVCDatasetSerializationAction = nil
) ; overload ;
procedure Render(
const ADataSet: TDataSet;
const AOwns: Boolean ;
const ASerializationAction: TMVCDatasetSerializationAction = nil ) ; overload ;
procedure Render(
const ADataSet: TDataSet;
const AOwns: Boolean ;
const ASerializationType: TMVCDatasetSerializationType;
const ASerializationAction: TMVCDatasetSerializationAction = nil ) ; overload ;
procedure Render(
const ADataSet: TDataSet;
const AOwns: Boolean ;
const AIgnoredFields: TMVCIgnoredList;
const ASerializationType: TMVCDatasetSerializationType;
const ASerializationAction: TMVCDatasetSerializationAction = nil ) ; overload ;
procedure Render(
const ADataSet: TDataSet;
const AOwns: Boolean ;
const AIgnoredFields: TMVCIgnoredList;
const ANameCase: TMVCNameCase;
const ASerializationType: TMVCDatasetSerializationType;
const ASerializationAction: TMVCDatasetSerializationAction = nil ) ; overload ;
2018-10-14 18:23:20 +02:00
// SSE Support
procedure RenderSSE( const EventID: string ; const EventData: string ; EventName: string = '' ;
const Retry: Integer = TMVCConstants. SSE_RETRY_DEFAULT) ;
end ;
TMVCController = class( TMVCRenderer)
private
FViewModel: TMVCViewDataObject;
FViewDataSets: TMVCViewDataSet;
function GetSession: TWebSession;
2018-01-29 17:30:53 +01:00
function GetViewData( const aModelName: string ) : TObject;
function GetViewDataset( const aDataSetName: string ) : TDataSet;
procedure SetViewData( const aModelName: string ; const Value: TObject) ;
procedure SetViewDataset( const aDataSetName: string ; const Value: TDataSet) ;
2015-12-02 04:14:15 +01:00
protected const
CLIENTID_KEY = '__clientid' ;
protected
2017-03-13 20:52:11 +01:00
procedure MVCControllerAfterCreate; virtual ;
procedure MVCControllerBeforeDestroy; virtual ;
procedure OnBeforeAction( AContext: TWebContext; const AActionName: string ; var AHandled: Boolean ) ; virtual ;
procedure OnAfterAction( AContext: TWebContext; const AActionName: string ) ; virtual ;
function GetClientId: string ;
2015-12-02 04:14:15 +01:00
function GetCurrentWebModule: TWebModule;
2017-03-20 19:08:01 +01:00
function GetViewModel: TMVCViewDataObject;
2017-11-23 17:29:51 +01:00
function GetViewDataSets: TMVCViewDataSet;
2017-03-20 19:08:01 +01:00
function GetRenderedView( const AViewNames: TArray< string > ) : string ; virtual ;
/// <summary>
/// Load mustache view located in TMVCConfigKey.ViewsPath
/// returns the rendered views and generates output using
/// models pushed using Push* methods
/// </summary>
function LoadView( const AViewNames: TArray< string > ) : string ; virtual ;
/// <summary>
/// Load a view fragment in the output render stream. The view fragment is appended to the
/// ResponseStream verbatim. No processing happens.
/// Useful when used with cache.
/// It is equivalent to <code>ResponseStream.Append(AViewFragment);</code>
/// </summary>
procedure LoadViewFragment( const AViewFragment: string ) ;
2016-10-02 17:44:20 +02:00
2016-12-05 15:50:00 +01:00
function SessionAs< T: TWebSession> : T;
2017-03-13 20:52:11 +01:00
procedure RaiseSessionExpired; virtual ;
2017-10-09 16:17:12 +02:00
// Properties
2017-03-13 20:52:11 +01:00
property Context: TWebContext read GetContext write FContext;
property Session: TWebSession read GetSession;
property ContentType: string read GetContentType write SetContentType;
property StatusCode: Integer read GetStatusCode write SetStatusCode;
2017-11-23 17:29:51 +01:00
property ViewModelList: TMVCViewDataObject read GetViewModel;
property ViewDataSetList: TMVCViewDataSet read GetViewDataSets;
2015-12-02 04:14:15 +01:00
public
2018-08-08 17:11:45 +02:00
constructor Create; virtual ;
2015-12-02 04:14:15 +01:00
destructor Destroy; override ;
2017-03-20 19:08:01 +01:00
2017-05-25 16:57:49 +02:00
// procedure PushToView(const AModelName: string; const AModel: string);
2018-08-08 17:11:45 +02:00
procedure PushObjectToView( const aModelName: string ; const AModel: TObject) ; deprecated 'Use "ViewData"' ;
procedure PushDataSetToView( const aModelName: string ; const ADataSet: TDataSet) ; deprecated 'Use "ViewDataSet"' ;
2017-11-23 17:29:51 +01:00
2018-01-29 17:30:53 +01:00
property ViewData[ const aModelName: string ] : TObject read GetViewData write SetViewData;
property ViewDataset[ const aDataSetName: string ] : TDataSet read GetViewDataset write SetViewDataset;
2015-12-02 04:14:15 +01:00
end ;
2017-03-13 20:52:11 +01:00
TMVCControllerClazz = class of TMVCController;
2015-12-02 04:14:15 +01:00
2017-03-13 20:52:11 +01:00
TMVCControllerCreateAction = reference to function : TMVCController;
2018-11-24 16:56:21 +01:00
TMVCObjectCreatorDelegate = reference to function : TObject;
2016-02-29 13:48:36 +01:00
2017-03-13 20:52:11 +01:00
TMVCControllerDelegate = class
private
FClazz: TMVCControllerClazz;
FCreateAction: TMVCControllerCreateAction;
2017-09-24 19:40:40 +02:00
FURLSegment: string ;
2017-03-13 20:52:11 +01:00
protected
{ protected declarations }
2016-02-29 13:48:36 +01:00
public
2019-02-24 20:43:06 +01:00
constructor Create( const AClazz: TMVCControllerClazz; const ACreateAction: TMVCControllerCreateAction;
const AURLSegment: string = '' ) ;
2017-03-13 20:52:11 +01:00
property Clazz: TMVCControllerClazz read FClazz;
property CreateAction: TMVCControllerCreateAction read FCreateAction;
2017-09-24 19:40:40 +02:00
property URLSegment: string read FURLSegment;
2017-03-13 20:52:11 +01:00
end ;
TMVCStaticContents = class( TMVCController)
private
{ private declarations }
protected
{ protected declarations }
public
class procedure SendFile( const AFileName, AMediaType: string ; AContext: TWebContext) ;
class function IsStaticFile( const AViewPath, AWebRequestPath: string ; out ARealFileName: string ) : Boolean ;
class function IsScriptableFile( const AStaticFileName: string ; const AConfig: TMVCConfig) : Boolean ;
2016-02-29 13:48:36 +01:00
end ;
2016-02-23 23:22:44 +01:00
/// <summary>
/// Basis Interface for DMVC Middleware.
/// </summary>
2015-12-02 04:14:15 +01:00
IMVCMiddleware = interface
[ '{3278183A-124A-4214-AB4E-94CA4C22450D}' ]
2016-02-23 23:22:44 +01:00
/// <summary>
/// Procedure is called before the MVCEngine routes the request to a specific controller/method.
/// </summary>
2017-03-13 20:52:11 +01:00
/// <param name="AContext">Webcontext which contains the complete request and response of the actual call.</param>
/// <param name="AHandled">If set to True the Request would finished. Response must be set by the implementor. Default value is False.</param>
2018-08-08 17:11:45 +02:00
procedure OnBeforeRouting( AContext: TWebContext; var AHandled: Boolean ) ;
2016-02-23 23:22:44 +01:00
/// <summary>
/// Procedure is called before the specific controller method is called.
/// </summary>
2017-03-13 20:52:11 +01:00
/// <param name="AContext">Webcontext which contains the complete request and response of the actual call.</param>
2016-02-23 23:22:44 +01:00
/// <param name="AControllerQualifiedClassName">Qualified classname of the matching controller.</param>
2017-03-13 20:52:11 +01:00
/// <param name="AActionName">Method name of the matching controller method.</param>
/// <param name="AHandled">If set to True the Request would finished. Response must be set by the implementor. Default value is False.</param>
2019-02-24 20:43:06 +01:00
procedure OnBeforeControllerAction( AContext: TWebContext; const AControllerQualifiedClassName: string ;
const AActionName: string ; var AHandled: Boolean ) ;
2016-02-23 23:22:44 +01:00
/// <summary>
/// Procedure is called after the specific controller method was called.
/// It is still possible to cancel or to completly modifiy the request.
/// </summary>
2017-03-13 20:52:11 +01:00
/// <param name="AContext">Webcontext which contains the complete request and response of the actual call.</param>
/// <param name="AActionName">Method name of the matching controller method.</param>
/// <param name="AHandled">If set to True the Request would finished. Response must be set by the implementor. Default value is False.</param>
2018-08-08 17:11:45 +02:00
procedure OnAfterControllerAction( AContext: TWebContext; const AActionName: string ; const AHandled: Boolean ) ;
2015-12-02 04:14:15 +01:00
end ;
2019-05-09 20:53:52 +02:00
TMVCExceptionHandlerProc = reference to procedure( E: Exception; SelectedController: TMVCController;
WebContext: TWebContext; var ExceptionHandled: Boolean ) ;
2019-04-20 12:09:39 +02:00
2017-05-25 16:57:49 +02:00
TMVCEngine = class( TComponent)
2017-03-13 20:52:11 +01:00
private const
2019-02-24 20:43:06 +01:00
ALLOWED_TYPED_ACTION_PARAMETERS_TYPES =
'Integer, Int64, Single, Double, Extended, Boolean, TDate, TTime, TDateTime and String' ;
2015-12-02 04:14:15 +01:00
private
2017-04-14 16:43:31 +02:00
FViewEngineClass: TMVCViewEngineClass;
2015-12-02 04:14:15 +01:00
FWebModule: TWebModule;
2017-03-13 20:52:11 +01:00
FConfig: TMVCConfig;
2018-12-17 00:39:29 +01:00
FConfigCache_MaxRequestSize: Int64 ;
2017-04-14 16:43:31 +02:00
FSerializers: TDictionary< string , IMVCSerializer> ;
2017-03-13 20:52:11 +01:00
FMiddlewares: TList< IMVCMiddleware> ;
FControllers: TObjectList< TMVCControllerDelegate> ;
FMediaTypes: TDictionary< string , string > ;
FApplicationSession: TWebApplicationSession;
FSavedOnBeforeDispatch: THTTPMethodEvent;
2019-04-20 12:09:39 +02:00
FOnException: TMVCExceptionHandlerProc;
2017-03-13 20:52:11 +01:00
function IsStaticFileRequest( const ARequest: TWebRequest; out AFileName: string ) : Boolean ;
2017-05-18 00:02:22 +02:00
function SendStaticFileIfPresent( const AContext: TWebContext; const AFileName: string ) : Boolean ;
2018-08-08 17:11:45 +02:00
procedure FillActualParamsForAction( const AContext: TWebContext; const AActionFormalParams: TArray< TRttiParameter> ;
const AActionName: string ; var AActualParams: TArray< TValue> ) ;
2017-04-14 16:43:31 +02:00
procedure RegisterDefaultsSerializers;
function GetViewEngineClass: TMVCViewEngineClass;
2015-12-02 04:14:15 +01:00
protected
2019-05-09 20:53:52 +02:00
function CustomExceptionHandling( const Ex: Exception; const ASelectedController: TMVCController;
const AContext: TWebContext) : Boolean ;
2015-12-02 04:14:15 +01:00
procedure ConfigDefaultValues; virtual ;
2018-12-17 00:39:29 +01:00
procedure SaveCacheConfigValues;
2015-12-02 04:14:15 +01:00
procedure LoadSystemControllers; virtual ;
2017-03-13 20:52:11 +01:00
procedure FixUpWebModule;
procedure ExecuteBeforeRoutingMiddleware( const AContext: TWebContext; var AHandled: Boolean ) ;
2019-02-24 20:43:06 +01:00
procedure ExecuteBeforeControllerActionMiddleware( const AContext: TWebContext;
const AControllerQualifiedClassName: string ; const AActionName: string ; var AHandled: Boolean ) ;
procedure ExecuteAfterControllerActionMiddleware( const AContext: TWebContext; const AActionName: string ;
const AHandled: Boolean ) ;
2018-09-25 15:36:53 +02:00
procedure DefineDefaultResponseHeaders( const AContext: TWebContext) ;
2019-02-24 20:43:06 +01:00
procedure OnBeforeDispatch( ASender: TObject; ARequest: TWebRequest; AResponse: TWebResponse;
var AHandled: Boolean ) ; virtual ;
procedure ResponseErrorPage( const AException: Exception; const ARequest: TWebRequest;
const AResponse: TWebResponse) ; virtual ;
function ExecuteAction( const ASender: TObject; const ARequest: TWebRequest; const AResponse: TWebResponse)
: Boolean ; virtual ;
2017-03-13 20:52:11 +01:00
public
2018-08-08 17:11:45 +02:00
class function GetCurrentSession( const ASessionTimeout: Integer ; const ASessionId: string ;
const ARaiseExceptionIfExpired: Boolean = True ) : TWebSession; static ;
2017-03-13 20:52:11 +01:00
class function ExtractSessionIdFromWebRequest( const AWebRequest: TWebRequest) : string ; static ;
class function SendSessionCookie( const AContext: TWebContext) : string ; overload ; static ;
class function SendSessionCookie( const AContext: TWebContext; const ASessionId: string ) : string ; overload ; static ;
class procedure ClearSessionCookiesAlreadySet( const ACookies: TCookieCollection) ; static ;
2015-12-02 04:14:15 +01:00
public
2019-02-24 20:43:06 +01:00
constructor Create( const AWebModule: TWebModule; const AConfigAction: TProc< TMVCConfig> = nil ;
const ACustomLogger: ILogWriter = nil ) ; reintroduce ;
2015-12-02 04:14:15 +01:00
destructor Destroy; override ;
2017-03-13 20:52:11 +01:00
function GetSessionBySessionId( const ASessionId: string ) : TWebSession;
2017-03-02 19:29:43 +01:00
function AddSerializer( const AContentType: string ; const ASerializer: IMVCSerializer) : TMVCEngine;
2017-03-13 20:52:11 +01:00
function AddMiddleware( const AMiddleware: IMVCMiddleware) : TMVCEngine;
2019-02-24 20:43:06 +01:00
function AddController( const AControllerClazz: TMVCControllerClazz; const AURLSegment: string = '' )
: TMVCEngine; overload ;
2018-08-08 17:11:45 +02:00
function AddController( const AControllerClazz: TMVCControllerClazz; const ACreateAction: TMVCControllerCreateAction;
const AURLSegment: string = '' ) : TMVCEngine; overload ;
2019-02-24 20:43:06 +01:00
function PublishObject( const AObjectCreatorDelegate: TMVCObjectCreatorDelegate; const AURLSegment: string )
: TMVCEngine;
2017-04-14 16:43:31 +02:00
function SetViewEngine( const AViewEngineClass: TMVCViewEngineClass) : TMVCEngine;
2019-04-20 12:09:39 +02:00
function SetExceptionHandler( const AExceptionHandlerProc: TMVCExceptionHandlerProc) : TMVCEngine;
2017-03-13 20:52:11 +01:00
2018-08-08 17:11:45 +02:00
function GetServerSignature( const AContext: TWebContext) : string ;
2017-03-13 20:52:11 +01:00
procedure HTTP404( const AContext: TWebContext) ;
procedure HTTP500( const AContext: TWebContext; const AReasonString: string = '' ) ;
2019-02-24 20:43:06 +01:00
procedure SendRawHTTPStatus( const AContext: TWebContext; const HTTPStatusCode: Integer ;
2019-03-16 17:20:28 +01:00
const AReasonString: string ; const AClassName: String = '' ) ;
2017-03-13 20:52:11 +01:00
2017-04-14 16:43:31 +02:00
property ViewEngineClass: TMVCViewEngineClass read GetViewEngineClass;
2017-03-13 20:52:11 +01:00
property WebModule: TWebModule read FWebModule;
property Config: TMVCConfig read FConfig;
2017-04-14 16:43:31 +02:00
property Serializers: TDictionary< string , IMVCSerializer> read FSerializers;
2017-03-13 20:52:11 +01:00
property Middlewares: TList< IMVCMiddleware> read FMiddlewares;
property Controllers: TObjectList< TMVCControllerDelegate> read FControllers;
property ApplicationSession: TWebApplicationSession read FApplicationSession write FApplicationSession;
2015-12-02 04:14:15 +01:00
end ;
2017-03-29 14:49:35 +02:00
[ MVCNameCase( ncLowerCase) ]
2017-03-13 20:52:11 +01:00
TMVCErrorResponseItem = class
private
FMessage: string ;
protected
{ protected declarations }
public
2017-05-25 16:57:49 +02:00
property message : string read FMessage write FMessage;
2017-03-13 20:52:11 +01:00
end ;
2017-03-29 14:49:35 +02:00
[ MVCNameCase( ncLowerCase) ]
2018-10-23 16:18:34 +02:00
TMVCResponse = class
2017-03-13 20:52:11 +01:00
private
FStatusCode: Integer ;
FReasonString: string ;
FMessage: string ;
2018-10-23 16:18:34 +02:00
fDataObject: TObject;
2017-03-13 20:52:11 +01:00
protected
{ protected declarations }
public
2018-10-23 16:18:34 +02:00
constructor Create; overload ; virtual ;
2017-05-18 00:02:22 +02:00
constructor Create( AStatusCode: Integer ; AReasonString: string ; AMessage: string ) ; overload ;
2017-03-13 20:52:11 +01:00
property StatusCode: Integer read FStatusCode write FStatusCode;
2018-08-08 17:11:45 +02:00
property ReasonString: string read FReasonString write FReasonString;
2017-05-25 16:57:49 +02:00
property message : string read FMessage write FMessage;
2018-10-23 16:18:34 +02:00
property Data: TObject read fDataObject write fDataObject;
end ;
2017-03-13 20:52:11 +01:00
2018-10-23 16:18:34 +02:00
[ MVCNameCase( ncLowerCase) ]
TMVCErrorResponse = class( TMVCResponse)
private
FClassname: string ;
FItems: TObjectList< TMVCErrorResponseItem> ;
public
constructor Create; override ;
destructor Destroy; override ;
property Classname: string read FClassname write FClassname;
2017-03-13 20:52:11 +01:00
[ MVCListOf( TMVCErrorResponseItem) ]
property Items: TObjectList< TMVCErrorResponseItem> read FItems;
2015-12-02 04:14:15 +01:00
end ;
2014-03-10 17:39:29 +01:00
2017-04-14 16:43:31 +02:00
TMVCBaseViewEngine = class( TMVCBase)
private
FViewName: string ;
FWebContext: TWebContext;
FViewModel: TMVCViewDataObject;
FViewDataSets: TObjectDictionary< string , TDataSet> ;
FContentType: string ;
FOutput: string ;
protected
function GetRealFileName( const AViewName: string ) : string ; virtual ;
function IsCompiledVersionUpToDate( const AFileName, ACompiledFileName: string ) : Boolean ; virtual ; abstract ;
public
2018-08-08 17:11:45 +02:00
constructor Create( const AEngine: TMVCEngine; const AWebContext: TWebContext; const AViewModel: TMVCViewDataObject;
const AViewDataSets: TObjectDictionary< string , TDataSet> ; const AContentType: string ) ; virtual ;
2017-04-14 16:43:31 +02:00
destructor Destroy; override ;
2018-01-29 17:30:53 +01:00
procedure Execute( const ViewName: string ; const OutputStream: TStream) ; virtual ; abstract ;
2017-04-14 16:43:31 +02:00
property ViewName: string read FViewName;
property WebContext: TWebContext read FWebContext;
property ViewModel: TMVCViewDataObject read FViewModel;
property ViewDataSets: TObjectDictionary< string , TDataSet> read FViewDataSets;
property ContentType: string read FContentType;
property Output: string read FOutput;
end ;
2016-06-22 17:49:16 +02:00
function IsShuttingDown: Boolean ;
2013-10-30 00:48:23 +01:00
procedure EnterInShutdownState;
2019-05-09 20:53:52 +02:00
function CreateResponse( const StatusCode: UInt16 ; const ReasonString: String ; const Message : String = '' ) : TMVCResponse;
2013-10-30 00:48:23 +01:00
implementation
uses
2015-12-02 04:14:15 +01:00
MVCFramework. Router,
2017-05-18 00:02:22 +02:00
MVCFramework. SysControllers,
2019-05-09 20:53:52 +02:00
MVCFramework. Serializer. JsonDataObjects,
2019-07-26 14:45:40 +02:00
MVCFramework. JSONRPC;
2013-10-30 01:09:09 +01:00
2013-10-30 00:48:23 +01:00
var
2015-12-02 04:14:15 +01:00
_IsShuttingDown: Int64 = 0 ;
2017-06-02 00:10:31 +02:00
_MVCGlobalActionParamsCache: TMVCStringObjectDictionary< TMVCActionParamCacheItem> = nil ;
2013-10-30 00:48:23 +01:00
2017-03-13 20:52:11 +01:00
function IsShuttingDown: Boolean ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
Result : = TInterlocked. Read( _IsShuttingDown) = 1
2016-02-29 13:48:36 +01:00
end ;
2017-03-13 20:52:11 +01:00
procedure EnterInShutdownState;
2016-02-29 13:48:36 +01:00
begin
2017-03-13 20:52:11 +01:00
TInterlocked. Add( _IsShuttingDown, 1 ) ;
2013-10-30 00:48:23 +01:00
end ;
2019-05-09 20:53:52 +02:00
function CreateResponse( const StatusCode: UInt16 ; const ReasonString: String ; const Message : String = '' ) : TMVCResponse;
begin
Result : = TMVCResponse. Create( StatusCode, ReasonString, Message ) ;
end ;
2017-03-13 20:52:11 +01:00
{ MVCHTTPMethodsAttribute }
2014-03-31 11:25:16 +02:00
2017-03-13 20:52:11 +01:00
constructor MVCHTTPMethodsAttribute. Create( const AMVCHTTPMethods: TMVCHTTPMethods) ;
2017-03-01 21:40:57 +01:00
begin
2017-03-13 20:52:11 +01:00
inherited Create;
FMVCHTTPMethods : = AMVCHTTPMethods;
2017-03-01 21:40:57 +01:00
end ;
2017-03-13 20:52:11 +01:00
function MVCHTTPMethodsAttribute. GetMVCHTTPMethodsAsString: string ;
2015-04-01 17:01:23 +02:00
var
2017-03-13 20:52:11 +01:00
I: TMVCHTTPMethodType;
2015-04-01 17:01:23 +02:00
begin
2017-03-13 20:52:11 +01:00
Result : = '' ;
2016-12-05 15:50:00 +01:00
2017-05-18 00:02:22 +02:00
for I : = low( TMVCHTTPMethodType) to high( TMVCHTTPMethodType) do
2017-03-13 20:52:11 +01:00
if I in FMVCHTTPMethods then
Result : = Result + ',' + GetEnumName( TypeInfo( TMVCHTTPMethodType) , Ord( I) ) ;
2015-04-01 17:01:23 +02:00
2017-03-13 20:52:11 +01:00
if Result < > EmptyStr then
Result : = Result . Remove( 0 , 1 )
else
Result : = 'any' ;
2016-09-16 23:54:54 +02:00
end ;
2017-03-13 20:52:11 +01:00
{ MVCStringAttribute }
2015-12-02 04:14:15 +01:00
2017-03-13 20:52:11 +01:00
constructor MVCStringAttribute. Create( const AValue: string ) ;
begin
inherited Create;
FValue : = AValue;
end ;
2016-04-20 11:02:27 +02:00
2017-03-13 20:52:11 +01:00
{ MVCProducesAttribute }
2015-12-02 04:14:15 +01:00
2017-09-08 16:59:02 +02:00
constructor MVCProducesAttribute. Create( const AValue, ACharset: string ) ;
2017-03-13 20:52:11 +01:00
begin
Create( AValue) ;
2017-09-08 16:59:02 +02:00
FCharset : = ACharset;
2015-10-18 16:35:50 +02:00
end ;
2017-03-13 20:52:11 +01:00
constructor MVCProducesAttribute. Create( const AValue: string ) ;
2015-12-02 04:14:15 +01:00
begin
2017-03-13 20:52:11 +01:00
inherited Create( AValue) ;
2017-09-08 16:59:02 +02:00
FCharset : = TMVCCharset. UTF_8;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
{ MVCPathAttribute }
constructor MVCPathAttribute. Create( const APath: string ) ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
inherited Create;
FPath : = APath;
2013-10-30 00:48:23 +01:00
end ;
2019-09-25 16:41:11 +02:00
constructor MVCResponseAttribute. Create( inStatusCode: Integer ; const inDescription: string ; inResponseClass : TClass) ;
begin
FStatusCode : = inStatusCode;
FDescription : = inDescription;
FResponseClass : = inResponseClass;
end ;
{ MVCResponseListAttribute }
constructor MVCResponseListAttribute. Create( inStatusCode: Integer ; const inDescription: string ; inResponseClass: TClass) ;
begin
FStatusCode : = inStatusCode;
FDescription : = inDescription;
FResponseClass : = inResponseClass;
end ;
{ MVCStringEnumAttribute }
constructor MVCStringEnumAttribute. Create( const enumValue: String ) ;
begin
FValues : = enumValue;
end ;
2017-03-13 20:52:11 +01:00
{ TMVCWebRequest }
function TMVCWebRequest. Accept: string ;
2016-02-28 19:06:05 +01:00
begin
2017-03-13 20:52:11 +01:00
Result : = FWebRequest. Accept;
2016-02-28 19:06:05 +01:00
end ;
2017-03-13 20:52:11 +01:00
function TMVCWebRequest. Body: string ;
2013-10-30 00:48:23 +01:00
var
2017-09-23 15:03:07 +02:00
lEncoding: TEncoding;
lCurrCharset: string ;
2017-08-29 11:54:22 +02:00
2018-08-08 17:11:45 +02:00
{$IFNDEF BERLINORBETTER}
2017-09-23 15:03:07 +02:00
lBuffer: TArray< Byte > ;
2017-08-29 11:54:22 +02:00
2018-08-08 17:11:45 +02:00
{$ENDIF}
2017-03-13 20:52:11 +01:00
begin
{ TODO -oEzequiel -cRefactoring : Refactoring the method TMVCWebRequest.Body }
if ( FBody = EmptyStr) then
2016-06-22 17:49:16 +02:00
begin
2017-09-23 15:03:07 +02:00
lCurrCharset : = FCharset;
if ( lCurrCharset = EmptyStr) then
lCurrCharset : = 'UTF-8' ;
lEncoding : = TEncoding. GetEncoding( lCurrCharset) ;
2017-03-13 20:52:11 +01:00
try
2016-06-22 17:49:16 +02:00
2018-08-08 17:11:45 +02:00
{$IFDEF BERLINORBETTER}
2017-09-23 15:03:07 +02:00
FWebRequest. ReadTotalContent; // Otherwise ISAPI Raises "Empty BODY"
FBody : = lEncoding. GetString( FWebRequest. RawContent) ;
2018-08-08 17:11:45 +02:00
{$ELSE}
2017-09-23 15:03:07 +02:00
SetLength( lBuffer, FWebRequest. ContentLength) ;
FWebRequest. ReadClient( lBuffer[ 0 ] , FWebRequest. ContentLength) ;
FBody : = lEncoding. GetString( lBuffer) ;
2018-08-08 17:11:45 +02:00
{$ENDIF}
2015-12-02 04:14:15 +01:00
finally
2017-09-23 15:03:07 +02:00
lEncoding. Free;
2015-12-02 04:14:15 +01:00
end ;
end ;
2017-03-13 20:52:11 +01:00
Result : = FBody;
2015-12-02 04:14:15 +01:00
end ;
2017-03-13 20:52:11 +01:00
function TMVCWebRequest. BodyAs< T> : T;
2014-03-31 11:25:16 +02:00
var
2017-03-13 20:52:11 +01:00
Obj: TObject;
2017-09-23 15:03:07 +02:00
lSerializer: IMVCSerializer;
2014-03-31 11:25:16 +02:00
begin
2017-03-13 20:52:11 +01:00
Result : = nil ;
2018-10-31 01:07:23 +01:00
if FSerializers. TryGetValue( ContentMediaType, lSerializer) then
2015-12-02 04:14:15 +01:00
begin
2018-10-31 01:07:23 +01:00
Obj : = TMVCSerializerHelper. CreateObject( TClass( T) . QualifiedClassName) ;
2017-09-23 15:03:07 +02:00
try
lSerializer. DeserializeObject( Body, Obj) ;
Result : = Obj as T;
except
on E: Exception do
begin
FreeAndNil( Obj) ;
raise ;
end ;
end ;
2017-03-13 20:52:11 +01:00
end
else
2018-09-25 15:36:53 +02:00
raise EMVCDeserializationException. CreateFmt( 'Body ContentType "%s" not supported' , [ ContentType] ) ;
2014-03-31 11:25:16 +02:00
end ;
2017-03-13 20:52:11 +01:00
function TMVCWebRequest. BodyAsListOf< T> : TObjectList< T> ;
2015-04-01 17:01:23 +02:00
var
2017-03-13 20:52:11 +01:00
List: TObjectList< T> ;
2017-09-23 15:03:07 +02:00
lSerializer: IMVCSerializer;
2015-04-01 17:01:23 +02:00
begin
2017-03-13 20:52:11 +01:00
Result : = nil ;
2018-10-31 01:07:23 +01:00
if FSerializers. TryGetValue( ContentMediaType, lSerializer) then
2017-03-13 20:52:11 +01:00
begin
2017-09-23 15:03:07 +02:00
List : = TObjectList< T> . Create( True ) ;
try
lSerializer. DeserializeCollection( Body, List, T) ;
Result : = List;
except
FreeAndNil( List) ;
raise ;
end ;
2017-03-13 20:52:11 +01:00
end
else
2018-09-25 15:36:53 +02:00
raise EMVCException. CreateFmt( 'Body ContentType "%s" not supported' , [ ContentType] ) ;
2015-04-01 17:01:23 +02:00
end ;
2017-03-13 20:52:11 +01:00
procedure TMVCWebRequest. BodyFor< T> ( const AObject: T) ;
2017-09-23 15:03:07 +02:00
var
lSerializer: IMVCSerializer;
2014-03-31 11:25:16 +02:00
begin
2017-03-13 20:52:11 +01:00
if Assigned( AObject) then
2018-10-31 01:07:23 +01:00
if FSerializers. TryGetValue( ContentMediaType, lSerializer) then
2017-09-23 15:03:07 +02:00
lSerializer. DeserializeObject( Body, AObject)
2017-03-13 20:52:11 +01:00
else
2019-05-09 20:53:52 +02:00
begin
if ContentType. Trim. IsEmpty then
begin
raise EMVCException. Create( 'Request ContentType header is empty, cannot deserialize body' ) ;
end
else
begin
raise EMVCException. CreateFmt( 'Body ContentType "%s" not supported' , [ ContentType] ) ;
end ;
end ;
2014-03-31 11:25:16 +02:00
end ;
2017-03-13 20:52:11 +01:00
procedure TMVCWebRequest. BodyForListOf< T> ( const AObjectList: TObjectList< T> ) ;
2017-09-23 15:03:07 +02:00
var
lSerializer: IMVCSerializer;
2015-10-18 16:35:50 +02:00
begin
2017-03-13 20:52:11 +01:00
if Assigned( AObjectList) then
2018-10-31 01:07:23 +01:00
if FSerializers. TryGetValue( ContentMediaType, lSerializer) then
2017-09-23 15:03:07 +02:00
lSerializer. DeserializeCollection( Body, AObjectList, T)
2017-03-13 20:52:11 +01:00
else
2018-09-25 15:36:53 +02:00
raise EMVCException. CreateFmt( 'Body ContentType "%s" not supported' , [ ContentType] ) ;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
function TMVCWebRequest. ClientIp: string ;
var
S: string ;
2017-03-01 21:40:57 +01:00
begin
2017-03-13 20:52:11 +01:00
Result : = EmptyStr;
2017-03-01 21:40:57 +01:00
2017-03-13 20:52:11 +01:00
if FWebRequest. GetFieldByName( 'HTTP_CLIENT_IP' ) < > EmptyStr then
Exit( FWebRequest. GetFieldByName( 'HTTP_CLIENT_IP' ) ) ;
2013-10-30 00:48:23 +01:00
2017-03-13 20:52:11 +01:00
for S in string( FWebRequest. GetFieldByName( 'HTTP_X_FORWARDED_FOR' ) ) . Split( [ ',' ] ) do
if not S. Trim. IsEmpty then
Exit( S. Trim) ;
2015-12-02 04:14:15 +01:00
2017-03-13 20:52:11 +01:00
if FWebRequest. GetFieldByName( 'HTTP_X_FORWARDED' ) < > EmptyStr then
Exit( FWebRequest. GetFieldByName( 'HTTP_X_FORWARDED' ) ) ;
2015-12-02 04:14:15 +01:00
2017-03-13 20:52:11 +01:00
if FWebRequest. GetFieldByName( 'HTTP_X_CLUSTER_CLIENT_IP' ) < > EmptyStr then
Exit( FWebRequest. GetFieldByName( 'HTTP_X_CLUSTER_CLIENT_IP' ) ) ;
2015-12-02 04:14:15 +01:00
2017-03-13 20:52:11 +01:00
if FWebRequest. GetFieldByName( 'HTTP_FORWARDED_FOR' ) < > EmptyStr then
Exit( FWebRequest. GetFieldByName( 'HTTP_FORWARDED_FOR' ) ) ;
2015-10-18 16:35:50 +02:00
2017-03-13 20:52:11 +01:00
if FWebRequest. GetFieldByName( 'HTTP_FORWARDED' ) < > EmptyStr then
Exit( FWebRequest. GetFieldByName( 'HTTP_FORWARDED' ) ) ;
2013-10-30 00:48:23 +01:00
2017-03-13 20:52:11 +01:00
if FWebRequest. GetFieldByName( 'REMOTE_ADDR' ) < > EmptyStr then
Exit( FWebRequest. GetFieldByName( 'REMOTE_ADDR' ) ) ;
2013-10-30 00:48:23 +01:00
2017-03-13 20:52:11 +01:00
if FWebRequest. RemoteIP < > EmptyStr then
Exit( FWebRequest. RemoteIP) ;
2013-10-30 00:48:23 +01:00
2017-03-13 20:52:11 +01:00
if FWebRequest. RemoteAddr < > EmptyStr then
Exit( FWebRequest. RemoteAddr) ;
2015-10-18 16:35:50 +02:00
2017-03-13 20:52:11 +01:00
if FWebRequest. RemoteHost < > EmptyStr then
Exit( FWebRequest. RemoteHost) ;
2013-10-30 00:48:23 +01:00
2017-03-13 20:52:11 +01:00
if FWebRequest. RemoteAddr < > EmptyStr then
Exit( FWebRequest. RemoteAddr) ;
2015-10-18 16:35:50 +02:00
2017-03-13 20:52:11 +01:00
if FWebRequest. RemoteIP < > EmptyStr then
Exit( FWebRequest. RemoteIP) ;
if FWebRequest. RemoteHost < > EmptyStr then
Exit( FWebRequest. RemoteHost) ;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
function TMVCWebRequest. ClientPrefer( const AMediaType: string ) : Boolean ;
2015-04-01 17:01:23 +02:00
begin
2017-03-13 20:52:11 +01:00
Result : = AnsiPos( AMediaType, LowerCase( RawWebRequest. Accept) ) = 1 ;
2015-04-01 17:01:23 +02:00
end ;
2017-03-20 19:08:01 +01:00
function TMVCWebRequest. ClientPreferHTML: Boolean ;
begin
Result : = ClientPrefer( TMVCMediaType. TEXT_HTML) ;
end ;
2017-03-13 20:52:11 +01:00
function TMVCWebRequest. ContentParam( const AName: string ) : string ;
2015-04-01 17:01:23 +02:00
begin
2017-03-13 20:52:11 +01:00
Result : = FWebRequest. ContentFields. Values[ AName] ;
2015-04-01 17:01:23 +02:00
end ;
2017-03-13 20:52:11 +01:00
function TMVCWebRequest. Cookie( const AName: string ) : string ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
Result : = FWebRequest. CookieFields. Values[ AName] ;
2013-10-30 00:48:23 +01:00
end ;
2019-02-24 20:43:06 +01:00
constructor TMVCWebRequest. Create( const AWebRequest: TWebRequest;
const ASerializers: TDictionary< string , IMVCSerializer> ) ;
2013-10-30 00:48:23 +01:00
begin
2015-12-02 04:14:15 +01:00
inherited Create;
2017-03-13 20:52:11 +01:00
FBody : = EmptyStr;
2019-03-05 20:55:37 +01:00
// FContentType := TMVCConstants.DEFAULT_CONTENT_TYPE;
2017-03-13 20:52:11 +01:00
FCharset : = TMVCConstants. DEFAULT_CONTENT_CHARSET;
FWebRequest : = AWebRequest;
FSerializers : = ASerializers;
FParamsTable : = nil ;
2017-09-08 16:59:02 +02:00
DefineContentType;
2017-03-13 20:52:11 +01:00
end ;
2014-05-14 15:55:41 +02:00
2017-09-08 16:59:02 +02:00
procedure TMVCWebRequest. DefineContentType;
2017-03-13 20:52:11 +01:00
begin
2017-09-08 16:59:02 +02:00
SplitContentMediaTypeAndCharset( FWebRequest. GetFieldByName( 'Content-Type' ) , FContentMediaType, FCharset) ;
2017-10-09 16:17:12 +02:00
FContentType : = BuildContentType( FContentMediaType, FCharset) ;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
destructor TMVCWebRequest. Destroy;
2013-10-30 00:48:23 +01:00
begin
2019-07-26 19:28:45 +02:00
if Assigned( FContentFields) then
begin
FContentFields. Free;
end ;
2019-08-23 13:42:20 +02:00
if Assigned( FQueryParams) then
begin
FQueryParams. Free;
end ;
2019-07-26 21:30:16 +02:00
inherited Destroy;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
procedure TMVCWebRequest. EnsureQueryParamExists( const AName: string ) ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
if GetParams( AName) . IsEmpty then
raise EMVCException. CreateFmt( 'Parameter "%s" required' , [ AName] ) ;
2013-10-30 00:48:23 +01:00
end ;
2019-07-26 18:59:07 +02:00
function TMVCWebRequest. GetContentFields: TDictionary< string , string > ;
var
I: Integer ;
begin
2019-07-26 21:30:16 +02:00
if not Assigned( FContentFields) then
2019-07-26 19:28:45 +02:00
begin
2019-07-26 21:30:16 +02:00
FContentFields : = TDictionary< string , string > . Create;
2019-07-26 18:59:07 +02:00
for I : = 0 to Pred( FWebRequest. ContentFields. Count) do
begin
2019-07-26 21:30:16 +02:00
FContentFields. Add( LowerCase( FWebRequest. ContentFields. Names[ I] ) , FWebRequest. ContentFields. ValueFromIndex[ I] ) ;
2019-07-26 18:59:07 +02:00
end ;
end ;
2019-07-26 19:28:45 +02:00
Result : = FContentFields;
2019-07-26 18:59:07 +02:00
end ;
2017-03-13 20:52:11 +01:00
function TMVCWebRequest. GetFiles: TAbstractWebRequestFiles;
2014-03-31 11:25:16 +02:00
begin
2017-03-13 20:52:11 +01:00
Result : = FWebRequest. Files;
2014-03-31 11:25:16 +02:00
end ;
2017-03-13 20:52:11 +01:00
function TMVCWebRequest. GetHeader( const AName: string ) : string ;
2015-04-01 17:01:23 +02:00
begin
2017-03-13 20:52:11 +01:00
Result : = FWebRequest. GetFieldByName( AName) ;
2015-04-01 17:01:23 +02:00
end ;
2017-03-13 20:52:11 +01:00
function TMVCWebRequest. GetHTTPMethod: TMVCHTTPMethodType;
2016-04-03 22:35:27 +02:00
begin
2017-03-13 20:52:11 +01:00
Result : = TMVCRouter. StringMethodToHTTPMetod( FWebRequest. Method) ;
2016-04-03 22:35:27 +02:00
end ;
2017-03-13 20:52:11 +01:00
function TMVCWebRequest. GetHTTPMethodAsString: string ;
2016-04-03 22:35:27 +02:00
begin
2017-03-13 20:52:11 +01:00
Result : = FWebRequest. Method;
2016-04-03 22:35:27 +02:00
end ;
2017-03-13 20:52:11 +01:00
function TMVCWebRequest. GetIsAjax: Boolean ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
Result : = LowerCase( FWebRequest. GetFieldByName( 'X-Requested-With' ) ) = 'xmlhttprequest' ;
2013-10-30 00:48:23 +01:00
end ;
2019-05-10 00:46:03 +02:00
function TMVCWebRequest. GetOverwrittenHTTPMethod: TMVCHTTPMethodType;
var
lOverriddenMethod: string ;
begin
lOverriddenMethod : = Headers[ TMVCConstants. X_HTTP_Method_Override] ;
if lOverriddenMethod. IsEmpty then
begin
Exit( HTTPMethod) ;
end
else
begin
Result : = TMVCRouter. StringMethodToHTTPMetod( FWebRequest. Method) ;
end ;
end ;
2017-03-13 20:52:11 +01:00
function TMVCWebRequest. GetParamAsInt64( const AParamName: string ) : Int64 ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
Result : = StrToInt64( GetParams( AParamName) ) ;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
function TMVCWebRequest. GetParamAsInteger( const AParamName: string ) : Integer ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
Result : = StrToInt( GetParams( AParamName) ) ;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
function TMVCWebRequest. GetParamNames: TArray< string > ;
var
I: Integer ;
Names: TList< string > ;
N: string ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
Names : = TList< string > . Create;
2015-12-02 04:14:15 +01:00
try
2017-03-13 20:52:11 +01:00
if Assigned( FParamsTable) and ( Length( FParamsTable. Keys. ToArray) > 0 ) then
for N in FParamsTable. Keys. ToArray do
Names. Add( N) ;
2013-10-30 00:48:23 +01:00
2017-03-13 20:52:11 +01:00
if ( FWebRequest. QueryFields. Count > 0 ) then
for I : = 0 to FWebRequest. QueryFields. Count - 1 do
Names. Add( FWebRequest. QueryFields. Names[ I] ) ;
2013-10-30 00:48:23 +01:00
2017-03-13 20:52:11 +01:00
if ( FWebRequest. ContentFields. Count > 0 ) then
for I : = 0 to FWebRequest. ContentFields. Count - 1 do
Names. Add( FWebRequest. ContentFields. Names[ I] ) ;
if ( FWebRequest. CookieFields. Count > 0 ) then
for I : = 0 to FWebRequest. CookieFields. Count - 1 do
Names. Add( FWebRequest. CookieFields. Names[ I] ) ;
Result : = Names. ToArray;
finally
Names. Free;
end ;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
function TMVCWebRequest. GetParams( const AParamName: string ) : string ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
if ( not Assigned( FParamsTable) ) or ( not FParamsTable. TryGetValue( AParamName, Result ) ) then
begin
2017-05-08 17:26:19 +02:00
Result : = FWebRequest. ContentFields. Values[ AParamName] ;
2017-03-13 20:52:11 +01:00
if Result . IsEmpty then
2017-05-08 17:26:19 +02:00
Result : = FWebRequest. QueryFields. Values[ AParamName] ;
2017-03-13 20:52:11 +01:00
if Result . IsEmpty then
Result : = FWebRequest. CookieFields. Values[ AParamName] ;
end ;
2013-10-30 00:48:23 +01:00
end ;
2018-08-08 17:11:45 +02:00
function TMVCWebRequest. GetParamsMulti( const AParamName: string ) : TArray< string > ;
2017-05-08 17:26:19 +02:00
var
2017-05-18 00:02:22 +02:00
lList: TList< string > ;
procedure AddParamsToList( const AStrings: TStrings; const AList: TList< string > ) ;
2017-05-08 17:26:19 +02:00
var
I: Integer ;
begin
for I : = 0 to AStrings. Count - 1 do
2018-08-08 17:11:45 +02:00
if SameText( AStrings. Names[ I] , AParamName) then
AList. Add( AStrings. ValueFromIndex[ I] ) ;
2017-05-08 17:26:19 +02:00
end ;
begin
2017-05-18 00:02:22 +02:00
lList : = TList< string > . Create;
2017-05-08 17:26:19 +02:00
try
AddParamsToList( FWebRequest. ContentFields, lList) ;
AddParamsToList( FWebRequest. QueryFields, lList) ;
AddParamsToList( FWebRequest. CookieFields, lList) ;
Result : = lList. ToArray;
finally
lList. Free;
end ;
end ;
2017-03-13 20:52:11 +01:00
function TMVCWebRequest. GetPathInfo: string ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
Result : = FWebRequest. PathInfo;
2013-10-30 00:48:23 +01:00
end ;
2019-08-23 13:42:20 +02:00
function TMVCWebRequest. GetQueryParams: TDictionary< string , string > ;
var
I: Integer ;
begin
if not Assigned( FQueryParams) then
begin
FQueryParams : = TDictionary< string , string > . Create;
for I : = 0 to Pred( FWebRequest. QueryFields. Count) do
begin
FQueryParams. Add( LowerCase( FWebRequest. QueryFields. Names[ I] ) , FWebRequest. QueryFields. ValueFromIndex[ I] ) ;
end ;
end ;
Result : = FQueryParams;
end ;
2017-03-13 20:52:11 +01:00
function TMVCWebRequest. QueryStringParam( const AName: string ) : string ;
2014-03-25 12:41:23 +01:00
begin
2017-03-13 20:52:11 +01:00
Result : = FWebRequest. QueryFields. Values[ AName] ;
2014-03-25 12:41:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
function TMVCWebRequest. QueryStringParamExists( const AName: string ) : Boolean ;
2015-08-27 11:13:40 +02:00
begin
2017-03-13 20:52:11 +01:00
Result : = QueryStringParam( AName) < > EmptyStr;
2015-08-27 11:13:40 +02:00
end ;
2017-03-13 20:52:11 +01:00
function TMVCWebRequest. QueryStringParams: TStrings;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
Result : = FWebRequest. QueryFields;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
function TMVCWebRequest. SegmentParam( const AParamName: string ; out AValue: string ) : Boolean ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
Result : = False ;
if Assigned( FParamsTable) then
Result : = FParamsTable. TryGetValue( AParamName, AValue) ;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
function TMVCWebRequest. SegmentParamsCount: Integer ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
Result : = 0 ;
if Assigned( FParamsTable) then
Result : = FParamsTable. Count;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
function TMVCWebRequest. ThereIsRequestBody: Boolean ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
Result : = ( FWebRequest. Content < > EmptyStr) ;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
{ TMVCWebResponse }
constructor TMVCWebResponse. Create( const AWebResponse: TWebResponse) ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
inherited Create;
FWebResponse : = AWebResponse;
FFlushOnDestroy : = True ;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
destructor TMVCWebResponse. Destroy;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
if FFlushOnDestroy then
2018-05-16 19:46:29 +02:00
begin
2017-03-13 20:52:11 +01:00
Flush;
2018-05-16 19:46:29 +02:00
end ;
2017-03-13 20:52:11 +01:00
inherited Destroy;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
procedure TMVCWebResponse. Flush;
2014-03-25 12:41:23 +01:00
begin
2018-05-16 19:46:29 +02:00
if not FWebResponse. Sent then
FWebResponse. SendResponse;
2014-03-25 12:41:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
function TMVCWebResponse. GetContent: string ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
Result : = FWebResponse. Content;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
function TMVCWebResponse. GetContentType: string ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
Result : = FWebResponse. ContentType;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
function TMVCWebResponse. GetCookies: TCookieCollection;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
Result : = FWebResponse. Cookies;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
function TMVCWebResponse. GetCustomHeaders: TStrings;
2015-12-02 04:14:15 +01:00
begin
2017-03-13 20:52:11 +01:00
Result : = FWebResponse. CustomHeaders;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
function TMVCWebResponse. GetLocation: string ;
2015-12-02 04:14:15 +01:00
begin
2017-03-13 20:52:11 +01:00
Result : = CustomHeaders. Values[ 'location' ] ;
2013-11-18 00:16:59 +01:00
end ;
2017-03-13 20:52:11 +01:00
function TMVCWebResponse. GetReasonString: string ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
Result : = FWebResponse. ReasonString;
2013-11-09 14:22:11 +01:00
end ;
2017-03-13 20:52:11 +01:00
function TMVCWebResponse. GetStatusCode: Integer ;
2013-11-09 14:22:11 +01:00
begin
2017-03-13 20:52:11 +01:00
Result : = FWebResponse. StatusCode;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
procedure TMVCWebResponse. SetContent( const AValue: string ) ;
2015-12-16 15:57:20 +01:00
begin
2017-03-13 20:52:11 +01:00
FWebResponse. Content : = AValue;
end ;
2015-12-16 15:57:20 +01:00
2017-03-13 20:52:11 +01:00
procedure TMVCWebResponse. SetContentStream( const AStream: TStream; const AContentType: string ) ;
begin
2019-03-05 20:55:37 +01:00
ContentType : = AContentType;
2017-03-13 20:52:11 +01:00
FWebResponse. ContentStream : = AStream;
end ;
2015-12-16 15:57:20 +01:00
2017-03-13 20:52:11 +01:00
procedure TMVCWebResponse. SetContentType( const AValue: string ) ;
begin
2019-03-05 20:55:37 +01:00
FWebResponse. ContentType : = '' ;
2017-03-13 20:52:11 +01:00
FWebResponse. ContentType : = AValue;
end ;
2015-12-16 15:57:20 +01:00
2017-03-13 20:52:11 +01:00
procedure TMVCWebResponse. SetCustomHeader( const AName, AValue: string ) ;
begin
FWebResponse. SetCustomHeader( AName, AValue) ;
end ;
2015-12-16 15:57:20 +01:00
2017-03-13 20:52:11 +01:00
procedure TMVCWebResponse. SetLocation( const AValue: string ) ;
begin
CustomHeaders. Values[ 'location' ] : = AValue;
end ;
2015-12-16 15:57:20 +01:00
2017-03-13 20:52:11 +01:00
procedure TMVCWebResponse. SetReasonString( const AValue: string ) ;
begin
FWebResponse. ReasonString : = AValue;
end ;
2015-12-16 15:57:20 +01:00
2017-03-13 20:52:11 +01:00
procedure TMVCWebResponse. SetStatusCode( const AValue: Integer ) ;
begin
FWebResponse. StatusCode : = AValue;
end ;
2015-12-16 15:57:20 +01:00
2017-03-13 20:52:11 +01:00
{ TUser }
2015-12-16 15:57:20 +01:00
2017-03-13 20:52:11 +01:00
procedure TUser. Clear;
begin
FUserName : = EmptyStr;
FLoggedSince : = 0 ;
FRealm : = EmptyStr;
FRoles. Clear;
2015-12-16 15:57:20 +01:00
end ;
2017-03-13 20:52:11 +01:00
constructor TUser. Create;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
inherited Create;
FRoles : = TList< string > . Create;
2017-09-07 00:10:21 +02:00
FCustomData : = nil ;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
destructor TUser. Destroy;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
FRoles. Free;
2017-09-07 00:10:21 +02:00
FreeAndNil( FCustomData) ;
2017-03-13 20:52:11 +01:00
inherited Destroy;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
function TUser. IsValid: Boolean ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
Result : = ( not UserName. IsEmpty) and ( LoggedSince > 0 ) ;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
function TUser. LoadFromSession( const AWebSession: TWebSession) : Boolean ;
2013-11-18 00:16:59 +01:00
var
2017-03-13 20:52:11 +01:00
SerObj: string ;
Pieces: TArray< string > ;
I: Integer ;
2015-12-02 04:14:15 +01:00
begin
2017-03-13 20:52:11 +01:00
if not Assigned( AWebSession) then
Exit( False ) ;
SerObj : = AWebSession[ TMVCConstants. CURRENT_USER_SESSION_KEY] ;
Result : = not SerObj. IsEmpty;
if Result then
2015-12-02 04:14:15 +01:00
begin
2017-03-13 20:52:11 +01:00
Clear;
Pieces : = SerObj. Split( [ '$$' ] , TStringSplitOptions. None) ;
UserName : = Pieces[ 0 ] ;
LoggedSince : = ISOTimeStampToDateTime( Pieces[ 1 ] ) ;
Realm : = Pieces[ 2 ] ;
Roles. Clear;
2019-08-23 12:16:25 +02:00
for I : = 3 to Length( Pieces) - 1 do // https://github.com/danieleteti/delphimvcframework/issues/225
2017-03-13 20:52:11 +01:00
Roles. Add( Pieces[ I] ) ;
2015-12-02 04:14:15 +01:00
end ;
2017-03-13 20:52:11 +01:00
end ;
2015-12-02 04:14:15 +01:00
2017-03-13 20:52:11 +01:00
procedure TUser. SaveToSession( const AWebSession: TWebSession) ;
var
LRoles: string ;
begin
if ( FRoles. Count > 0 ) then
LRoles : = string . Join( '$$' , FRoles. ToArray)
else
LRoles : = '' ;
2019-02-24 20:43:06 +01:00
AWebSession[ TMVCConstants. CURRENT_USER_SESSION_KEY] : = FUserName + '$$' + DateTimeToISOTimeStamp( FLoggedSince) + '$$'
+ FRealm + '$$' + LRoles;
2013-11-18 00:16:59 +01:00
end ;
2017-09-07 00:10:21 +02:00
procedure TUser. SetCustomData( const Value: TMVCCustomData) ;
begin
FCustomData : = Value;
end ;
2017-03-13 20:52:11 +01:00
procedure TUser. SetLoggedSince( const AValue: TDateTime) ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
if ( FLoggedSince = 0 ) then
FLoggedSince : = AValue
else
raise EMVCException. Create( 'TUser.LoggedSince already set.' ) ;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
{ TWebContext }
2019-02-24 20:43:06 +01:00
function TWebContext. AddSessionToTheSessionList( const ASessionType, ASessionId: string ; const ASessionTimeout: Integer )
: TWebSession;
2017-03-13 20:52:11 +01:00
var
Session: TWebSession;
begin
if ( Trim( ASessionType) = EmptyStr) then
raise EMVCException. Create( 'Empty Session Type' ) ;
2017-03-23 18:51:25 +01:00
TMonitor. Enter( GlobalSessionList) ;
2017-03-13 20:52:11 +01:00
try
Session : = TMVCSessionFactory. GetInstance. CreateNewByType( ASessionType, ASessionId, ASessionTimeout) ;
2017-03-23 18:51:25 +01:00
GlobalSessionList. Add( ASessionId, Session) ;
2017-03-13 20:52:11 +01:00
Result : = Session;
Session. MarkAsUsed;
finally
2017-03-23 18:51:25 +01:00
TMonitor. Exit( GlobalSessionList) ;
2017-03-13 20:52:11 +01:00
end ;
end ;
2013-10-30 00:48:23 +01:00
2017-03-13 20:52:11 +01:00
procedure TWebContext. BindToSession( const ASessionId: string ) ;
2013-10-30 00:48:23 +01:00
begin
2015-12-02 04:14:15 +01:00
if not Assigned( FWebSession) then
begin
2017-03-13 20:52:11 +01:00
FWebSession : = TMVCEngine. GetCurrentSession( StrToInt64( FConfig[ TMVCConfigKey. SessionTimeout] ) , ASessionId, False ) ;
2015-12-02 04:14:15 +01:00
if not Assigned( FWebSession) then
raise EMVCException. Create( 'Invalid SessionID' ) ;
FWebSession. MarkAsUsed;
2017-03-13 20:52:11 +01:00
TMVCEngine. SendSessionCookie( Self, ASessionId) ;
2015-12-02 04:14:15 +01:00
end
else
raise EMVCException. Create( 'Session already bounded for this request' ) ;
2013-10-30 00:48:23 +01:00
end ;
2018-08-08 17:11:45 +02:00
constructor TWebContext. Create( const ARequest: TWebRequest; const AResponse: TWebResponse; const AConfig: TMVCConfig;
2017-03-13 20:52:11 +01:00
const ASerializers: TDictionary< string , IMVCSerializer> ) ;
2013-10-30 00:48:23 +01:00
begin
2015-12-02 04:14:15 +01:00
inherited Create;
2017-03-13 20:52:11 +01:00
FIsSessionStarted : = False ;
FSessionMustBeClose : = False ;
FWebSession : = nil ;
2019-05-19 14:19:58 +02:00
FRequest : = nil ;
2013-10-30 00:48:23 +01:00
2019-05-19 14:19:58 +02:00
if not IsLibrary then
begin
FRequest : = TMVCIndyWebRequest. Create( ARequest, ASerializers) ;
end
else
2017-03-13 20:52:11 +01:00
begin
2018-08-08 17:11:45 +02:00
{$IFDEF WEBAPACHEHTTP}
2019-05-19 14:19:58 +02:00
if ARequest. ClassType = TApacheRequest then
begin
2017-03-13 20:52:11 +01:00
FRequest : = TMVCApacheWebRequest. Create( ARequest, ASerializers)
2019-08-23 12:16:25 +02:00
end
else
2018-08-08 17:11:45 +02:00
{$IFNDEF LINUX}
2019-08-23 12:16:25 +02:00
if ARequest. ClassType = TISAPIRequest then
begin
FRequest : = TMVCISAPIWebRequest. Create( ARequest, ASerializers)
end
else
2018-08-08 17:11:45 +02:00
{$ENDIF}
2019-05-19 14:19:58 +02:00
{$ENDIF}
2019-08-23 12:16:25 +02:00
begin
FRequest : = TMVCIndyWebRequest. Create( ARequest, ASerializers) ;
end ;
2019-05-19 14:19:58 +02:00
end ;
2017-03-13 20:52:11 +01:00
FResponse : = TMVCWebResponse. Create( AResponse) ;
FConfig : = AConfig;
FSerializers : = ASerializers;
FData : = TDictionary< string , string > . Create;
FLoggedUser : = nil ;
2013-11-05 14:57:50 +01:00
end ;
2017-03-13 20:52:11 +01:00
destructor TWebContext. Destroy;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
FResponse. Free;
FRequest. Free;
FData. Free;
if Assigned( FLoggedUser) then
FLoggedUser. Free;
inherited Destroy;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
procedure TWebContext. Flush;
2013-11-10 01:04:17 +01:00
begin
2017-03-13 20:52:11 +01:00
FResponse. Flush;
2013-11-10 01:04:17 +01:00
end ;
2017-03-13 20:52:11 +01:00
function TWebContext. GetLoggedUser: TUser;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
if not Assigned( FLoggedUser) then
FLoggedUser : = TUser. Create;
Result : = FLoggedUser;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
function TWebContext. GetParamsTable: TMVCRequestParamsTable;
2016-12-05 15:50:00 +01:00
begin
2017-03-13 20:52:11 +01:00
Result : = FRequest. ParamsTable;
2016-12-05 15:50:00 +01:00
end ;
2017-03-13 20:52:11 +01:00
function TWebContext. GetWebSession: TWebSession;
2016-02-27 09:58:54 +01:00
begin
2017-03-13 20:52:11 +01:00
if not Assigned( FWebSession) then
begin
2018-08-08 17:11:45 +02:00
FWebSession : = TMVCEngine. GetCurrentSession( StrToInt64( FConfig[ TMVCConfigKey. SessionTimeout] ) ,
TMVCEngine. ExtractSessionIdFromWebRequest( FRequest. RawWebRequest) , False ) ;
2017-03-13 20:52:11 +01:00
if not Assigned( FWebSession) then
SessionStart
else
TMVCEngine. SendSessionCookie( Self, FWebSession. SessionId) ;
2016-02-27 09:58:54 +01:00
end ;
2017-03-13 20:52:11 +01:00
Result : = FWebSession;
Result . MarkAsUsed;
2016-02-27 09:58:54 +01:00
end ;
2017-03-13 20:52:11 +01:00
function TWebContext. IsSessionStarted: Boolean ;
2017-02-08 11:42:05 +01:00
begin
2017-03-13 20:52:11 +01:00
Result : = FIsSessionStarted;
2017-02-08 11:42:05 +01:00
end ;
2017-03-13 20:52:11 +01:00
function TWebContext. SendSessionCookie( const AContext: TWebContext) : string ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
Result : = TMVCEngine. SendSessionCookie( Self) ;
2015-10-18 16:35:50 +02:00
end ;
2017-03-13 20:52:11 +01:00
function TWebContext. SessionId: string ;
2015-12-02 04:14:15 +01:00
begin
2017-03-13 20:52:11 +01:00
if Assigned( FWebSession) then
Exit( FWebSession. SessionId) ;
Result : = FRequest. Cookie( TMVCConstants. SESSION_TOKEN_NAME) ;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
function TWebContext. SessionMustBeClose: Boolean ;
2016-10-02 17:44:20 +02:00
begin
2017-03-13 20:52:11 +01:00
Result : = FSessionMustBeClose;
2016-10-02 17:44:20 +02:00
end ;
2017-03-13 20:52:11 +01:00
procedure TWebContext. SessionStart;
var
2019-09-01 20:35:19 +02:00
ID: string ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
if not Assigned( FWebSession) then
begin
2019-09-01 20:35:19 +02:00
ID : = TMVCEngine. SendSessionCookie( Self) ;
FWebSession : = AddSessionToTheSessionList( Config[ TMVCConfigKey. SessionType] , ID,
2019-02-24 20:43:06 +01:00
StrToInt64( Config[ TMVCConfigKey. SessionTimeout] ) ) ;
2017-03-13 20:52:11 +01:00
FIsSessionStarted : = True ;
FSessionMustBeClose : = False ;
end ;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
function TWebContext. SessionStarted: Boolean ;
var
SId: string ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
SId : = SessionId;
if SId. IsEmpty then
Exit( False ) ;
2017-03-23 18:51:25 +01:00
TMonitor. Enter( GlobalSessionList) ;
2017-03-13 20:52:11 +01:00
try
2017-03-23 18:51:25 +01:00
Result : = GlobalSessionList. ContainsKey( SId) ;
2017-03-13 20:52:11 +01:00
finally
2017-03-23 18:51:25 +01:00
TMonitor. Exit( GlobalSessionList) ;
2017-03-13 20:52:11 +01:00
end ;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
procedure TWebContext. SessionStop( const ARaiseExceptionIfExpired: Boolean ) ;
var
Cookie: TCookie;
SId: string ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
FResponse. Cookies. Clear;
2013-10-30 00:48:23 +01:00
2017-03-13 20:52:11 +01:00
Cookie : = FResponse. Cookies. Add;
Cookie. Name : = TMVCConstants. SESSION_TOKEN_NAME;
2013-10-30 00:48:23 +01:00
2017-03-13 20:52:11 +01:00
Cookie. Value : = GUIDToString( TGUID. NewGuid) + 'invalid' + GUIDToString( TGUID. NewGuid) ;
Cookie. Expires : = EncodeDate( 1 9 7 0 , 1 , 1 ) ;
Cookie. Path : = '/' ;
2017-03-23 18:51:25 +01:00
TMonitor. Enter( GlobalSessionList) ;
2015-12-02 04:14:15 +01:00
try
2017-03-13 20:52:11 +01:00
SId : = TMVCEngine. ExtractSessionIdFromWebRequest( FRequest. RawWebRequest) ;
2017-03-23 18:51:25 +01:00
GlobalSessionList. Remove( SId) ;
2017-03-13 20:52:11 +01:00
finally
2017-03-23 18:51:25 +01:00
TMonitor. Exit( GlobalSessionList) ;
2015-12-02 04:14:15 +01:00
end ;
2017-03-13 20:52:11 +01:00
FIsSessionStarted : = False ;
FSessionMustBeClose : = True ;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
procedure TWebContext. SetParamsTable( const AValue: TMVCRequestParamsTable) ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
FRequest. ParamsTable : = AValue;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
{ TMVCEngine }
2017-09-24 19:40:40 +02:00
function TMVCEngine. AddController( const AControllerClazz: TMVCControllerClazz; const AURLSegment: string ) : TMVCEngine;
2013-10-30 00:48:23 +01:00
begin
2017-09-24 19:40:40 +02:00
Result : = AddController( AControllerClazz, nil , AURLSegment) ;
2013-10-30 00:48:23 +01:00
end ;
2019-02-24 20:43:06 +01:00
function TMVCEngine. AddController( const AControllerClazz: TMVCControllerClazz;
const ACreateAction: TMVCControllerCreateAction; const AURLSegment: string ) : TMVCEngine;
2015-12-02 04:14:15 +01:00
begin
2017-09-24 19:40:40 +02:00
FControllers. Add( TMVCControllerDelegate. Create( AControllerClazz, ACreateAction, AURLSegment) ) ;
2017-03-13 20:52:11 +01:00
Result : = Self;
end ;
2015-12-02 04:14:15 +01:00
2017-03-13 20:52:11 +01:00
function TMVCEngine. AddMiddleware( const AMiddleware: IMVCMiddleware) : TMVCEngine;
begin
FMiddlewares. Add( AMiddleware) ;
Result : = Self;
2015-10-18 16:35:50 +02:00
end ;
2017-03-13 20:52:11 +01:00
function TMVCEngine. AddSerializer( const AContentType: string ; const ASerializer: IMVCSerializer) : TMVCEngine;
2015-12-02 04:14:15 +01:00
begin
2017-04-14 16:43:31 +02:00
FSerializers. AddOrSetValue( AContentType, ASerializer) ;
2017-03-13 20:52:11 +01:00
Result : = Self;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
class procedure TMVCEngine. ClearSessionCookiesAlreadySet( const ACookies: TCookieCollection) ;
var
I: Integer ;
SessionCookieName: string ;
Cookie: TCookie;
2016-09-25 16:17:37 +02:00
begin
2017-03-13 20:52:11 +01:00
SessionCookieName : = TMVCConstants. SESSION_TOKEN_NAME. ToLower;
I : = 0 ;
2018-08-08 17:11:45 +02:00
while True do
2017-03-13 20:52:11 +01:00
begin
if I = ACookies. Count then
Break;
Cookie : = ACookies[ I] ;
if LowerCase( Cookie. Name ) = SessionCookieName then
ACookies. Delete( I)
else
Inc( I) ;
end ;
2016-09-25 16:17:37 +02:00
end ;
2017-03-13 20:52:11 +01:00
procedure TMVCEngine. ConfigDefaultValues;
2013-12-04 13:06:18 +01:00
begin
2017-03-13 20:52:11 +01:00
Log. Info( 'ENTER: Config default values' , LOGGERPRO_TAG) ;
2013-12-04 13:06:18 +01:00
2017-03-13 20:52:11 +01:00
Config[ TMVCConfigKey. SessionTimeout] : = '30' { 30 minutes } ;
Config[ TMVCConfigKey. DocumentRoot] : = '.\www' ;
Config[ TMVCConfigKey. FallbackResource] : = '' ;
Config[ TMVCConfigKey. DefaultContentType] : = TMVCConstants. DEFAULT_CONTENT_TYPE;
Config[ TMVCConfigKey. DefaultContentCharset] : = TMVCConstants. DEFAULT_CONTENT_CHARSET;
Config[ TMVCConfigKey. DefaultViewFileExtension] : = 'html' ;
Config[ TMVCConfigKey. ViewPath] : = 'templates' ;
2017-06-22 16:18:58 +02:00
Config[ TMVCConfigKey. PathPrefix] : = '' ;
2017-03-13 20:52:11 +01:00
Config[ TMVCConfigKey. AllowUnhandledAction] : = 'false' ;
Config[ TMVCConfigKey. ServerName] : = 'DelphiMVCFramework' ;
Config[ TMVCConfigKey. ExposeServerSignature] : = 'true' ;
Config[ TMVCConfigKey. SessionType] : = 'memory' ;
Config[ TMVCConfigKey. IndexDocument] : = 'index.html' ;
2018-10-23 16:18:34 +02:00
Config[ TMVCConfigKey. MaxEntitiesRecordCount] : = '20' ;
2018-12-17 00:39:29 +01:00
Config[ TMVCConfigKey. MaxRequestSize] : = IntToStr( TMVCConstants. DEFAULT_MAX_REQUEST_SIZE) ;
2019-03-08 09:33:41 +01:00
Config[ TMVCConfigKey. HATEOSPropertyName] : = '_links' ;
2017-02-09 11:24:18 +01:00
2017-03-13 20:52:11 +01:00
FMediaTypes. Add( '.html' , TMVCMediaType. TEXT_HTML) ;
FMediaTypes. Add( '.htm' , TMVCMediaType. TEXT_HTML) ;
FMediaTypes. Add( '.txt' , TMVCMediaType. TEXT_PLAIN) ;
FMediaTypes. Add( '.css' , TMVCMediaType. TEXT_CSS) ;
FMediaTypes. Add( '.js' , TMVCMediaType. TEXT_JAVASCRIPT) ;
FMediaTypes. Add( '.jpg' , TMVCMediaType. IMAGE_JPEG) ;
FMediaTypes. Add( '.jpeg' , TMVCMediaType. IMAGE_JPEG) ;
FMediaTypes. Add( '.png' , TMVCMediaType. IMAGE_PNG) ;
FMediaTypes. Add( '.appcache' , TMVCMediaType. TEXT_CACHEMANIFEST) ;
2017-02-09 11:24:18 +01:00
2017-03-13 20:52:11 +01:00
Log. Info( 'EXIT: Config default values' , LOGGERPRO_TAG) ;
2013-10-30 00:48:23 +01:00
end ;
2019-02-24 20:43:06 +01:00
constructor TMVCEngine. Create( const AWebModule: TWebModule; const AConfigAction: TProc< TMVCConfig> ;
const ACustomLogger: ILogWriter) ;
2013-10-30 00:48:23 +01:00
begin
2017-05-25 16:57:49 +02:00
inherited Create( AWebModule) ;
2017-03-13 20:52:11 +01:00
FWebModule : = AWebModule;
2017-10-16 22:57:27 +02:00
FixUpWebModule;
2017-03-13 20:52:11 +01:00
FConfig : = TMVCConfig. Create;
2017-04-14 16:43:31 +02:00
FSerializers : = TDictionary< string , IMVCSerializer> . Create;
2017-03-13 20:52:11 +01:00
FMiddlewares : = TList< IMVCMiddleware> . Create;
FControllers : = TObjectList< TMVCControllerDelegate> . Create( True ) ;
FMediaTypes : = TDictionary< string , string > . Create;
FApplicationSession : = nil ;
FSavedOnBeforeDispatch : = nil ;
2013-10-30 00:48:23 +01:00
2017-03-13 20:52:11 +01:00
WebRequestHandler. CacheConnections : = True ;
WebRequestHandler. MaxConnections : = 4 0 9 6 ;
2013-10-30 00:48:23 +01:00
2017-03-13 20:52:11 +01:00
MVCFramework. Logger. SetDefaultLogger( ACustomLogger) ;
ConfigDefaultValues;
2016-11-18 18:25:09 +01:00
2017-03-13 20:52:11 +01:00
if Assigned( AConfigAction) then
2016-11-18 18:25:09 +01:00
begin
2017-03-13 20:52:11 +01:00
LogEnterMethod( 'Custom configuration method' ) ;
AConfigAction( FConfig) ;
LogExitMethod( 'Custom configuration method' ) ;
2016-11-18 18:25:09 +01:00
end ;
2018-12-17 00:39:29 +01:00
SaveCacheConfigValues;
2017-04-14 16:43:31 +02:00
RegisterDefaultsSerializers;
2017-03-13 20:52:11 +01:00
LoadSystemControllers;
2016-06-28 13:42:14 +02:00
end ;
2019-04-20 12:09:39 +02:00
function TMVCEngine. CustomExceptionHandling( const Ex: Exception;
const ASelectedController: TMVCController;
const AContext: TWebContext) : Boolean ;
begin
Result : = False ;
if Assigned( FOnException) then
begin
Log. ErrorFmt( '[%s] %s' ,
[ Ex. Classname, Ex. Message ] , LOGGERPRO_TAG) ;
FOnException( Ex, ASelectedController, AContext, Result ) ;
end ;
end ;
2018-09-25 15:36:53 +02:00
procedure TMVCEngine. DefineDefaultResponseHeaders( const AContext: TWebContext) ;
2016-04-03 22:35:27 +02:00
begin
2017-03-13 20:52:11 +01:00
if Config[ TMVCConfigKey. ExposeServerSignature] = 'true' then
2018-08-05 20:31:33 +02:00
AContext. Response. CustomHeaders. Values[ 'Server' ] : = GetServerSignature( AContext) ;
2017-03-13 20:52:11 +01:00
AContext. Response. RawWebResponse. Date : = Now;
2016-04-03 22:35:27 +02:00
end ;
2017-03-13 20:52:11 +01:00
destructor TMVCEngine. Destroy;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
FConfig. Free;
2017-04-14 16:43:31 +02:00
FSerializers. Free;
2017-03-13 20:52:11 +01:00
FMiddlewares. Free;
FControllers. Free;
FMediaTypes. Free;
inherited Destroy;
2013-10-30 00:48:23 +01:00
end ;
2019-02-24 20:43:06 +01:00
function TMVCEngine. ExecuteAction( const ASender: TObject; const ARequest: TWebRequest;
const AResponse: TWebResponse) : Boolean ;
2016-06-28 13:42:14 +02:00
var
2017-03-13 20:52:11 +01:00
LParamsTable: TMVCRequestParamsTable;
LContext: TWebContext;
LFileName: string ;
LRouter: TMVCRouter;
LHandled: Boolean ;
2017-09-08 16:59:02 +02:00
LResponseContentMediaType: string ;
2017-03-13 20:52:11 +01:00
LResponseContentCharset: string ;
LSelectedController: TMVCController;
LActionFormalParams: TArray< TRttiParameter> ;
LActualParams: TArray< TValue> ;
begin
Result : = False ;
2019-03-19 12:06:13 +01:00
if ARequest. ContentLength > FConfigCache_MaxRequestSize then
begin
raise EMVCException. CreateFmt( 'Request size exceeded the max allowed size [%d KiB] (1)' ,
[ ( FConfigCache_MaxRequestSize div 1 0 2 4 ) ] ) ;
end ;
{$IFDEF BERLINORBETTER}
2018-12-17 00:39:29 +01:00
ARequest. ReadTotalContent;
2019-03-19 12:06:13 +01:00
2019-05-09 20:53:52 +02:00
// Double check for malicious content-length header
2019-02-24 20:43:06 +01:00
if ARequest. ContentLength > FConfigCache_MaxRequestSize then
2018-12-17 00:39:29 +01:00
begin
2019-03-19 12:06:13 +01:00
raise EMVCException. CreateFmt( 'Request size exceeded the max allowed size [%d KiB] (2)' ,
2019-02-24 20:43:06 +01:00
[ ( FConfigCache_MaxRequestSize div 1 0 2 4 ) ] ) ;
2018-12-17 00:39:29 +01:00
end ;
2019-03-19 12:06:13 +01:00
{$ENDIF}
2017-03-13 20:52:11 +01:00
LParamsTable : = TMVCRequestParamsTable. Create;
2016-06-28 13:42:14 +02:00
try
2017-04-14 16:43:31 +02:00
LContext : = TWebContext. Create( ARequest, AResponse, FConfig, FSerializers) ;
2017-03-13 20:52:11 +01:00
try
2018-09-25 15:36:53 +02:00
DefineDefaultResponseHeaders( LContext) ;
2019-02-24 20:43:06 +01:00
LHandled : = False ;
LRouter : = TMVCRouter. Create( FConfig, _MVCGlobalActionParamsCache) ;
try // finally
LSelectedController : = nil ;
try // only for lselectedcontroller
try // global exception handler
ExecuteBeforeRoutingMiddleware( LContext, LHandled) ;
if not LHandled then
2017-03-13 20:52:11 +01:00
begin
2019-05-19 14:19:58 +02:00
if LRouter. ExecuteRouting( ARequest. PathInfo,
LContext. Request. GetOverwrittenHTTPMethod { LContext.Request.HTTPMethod } ,
2019-02-24 20:43:06 +01:00
ARequest. ContentType, ARequest. Accept, FControllers, FConfig[ TMVCConfigKey. DefaultContentType] ,
FConfig[ TMVCConfigKey. DefaultContentCharset] , LParamsTable, LResponseContentMediaType,
LResponseContentCharset) then
begin
try
if Assigned( LRouter. ControllerCreateAction) then
LSelectedController : = LRouter. ControllerCreateAction( )
else
LSelectedController : = LRouter. ControllerClazz. Create;
except
on Ex: Exception do
begin
Log. ErrorFmt( '[%s] %s (Custom message: "%s")' ,
[ Ex. Classname, Ex. Message , 'Cannot create controller' ] , LOGGERPRO_TAG) ;
raise EMVCException. Create( HTTP_STATUS. InternalServerError, 'Cannot create controller' ) ;
// HTTP500(LContext, 'Cannot create controller');
// Result := False;
// Exit;
end ;
2018-08-08 17:11:45 +02:00
end ;
2017-03-13 20:52:11 +01:00
LSelectedController. Engine : = Self;
LSelectedController. Context : = LContext;
LSelectedController. ApplicationSession : = FApplicationSession;
LContext. ParamsTable : = LParamsTable;
2019-02-24 20:43:06 +01:00
ExecuteBeforeControllerActionMiddleware( LContext, LRouter. ControllerClazz. QualifiedClassName,
LRouter. MethodToCall. Name , LHandled) ;
if LHandled then
Exit( True ) ;
2016-06-28 13:42:14 +02:00
2019-02-24 20:43:06 +01:00
LSelectedController. MVCControllerAfterCreate;
2017-03-13 20:52:11 +01:00
try
2019-02-24 20:43:06 +01:00
LHandled : = False ;
LSelectedController. ContentType : = BuildContentType( LResponseContentMediaType,
LResponseContentCharset) ;
// LSelectedController.ContentCharset := LResponseContentCharset;
LActionFormalParams : = LRouter. MethodToCall. GetParameters;
if ( Length( LActionFormalParams) = 0 ) then
SetLength( LActualParams, 0 )
else
2019-05-09 20:53:52 +02:00
if ( Length( LActionFormalParams) = 1 ) and
2019-05-19 14:19:58 +02:00
( SameText( LActionFormalParams[ 0 ] . ParamType. QualifiedName, 'MVCFramework.TWebContext' ) ) then
begin
SetLength( LActualParams, 1 ) ;
LActualParams[ 0 ] : = LContext;
end
else
FillActualParamsForAction( LContext, LActionFormalParams, LRouter. MethodToCall. Name ,
LActualParams) ;
2018-02-20 22:36:18 +01:00
2019-02-24 20:43:06 +01:00
LSelectedController. OnBeforeAction( LContext, LRouter. MethodToCall. Name , LHandled) ;
if not LHandled then
2017-03-13 20:52:11 +01:00
begin
2019-02-24 20:43:06 +01:00
try
LRouter. MethodToCall. Invoke( LSelectedController, LActualParams) ;
finally
LSelectedController. OnAfterAction( LContext, LRouter. MethodToCall. Name ) ;
end ;
2017-03-13 20:52:11 +01:00
end ;
2019-02-24 20:43:06 +01:00
finally
LSelectedController. MVCControllerBeforeDestroy;
end ;
ExecuteAfterControllerActionMiddleware( LContext, LRouter. MethodToCall. Name , LHandled) ;
LContext. Response. ContentType : = LSelectedController. ContentType;
Log( TLogLevel. levNormal, ARequest. Method + ':' + ARequest. RawPathInfo + ' -> ' +
LRouter. ControllerClazz. QualifiedClassName + ' - ' + IntToStr( AResponse. StatusCode) + ' ' +
AResponse. ReasonString)
end
else // execute-routing
begin
if Config[ TMVCConfigKey. AllowUnhandledAction] = 'false' then
begin
if not Config[ TMVCConfigKey. FallbackResource] . IsEmpty then
2017-03-13 20:52:11 +01:00
begin
2019-02-24 20:43:06 +01:00
if ( LContext. Request. PathInfo = '/' ) or ( LContext. Request. PathInfo = '' ) then // useful for SPA
Result : = SendStaticFileIfPresent( LContext, TPath. Combine( Config[ TMVCConfigKey. DocumentRoot] ,
Config[ TMVCConfigKey. FallbackResource] ) ) ;
2017-03-13 20:52:11 +01:00
end ;
2019-02-24 20:43:06 +01:00
if ( not Result ) and ( IsStaticFileRequest( ARequest, LFileName) ) then
2017-03-13 20:52:11 +01:00
begin
2019-02-24 20:43:06 +01:00
Result : = SendStaticFileIfPresent( LContext, LFileName) ;
2017-03-13 20:52:11 +01:00
end ;
2019-02-24 20:43:06 +01:00
if not Result then
2017-03-13 20:52:11 +01:00
begin
2019-02-24 20:43:06 +01:00
// HTTP404(LContext);
Log( TLogLevel. levNormal, ARequest. Method + ':' + ARequest. RawPathInfo + ' -> NO ACTION ' + ' - ' +
IntToStr( AResponse. StatusCode) + ' ' + AResponse. ReasonString) ;
raise EMVCException. Create( HTTP_STATUS. NotFound, 'Not Found' ) ;
2017-03-13 20:52:11 +01:00
end ;
2019-02-24 20:43:06 +01:00
end
else
LContext. Response. FlushOnDestroy : = False ;
end ; // end-execute-routing
end ; // if not handled by beforerouting
except
2019-04-20 12:09:39 +02:00
on ESess: EMVCSessionExpiredException do
2019-02-24 20:43:06 +01:00
begin
2019-04-20 12:09:39 +02:00
if not CustomExceptionHandling( ESess, LSelectedController, LContext) then
begin
Log. ErrorFmt( '[%s] %s (Custom message: "%s")' , [ ESess. Classname, ESess. Message , ESess. DetailedMessage] ,
LOGGERPRO_TAG) ;
LContext. SessionStop( False ) ;
LSelectedController. ResponseStatus( ESess. HTTPErrorCode) ;
LSelectedController. Render( ESess) ;
end ;
2019-02-24 20:43:06 +01:00
end ;
on E: EMVCException do
begin
2019-04-20 12:09:39 +02:00
if not CustomExceptionHandling( E, LSelectedController, LContext) then
2019-02-24 20:43:06 +01:00
begin
2019-04-20 12:09:39 +02:00
Log. ErrorFmt( '[%s] %s (Custom message: "%s")' , [ E. Classname, E. Message , E. DetailedMessage] ,
LOGGERPRO_TAG) ;
if Assigned( LSelectedController) then
begin
LSelectedController. ResponseStatus( E. HTTPErrorCode) ;
LSelectedController. Render( E) ;
end
else
begin
2019-05-09 20:53:52 +02:00
SendRawHTTPStatus( LContext, E. HTTPErrorCode, Format( '[%s] %s' , [ E. Classname, E. Message ] ) ,
E. Classname) ;
2019-04-20 12:09:39 +02:00
end ;
2017-03-13 20:52:11 +01:00
end ;
2019-02-24 20:43:06 +01:00
end ;
2019-04-20 12:09:39 +02:00
on EIO: EInvalidOp do
2017-03-13 20:52:11 +01:00
begin
2019-04-20 12:09:39 +02:00
if not CustomExceptionHandling( EIO, LSelectedController, LContext) then
2017-03-13 20:52:11 +01:00
begin
2019-05-09 20:53:52 +02:00
Log. ErrorFmt( '[%s] %s (Custom message: "%s")' , [ EIO. Classname, EIO. Message , 'Invalid Op' ] ,
LOGGERPRO_TAG) ;
2019-04-20 12:09:39 +02:00
if Assigned( LSelectedController) then
begin
LSelectedController. ResponseStatus( HTTP_STATUS. InternalServerError) ;
LSelectedController. Render( EIO) ;
end
else
begin
SendRawHTTPStatus( LContext, HTTP_STATUS. InternalServerError,
Format( '[%s] %s' , [ EIO. Classname, EIO. Message ] ) , EIO. Classname) ;
end ;
2019-02-24 20:43:06 +01:00
end ;
end ;
2019-04-20 12:09:39 +02:00
on Ex: Exception do
2019-02-24 20:43:06 +01:00
begin
2019-04-20 12:09:39 +02:00
if not CustomExceptionHandling( Ex, LSelectedController, LContext) then
2019-02-24 20:43:06 +01:00
begin
2019-04-20 12:09:39 +02:00
Log. ErrorFmt( '[%s] %s (Custom message: "%s")' ,
[ Ex. Classname, Ex. Message , 'Global Action Exception Handler' ] , LOGGERPRO_TAG) ;
if Assigned( LSelectedController) then
begin
LSelectedController. ResponseStatus( HTTP_STATUS. InternalServerError) ;
LSelectedController. Render( Ex) ;
end
else
begin
SendRawHTTPStatus( LContext, HTTP_STATUS. InternalServerError,
2019-05-09 20:53:52 +02:00
Format( '[%s] %s' , [ Ex. Classname, Ex. Message ] ) , Ex. Classname) ;
2019-04-20 12:09:39 +02:00
end ;
2019-02-24 20:43:06 +01:00
end ;
2017-03-13 20:52:11 +01:00
end ;
end ;
finally
2019-02-24 20:43:06 +01:00
FreeAndNil( LSelectedController) ;
2017-03-13 20:52:11 +01:00
end ;
2019-02-24 20:43:06 +01:00
finally
LRouter. Free;
2017-03-13 20:52:11 +01:00
end ;
finally
LContext. Free;
end ;
2015-12-02 04:14:15 +01:00
finally
2017-03-13 20:52:11 +01:00
LParamsTable. Free;
2015-12-02 04:14:15 +01:00
end ;
2013-10-30 00:48:23 +01:00
end ;
2018-08-08 17:11:45 +02:00
procedure TMVCEngine. ExecuteAfterControllerActionMiddleware( const AContext: TWebContext; const AActionName: string ;
2017-03-13 20:52:11 +01:00
const AHandled: Boolean ) ;
var
I: Integer ;
2013-11-05 14:57:50 +01:00
begin
2017-03-13 20:52:11 +01:00
for I : = FMiddlewares. Count - 1 downto 0 do
FMiddlewares[ I] . OnAfterControllerAction( AContext, AActionName, AHandled) ;
2013-11-05 14:57:50 +01:00
end ;
2019-02-24 20:43:06 +01:00
procedure TMVCEngine. ExecuteBeforeControllerActionMiddleware( const AContext: TWebContext;
const AControllerQualifiedClassName: string ; const AActionName: string ; var AHandled: Boolean ) ;
2017-03-13 20:52:11 +01:00
var
Middleware: IMVCMiddleware;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
if not AHandled then
for Middleware in FMiddlewares do
begin
Middleware. OnBeforeControllerAction( AContext, AControllerQualifiedClassName, AActionName, AHandled) ;
if AHandled then
Break;
end ;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
procedure TMVCEngine. ExecuteBeforeRoutingMiddleware( const AContext: TWebContext; var AHandled: Boolean ) ;
var
Middleware: IMVCMiddleware;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
if not AHandled then
for Middleware in FMiddlewares do
begin
Middleware. OnBeforeRouting( AContext, AHandled) ;
if AHandled then
Break;
end ;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
class function TMVCEngine. ExtractSessionIdFromWebRequest( const AWebRequest: TWebRequest) : string ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
Result : = AWebRequest. CookieFields. Values[ TMVCConstants. SESSION_TOKEN_NAME] ;
if not Result . IsEmpty then
Result : = TIdURI. URLDecode( Result ) ;
2013-10-30 00:48:23 +01:00
end ;
2019-02-24 20:43:06 +01:00
procedure TMVCEngine. FillActualParamsForAction( const AContext: TWebContext;
const AActionFormalParams: TArray< TRttiParameter> ; const AActionName: string ; var AActualParams: TArray< TValue> ) ;
2017-03-13 20:52:11 +01:00
var
ParamName: string ;
I: Integer ;
StrValue: string ;
FormatSettings: TFormatSettings;
WasDateTime: Boolean ;
2018-11-09 18:11:59 +01:00
lQualifiedName: string ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
if AContext. Request. SegmentParamsCount < > Length( AActionFormalParams) then
2018-10-23 16:18:34 +02:00
raise EMVCException. CreateFmt( 'Parameters count mismatch (expected %d actual %d) for action "%s"' ,
2018-08-08 17:11:45 +02:00
[ Length( AActionFormalParams) , AContext. Request. SegmentParamsCount, AActionName] ) ;
2017-03-13 20:52:11 +01:00
SetLength( AActualParams, Length( AActionFormalParams) ) ;
for I : = 0 to Length( AActionFormalParams) - 1 do
begin
ParamName : = AActionFormalParams[ I] . Name ;
if not AContext. Request. SegmentParam( ParamName, StrValue) then
2019-02-24 20:43:06 +01:00
raise EMVCException. CreateFmt
( 'Invalid parameter %s for action %s (Hint: Here parameters names are case-sensitive)' ,
2018-08-08 17:11:45 +02:00
[ ParamName, AActionName] ) ;
2017-03-13 20:52:11 +01:00
case AActionFormalParams[ I] . ParamType. TypeKind of
2018-11-09 18:11:59 +01:00
tkInteger:
2017-03-13 20:52:11 +01:00
begin
AActualParams[ I] : = StrToInt( StrValue) ;
end ;
2018-11-09 18:11:59 +01:00
tkInt64:
begin
AActualParams[ I] : = StrToInt64( StrValue) ;
end ;
2017-03-13 20:52:11 +01:00
tkUString:
begin
AActualParams[ I] : = StrValue;
end ;
tkFloat:
begin
WasDateTime : = False ;
2018-11-09 18:11:59 +01:00
lQualifiedName : = AActionFormalParams[ I] . ParamType. QualifiedName;
if lQualifiedName = 'System.TDate' then
2017-03-13 20:52:11 +01:00
begin
try
WasDateTime : = True ;
AActualParams[ I] : = ISODateToDate( StrValue) ;
except
raise EMVCException. CreateFmt( 'Invalid TDate value for param [%s]' , [ AActionFormalParams[ I] . Name ] ) ;
end ;
end
2019-05-09 20:53:52 +02:00
else
if lQualifiedName = 'System.TDateTime' then
2019-05-19 14:19:58 +02:00
begin
try
WasDateTime : = True ;
AActualParams[ I] : = ISOTimeStampToDateTime( StrValue) ;
except
on E: Exception do
2017-08-29 11:54:22 +02:00
begin
2019-05-19 14:19:58 +02:00
raise EMVCException. CreateFmt( 'Invalid TDateTime value for param [%s][%s]' ,
[ AActionFormalParams[ I] . Name , E. Message ] ) ;
2017-08-29 11:54:22 +02:00
end ;
2019-05-19 14:19:58 +02:00
end ;
end
else
if lQualifiedName = 'System.TTime' then
begin
try
WasDateTime : = True ;
AActualParams[ I] : = ISOTimeToTime( StrValue) ;
except
raise EMVCException. CreateFmt( 'Invalid TTime value for param [%s]' , [ AActionFormalParams[ I] . Name ] ) ;
end ;
end ;
2017-03-13 20:52:11 +01:00
if not WasDateTime then
begin
FormatSettings. DecimalSeparator : = '.' ;
AActualParams[ I] : = StrToFloat( StrValue, FormatSettings) ;
end ;
end ;
tkEnumeration:
begin
if AActionFormalParams[ I] . ParamType. QualifiedName = 'System.Boolean' then
begin
if SameText( StrValue, 'true' ) or SameText( StrValue, '1' ) then
AActualParams[ I] : = True
else
2019-05-09 20:53:52 +02:00
if SameText( StrValue, 'false' ) or SameText( StrValue, '0' ) then
2019-05-19 14:19:58 +02:00
AActualParams[ I] : = False
else
raise EMVCException. CreateFmt
( 'Invalid boolean value for parameter %s. Boolean parameters accepts only "true"/"false" or "1"/"0".' ,
[ ParamName] ) ;
2017-03-13 20:52:11 +01:00
end
else
2019-02-24 20:43:06 +01:00
raise EMVCException. CreateFmt( 'Invalid type for parameter %s. Allowed types are ' +
ALLOWED_TYPED_ACTION_PARAMETERS_TYPES, [ ParamName] ) ;
2017-03-13 20:52:11 +01:00
end ;
else
begin
2019-02-24 20:43:06 +01:00
raise EMVCException. CreateFmt( 'Invalid type for parameter %s. Allowed types are ' +
ALLOWED_TYPED_ACTION_PARAMETERS_TYPES, [ ParamName] ) ;
2017-03-13 20:52:11 +01:00
end ;
end ;
end ;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
procedure TMVCEngine. FixUpWebModule;
2016-06-23 11:42:16 +02:00
begin
2017-03-13 20:52:11 +01:00
FSavedOnBeforeDispatch : = FWebModule. BeforeDispatch;
FWebModule. BeforeDispatch : = OnBeforeDispatch;
2016-06-23 11:42:16 +02:00
end ;
2018-08-08 17:11:45 +02:00
class function TMVCEngine. GetCurrentSession( const ASessionTimeout: Integer ; const ASessionId: string ;
2017-03-13 20:52:11 +01:00
const ARaiseExceptionIfExpired: Boolean ) : TWebSession;
var
List: TObjectDictionary< string , TWebSession> ;
IsExpired: Boolean ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
Result : = nil ;
2017-03-23 18:51:25 +01:00
List : = GlobalSessionList;
2017-03-13 20:52:11 +01:00
TMonitor. Enter( List) ;
try
if not ASessionId. IsEmpty then
begin
IsExpired : = True ;
if List. TryGetValue( ASessionId, Result ) then
if ( ASessionTimeout = 0 ) then
IsExpired : = MinutesBetween( Now, Result . LastAccess) > DEFAULT_SESSION_INACTIVITY
else
IsExpired : = MinutesBetween( Now, Result . LastAccess) > ASessionTimeout;
if Assigned( Result ) then
if IsExpired then
begin
List. Remove( ASessionId) ;
if ARaiseExceptionIfExpired then
raise EMVCSessionExpiredException. Create( 'Session expired.' )
else
Result : = nil ;
end
else
Result . MarkAsUsed;
end ;
finally
TMonitor. Exit( List) ;
end ;
2013-10-30 00:48:23 +01:00
end ;
2018-08-08 17:11:45 +02:00
function TMVCEngine. GetServerSignature( const AContext: TWebContext) : string ;
2018-08-05 20:31:33 +02:00
begin
if AContext. Config. Value[ TMVCConfigKey. ExposeServerSignature] = 'true' then
begin
Result : = 'DelphiMVCFramework ' + DMVCFRAMEWORK_VERSION;
end
else
begin
Result : = '' ;
end ;
end ;
2017-03-13 20:52:11 +01:00
function TMVCEngine. GetSessionBySessionId( const ASessionId: string ) : TWebSession;
2016-05-11 10:39:20 +02:00
begin
2017-03-13 20:52:11 +01:00
Result : = TMVCEngine. GetCurrentSession( StrToInt64( Config[ TMVCConfigKey. SessionTimeout] ) , ASessionId, False ) ;
if Assigned( Result ) then
Result . MarkAsUsed;
2016-05-11 10:39:20 +02:00
end ;
2017-04-14 16:43:31 +02:00
function TMVCEngine. GetViewEngineClass: TMVCViewEngineClass;
begin
if FViewEngineClass = nil then
2019-02-24 20:43:06 +01:00
raise EMVCConfigException. Create
( 'No View Engine configured. [HINT: Use TMVCEngine.SetViewEngine() to set a valid view engine]' ) ;
2017-04-14 16:43:31 +02:00
Result : = FViewEngineClass;
end ;
2017-03-13 20:52:11 +01:00
procedure TMVCEngine. HTTP404( const AContext: TWebContext) ;
2013-11-08 23:10:25 +01:00
begin
2018-08-08 15:43:37 +02:00
AContext. Response. SetStatusCode( HTTP_STATUS. NotFound) ;
2019-02-24 20:43:06 +01:00
AContext. Response. SetContentType( BuildContentType( TMVCMediaType. TEXT_PLAIN,
AContext. Config[ TMVCConfigKey. DefaultContentCharset] ) ) ;
2018-08-08 15:43:37 +02:00
AContext. Response. SetReasonString( 'Not Found' ) ;
AContext. Response. SetContent( 'Not Found' + sLineBreak + GetServerSignature( AContext) ) ;
2013-11-08 23:10:25 +01:00
end ;
2017-03-13 20:52:11 +01:00
procedure TMVCEngine. HTTP500( const AContext: TWebContext; const AReasonString: string ) ;
2013-10-30 00:48:23 +01:00
begin
2018-08-08 15:43:37 +02:00
AContext. Response. SetStatusCode( HTTP_STATUS. InternalServerError) ;
2019-02-24 20:43:06 +01:00
AContext. Response. SetContentType( BuildContentType( TMVCMediaType. TEXT_PLAIN,
AContext. Config[ TMVCConfigKey. DefaultContentCharset] ) ) ;
2018-08-08 17:11:45 +02:00
AContext. Response. SetReasonString( 'Internal server error' ) ;
2019-02-24 20:43:06 +01:00
AContext. Response. SetContent( 'Internal server error' + sLineBreak + GetServerSignature( AContext) + ': ' +
AReasonString) ;
end ;
procedure TMVCEngine. SendRawHTTPStatus( const AContext: TWebContext; const HTTPStatusCode: Integer ;
2019-03-16 17:20:28 +01:00
const AReasonString: string ; const AClassName: String ) ;
2019-02-24 20:43:06 +01:00
var
lSer: IMVCSerializer;
lError: TMVCErrorResponse;
begin
AContext. Response. SetStatusCode( HTTPStatusCode) ;
AContext. Response. SetReasonString( AReasonString) ;
if Serializers. TryGetValue( AContext. Config[ TMVCConfigKey. DefaultContentType] , lSer) then
begin
lError : = TMVCErrorResponse. Create;
try
2019-03-16 17:20:28 +01:00
lError. Classname : = AClassName;
2019-02-24 20:43:06 +01:00
lError. StatusCode : = HTTPStatusCode;
lError. Message : = AReasonString;
AContext. Response. SetContent( lSer. SerializeObject( lError) ) ;
finally
lError. Free;
end ;
2019-08-13 16:34:37 +02:00
AContext. Response. SetContentType( BuildContentType( AContext. Config[ TMVCConfigKey. DefaultContentType] ,
AContext. Config[ TMVCConfigKey. DefaultContentCharset] ) ) ;
2019-02-24 20:43:06 +01:00
end
else
begin
AContext. Response. SetContentType( BuildContentType( TMVCMediaType. TEXT_PLAIN,
AContext. Config[ TMVCConfigKey. DefaultContentCharset] ) ) ;
AContext. Response. SetContent( GetServerSignature( AContext) + sLineBreak + 'HTTP ' + HTTPStatusCode. ToString + ': ' +
AReasonString) ;
end ;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
function TMVCEngine. IsStaticFileRequest( const ARequest: TWebRequest; out AFileName: string ) : Boolean ;
2013-10-30 00:48:23 +01:00
begin
2018-08-05 20:31:33 +02:00
Result : = ( not FConfig[ TMVCConfigKey. DocumentRoot] . IsEmpty) and
( TMVCStaticContents. IsStaticFile( FConfig[ TMVCConfigKey. DocumentRoot] , ARequest. PathInfo, AFileName) ) ;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
procedure TMVCEngine. LoadSystemControllers;
2014-04-10 13:56:23 +02:00
begin
2017-03-13 20:52:11 +01:00
Log( TLogLevel. levNormal, 'ENTER: LoadSystemControllers' ) ;
AddController( TMVCSystemController) ;
Log( TLogLevel. levNormal, 'EXIT: LoadSystemControllers' ) ;
2014-04-10 13:56:23 +02:00
end ;
2019-02-24 20:43:06 +01:00
procedure TMVCEngine. OnBeforeDispatch( ASender: TObject; ARequest: TWebRequest; AResponse: TWebResponse;
var AHandled: Boolean ) ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
AHandled : = False ;
2017-10-16 22:57:27 +02:00
{ there is a bug in WebBroker Linux on 10.2.1 tokyo }
// if Assigned(FSavedOnBeforeDispatch) then
// begin
// FSavedOnBeforeDispatch(ASender, ARequest, AResponse, AHandled);
// end;
2017-03-13 20:52:11 +01:00
if not AHandled then
begin
try
AHandled : = ExecuteAction( ASender, ARequest, AResponse) ;
except
on E: Exception do
begin
2018-08-08 17:11:45 +02:00
Log. ErrorFmt( '[%s] %s' , [ E. Classname, E. Message ] , LOGGERPRO_TAG) ;
2017-03-13 20:52:11 +01:00
AResponse. Content : = E. Message ;
AResponse. SendResponse;
AHandled : = True ;
end ;
end ;
end ;
2013-10-30 00:48:23 +01:00
end ;
2019-02-24 20:43:06 +01:00
function TMVCEngine. PublishObject( const AObjectCreatorDelegate: TMVCObjectCreatorDelegate; const AURLSegment: string )
: TMVCEngine;
2018-11-24 16:56:21 +01:00
begin
Result : = AddController( TMVCJSONRPCPublisher,
function : TMVCController
begin
Result : = TMVCJSONRPCPublisher. Create( AObjectCreatorDelegate( ) , True ) ;
end , AURLSegment) ;
end ;
2017-04-14 16:43:31 +02:00
procedure TMVCEngine. RegisterDefaultsSerializers;
2017-09-08 16:59:02 +02:00
var
lDefaultSerializerContentType: string ;
2013-10-30 00:48:23 +01:00
begin
2017-10-09 16:17:12 +02:00
lDefaultSerializerContentType : = BuildContentType( TMVCMediaType. APPLICATION_JSON, TMVCCharset. UTF_8) ;
2017-09-08 16:59:02 +02:00
if not FSerializers. ContainsKey( lDefaultSerializerContentType) then
2017-05-18 00:02:22 +02:00
begin
2018-08-08 17:11:45 +02:00
FSerializers. Add( lDefaultSerializerContentType, TMVCJSONDataObjectsSerializer. Create) ;
2017-09-22 09:33:21 +02:00
end ;
// register the same serializer without the charset in the contenttype
2017-10-09 16:17:12 +02:00
lDefaultSerializerContentType : = BuildContentType( TMVCMediaType. APPLICATION_JSON, '' ) ;
2017-09-22 09:33:21 +02:00
if not FSerializers. ContainsKey( lDefaultSerializerContentType) then
begin
2018-08-08 17:11:45 +02:00
FSerializers. Add( lDefaultSerializerContentType, TMVCJSONDataObjectsSerializer. Create) ;
2017-05-18 00:02:22 +02:00
end ;
2013-10-30 00:48:23 +01:00
end ;
2019-02-24 20:43:06 +01:00
procedure TMVCEngine. ResponseErrorPage( const AException: Exception; const ARequest: TWebRequest;
const AResponse: TWebResponse) ;
2013-10-30 00:48:23 +01:00
begin
2018-08-08 17:11:45 +02:00
AResponse. SetCustomHeader( 'x-mvc-error' , AException. Classname + ': ' + AException. Message ) ;
2017-03-13 20:52:11 +01:00
AResponse. StatusCode : = HTTP_STATUS. OK;
2019-05-19 14:19:58 +02:00
2017-03-13 20:52:11 +01:00
begin
AResponse. ContentType : = TMVCMediaType. TEXT_PLAIN;
2019-02-24 20:43:06 +01:00
AResponse. Content : = Config[ TMVCConfigKey. ServerName] + ' ERROR:' + sLineBreak + 'Exception raised of class: ' +
AException. Classname + sLineBreak + '***********************************************' + sLineBreak +
AException. Message + sLineBreak + '***********************************************' ;
2017-03-13 20:52:11 +01:00
end ;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
class function TMVCEngine. SendSessionCookie( const AContext: TWebContext) : string ;
var
SId: string ;
2016-06-22 17:49:16 +02:00
begin
2019-02-24 20:43:06 +01:00
SId : = StringReplace( StringReplace( StringReplace( GUIDToString( TGUID. NewGuid) , '}' , '' , [ ] ) , '{' , '' , [ ] ) , '-' , '' ,
[ rfReplaceAll] ) ;
2017-03-13 20:52:11 +01:00
Result : = SendSessionCookie( AContext, SId) ;
2016-06-22 17:49:16 +02:00
end ;
2018-12-17 00:39:29 +01:00
procedure TMVCEngine. SaveCacheConfigValues;
begin
2019-02-24 20:43:06 +01:00
FConfigCache_MaxRequestSize : = StrToInt64Def( Config[ TMVCConfigKey. MaxRequestSize] ,
TMVCConstants. DEFAULT_MAX_REQUEST_SIZE) ;
2018-12-17 00:39:29 +01:00
end ;
2017-03-13 20:52:11 +01:00
class function TMVCEngine. SendSessionCookie( const AContext: TWebContext; const ASessionId: string ) : string ;
var
Cookie: TCookie;
SessionTimeout: Integer ;
2016-06-22 17:49:16 +02:00
begin
2017-03-13 20:52:11 +01:00
ClearSessionCookiesAlreadySet( AContext. Response. Cookies) ;
Cookie : = AContext. Response. Cookies. Add;
Cookie. Name : = TMVCConstants. SESSION_TOKEN_NAME;
Cookie. Value : = ASessionId;
2017-06-22 16:18:58 +02:00
if not TryStrToInt( AContext. Config[ TMVCConfigKey. SessionTimeout] , SessionTimeout) then
raise EMVCException. Create( '[Config::Session Timeout] is not a valid integer' ) ;
2017-03-13 20:52:11 +01:00
if SessionTimeout = 0 then
2017-06-22 16:18:58 +02:00
Cookie. Expires : = 0 // session cookie
2016-06-22 17:49:16 +02:00
else
2017-03-13 20:52:11 +01:00
Cookie. Expires : = Now + OneMinute * SessionTimeout;
2017-06-22 16:18:58 +02:00
2017-03-13 20:52:11 +01:00
Cookie. Path : = '/' ;
Result : = ASessionId;
2016-06-22 17:49:16 +02:00
end ;
2017-05-18 00:02:22 +02:00
function TMVCEngine. SendStaticFileIfPresent( const AContext: TWebContext; const AFileName: string ) : Boolean ;
2017-03-13 20:52:11 +01:00
var
2018-10-14 18:23:20 +02:00
lContentType: string ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
Result : = False ;
if TFile. Exists( AFileName) then
2015-12-02 04:14:15 +01:00
begin
2018-10-14 18:23:20 +02:00
if FMediaTypes. TryGetValue( LowerCase( ExtractFileExt( AFileName) ) , lContentType) then
lContentType : = BuildContentType( lContentType, FConfig[ TMVCConfigKey. DefaultContentCharset] )
2017-03-13 20:52:11 +01:00
else
2018-10-14 18:23:20 +02:00
lContentType : = BuildContentType( TMVCMediaType. APPLICATION_OCTETSTREAM, '' ) ;
TMVCStaticContents. SendFile( AFileName, lContentType, AContext) ;
2017-03-13 20:52:11 +01:00
Result : = True ;
2015-12-02 04:14:15 +01:00
end ;
2013-10-30 00:48:23 +01:00
end ;
2019-04-20 12:09:39 +02:00
function TMVCEngine. SetExceptionHandler(
const AExceptionHandlerProc: TMVCExceptionHandlerProc) : TMVCEngine;
begin
FOnException : = AExceptionHandlerProc;
Result : = Self;
end ;
2018-08-08 17:11:45 +02:00
function TMVCEngine. SetViewEngine( const AViewEngineClass: TMVCViewEngineClass) : TMVCEngine;
2017-04-14 16:43:31 +02:00
begin
FViewEngineClass : = AViewEngineClass;
Result : = Self;
end ;
2017-03-13 20:52:11 +01:00
{ TMVCBase }
class function TMVCBase. GetApplicationFileName: string ;
2017-04-14 16:43:31 +02:00
// var
// Name: PChar;
// Size: Integer;
begin
Result : = GetModuleName( HInstance) ;
// Result := EmptyStr;
// Name := GetMemory(2048);
// try
// GetModuleName()
// Size := GetModuleFileName(0, Name, 2048);
// if Size > 0 then
// Result := Name;
// finally
// FreeMem(Name, 2048);
// end;
2016-09-27 14:33:51 +02:00
end ;
2017-03-13 20:52:11 +01:00
class function TMVCBase. GetApplicationFileNamePath: string ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
Result : = IncludeTrailingPathDelimiter( ExtractFilePath( GetApplicationFileName) ) ;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
function TMVCBase. GetApplicationSession: TWebApplicationSession;
2013-11-12 01:23:50 +01:00
begin
2017-03-13 20:52:11 +01:00
if not Assigned( FApplicationSession) then
2018-08-08 17:11:45 +02:00
raise EMVCException. CreateFmt( 'ApplicationSession not assigned to this %s instance.' , [ Classname] ) ;
2017-03-13 20:52:11 +01:00
Result : = FApplicationSession;
end ;
2013-11-12 01:23:50 +01:00
2017-03-13 20:52:11 +01:00
function TMVCBase. GetConfig: TMVCConfig;
begin
Result : = Engine. Config;
2013-11-12 01:23:50 +01:00
end ;
2017-03-13 20:52:11 +01:00
function TMVCBase. GetEngine: TMVCEngine;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
if not Assigned( FEngine) then
2018-08-08 17:11:45 +02:00
raise EMVCException. CreateFmt( 'MVCEngine not assigned to this %s instance.' , [ Classname] ) ;
2017-03-13 20:52:11 +01:00
Result : = FEngine;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
procedure TMVCBase. SetApplicationSession( const AValue: TWebApplicationSession) ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
FApplicationSession : = AValue;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
procedure TMVCBase. SetEngine( const AValue: TMVCEngine) ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
FEngine : = AValue;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
{ TMVCControllerDelegate }
2013-10-30 00:48:23 +01:00
2019-02-24 20:43:06 +01:00
constructor TMVCControllerDelegate. Create( const AClazz: TMVCControllerClazz;
const ACreateAction: TMVCControllerCreateAction; const AURLSegment: string = '' ) ;
2013-10-30 00:48:23 +01:00
begin
2015-12-02 04:14:15 +01:00
inherited Create;
2017-03-13 20:52:11 +01:00
FClazz : = AClazz;
FCreateAction : = ACreateAction;
2017-09-24 19:40:40 +02:00
FURLSegment : = AURLSegment;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
{ TMVCStaticContents }
class function TMVCStaticContents. IsScriptableFile( const AStaticFileName: string ; const AConfig: TMVCConfig) : Boolean ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
Result : = TPath. GetExtension( AStaticFileName) . ToLower = '.' + AConfig[ TMVCConfigKey. DefaultViewFileExtension] . ToLower;
end ;
2013-10-30 00:48:23 +01:00
2019-02-24 20:43:06 +01:00
class function TMVCStaticContents. IsStaticFile( const AViewPath, AWebRequestPath: string ;
out ARealFileName: string ) : Boolean ;
2017-03-13 20:52:11 +01:00
var
FileName: string ;
begin
if TDirectory. Exists( AViewPath) then
FileName : = AViewPath + AWebRequestPath. Replace( '/' , TPath. DirectorySeparatorChar)
2015-12-02 04:14:15 +01:00
else
2017-03-13 20:52:11 +01:00
FileName : = GetApplicationFileNamePath + AViewPath + AWebRequestPath. Replace( '/' , TPath. DirectorySeparatorChar) ;
ARealFileName : = FileName;
Result : = TFile. Exists( ARealFileName) ;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
class procedure TMVCStaticContents. SendFile( const AFileName, AMediaType: string ; AContext: TWebContext) ;
2013-10-30 00:48:23 +01:00
var
2017-03-13 20:52:11 +01:00
FileDate: TDateTime;
ReqDate: TDateTime;
2015-12-02 04:14:15 +01:00
S: TFileStream;
begin
2017-03-13 20:52:11 +01:00
FileDate : = IndyFileAge( AFileName) ;
if ( FileDate = 0.0 ) and ( not FileExists( AFileName) ) then
2015-12-02 04:14:15 +01:00
begin
2017-03-13 20:52:11 +01:00
AContext. Response. StatusCode : = 4 0 4 ;
2015-12-02 04:14:15 +01:00
end
else
begin
2017-03-13 20:52:11 +01:00
ReqDate : = GMTToLocalDateTime( AContext. Request. Headers[ 'If-Modified-Since' ] ) ;
2018-08-08 17:11:45 +02:00
if ( ReqDate < > 0 ) and ( abs( ReqDate - FileDate) < 2 * ( 1 / ( 2 4 * 6 0 * 6 0 ) ) ) then
2015-12-02 04:14:15 +01:00
begin
2017-03-13 20:52:11 +01:00
AContext. Response. ContentType : = AMediaType;
AContext. Response. StatusCode : = 3 0 4 ;
2015-12-02 04:14:15 +01:00
end
else
begin
S : = TFileStream. Create( AFileName, fmOpenRead or fmShareDenyNone) ;
2017-03-13 20:52:11 +01:00
AContext. Response. SetCustomHeader( 'Last-Modified' , LocalDateTimeToHttpStr( FileDate) ) ;
AContext. Response. SetContentStream( S, AMediaType) ;
2015-12-02 04:14:15 +01:00
end ;
end ;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
{ TMVCController }
constructor TMVCController. Create;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
inherited Create;
FContext : = nil ;
FContentCharset : = TMVCConstants. DEFAULT_CONTENT_CHARSET;
FResponseStream : = nil ;
2017-03-20 19:08:01 +01:00
FViewModel : = nil ;
FViewDataSets : = nil ;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
destructor TMVCController. Destroy;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
if Assigned( FResponseStream) then
FResponseStream. Free;
2017-03-20 19:08:01 +01:00
if Assigned( FViewModel) then
FViewModel. Free;
if Assigned( FViewDataSets) then
FViewDataSets. Free;
2017-03-13 20:52:11 +01:00
inherited Destroy;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
function TMVCController. GetClientId: string ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
Result : = Session[ CLIENTID_KEY] ;
if Result . IsEmpty then
raise EMVCException. Create( 'Invalid ClientID' + sLineBreak +
'Hint: Messaging extensions require a valid clientid. Did you call /messages/clients/YOUR_CLIENT_ID ?' ) ;
2013-10-30 00:48:23 +01:00
end ;
2018-10-14 18:23:20 +02:00
function TMVCRenderer. GetContentType: string ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
Result : = GetContext. Response. ContentType;
2019-02-24 20:43:06 +01:00
if Result . Trim. IsEmpty then
begin
GetContext. Response. ContentType : = FContext. FConfig[ MVCFramework. Commons. TMVCConfigKey. DefaultContentType] ;
Result : = GetContentType;
end ;
2013-10-30 00:48:23 +01:00
end ;
2018-10-14 18:23:20 +02:00
function TMVCRenderer. GetContext: TWebContext;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
if not Assigned( FContext) then
2018-08-08 17:11:45 +02:00
raise EMVCException. CreateFmt( 'Context already set on %s.' , [ Classname] ) ;
2017-03-13 20:52:11 +01:00
Result : = FContext;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
function TMVCController. GetCurrentWebModule: TWebModule;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
Result : = Engine. WebModule;
2013-10-30 00:48:23 +01:00
end ;
2017-03-13 20:52:11 +01:00
function TMVCController. GetSession: TWebSession;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
Result : = GetContext. Session;
2013-10-30 00:48:23 +01:00
end ;
2018-10-14 18:23:20 +02:00
function TMVCRenderer. GetStatusCode: Integer ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
Result : = GetContext. Response. StatusCode;
2013-10-30 00:48:23 +01:00
end ;
2018-01-29 17:30:53 +01:00
function TMVCController. GetViewData( const aModelName: string ) : TObject;
2017-11-23 17:29:51 +01:00
begin
if not FViewModel. TryGetValue( aModelName, Result ) then
Result : = nil ;
end ;
2018-01-29 17:30:53 +01:00
function TMVCController. GetViewDataset( const aDataSetName: string ) : TDataSet;
2017-11-23 17:29:51 +01:00
begin
if not FViewDataSets. TryGetValue( aDataSetName, Result ) then
Result : = nil ;
end ;
function TMVCController. GetViewDataSets: TMVCViewDataSet;
2017-03-20 19:08:01 +01:00
begin
if not Assigned( FViewDataSets) then
2017-11-23 17:29:51 +01:00
FViewDataSets : = TMVCViewDataSet. Create;
2017-03-20 19:08:01 +01:00
Result : = FViewDataSets;
end ;
function TMVCController. GetViewModel: TMVCViewDataObject;
begin
if not Assigned( FViewModel) then
FViewModel : = TMVCViewDataObject. Create;
Result : = FViewModel;
end ;
function TMVCController. LoadView( const AViewNames: TArray< string > ) : string ;
begin
try
Result : = GetRenderedView( AViewNames) ;
ResponseStream. Append( Result ) ;
except
on E: Exception do
begin
2018-08-08 17:11:45 +02:00
Log. ErrorFmt( '[%s] %s' , [ E. Classname, E. Message ] , LOGGERPRO_TAG) ;
2017-03-20 19:08:01 +01:00
ContentType : = TMVCMediaType. TEXT_PLAIN;
Render( E) ;
end ;
end ;
end ;
procedure TMVCController. LoadViewFragment( const AViewFragment: string ) ;
begin
ResponseStream. Append( AViewFragment) ;
end ;
2017-03-13 20:52:11 +01:00
procedure TMVCController. MVCControllerAfterCreate;
begin
{ Implement if need be. }
end ;
2014-05-14 15:55:41 +02:00
2017-03-13 20:52:11 +01:00
procedure TMVCController. MVCControllerBeforeDestroy;
begin
{ Implement if need be. }
end ;
2016-05-11 10:39:20 +02:00
2017-03-13 20:52:11 +01:00
procedure TMVCController. OnAfterAction( AContext: TWebContext; const AActionName: string ) ;
2014-05-14 15:55:41 +02:00
begin
2017-03-13 20:52:11 +01:00
{ Implement if need be. }
2014-05-14 15:55:41 +02:00
end ;
2013-10-30 00:48:23 +01:00
2017-03-13 20:52:11 +01:00
procedure TMVCController. OnBeforeAction( AContext: TWebContext; const AActionName: string ; var AHandled: Boolean ) ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
AHandled : = False ;
if ContentType. IsEmpty then
ContentType : = Config[ TMVCConfigKey. DefaultContentType] ;
{ Implement if need be. }
2013-10-30 00:48:23 +01:00
end ;
2018-08-08 17:11:45 +02:00
procedure TMVCController. PushDataSetToView( const aModelName: string ; const ADataSet: TDataSet) ;
2017-03-20 19:08:01 +01:00
begin
2018-08-08 17:11:45 +02:00
GetViewDataSets. Add( aModelName, ADataSet) ;
2017-03-20 19:08:01 +01:00
end ;
2018-08-08 17:11:45 +02:00
procedure TMVCController. PushObjectToView( const aModelName: string ; const AModel: TObject) ;
2017-03-20 19:08:01 +01:00
begin
2018-08-08 17:11:45 +02:00
GetViewModel. Add( aModelName, AModel) ;
2017-03-20 19:08:01 +01:00
end ;
2014-05-05 18:52:49 +02:00
procedure TMVCController. RaiseSessionExpired;
begin
2017-03-13 20:52:11 +01:00
raise EMVCSessionExpiredException. Create( 'Session expired.' ) ;
2014-05-05 18:52:49 +02:00
end ;
2018-10-14 18:23:20 +02:00
procedure TMVCRenderer. Redirect( const AUrl: string ) ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
GetContext. Response. RawWebResponse. SendRedirect( AUrl) ;
2013-10-30 00:48:23 +01:00
end ;
2019-05-09 20:53:52 +02:00
procedure TMVCRenderer. Render( const AObject: TObject; const AOwns: Boolean ;
const ASerializationAction: TMVCSerializationAction = nil ) ;
2015-12-02 04:14:15 +01:00
begin
2019-03-10 16:29:18 +01:00
Render( AObject, AOwns, stDefault, ASerializationAction) ;
2017-03-13 20:52:11 +01:00
end ;
2015-12-02 04:14:15 +01:00
2018-10-14 18:23:20 +02:00
procedure TMVCRenderer. Render( const AContent: string ) ;
2017-03-13 20:52:11 +01:00
var
2018-10-14 18:23:20 +02:00
lContentType: string ;
lOutEncoding: TEncoding;
2017-09-08 16:59:02 +02:00
lCharset: string ;
2017-03-13 20:52:11 +01:00
begin
2018-10-14 18:23:20 +02:00
SplitContentMediaTypeAndCharset( GetContentType, lContentType, lCharset) ;
2017-09-08 16:59:02 +02:00
if lCharset. IsEmpty then
lCharset : = TMVCConstants. DEFAULT_CONTENT_CHARSET;
2018-10-14 18:23:20 +02:00
if lContentType. IsEmpty then
lContentType : = TMVCConstants. DEFAULT_CONTENT_TYPE;
lContentType : = BuildContentType( lContentType, lCharset) ;
2017-09-08 16:59:02 +02:00
2018-10-14 18:23:20 +02:00
lOutEncoding : = TEncoding. GetEncoding( lCharset) ;
2017-03-13 20:52:11 +01:00
try
2017-09-08 16:59:02 +02:00
if SameText( 'UTF-8' , UpperCase( lCharset) ) then
2018-10-14 18:23:20 +02:00
GetContext. Response. SetContentStream( TStringStream. Create( AContent, TEncoding. UTF8) , lContentType)
2015-12-02 04:14:15 +01:00
else
begin
2018-10-14 18:23:20 +02:00
GetContext. Response. SetContentStream( TBytesStream. Create( TEncoding. Convert( TEncoding. Default , lOutEncoding,
TEncoding. Default . GetBytes( AContent) ) ) , lContentType) ;
2015-12-02 04:14:15 +01:00
end ;
2017-03-13 20:52:11 +01:00
finally
2018-10-14 18:23:20 +02:00
lOutEncoding. Free;
2015-12-02 04:14:15 +01:00
end ;
2015-10-18 16:35:50 +02:00
end ;
2019-03-08 09:33:41 +01:00
procedure TMVCRenderer. Render< T> ( const ACollection: TObjectList< T> ; const AOwns: Boolean ;
const ASerializationAction: TMVCSerializationAction< T> ) ;
2015-12-02 04:14:15 +01:00
begin
2019-03-08 09:33:41 +01:00
Self. Render< T> ( ACollection, AOwns, stDefault, ASerializationAction) ;
2013-10-30 00:48:23 +01:00
end ;
2019-09-01 20:35:19 +02:00
procedure TMVCRenderer. ResponseAccepted( const HREF: String ; const ID: String ; const Reason: String ) ;
begin
if HREF. IsEmpty then
begin
raise EMVCException. Create( 'Cannot send 202 without provide an HREF' ) ;
end ;
ResponseStatus( HTTP_STATUS. Accepted, Reason) ;
Render( TMVCAcceptedResponse. Create( HREF, ID) ) ;
end ;
procedure TMVCRenderer. ResponseCreated( const Location, Reason: String ) ;
2019-08-28 00:18:30 +02:00
begin
if not Location. IsEmpty then
begin
FContext. Response. CustomHeaders. AddPair( 'location' , Location) ;
end ;
2019-09-01 20:35:19 +02:00
ResponseStatus( HTTP_STATUS. Created, Reason) ;
end ;
procedure TMVCRenderer. ResponseNoContent( const Reason: String ) ;
begin
ResponseStatus( HTTP_STATUS. NoContent, Reason) ;
2019-08-28 00:18:30 +02:00
end ;
2018-10-14 18:23:20 +02:00
procedure TMVCRenderer. ResponseStatus( const AStatusCode: Integer ; const AReasonString: string ) ;
2015-12-02 04:14:15 +01:00
begin
2018-10-14 18:23:20 +02:00
SetStatusCode( AStatusCode) ;
2017-03-13 20:52:11 +01:00
GetContext. Response. ReasonString : = AReasonString;
end ;
2018-10-14 18:23:20 +02:00
function TMVCRenderer. ResponseStream: TStringBuilder;
2017-03-13 20:52:11 +01:00
begin
if not Assigned( FResponseStream) then
FResponseStream : = TStringBuilder. Create;
Result : = FResponseStream;
2015-10-18 16:35:50 +02:00
end ;
2018-10-14 18:23:20 +02:00
function TMVCRenderer. Serializer: IMVCSerializer;
2015-10-18 16:35:50 +02:00
begin
2018-10-14 18:23:20 +02:00
Result : = Serializer( GetContentType) ;
2015-10-18 16:35:50 +02:00
end ;
2018-10-14 18:23:20 +02:00
procedure TMVCRenderer. SendFile( const AFileName: string ) ;
2016-09-29 18:17:12 +02:00
begin
2018-10-14 18:23:20 +02:00
TMVCStaticContents. SendFile( AFileName, GetContentType, GetContext) ;
2016-09-29 18:17:12 +02:00
end ;
2018-10-14 18:23:20 +02:00
procedure TMVCRenderer. SendStream( const AStream: TStream; const AOwns: Boolean ; const ARewind: Boolean ) ;
2013-10-30 00:48:23 +01:00
var
2019-03-05 20:55:37 +01:00
lTemp: TStream;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
if ARewind then
2019-03-05 20:55:37 +01:00
begin
2017-03-13 20:52:11 +01:00
AStream. Position : = 0 ;
2019-03-05 20:55:37 +01:00
end ;
2017-02-08 18:29:52 +01:00
2019-03-05 20:55:37 +01:00
lTemp : = TMemoryStream. Create;
try
lTemp. CopyFrom( AStream, 0 ) ;
lTemp. Position : = 0 ;
except
lTemp. Free;
raise ;
end ;
if AOwns then
2017-03-13 20:52:11 +01:00
begin
2019-03-05 20:55:37 +01:00
AStream. Free;
end ;
2017-02-08 18:29:52 +01:00
2017-03-13 20:52:11 +01:00
GetContext. Response. RawWebResponse. Content : = EmptyStr;
2018-10-14 18:23:20 +02:00
GetContext. Response. RawWebResponse. ContentType : = GetContentType;
2019-03-05 20:55:37 +01:00
GetContext. Response. RawWebResponse. ContentStream : = lTemp;
2017-03-13 20:52:11 +01:00
GetContext. Response. RawWebResponse. FreeContentStream : = True ;
2013-10-30 00:48:23 +01:00
end ;
2019-03-16 17:20:28 +01:00
function TMVCRenderer. Serializer( const AContentType: string ; const ARaiseExceptionIfNotExists: Boolean ) : IMVCSerializer;
2017-09-23 15:03:07 +02:00
var
2019-03-06 12:00:56 +01:00
lContentMediaType: string ;
lContentCharSet: string ;
2014-04-15 17:03:47 +02:00
begin
2019-03-06 12:00:56 +01:00
SplitContentMediaTypeAndCharset( AContentType. ToLower, lContentMediaType, lContentCharSet) ;
2019-03-16 17:20:28 +01:00
if Engine. Serializers. ContainsKey( lContentMediaType) then
begin
Result : = Engine. Serializers. Items[ lContentMediaType] ;
end
else
begin
if ARaiseExceptionIfNotExists then
begin
raise EMVCException. CreateFmt( 'The serializer for %s could not be found.' , [ lContentMediaType] ) ;
end
else
begin
Result : = nil ;
end ;
end ;
2014-04-15 17:03:47 +02:00
end ;
2017-03-13 20:52:11 +01:00
function TMVCController. SessionAs< T> : T;
2016-04-22 09:46:21 +02:00
begin
2017-03-13 20:52:11 +01:00
Result : = Session as T;
2016-04-22 09:46:21 +02:00
end ;
2018-10-14 18:23:20 +02:00
procedure TMVCRenderer. SetContentType( const AValue: string ) ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
GetContext. Response. ContentType : = AValue;
2013-10-30 00:48:23 +01:00
end ;
2018-10-14 18:23:20 +02:00
procedure TMVCRenderer. SetStatusCode( const AValue: Integer ) ;
2017-01-05 12:44:34 +01:00
begin
2017-03-13 20:52:11 +01:00
GetContext. Response. StatusCode : = AValue;
2017-01-05 12:44:34 +01:00
end ;
2019-10-10 20:16:20 +02:00
function TMVCRenderer. ToMVCList( const AObject: TObject; AOwnsObject: Boolean ) : IMVCList;
begin
Result : = MVCFramework. DuckTyping. WrapAsList( AObject, AOwnsObject) ;
end ;
2018-01-29 17:30:53 +01:00
procedure TMVCController. SetViewData( const aModelName: string ; const Value: TObject) ;
2017-11-23 17:29:51 +01:00
begin
2018-08-08 17:11:45 +02:00
GetViewModel. Add( aModelName, Value) ;
2017-11-23 17:29:51 +01:00
end ;
2018-08-08 17:11:45 +02:00
procedure TMVCController. SetViewDataset( const aDataSetName: string ; const Value: TDataSet) ;
2017-11-23 17:29:51 +01:00
begin
GetViewDataSets. Add( aDataSetName, Value) ;
end ;
2019-05-09 20:53:52 +02:00
procedure TMVCRenderer. Render( const AObject: TObject; const AOwns: Boolean ; const AType: TMVCSerializationType;
const ASerializationAction: TMVCSerializationAction = nil ) ;
2017-01-05 12:44:34 +01:00
begin
2017-05-18 00:02:22 +02:00
try
2019-03-10 16:29:18 +01:00
Render( Serializer( GetContentType) . SerializeObject( AObject, AType, [ ] , ASerializationAction) ) ;
2017-05-18 00:02:22 +02:00
finally
if AOwns then
AObject. Free;
end ;
2017-01-05 12:44:34 +01:00
end ;
2018-10-14 18:23:20 +02:00
procedure TMVCRenderer. Render( const AStream: TStream; const AOwns: Boolean ) ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
SendStream( AStream, AOwns) ;
2013-10-30 00:48:23 +01:00
end ;
2019-02-24 20:43:06 +01:00
procedure TMVCRenderer. Render( const AErrorCode: Integer ; const AErrorMessage, AErrorClassName: string ;
const ADataObject: TObject) ;
2017-03-13 20:52:11 +01:00
var
R: TMVCErrorResponse;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
ResponseStatus( AErrorCode, AErrorMessage) ;
R : = TMVCErrorResponse. Create;
try
R. StatusCode : = AErrorCode;
if ( ( R. StatusCode div 1 0 0 ) = 2 ) then
R. ReasonString : = 'ok'
else
R. ReasonString : = 'error' ;
R. Message : = AErrorMessage;
R. Classname : = AErrorClassName;
2018-10-23 16:18:34 +02:00
R. Data : = ADataObject;
2017-03-13 20:52:11 +01:00
Render( R, False , stProperties) ;
finally
R. Free;
end ;
2013-10-30 00:48:23 +01:00
end ;
2018-10-14 18:23:20 +02:00
procedure TMVCRenderer. Render( const ADataSet: TDataSet; const AOwns: Boolean ; const AIgnoredFields: TMVCIgnoredList;
2019-05-09 20:53:52 +02:00
const ANameCase: TMVCNameCase; const ASerializationType: TMVCDatasetSerializationType;
const ASerializationAction: TMVCDatasetSerializationAction) ;
2017-03-29 14:49:35 +02:00
begin
if Assigned( ADataSet) then
begin
2017-03-30 17:00:04 +02:00
try
2019-05-09 20:53:52 +02:00
case ASerializationType of
dstSingleRecord:
begin
Render( Serializer( GetContentType) . SerializeDataSetRecord( ADataSet, AIgnoredFields, ANameCase,
ASerializationAction) )
end ;
dstAllRecords:
begin
Render( Serializer( GetContentType) . SerializeDataSet( ADataSet, AIgnoredFields, ANameCase,
ASerializationAction) )
end
2017-04-14 16:43:31 +02:00
else
2019-05-09 20:53:52 +02:00
begin
raise EMVCSerializationException. Create( 'Invalid dataset serialization type' ) ;
end ;
end ;
// if ASerializationType = dstSingleRecord then
// Render(Serializer(GetContentType).SerializeDataSetRecord(ADataSet, AIgnoredFields, ANameCase,
// ASerializationAction))
// else
// Render(Serializer(GetContentType).SerializeDataSet(ADataSet, AIgnoredFields, ANameCase, ASerializationAction))
2017-03-30 17:00:04 +02:00
finally
if AOwns then
ADataSet. Free;
end ;
2017-03-29 14:49:35 +02:00
end
else
raise EMVCException. Create( 'Can not render an empty dataset.' ) ;
end ;
2019-09-18 16:53:54 +02:00
procedure TMVCRenderer. Render( const AObject: IInterface; const ASerializationAction: TMVCSerializationAction) ;
begin
Render( TObject( AObject) , False , ASerializationAction) ;
end ;
2019-08-23 12:16:25 +02:00
procedure TMVCRenderer. Render( const AStatusCode: Integer ; AObject: TObject;
2019-08-28 00:18:30 +02:00
const AOwns: Boolean ; const ASerializationAction: TMVCSerializationAction) ;
2019-08-23 12:16:25 +02:00
begin
ResponseStatus( AStatusCode) ;
Render( AObject, AOwns, ASerializationAction) ;
end ;
2019-07-26 15:04:19 +02:00
procedure TMVCRenderer. Render( const AStatusCode: Integer ; const AObject: TObject;
2019-08-23 12:16:25 +02:00
const ASerializationAction: TMVCSerializationAction) ;
2019-07-26 15:04:19 +02:00
begin
ResponseStatus( AStatusCode) ;
Render( AObject, True , ASerializationAction) ;
end ;
2019-02-24 20:43:06 +01:00
procedure TMVCRenderer. Render< T> ( const ACollection: TObjectList< T> ; const AOwns: Boolean ;
2019-03-08 09:33:41 +01:00
const AType: TMVCSerializationType; const ASerializationAction: TMVCSerializationAction< T> ) ;
var
lSerializationAction: TMVCSerializationAction;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
if Assigned( ACollection) then
2015-12-02 04:14:15 +01:00
begin
2017-03-13 20:52:11 +01:00
try
2019-03-08 09:33:41 +01:00
if Assigned( ASerializationAction) then
begin
2019-05-09 20:53:52 +02:00
lSerializationAction : = procedure( const AObject: TObject; const Dict: IMVCLinks)
2019-03-08 09:33:41 +01:00
begin
ASerializationAction( T( AObject) , Dict) ;
end ;
end
else
begin
lSerializationAction : = nil ;
end ;
Render( Serializer( GetContentType) . SerializeCollection( ACollection, AType, [ ] , lSerializationAction) ) ;
2017-03-13 20:52:11 +01:00
finally
if AOwns then
ACollection. Free;
end ;
2015-12-02 04:14:15 +01:00
end
else
2017-03-13 20:52:11 +01:00
raise EMVCException. Create( 'Can not render an empty collection.' ) ;
2013-10-30 00:48:23 +01:00
end ;
2017-03-20 19:08:01 +01:00
function TMVCController. GetRenderedView( const AViewNames: TArray< string > ) : string ;
var
2018-01-29 17:30:53 +01:00
lView: TMVCBaseViewEngine;
lViewName: string ;
lStrStream: TStringStream;
2017-03-20 19:08:01 +01:00
begin
2018-01-29 17:30:53 +01:00
lStrStream : = TStringStream. Create( '' , TEncoding. UTF8) ;
2017-03-20 19:08:01 +01:00
try
2018-08-08 17:11:45 +02:00
lView : = FEngine. ViewEngineClass. Create( Engine, Context, ViewModelList, ViewDataSetList, ContentType) ;
2017-03-20 19:08:01 +01:00
try
2018-01-29 17:30:53 +01:00
for lViewName in AViewNames do
2017-03-20 19:08:01 +01:00
begin
2018-01-29 17:30:53 +01:00
lView. Execute( lViewName, lStrStream) ;
2017-03-20 19:08:01 +01:00
end ;
2018-01-29 17:30:53 +01:00
finally
lView. Free;
2017-03-20 19:08:01 +01:00
end ;
2018-01-29 17:30:53 +01:00
lStrStream. Position : = 0 ;
Result : = lStrStream. DataString;
2017-03-20 19:08:01 +01:00
finally
2018-01-29 17:30:53 +01:00
lStrStream. Free;
2017-03-20 19:08:01 +01:00
end ;
end ;
2019-03-08 09:33:41 +01:00
procedure TMVCRenderer. Render< T> ( const ACollection: TObjectList< T> ;
const ASerializationAction: TMVCSerializationAction< T> ) ;
2013-10-30 00:48:23 +01:00
begin
2019-03-08 09:33:41 +01:00
Self. Render< T> ( ACollection, True , ASerializationAction) ;
2013-10-30 00:48:23 +01:00
end ;
2018-10-14 18:23:20 +02:00
procedure TMVCRenderer. RenderResponseStream;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
Render( ResponseStream. ToString) ;
2013-10-30 00:48:23 +01:00
end ;
2018-10-14 18:23:20 +02:00
procedure TMVCRenderer. RenderSSE( const EventID, EventData: string ; EventName: string ; const Retry: Integer ) ;
2017-10-09 16:17:12 +02:00
begin
// setting up the correct SSE headers
2018-10-14 18:23:20 +02:00
SetContentType( 'text/event-stream' ) ;
GetContext. Response. SetCustomHeader( 'Cache-Control' , 'no-cache' ) ;
GetContext. Response. StatusCode : = HTTP_STATUS. OK;
2017-10-09 16:17:12 +02:00
// render the response using SSE compliant data format
// current event id (the client will resend this number at the next request)
ResponseStream. Append( Format( 'id: %s' #13 , [ EventID] ) ) ;
// The browser attempts to reconnect to the source roughly 3 seconds after
// each connection is closed. You can change that timeout by including a line
// beginning with "retry:", followed by the number of milliseconds to wait
// before trying to reconnect.
if Retry > - 1 then
begin
ResponseStream. Append( Format( 'retry: %d' #13 , [ Retry] ) ) ;
end ;
if not EventName. IsEmpty then
begin
ResponseStream. Append( Format( 'event: %s' #13 , [ EventName] ) ) ;
end ;
// actual message
ResponseStream. Append( 'data: ' + EventData + #13 #13 ) ;
// render all the stuff
RenderResponseStream;
end ;
2018-10-14 18:23:20 +02:00
procedure TMVCRenderer. Render( const ACollection: IMVCList) ;
2013-10-30 00:48:23 +01:00
begin
2017-03-13 20:52:11 +01:00
Render( ACollection, stDefault) ;
2013-10-30 00:48:23 +01:00
end ;
2018-10-14 18:23:20 +02:00
procedure TMVCRenderer. Render( const ACollection: IMVCList; const AType: TMVCSerializationType) ;
2013-11-08 23:10:25 +01:00
begin
2017-03-13 20:52:11 +01:00
if Assigned( ACollection) then
2018-10-14 18:23:20 +02:00
Render( Serializer( GetContentType) . SerializeCollection( TObject( ACollection) , AType) )
2017-03-13 20:52:11 +01:00
else
raise EMVCException. Create( 'Can not render an empty collection.' ) ;
2013-11-08 23:10:25 +01:00
end ;
2018-10-14 18:23:20 +02:00
procedure TMVCRenderer. Render( const ATextWriter: TTextWriter; const AOwns: Boolean ) ;
2013-11-08 23:10:25 +01:00
begin
2017-03-13 20:52:11 +01:00
if Assigned( ATextWriter) then
begin
try
Render( ATextWriter. ToString) ;
finally
if AOwns then
ATextWriter. Free;
end ;
end
else
raise EMVCException. Create( 'Can not render an empty textwriter.' ) ;
2013-11-08 23:10:25 +01:00
end ;
2018-10-14 18:23:20 +02:00
procedure TMVCRenderer. Render( const AException: Exception; AExceptionItems: TList< string > ; const AOwns: Boolean ) ;
2017-03-13 20:52:11 +01:00
var
S: string ;
R: TMVCErrorResponse;
I: TMVCErrorResponseItem;
2013-11-08 23:10:25 +01:00
begin
2017-03-13 20:52:11 +01:00
try
if AException is EMVCException then
2018-08-08 17:11:45 +02:00
ResponseStatus( EMVCException( AException) . HTTPErrorCode, AException. Message + ' [' + AException. Classname + ']' ) ;
2013-11-08 23:10:25 +01:00
2017-03-13 20:52:11 +01:00
if ( GetContext. Response. StatusCode = HTTP_STATUS. OK) then
2018-08-08 17:11:45 +02:00
ResponseStatus( HTTP_STATUS. InternalServerError, AException. Message + ' [' + AException. Classname + ']' ) ;
2015-04-01 17:01:23 +02:00
2017-03-13 20:52:11 +01:00
if ( not GetContext. Request. IsAjax) and ( GetContext. Request. ClientPrefer( TMVCMediaType. TEXT_HTML) ) then
begin
2018-10-14 18:23:20 +02:00
SetContentType( TMVCMediaType. TEXT_HTML) ;
2017-03-13 20:52:11 +01:00
ResponseStream. Clear;
2019-02-24 20:43:06 +01:00
ResponseStream. Append
2019-11-06 20:42:17 +01:00
( '<html><head><style>pre { padding: 15px; color: #000000; background-color: #e0e0e0; }</style></head><body>' )
2019-02-24 20:43:06 +01:00
. Append( '<h1>' + Config[ TMVCConfigKey. ServerName] + ': Error Raised</h1>' )
. AppendFormat( '<pre>HTTP Return Code: %d' + sLineBreak, [ GetContext. Response. StatusCode] )
. AppendFormat( 'HTTP Reason Text: "%s"</pre>' , [ GetContext. Response. ReasonString] ) . Append( '<h3><pre>' )
. AppendFormat( 'Exception Class Name : %s' + sLineBreak, [ AException. Classname] )
2018-08-08 17:11:45 +02:00
. AppendFormat( 'Exception Message : %s' + sLineBreak, [ AException. Message ] ) . Append( '</pre></h3>' ) ;
2017-03-13 20:52:11 +01:00
if Assigned( AExceptionItems) and ( AExceptionItems. Count > 0 ) then
begin
ResponseStream. Append( '<h2><pre>' ) ;
for S in AExceptionItems do
ResponseStream. AppendLine( '- ' + S) ;
ResponseStream. Append( '</pre><h2>' ) ;
end
else
2019-02-24 20:43:06 +01:00
ResponseStream. AppendLine( '<pre>No other information available</pre>' ) ;
2017-03-13 20:52:11 +01:00
ResponseStream. Append( '</body></html>' ) ;
RenderResponseStream;
end
else
begin
R : = TMVCErrorResponse. Create;
try
R. StatusCode : = GetContext. Response. StatusCode;
R. ReasonString : = 'error' ;
R. Message : = AException. Message ;
2018-08-08 17:11:45 +02:00
R. Classname : = AException. Classname;
2017-03-13 20:52:11 +01:00
if Assigned( AExceptionItems) and ( AExceptionItems. Count > 0 ) then
begin
for S in AExceptionItems do
begin
I : = TMVCErrorResponseItem. Create;
I. Message : = S;
R. Items. Add( I) ;
end ;
end ;
2019-03-16 17:20:28 +01:00
if Serializer( GetContentType, False ) = nil then
begin
GetContext. Response. ContentType : = GetConfig[ TMVCConfigKey. DefaultContentType] ;
end ;
2017-03-13 20:52:11 +01:00
Render( R, False ) ;
finally
R. Free;
end ;
end ;
finally
if AOwns then
AExceptionItems. Free;
end ;
2015-04-01 17:01:23 +02:00
end ;
2018-10-23 16:18:34 +02:00
procedure TMVCRenderer. Render( const AResponse: TMVCResponse; const AOwns: Boolean ) ;
2015-04-01 17:01:23 +02:00
begin
2018-10-23 16:18:34 +02:00
if Assigned( AResponse) then
2017-03-13 20:52:11 +01:00
begin
try
2018-10-23 16:18:34 +02:00
GetContext. Response. StatusCode : = AResponse. StatusCode;
Render( AResponse, False , stProperties) ;
2017-03-13 20:52:11 +01:00
finally
if AOwns then
2018-10-23 16:18:34 +02:00
AResponse. Free;
2017-03-13 20:52:11 +01:00
end ;
end
else
2018-10-23 16:18:34 +02:00
raise EMVCException. Create( 'Cannot render an empty response object.' ) ;
2015-04-01 17:01:23 +02:00
end ;
2019-03-10 16:29:18 +01:00
procedure TMVCRenderer. Render( const ADataSet: TDataSet; const ASerializationAction: TMVCDatasetSerializationAction) ;
2017-04-29 23:56:56 +02:00
begin
2019-03-10 16:29:18 +01:00
Render( ADataSet, True , ASerializationAction) ;
2017-04-29 23:56:56 +02:00
end ;
2019-05-09 20:53:52 +02:00
procedure TMVCRenderer. Render( const ADataSet: TDataSet; const AOwns: Boolean ;
const ASerializationAction: TMVCDatasetSerializationAction) ;
2015-04-01 17:01:23 +02:00
begin
2019-03-10 16:29:18 +01:00
Render( ADataSet, AOwns, dstAllRecords, ASerializationAction) ;
2015-04-01 17:01:23 +02:00
end ;
2019-03-10 16:29:18 +01:00
procedure TMVCRenderer. Render( const AObject: TObject; const ASerializationAction: TMVCSerializationAction = nil ) ;
2015-04-01 17:01:23 +02:00
begin
2019-03-10 16:29:18 +01:00
Render( AObject, True , ASerializationAction) ;
2015-04-01 17:01:23 +02:00
end ;
2019-03-10 16:29:18 +01:00
procedure TMVCRenderer. Render(
const ADataSet: TDataSet;
2019-05-09 20:53:52 +02:00
const AOwns: Boolean ;
const AIgnoredFields: TMVCIgnoredList;
const ASerializationType: TMVCDatasetSerializationType;
const ASerializationAction: TMVCDatasetSerializationAction) ;
2015-12-02 04:14:15 +01:00
begin
2019-03-10 16:29:18 +01:00
Render( ADataSet, AOwns, AIgnoredFields, ncLowerCase, ASerializationType, ASerializationAction) ;
2015-04-01 17:01:23 +02:00
end ;
2019-03-10 16:29:18 +01:00
procedure TMVCRenderer. Render(
const ADataSet: TDataSet;
2019-05-09 20:53:52 +02:00
const AOwns: Boolean ;
const ASerializationType: TMVCDatasetSerializationType;
const ASerializationAction: TMVCDatasetSerializationAction) ;
2015-04-01 17:01:23 +02:00
begin
2019-03-10 16:29:18 +01:00
Render( ADataSet, AOwns, [ ] , ASerializationType, ASerializationAction) ;
2015-04-01 17:01:23 +02:00
end ;
2018-10-23 16:18:34 +02:00
constructor TMVCResponse. Create;
begin
inherited Create;
end ;
2015-04-01 17:01:23 +02:00
2017-03-13 20:52:11 +01:00
constructor TMVCErrorResponse. Create;
2015-04-01 17:01:23 +02:00
begin
2017-03-13 20:52:11 +01:00
inherited Create;
2018-10-23 16:18:34 +02:00
FItems : = TObjectList< TMVCErrorResponseItem> . Create( True ) ;
2015-04-01 17:01:23 +02:00
end ;
2018-10-23 16:18:34 +02:00
constructor TMVCResponse. Create( AStatusCode: Integer ; AReasonString, AMessage: string ) ;
2017-05-09 23:13:51 +02:00
begin
Create;
StatusCode : = AStatusCode;
ReasonString : = AReasonString;
2017-05-25 16:57:49 +02:00
message : = AMessage;
2017-05-09 23:13:51 +02:00
end ;
2017-03-13 20:52:11 +01:00
destructor TMVCErrorResponse. Destroy;
2016-02-29 13:48:36 +01:00
begin
2017-03-13 20:52:11 +01:00
FItems. Free;
inherited Destroy;
2016-02-29 13:48:36 +01:00
end ;
2017-04-14 16:43:31 +02:00
{ TMVCBaseView }
2019-02-24 20:43:06 +01:00
constructor TMVCBaseViewEngine. Create( const AEngine: TMVCEngine; const AWebContext: TWebContext;
const AViewModel: TMVCViewDataObject; const AViewDataSets: TObjectDictionary< string , TDataSet> ;
const AContentType: string ) ;
2017-04-14 16:43:31 +02:00
begin
inherited Create;
Engine : = AEngine;
FWebContext : = AWebContext;
FViewModel : = AViewModel;
FViewDataSets : = AViewDataSets;
FContentType : = AContentType;
FOutput : = EmptyStr;
end ;
destructor TMVCBaseViewEngine. Destroy;
begin
inherited Destroy;
end ;
function TMVCBaseViewEngine. GetRealFileName( const AViewName: string ) : string ;
var
FileName: string ;
F: string ;
DefaultViewFileExtension: string ;
begin
DefaultViewFileExtension : = Config[ TMVCConfigKey. DefaultViewFileExtension] ;
2018-08-08 17:11:45 +02:00
FileName : = StringReplace( AViewName, '/' , '\' , [ rfReplaceAll] ) ;
2017-04-14 16:43:31 +02:00
if ( FileName = '\' ) then
FileName : = '\index.' + DefaultViewFileExtension
else
FileName : = FileName + '.' + DefaultViewFileExtension;
if DirectoryExists( Config[ TMVCConfigKey. ViewPath] ) then
F : = ExpandFileName( IncludeTrailingPathDelimiter( Config. Value[ TMVCConfigKey. ViewPath] ) + FileName)
else
2019-02-24 20:43:06 +01:00
F : = ExpandFileName( IncludeTrailingPathDelimiter( GetApplicationFileNamePath + Config. Value[ TMVCConfigKey. ViewPath] )
+ FileName) ;
2017-04-14 16:43:31 +02:00
if not TFile. Exists( F) then
2019-02-24 20:43:06 +01:00
FileName : = ExpandFileName( IncludeTrailingPathDelimiter( GetApplicationFileNamePath +
Config. Value[ TMVCConfigKey. DocumentRoot] ) + FileName)
2017-04-14 16:43:31 +02:00
else
FileName : = F;
if FileExists( FileName) then
Result : = FileName
else
Result : = EmptyStr;
end ;
2019-09-25 16:41:11 +02:00
{ MVCIntegerAttribute }
constructor MVCIntegerAttribute. Create( const AValue: Int64 ) ;
begin
FValue : = AValue;
end ;
{ MVCPathParamAttribute }
constructor MVCPathParamAttribute. Create( AType: TSwagTypeParameter; APattern, AFormat: string ) ;
begin
FType : = AType;
FValue : = APattern;
FFormat : = AFormat;
end ;
{ MVCParamAttribute }
constructor MVCParamAttribute. Create( name : string ;
location: TSwagRequestParameterInLocation; AType: TSwagTypeParameter;
APattern, AFormat: string ) ;
begin
fName : = name ;
FLocation : = location;
FType : = AType;
FPattern : = APattern;
FFormat : = AFormat;
end ;
constructor MVCParamAttribute. Create( name : string ;
location: TSwagRequestParameterInLocation; AType: TClass; APattern,
AFormat: string ) ;
begin
FName : = name ;
FLocation : = location;
FClassType : = AType;
FPattern : = APattern;
FFormat : = AFormat;
end ;
2013-10-30 00:48:23 +01:00
initialization
_IsShuttingDown : = 0 ;
2017-06-02 00:10:31 +02:00
_MVCGlobalActionParamsCache : = TMVCStringObjectDictionary< TMVCActionParamCacheItem> . Create;
finalization
FreeAndNil( _MVCGlobalActionParamsCache) ;
2013-10-30 00:48:23 +01:00
end .