DelphiMVCFrameWork 源码分析(一)
Delphi 基础Web Service Application 见：
Delphi Web Server 流程分析_看那山瞧那水的博客-CSDN博客
DataSnap的见：
Delphi DataSnap 流程分析(一)_看那山瞧那水的博客-CSDN博客
Delphi DataSnap 流程分析(二)_看那山瞧那水的博客-CSDN博客
DelphiMVCFrameWork 是个开源的框架，Star 已经1.1K+了，在Pascal里算比较高了。
https://github.com/danieleteti/delphimvcframework
DelphiMVCFrameWork框架的网络通信也是基于Delphi WebBroker技术(早期版本是基于IOComp)，使用REST架构。正如框架名称，采用服务端的MVC架构，具体是采用了路由器(Router)，控制器(Controler)，中间件(Middleware)等结构，这样松耦合的结构，更有利于项目的开发和构建，也更有利用项目的扩展和维护。同时，也可以采用同个作者开源的ORM框架，MVCActivedWork，这样可以更简便开发Database运用。
DelphiMVCFrameWork框架如何挂钩Delphi的WebService？
“Delphi Web Server 流程分析”里，当调用TCustomWebDispatcher.DispatchAction()，
提到：
" Result := DoBeforeDispatch(Request, Response) or Response.Sent;
注意这一行代码！！！这里可以让我们有机会插入请求处理过程及结果。嗯，我们可以在这里"截胡"。"
function TCustomWebDispatcher.DoBeforeDispatch(Request: TWebRequest; Response: TWebResponse): Boolean;
beginResult := False;if Assigned(FBeforeDispatch) thenFBeforeDispatch(Self, Request, Response, Result);
end;
DoBeforeDispatch()方法就是执行TWebModule的OnBeforeDispatch事件。
DelphiMVCFrameWork框架就是通过OnBeforeDispatch事件开始"截胡"。这是通过框架的基础核心类TMVCEngine来实现的：
constructor TMVCEngine.Create(const AWebModule: TWebModule; const AConfigAction: TProc<TMVCConfig>;const ACustomLogger: ILogWriter);
begininherited Create(AWebModule);FWebModule := AWebModule;FixUpWebModule;FConfig := TMVCConfig.Create;FSerializers := TDictionary<string, IMVCSerializer>.Create;FMiddlewares := TList<IMVCMiddleware>.Create;FControllers := TObjectList<TMVCControllerDelegate>.Create(True);FApplicationSession := nil;FSavedOnBeforeDispatch := nil;WebRequestHandler.CacheConnections := True;WebRequestHandler.MaxConnections := 4096;MVCFramework.Logger.SetDefaultLogger(ACustomLogger);ConfigDefaultValues;if Assigned(AConfigAction) thenbeginLogEnterMethod('Custom configuration method');AConfigAction(FConfig);LogExitMethod('Custom configuration method');end;FConfig.Freeze;SaveCacheConfigValues;RegisterDefaultsSerializers;LoadSystemControllers;
end;procedure TMVCEngine.FixUpWebModule;
beginFSavedOnBeforeDispatch := FWebModule.BeforeDispatch;FWebModule.BeforeDispatch := OnBeforeDispatch;
end;
TMVCEngine创建的时候传入TWebModule实例，然后挂钩OnBeforeDispatch事件，FSavedOnBeforeDispatch 先保存已有的事件，先处理TMVCEngine，处理完后再恢复执行(如果有)。
procedure TMVCEngine.OnBeforeDispatch(ASender: TObject; ARequest: TWebRequest;AResponse: TWebResponse; var AHandled: Boolean);
beginAHandled := False;{ there is a bug in WebBroker Linux on 10.2.1 tokyo }// if Assigned(FSavedOnBeforeDispatch) then// begin// FSavedOnBeforeDispatch(ASender, ARequest, AResponse, AHandled);// end;if IsShuttingDown thenbeginAResponse.StatusCode := http_status.ServiceUnavailable;AResponse.ContentType := TMVCMediaType.TEXT_PLAIN;AResponse.Content := 'Server is shutting down';AHandled := True;end;if not AHandled thenbegintryAHandled := ExecuteAction(ASender, ARequest, AResponse);if not AHandled thenbeginAResponse.ContentStream := nil;end;excepton E: Exception dobeginLog.ErrorFmt('[%s] %s', [E.Classname, E.Message], LOGGERPRO_TAG);AResponse.StatusCode := http_status.InternalServerError; // default is Internal Server Errorif E is EMVCException thenbeginAResponse.StatusCode := (E as EMVCException).HTTPErrorCode;end;AResponse.Content := E.Message;AResponse.SendResponse;AHandled := True;end;end;end;
end;
IsShuttingDown使用同步锁实现判断Server是否下线：
function IsShuttingDown: Boolean;
begin
Result := TInterlocked.Read(gIsShuttingDown) = 1
end;
先插入2张图，说明Router、Controler、Middleware的动作系列：
MVCEngine,Router,Controler系列图
MVCEngine,Router,Controler,MiddleWare系列图
回头看代码，TMVCEngine.ExecuteAction():
function TMVCEngine.ExecuteAction(const ASender: TObject; const ARequest: TWebRequest;const AResponse: TWebResponse): Boolean;
varlParamsTable: TMVCRequestParamsTable;lContext: TWebContext;lRouter: TMVCRouter;lHandled: Boolean;lResponseContentMediaType: string;lResponseContentCharset: string;lRouterMethodToCallName: string;lRouterControllerClazzQualifiedClassName: string;lSelectedController: TMVCController;lActionFormalParams: TArray<TRttiParameter>;lActualParams: TArray<TValue>;lBodyParameter: TObject;
beginResult := False;if ARequest.ContentLength > FConfigCache_MaxRequestSize thenbeginraise EMVCException.CreateFmt(http_status.RequestEntityTooLarge,'Request size exceeded the max allowed size [%d KiB] (1)',[(FConfigCache_MaxRequestSize div 1024)]);end;{$IF Defined(BERLINORBETTER)}ARequest.ReadTotalContent;// Double check for malicious content-length headerif ARequest.ContentLength > FConfigCache_MaxRequestSize thenbeginraise EMVCException.CreateFmt(http_status.RequestEntityTooLarge,'Request size exceeded the max allowed size [%d KiB] (2)',[(FConfigCache_MaxRequestSize div 1024)]);end;
{$ENDIF}lParamsTable := TMVCRequestParamsTable.Create;trylContext := TWebContext.Create(ARequest, AResponse, FConfig, FSerializers);tryDefineDefaultResponseHeaders(lContext);DoWebContextCreateEvent(lContext);lHandled := False;lRouter := TMVCRouter.Create(FConfig, gMVCGlobalActionParamsCache);try // finallylSelectedController := nil;try // only for lSelectedControllertry // global exception handlerExecuteBeforeRoutingMiddleware(lContext, lHandled);if not lHandled thenbeginif lRouter.ExecuteRouting(ARequest.PathInfo,lContext.Request.GetOverwrittenHTTPMethod { lContext.Request.HTTPMethod } ,ARequest.ContentType, ARequest.Accept, FControllers,FConfigCache_DefaultContentType, FConfigCache_DefaultContentCharset,FConfigCache_PathPrefix, lParamsTable, lResponseContentMediaType,lResponseContentCharset) thenbegintryif Assigned(lRouter.ControllerCreateAction) thenlSelectedController := lRouter.ControllerCreateAction()elselSelectedController := lRouter.ControllerClazz.Create;excepton Ex: Exception dobeginLog.ErrorFmt('[%s] %s [PathInfo "%s"] (Custom message: "%s")',[Ex.Classname, Ex.Message, GetRequestShortDescription(ARequest), 'Cannot create controller'], LOGGERPRO_TAG);raise EMVCException.Create(http_status.InternalServerError,'Cannot create controller');end;end;lRouterMethodToCallName := lRouter.MethodToCall.Name;lRouterControllerClazzQualifiedClassName := lRouter.ControllerClazz.QualifiedClassName;MVCFramework.Logger.InitThreadVars;lContext.fActionQualifiedName := lRouterControllerClazzQualifiedClassName + '.'+ lRouterMethodToCallName;lSelectedController.Engine := Self;lSelectedController.Context := lContext;lSelectedController.ApplicationSession := FApplicationSession;lContext.ParamsTable := lParamsTable;ExecuteBeforeControllerActionMiddleware(lContext,lRouterControllerClazzQualifiedClassName,lRouterMethodToCallName,lHandled);if lHandled thenExit(True);lBodyParameter := nil;lSelectedController.MVCControllerAfterCreate;trylHandled := False;lSelectedController.ContentType := BuildContentType(lResponseContentMediaType,lResponseContentCharset);lActionFormalParams := lRouter.MethodToCall.GetParameters;if (Length(lActionFormalParams) = 0) thenSetLength(lActualParams, 0)else if (Length(lActionFormalParams) = 1) and(SameText(lActionFormalParams[0].ParamType.QualifiedName,'MVCFramework.TWebContext')) thenbeginSetLength(lActualParams, 1);lActualParams[0] := lContext;endelsebeginFillActualParamsForAction(lSelectedController, lContext, lActionFormalParams,lRouterMethodToCallName, lActualParams, lBodyParameter);end;lSelectedController.OnBeforeAction(lContext, lRouterMethodToCallName, lHandled);if not lHandled thenbegintrylRouter.MethodToCall.Invoke(lSelectedController, lActualParams);finallylSelectedController.OnAfterAction(lContext, lRouterMethodToCallName);end;end;finallytrylBodyParameter.Free;excepton E: Exception dobeginLogE(Format('Cannot free Body object: [CLS: %s][MSG: %s]',[E.Classname, E.Message]));end;end;lSelectedController.MVCControllerBeforeDestroy;end;ExecuteAfterControllerActionMiddleware(lContext,lRouterControllerClazzQualifiedClassName,lRouterMethodToCallName,lHandled);lContext.Response.ContentType := lSelectedController.ContentType;fOnRouterLog(lRouter, rlsRouteFound, lContext);endelse // execute-routingbeginif Config[TMVCConfigKey.AllowUnhandledAction] = 'false' thenbeginlContext.Response.StatusCode := http_status.NotFound;lContext.Response.ReasonString := 'Not Found';fOnRouterLog(lRouter, rlsRouteNotFound, lContext);raise EMVCException.Create(lContext.Response.ReasonString,lContext.Request.HTTPMethodAsString + ' ' + lContext.Request.PathInfo, 0,http_status.NotFound);endelsebeginlContext.Response.FlushOnDestroy := False;end;end; // end-execute-routingend; // if not handled by beforeroutingexcepton ESess: EMVCSessionExpiredException dobeginif not CustomExceptionHandling(ESess, lSelectedController, lContext) thenbeginLog.ErrorFmt('[%s] %s [PathInfo "%s"] (Custom message: "%s")',[ESess.Classname, ESess.Message, GetRequestShortDescription(ARequest),ESess.DetailedMessage], LOGGERPRO_TAG);lContext.SessionStop;lSelectedController.ResponseStatus(ESess.HTTPErrorCode);lSelectedController.Render(ESess);end;end;on E: EMVCException dobeginif not CustomExceptionHandling(E, lSelectedController, lContext) thenbeginLog.ErrorFmt('[%s] %s [PathInfo "%s"] (Custom message: "%s")',[E.Classname, E.Message, GetRequestShortDescription(ARequest), E.DetailedMessage], LOGGERPRO_TAG);if Assigned(lSelectedController) thenbeginlSelectedController.ResponseStatus(E.HTTPErrorCode);lSelectedController.Render(E);endelsebeginSendRawHTTPStatus(lContext, E.HTTPErrorCode,Format('[%s] %s', [E.Classname, E.Message]), E.Classname);end;end;end;on EIO: EInvalidOp dobeginif not CustomExceptionHandling(EIO, lSelectedController, lContext) thenbeginLog.ErrorFmt('[%s] %s [PathInfo "%s"] (Custom message: "%s")',[EIO.Classname, EIO.Message, GetRequestShortDescription(ARequest), 'Invalid Op'], LOGGERPRO_TAG);if Assigned(lSelectedController) thenbeginlSelectedController.ResponseStatus(http_status.InternalServerError);lSelectedController.Render(EIO);endelsebeginSendRawHTTPStatus(lContext, http_status.InternalServerError,Format('[%s] %s', [EIO.Classname, EIO.Message]), EIO.Classname);end;end;end;on Ex: Exception dobeginif not CustomExceptionHandling(Ex, lSelectedController, lContext) thenbeginLog.ErrorFmt('[%s] %s [PathInfo "%s"] (Custom message: "%s")',[Ex.Classname, Ex.Message, GetRequestShortDescription(ARequest), 'Global Action Exception Handler'], LOGGERPRO_TAG);if Assigned(lSelectedController) thenbeginlSelectedController.ResponseStatus(http_status.InternalServerError);lSelectedController.Render(Ex);endelsebeginSendRawHTTPStatus(lContext, http_status.InternalServerError,Format('[%s] %s', [Ex.Classname, Ex.Message]), Ex.Classname);end;end;end;end;tryExecuteAfterRoutingMiddleware(lContext, lHandled);excepton Ex: Exception dobeginif not CustomExceptionHandling(Ex, lSelectedController, lContext) thenbeginLog.ErrorFmt('[%s] %s [PathInfo "%s"] (Custom message: "%s")',[Ex.Classname, Ex.Message, GetRequestShortDescription(ARequest), 'After Routing Exception Handler'], LOGGERPRO_TAG);if Assigned(lSelectedController) thenbegin{ middlewares *must* not raise unhandled exceptions }lSelectedController.ResponseStatus(http_status.InternalServerError);lSelectedController.Render(Ex);endelsebeginSendRawHTTPStatus(lContext, http_status.InternalServerError,Format('[%s] %s', [Ex.Classname, Ex.Message]), Ex.Classname);end;end;end;end;finallyFreeAndNil(lSelectedController);end;finallylRouter.Free;end;finallyDoWebContextDestroyEvent(lContext);lContext.Free;end;finallylParamsTable.Free;end;
end;
首先判断请求内容的长度是否超长，FConfigCache_MaxRequestSize是配置常量，默认5MB（5*1024*1024, MVCFramework.Commons.pas 单元的 TMVCConstants结构)，
lParamsTable: TMVCRequestParamsTable，只是TDictionary<string,string>别名。
MVCFrameWork框架有自己的一套 Context，Request，Response，均定义在MVCFramework.pas单元，TMVCWebRequest包装了系统的TWebRequest，TMVCWebResponse包装了系统的TWebResponse，TWebContext是重新定义的。
DefineDefaultResponseHeaders()定制默认的Header。
lRouter := TMVCRouter.Create(FConfig, gMVCGlobalActionParamsCache);
创建路由器，FConfig是Web配置，gMVCGlobalActionParamsCache参数是个全局线程安全对象，用于缓存动作参数列表。
ExecuteBeforeRoutingMiddleware(lContext, lHandled);
执行中间件的OnBeforeRouting()，然后开始执行路由lRouter.ExecuteRouting():
function TMVCRouter.ExecuteRouting(const ARequestPathInfo: string;const ARequestMethodType: TMVCHTTPMethodType;const ARequestContentType, ARequestAccept: string;const AControllers: TObjectList<TMVCControllerDelegate>;const ADefaultContentType: string;const ADefaultContentCharset: string;const APathPrefix: string;var ARequestParams: TMVCRequestParamsTable;out AResponseContentMediaType: string;out AResponseContentCharset: string): Boolean;
varLRequestPathInfo: string;LRequestAccept: string;LRequestContentType: string;LControllerMappedPath: string;LControllerMappedPaths: TStringList;LControllerDelegate: TMVCControllerDelegate;LAttributes: TArray<TCustomAttribute>;LAtt: TCustomAttribute;LRttiType: TRttiType;LMethods: TArray<TRttiMethod>;LMethod: TRttiMethod;LMethodPath: string;LProduceAttribute: MVCProducesAttribute;lURLSegment: string;LItem: String;// JUST FOR DEBUG// lMethodCompatible: Boolean;// lContentTypeCompatible: Boolean;// lAcceptCompatible: Boolean;
beginResult := False;FMethodToCall := nil;FControllerClazz := nil;FControllerCreateAction := nil;LRequestAccept := ARequestAccept;LRequestContentType := ARequestContentType;LRequestPathInfo := ARequestPathInfo;if (Trim(LRequestPathInfo) = EmptyStr) thenLRequestPathInfo := '/'elsebeginif not LRequestPathInfo.StartsWith('/') thenbeginLRequestPathInfo := '/' + LRequestPathInfo;end;end;//LRequestPathInfo := TNetEncoding.URL.EncodePath(LRequestPathInfo, [Ord('$')]);LRequestPathInfo := TIdURI.PathEncode(Trim(LRequestPathInfo)); //regression introduced in fix for issue 492TMonitor.Enter(gLock);try//LControllerMappedPaths := TArray<string>.Create();LControllerMappedPaths := TStringList.Create;tryfor LControllerDelegate in AControllers dobeginLControllerMappedPaths.Clear;SetLength(LAttributes, 0);LRttiType := FRttiContext.GetType(LControllerDelegate.Clazz.ClassInfo);lURLSegment := LControllerDelegate.URLSegment;if lURLSegment.IsEmpty thenbeginLAttributes := LRttiType.GetAttributes;if (LAttributes = nil) thenContinue;//LControllerMappedPaths := GetControllerMappedPath(LRttiType.Name, LAttributes);FillControllerMappedPaths(LRttiType.Name, LAttributes, LControllerMappedPaths);endelsebeginLControllerMappedPaths.Add(lURLSegment);end;for LItem in LControllerMappedPaths dobeginLControllerMappedPath := LItem;if (LControllerMappedPath = '/') thenbeginLControllerMappedPath := '';end;{$IF defined(TOKYOORBETTER)}if not LRequestPathInfo.StartsWith(APathPrefix + LControllerMappedPath, True) then{$ELSE}if not TMVCStringHelper.StartsWith(APathPrefix + LControllerMappedPath, LRequestPathInfo, True) then{$ENDIF}beginContinue;end;
// end;// if (not LControllerMappedPathFound) then
// continue;LMethods := LRttiType.GetMethods; { do not use GetDeclaredMethods because JSON-RPC rely on this!! }for LMethod in LMethods dobeginif LMethod.Visibility <> mvPublic then // 2020-08-08Continue;if (LMethod.MethodKind <> mkProcedure) { or LMethod.IsClassMethod } thenContinue;LAttributes := LMethod.GetAttributes;if Length(LAttributes) = 0 thenContinue;for LAtt in LAttributes dobeginif LAtt is MVCPathAttribute thenbegin// THIS BLOCK IS HERE JUST FOR DEBUG// if LMethod.Name.Contains('GetProject') then// begin// lMethodCompatible := True; //debug here// end;// lMethodCompatible := IsHTTPMethodCompatible(ARequestMethodType, LAttributes);// lContentTypeCompatible := IsHTTPContentTypeCompatible(ARequestMethodType, LRequestContentType, LAttributes);// lAcceptCompatible := IsHTTPAcceptCompatible(ARequestMethodType, LRequestAccept, LAttributes);if IsHTTPMethodCompatible(ARequestMethodType, LAttributes) andIsHTTPContentTypeCompatible(ARequestMethodType, LRequestContentType, LAttributes) andIsHTTPAcceptCompatible(ARequestMethodType, LRequestAccept, LAttributes) thenbeginLMethodPath := MVCPathAttribute(LAtt).Path;if IsCompatiblePath(APathPrefix + LControllerMappedPath + LMethodPath,LRequestPathInfo, ARequestParams) thenbeginFMethodToCall := LMethod;FControllerClazz := LControllerDelegate.Clazz;FControllerCreateAction := LControllerDelegate.CreateAction;LProduceAttribute := GetAttribute<MVCProducesAttribute>(LAttributes);if LProduceAttribute <> nil thenbeginAResponseContentMediaType := LProduceAttribute.Value;AResponseContentCharset := LProduceAttribute.Charset;endelsebeginAResponseContentMediaType := ADefaultContentType;AResponseContentCharset := ADefaultContentCharset;end;Exit(True);end;end;end; // if MVCPathAttributeend; // for in Attributesend; // for in Methodsend;end; // for in ControllersfinallyLControllerMappedPaths.Free;end;finallyTMonitor.Exit(gLock);end;
end;
对URL路由，URL参数等进行解析，找到当前执行的Controler及要执行的方法(Action)及参数等，
执行方法并返回客户端。
将结果返回客户端，有个专门的通用方法Render()，
TMVCRenderer = class(TMVCBase)
TMVCController = class(TMVCRenderer)
TMVCRenderer类里定义了各种各样的Render()方法，TMVCController是TMVCRenderer的子类，可以方便调用。
看几个Render()方法定义:
procedure Render(const AContent: string); overload;
procedure Render(const AStatusCode: Integer; const AContent: string); overload;
procedure Render(const AStatusCode: Integer); overload;
.......................
procedure Render(const AObject: TObject;
const ASerializationAction: TMVCSerializationAction = nil;
const AIgnoredFields: TMVCIgnoredList = nil); overload;
procedure Render(const AObject: TObject; const AOwns: Boolean;
const ASerializationAction: TMVCSerializationAction = nil;
const AIgnoredFields: TMVCIgnoredList = nil); overload;
...............
这样的Render()方法有差不多30个...............
这里只是粗略介绍了DelphiMVCFrameWork框架，没有深入进去，后续再详细分析，比如认证授权、ORM等部分。