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;
begin
  Result := False;
  if Assigned(FBeforeDispatch) then
    FBeforeDispatch(Self, Request, Response, Result);
end;

DoBeforeDispatch()方法就是执行TWebModule的OnBeforeDispatch事件。

DelphiMVCFrameWork框架就是通过OnBeforeDispatch事件开始"截胡"。这是通过框架的基础核心类TMVCEngine来实现的：

constructor TMVCEngine.Create(const AWebModule: TWebModule; const AConfigAction: TProc<TMVCConfig>;
  const ACustomLogger: ILogWriter);
begin
  inherited 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) then
  begin
    LogEnterMethod('Custom configuration method');
    AConfigAction(FConfig);
    LogExitMethod('Custom configuration method');
  end;
  FConfig.Freeze;
  SaveCacheConfigValues;
  RegisterDefaultsSerializers;
  LoadSystemControllers;
end;

procedure TMVCEngine.FixUpWebModule;
begin
  FSavedOnBeforeDispatch := FWebModule.BeforeDispatch;
  FWebModule.BeforeDispatch := OnBeforeDispatch;
end;

TMVCEngine创建的时候传入TWebModule实例，然后挂钩OnBeforeDispatch事件，FSavedOnBeforeDispatch 先保存已有的事件，先处理TMVCEngine，处理完后再恢复执行(如果有)。


procedure TMVCEngine.OnBeforeDispatch(ASender: TObject; ARequest: TWebRequest;
  AResponse: TWebResponse; var AHandled: Boolean);
begin
  AHandled := 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 then
  begin
    AResponse.StatusCode := http_status.ServiceUnavailable;
    AResponse.ContentType := TMVCMediaType.TEXT_PLAIN;
    AResponse.Content := 'Server is shutting down';
    AHandled := True;
  end;

  if not AHandled then
  begin
    try
      AHandled := ExecuteAction(ASender, ARequest, AResponse);
      if not AHandled then
      begin
        AResponse.ContentStream := nil;
      end;
    except
      on E: Exception do
      begin
        Log.ErrorFmt('[%s] %s', [E.Classname, E.Message], LOGGERPRO_TAG);

        AResponse.StatusCode := http_status.InternalServerError; // default is Internal Server Error
        if E is EMVCException then
        begin
          AResponse.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;
var
  lParamsTable: 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;
begin
  Result := False;

  if ARequest.ContentLength > FConfigCache_MaxRequestSize then
  begin
    raise 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 header
  if ARequest.ContentLength > FConfigCache_MaxRequestSize then
  begin
    raise EMVCException.CreateFmt(http_status.RequestEntityTooLarge,
      'Request size exceeded the max allowed size [%d KiB] (2)',
      [(FConfigCache_MaxRequestSize div 1024)]);
  end;
{$ENDIF}
  lParamsTable := TMVCRequestParamsTable.Create;
  try
    lContext := TWebContext.Create(ARequest, AResponse, FConfig, FSerializers);
    try
      DefineDefaultResponseHeaders(lContext);
      DoWebContextCreateEvent(lContext);
      lHandled := False;
      lRouter := TMVCRouter.Create(FConfig, gMVCGlobalActionParamsCache);
      try // finally
        lSelectedController := nil;
        try // only for lSelectedController
          try // global exception handler
            ExecuteBeforeRoutingMiddleware(lContext, lHandled);
            if not lHandled then
            begin
              if lRouter.ExecuteRouting(ARequest.PathInfo,
                lContext.Request.GetOverwrittenHTTPMethod { lContext.Request.HTTPMethod } ,
                ARequest.ContentType, ARequest.Accept, FControllers,
                FConfigCache_DefaultContentType, FConfigCache_DefaultContentCharset,
                FConfigCache_PathPrefix, 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 [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 then
                  Exit(True);

                lBodyParameter := nil;
                lSelectedController.MVCControllerAfterCreate;
                try
                  lHandled := False;
                  lSelectedController.ContentType := BuildContentType(lResponseContentMediaType,
                    lResponseContentCharset);
                  lActionFormalParams := lRouter.MethodToCall.GetParameters;
                  if (Length(lActionFormalParams) = 0) then
                    SetLength(lActualParams, 0)
                  else if (Length(lActionFormalParams) = 1) and
                    (SameText(lActionFormalParams[0].ParamType.QualifiedName,
                    'MVCFramework.TWebContext')) then
                  begin
                    SetLength(lActualParams, 1);
                    lActualParams[0] := lContext;
                  end
                  else
                  begin
                    FillActualParamsForAction(lSelectedController, lContext, lActionFormalParams,
                      lRouterMethodToCallName, lActualParams, lBodyParameter);
                  end;
                  lSelectedController.OnBeforeAction(lContext, lRouterMethodToCallName, lHandled);
                  if not lHandled then
                  begin
                    try
                      lRouter.MethodToCall.Invoke(lSelectedController, lActualParams);
                    finally
                      lSelectedController.OnAfterAction(lContext, lRouterMethodToCallName);
                    end;
                  end;
                finally
                  try
                    lBodyParameter.Free;
                  except
                    on E: Exception do
                    begin
                      LogE(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);
              end
              else // execute-routing
              begin
                if Config[TMVCConfigKey.AllowUnhandledAction] = 'false' then
                begin
                  lContext.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);
                end
                else
                begin
                  lContext.Response.FlushOnDestroy := False;
                end;
              end; // end-execute-routing
            end; // if not handled by beforerouting
          except
            on ESess: EMVCSessionExpiredException do
            begin
              if not CustomExceptionHandling(ESess, lSelectedController, lContext) then
              begin
                Log.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 do
            begin
              if not CustomExceptionHandling(E, lSelectedController, lContext) then
              begin
                Log.ErrorFmt('[%s] %s [PathInfo "%s"] (Custom message: "%s")',
                  [E.Classname, E.Message, GetRequestShortDescription(ARequest), E.DetailedMessage], LOGGERPRO_TAG);
                if Assigned(lSelectedController) then
                begin
                  lSelectedController.ResponseStatus(E.HTTPErrorCode);
                  lSelectedController.Render(E);
                end
                else
                begin
                  SendRawHTTPStatus(lContext, E.HTTPErrorCode,
                    Format('[%s] %s', [E.Classname, E.Message]), E.Classname);
                end;
              end;
            end;
            on EIO: EInvalidOp do
            begin
              if not CustomExceptionHandling(EIO, lSelectedController, lContext) then
              begin
                Log.ErrorFmt('[%s] %s [PathInfo "%s"] (Custom message: "%s")',
                  [EIO.Classname, EIO.Message, GetRequestShortDescription(ARequest), 'Invalid Op'], LOGGERPRO_TAG);
                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;
              end;
            end;
            on Ex: Exception do
            begin
              if not CustomExceptionHandling(Ex, lSelectedController, lContext) then
              begin
                Log.ErrorFmt('[%s] %s [PathInfo "%s"] (Custom message: "%s")',
                  [Ex.Classname, Ex.Message, GetRequestShortDescription(ARequest), '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,
                    Format('[%s] %s', [Ex.Classname, Ex.Message]), Ex.Classname);
                end;
              end;
            end;
          end;
          try
            ExecuteAfterRoutingMiddleware(lContext, lHandled);
          except
            on Ex: Exception do
            begin
              if not CustomExceptionHandling(Ex, lSelectedController, lContext) then
              begin
                Log.ErrorFmt('[%s] %s [PathInfo "%s"] (Custom message: "%s")',
                  [Ex.Classname, Ex.Message, GetRequestShortDescription(ARequest), 'After Routing Exception Handler'], LOGGERPRO_TAG);
                if Assigned(lSelectedController) then
                begin
                  { middlewares *must* not raise unhandled exceptions }
                  lSelectedController.ResponseStatus(http_status.InternalServerError);
                  lSelectedController.Render(Ex);
                end
                else
                begin
                  SendRawHTTPStatus(lContext, http_status.InternalServerError,
                    Format('[%s] %s', [Ex.Classname, Ex.Message]), Ex.Classname);
                end;
              end;
            end;
          end;
        finally
          FreeAndNil(lSelectedController);
        end;
      finally
        lRouter.Free;
      end;
    finally
      DoWebContextDestroyEvent(lContext);
      lContext.Free;
    end;
  finally
    lParamsTable.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;
var
  LRequestPathInfo: 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;
begin
  Result := False;

  FMethodToCall := nil;
  FControllerClazz := nil;
  FControllerCreateAction := nil;

  LRequestAccept := ARequestAccept;
  LRequestContentType := ARequestContentType;
  LRequestPathInfo := ARequestPathInfo;
  if (Trim(LRequestPathInfo) = EmptyStr) then
    LRequestPathInfo := '/'
  else
  begin
    if not LRequestPathInfo.StartsWith('/') then
    begin
      LRequestPathInfo := '/' + LRequestPathInfo;
    end;
  end;
  //LRequestPathInfo := TNetEncoding.URL.EncodePath(LRequestPathInfo, [Ord('$')]);
  LRequestPathInfo := TIdURI.PathEncode(Trim(LRequestPathInfo)); //regression introduced in fix for issue 492

  TMonitor.Enter(gLock);
  try
    //LControllerMappedPaths := TArray<string>.Create();
    LControllerMappedPaths := TStringList.Create;
    try
      for LControllerDelegate in AControllers do
      begin
        LControllerMappedPaths.Clear;
        SetLength(LAttributes, 0);
        LRttiType := FRttiContext.GetType(LControllerDelegate.Clazz.ClassInfo);

        lURLSegment := LControllerDelegate.URLSegment;
        if lURLSegment.IsEmpty then
        begin
          LAttributes := LRttiType.GetAttributes;
          if (LAttributes = nil) then
            Continue;
          //LControllerMappedPaths := GetControllerMappedPath(LRttiType.Name, LAttributes);
          FillControllerMappedPaths(LRttiType.Name, LAttributes, LControllerMappedPaths);
        end
        else
        begin
          LControllerMappedPaths.Add(lURLSegment);
        end;

        for LItem in LControllerMappedPaths do
        begin
          LControllerMappedPath := LItem;
          if (LControllerMappedPath = '/') then
          begin
            LControllerMappedPath := '';
          end;

    {$IF defined(TOKYOORBETTER)}
          if not LRequestPathInfo.StartsWith(APathPrefix + LControllerMappedPath, True) then
    {$ELSE}
          if not TMVCStringHelper.StartsWith(APathPrefix + LControllerMappedPath, LRequestPathInfo, True) then
    {$ENDIF}
          begin
            Continue;
          end;
//        end;

//          if (not LControllerMappedPathFound) then
//            continue;

          LMethods := LRttiType.GetMethods; { do not use GetDeclaredMethods because JSON-RPC rely on this!! }
          for LMethod in LMethods do
          begin
            if LMethod.Visibility <> mvPublic then // 2020-08-08
              Continue;
            if (LMethod.MethodKind <> mkProcedure) { or LMethod.IsClassMethod } then
              Continue;

            LAttributes := LMethod.GetAttributes;
            if Length(LAttributes) = 0 then
              Continue;

            for LAtt in LAttributes do
            begin
              if LAtt is MVCPathAttribute then
              begin
                // 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) and
                  IsHTTPContentTypeCompatible(ARequestMethodType, LRequestContentType, LAttributes) and
                  IsHTTPAcceptCompatible(ARequestMethodType, LRequestAccept, LAttributes) then
                begin
                  LMethodPath := MVCPathAttribute(LAtt).Path;
                  if IsCompatiblePath(APathPrefix + LControllerMappedPath + LMethodPath,
                    LRequestPathInfo, ARequestParams) then
                  begin
                    FMethodToCall := LMethod;
                    FControllerClazz := LControllerDelegate.Clazz;
                    FControllerCreateAction := LControllerDelegate.CreateAction;
                    LProduceAttribute := GetAttribute<MVCProducesAttribute>(LAttributes);
                    if LProduceAttribute <> nil then
                    begin
                      AResponseContentMediaType := LProduceAttribute.Value;
                      AResponseContentCharset := LProduceAttribute.Charset;
                    end
                    else
                    begin
                      AResponseContentMediaType := ADefaultContentType;
                      AResponseContentCharset := ADefaultContentCharset;
                    end;
                    Exit(True);
                  end;
                end;
              end; // if MVCPathAttribute
            end; // for in Attributes
          end; // for in Methods
        end;
      end; // for in Controllers
    finally
      LControllerMappedPaths.Free;
    end;
  finally
    TMonitor.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等部分。