Delphi DataSnap 流程分析(二)

Delphi DataSnap 流程分析(一)_看那山瞧那水的博客-CSDN博客

粗略分析了 创建传统DataSnap的流程，现在再分析下创建现在更常用的 方式：

DataSnap REST Application

这种方式只支持HTTP(普通HTTP和REST HTTP)通信，不支持TCP通信。

 这种方式包含有WebModule，HTTP服务器也是TIdHTTPWebBrokerBridge

 因此其HTTP Server的启动流程和 Delphi Web Server 流程分析_看那山瞧那水的博客-CSDN博客

里分析的一样，只是到了最后，也就是方法TCustomWebDispatcher.DispatchAction()，接着进行后续处理。

代码： 

constructor TCustomWebDispatcher.Create(AOwner: TComponent);
var
  I: Integer;
  Component: TComponent;
  SetAppDispatcher: ISetAppDispatcher;
begin
{$IFDEF MSWINDOWS}
{$ENDIF}
  FDispatchList := TObjectList<TComponent>.Create;//TComponentList.Create;
  FDispatchList.OwnsObjects := False;
  FOnException := nil;
  if AOwner <> nil then
    if AOwner is TCustomWebDispatcher then
      raise EWebBrokerException.Create(sOnlyOneDispatcher)
    else
      for I := 0 to AOwner.ComponentCount - 1 do
        if AOwner.Components[I] is TCustomWebDispatcher then
          raise EWebBrokerException.Create(sOnlyOneDispatcher);
  inherited CreateNew(AOwner, -1);
  FActions := TWebActionItems.Create(Self, TWebActionItem);
  if Owner <> nil then
    for I := 0 to Owner.ComponentCount - 1 do
    begin
      Component := Owner.Components[I];
      if Supports(IInterface(Component), ISetAppDispatcher, SetAppDispatcher) then
        SetAppDispatcher.SetAppDispatcher(Self)
      else if Supports(IInterface(Component), IWebDispatch) then
        FDispatchList.Add(Component);
    end;
end;

TCustomWebDispatcher类创建的时候，会加载支持接口IWebDispatch的组件，TDSHTTPWebDispatcher是支持IWebDispatch接口的:

TDSHTTPWebDispatcher = class(TDSHTTPServerTransport, IWebDispatch) 

所以FDispatchList列表包含了WebModule的组件DSHTTPWebDispatcher1。

 
function TCustomWebDispatcher.DispatchAction(Request: TWebRequest;
  Response: TWebResponse): Boolean;
var
  I: Integer;
  Action, Default: TWebActionItem;
  Dispatch: IWebDispatch;
begin
  FRequest := Request;
  FResponse := Response;
  I := 0;
  Default := nil;
  if Response.Sent then
  begin
    Result := True;
    { Note that WebSnapSvr enabled apps have no way to mark response as sent }
    Exit;
  end;
  Result := DoBeforeDispatch(Request, Response) or Response.Sent;
  while not Result and (I < FActions.Count) do
  begin
    Action := FActions[I];
    Result := Action.DispatchAction(Request, Response, False);
    if Action.Default then Default := Action;
    Inc(I);
  end;
  // Dispatch to self registering components
  I := 0;
  while not Result and (I < FDispatchList.Count) do
  begin
    if Supports(IInterface(FDispatchList.Items[I]), IWebDispatch, Dispatch) then
    begin
      Result := DispatchHandler(Self, Dispatch,
        Request, Response, False);
    end;
    Inc(I);
  end;
 
  if not Result and Assigned(Default) then
    Result := Default.DispatchAction(Request, Response, True);
  if Result and not Response.Sent then
    Result := DoAfterDispatch(Request, Response);
 
end;

如果前面没有中断，则执行下面的代码：

  // Dispatch to self registering components
  I := 0;
  while not Result and (I < FDispatchList.Count) do
  begin
    if Supports(IInterface(FDispatchList.Items[I]), IWebDispatch, Dispatch) then
    begin
      Result := DispatchHandler(Self, Dispatch,
        Request, Response, False);
    end;
    Inc(I);
  end;

因而执行Dispatch := DSHTTPWebDispatcher1(TDSHTTPWebDispatcher类)，

DispatchHandler(): 这是一个局部方法

function DispatchHandler(Sender: TObject; Dispatch: IWebDispatch; Request: TWebRequest; Response: TWebResponse;
  DoDefault: Boolean): Boolean;
begin
  Result := False;
  if (Dispatch.Enabled and ((Dispatch.MethodType = mtAny) or
    (Request.MethodType = Dispatch.MethodType)) and
    Dispatch.Mask.Matches(string(Request.InternalPathInfo))) then
  begin
    Result := Dispatch.DispatchRequest(Sender, Request, Response);
  end;
end;

进行一些判断，比如格式 /data、/rest等路径格式，调用：

function TDSHTTPWebDispatcher.DispatchRequest(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse): Boolean;
begin
  try
    if Owner is TWebModule then
      DataSnapWebModule := TWebModule(Owner);
    try
      try
        RequiresServer;
        TDSHTTPServerWebBroker(Self.FHttpServer).DispatchDataSnap(Request, Response);
        Result := True;
      except
        on E: Exception do
        begin
          { Default to 500, like web services. }
          Response.StatusCode := 500;
          Result := True;
        end;
      end;
    except
      { Swallow any unexpected exception, it will bring down some web servers }
      Result := False;
    end;
  finally
    { Reset current DataSnapWebModule }
    DataSnapWebModule := nil;
  end;
end;

这里的RequiresServer()是调用祖先类的:

 
procedure TCustomDSRESTServerTransport.RequiresServer;
begin
  if FRestServer = nil then
  begin
    FRESTServer := CreateRESTServer;
    InitializeRESTServer;
  end;
end;
 
function TCustomDSHTTPServerTransport.CreateRESTServer: TDSRESTServer;
begin
  FHttpServer := CreateHttpServer;
  Result := FHttpServer;
end;
 
 
function TDSHTTPService.CreateHttpServer: TDSHTTPServer;
var
  LHTTPServer: TDSHTTPServerIndy;
begin
  if Assigned(FCertFiles) then
    LHTTPServer := TDSHTTPSServerIndy.Create(Self.Server, IPImplementationID)
  else
    LHTTPServer := TDSHTTPServerIndy.Create(Self.Server, IPImplementationID);
  Result := LHTTPServer;
  LHTTPServer.HTTPOtherContext := HTTPOtherContext;
end;

获得RestServer和httpServer。然后调用：

procedure TDSHTTPServerWebBroker.DispatchDataSnap(ARequest: TWebRequest;
  AResponse: TWebResponse);
var
  LDispatch: TDSHTTPDispatch;
  LContext: TDSHTTPContextWebBroker;
begin
  LDispatch := TDSHTTPApplication.Instance.HTTPDispatch;
  if LDispatch <> nil then
    DoCommand(LDispatch.Context, LDispatch.Request, LDispatch.Response)
  else
  begin
    LContext := TDSHTTPContextWebBroker.Create(ARequest, AResponse);
    try
      DoCommand(LContext, LContext.FRequest, LContext.FResponse);
    finally
      LContext.Free;
    end;
  end;
end;

又到了DoCommand()方法了

DoCommand():

procedure TDSRESTServer.DoCommand(AContext: TDSHTTPContext; ARequestInfo: TDSHTTPRequest;
                                  AResponseInfo: TDSHTTPResponse);
var
  Request: string;
  NextRequest: string;
  NextContext: string;
  RestCtxt: string;
  StartDispatch: Boolean;
begin

  // HTTPDispatch object if necessary
  StartDispatch := not TDSHTTPApplication.Instance.Dispatching;
  if StartDispatch then
    TDSHTTPApplication.Instance.StartDispatch(AContext, ARequestInfo, AResponseInfo);
  try
{$IFNDEF POSIX}
  if CoInitFlags = -1 then
    CoInitializeEx(nil, COINIT_MULTITHREADED)
  else
    CoInitializeEx(nil, CoInitFlags);
{$ENDIF}
  try
    // check for context, if not found send the appropriate error message
    Request := ARequestInfo.URI;
    if Consume(FDSContext, Request, NextRequest) then
    begin
      Request := NextRequest;
      if Consume(FRESTContext, Request, NextRequest) then
      begin
        // datasnap/rest
        DoDSRESTCommand(ARequestInfo, AResponseInfo, NextRequest);
      end
      else if ConsumeOtherContext(Request, NextContext, NextRequest) then
      begin
        DoDSOtherCommand(AContext, ARequestInfo, AResponseInfo, NextContext, NextRequest, FDSServerName <> EmptyStr);
      end
      else
      begin
        RestCtxt := Trim(FRESTContext);
        if RestCtxt = EmptyStr then
          RestCtxt := SProtocolRestEmpty;

        AResponseInfo.ResponseNo := 501; {rest or other service not found in URI}
        AResponseInfo.ContentText := Format(SProtocolNotSupported, [Request, RestCtxt]);
        AResponseInfo.CloseConnection := true;
      end;
    end
    else
    begin
      // This may dispatch .js files for example
      DoCommandOtherContext(AContext, ARequestInfo, AResponseInfo, Request);
    end;
    if Assigned(Self.FTrace ) then
    begin
      FTrace(Self, AContext, ARequestInfo, AResponseInfo);
    end;
  finally
                                                     
    ClearInvocationMetadata();
{$IFNDEF POSIX}
    CoUnInitialize;
{$ENDIF}
  end;
  finally
    if StartDispatch then
      TDSHTTPApplication.Instance.EndDispatch;
  end;
end;

看到处理路径包含 /datasnap/rest的处理：DoDSRESTCommand():

                            
// Entry point for rest.  Should be able to create session before calling this method
procedure TDSRESTServer.DoDSRESTCommand(ARequestInfo: TDSHTTPRequest;
                                        AResponseInfo: TDSHTTPResponse;
                                        Request: string);
var
  CmdType: TDSHTTPCommandType;
  ResponseOk: Integer;
  RESTService: TDSRESTService;
  Len: Integer;
  ParamName: string;
  SessionID: string;
  Session: TDSSession;
  IsNewSession: Boolean;
  SessionFailure: Boolean;
  RespHandler: TDSServiceResponseHandler;
  OwnService: Boolean;
begin
  OwnService := True;
  RespHandler := nil;

  CmdType := ARequestInfo.CommandType;
  ResponseOk := 200;

  RESTService := CreateRESTService(ARequestInfo.AuthUserName, ARequestInfo.AuthPassword);

  // process query parameters
  Len := 0;
  while (Len < ARequestInfo.Params.Count) and (ResponseOk < 300) do
  begin
    ParamName := ARequestInfo.Params.Names[Len];
    //check for session ID parameter in the URL
    if (Uppercase(ParamName) = 'SESSIONID') or (Uppercase(ParamName) = 'SID') then
    begin
      SessionID := ARequestInfo.Params.Values[ParamName]
    end
    else if not RESTService.ProcessQueryParameter(ParamName, ARequestInfo.Params.ValueFromIndex[Len]) then
    begin
      ResponseOK := 409;
      AResponseInfo.ResponseText := Format(CANNOT_PROCESS_PARAM, [ARequestInfo.Params.Names[Len],
                                           ARequestInfo.Params.Values[ARequestInfo.Params.Names[Len]]]);
    end;
    Inc(Len);
  end;
  if (ResponseOK < 300) and not RESTService.CheckConvertersForConsistency then
  begin
    // 409 - Indicates that the request could not be processed because of conflict in the request
    AResponseInfo.ResponseNo := 409;
    AResponseInfo.ResponseText := QUERY_PARAM_CONFLICT;
  end;

  //if no session ID is given in the URL, then try to load it from the Pragma header field
  if SessionID = EmptyStr then
  begin
    SessionID := TDSHTTPApplication.Instance.GetRequestSessionId(aRequestInfo, False);
  end;

  //Try to load the session with the given session ID into the current thread
  SessionFailure :=
     not TDSHTTPApplication.FInstance.LoadRESTSession(SessionID, ARequestInfo.AuthUserName, FSessionTimeout, FSessionLifetime,
                           nil (*FTunnelService*), FDSHTTPAuthenticationManager, ARequestInfo,
                           IsNewSession);
  Session := TDSSessionManager.GetThreadSession;

  //free any stream which was stored from a previous execution
  if Session <> nil then
  begin
    Session.LastResultStream.Free;
    Session.LastResultStream := nil;

    if not SessionFailure then
      UpdateSessionTunnelHook(Request, Session, ARequestInfo);
  end;

  if not SessionFailure and IsClosingSession(Request) then
  begin
    try
      CloseRESTSession(Session, AResponseInfo);
    finally
      FreeAndNil(RESTService);
                                                                         
      TDSSessionManager.ClearThreadSession;
    end;
    exit;
  end;

  try
    if SessionFailure then
    begin
      AResponseInfo.ResponseNo := 403; //Forbidden
      AResponseInfo.ResponseText := SESSION_EXPIRED;
      AResponseInfo.ContentText := '{"SessionExpired":"' + SSessionExpiredMsg + '"}';
    end
    else if ResponseOK >= 300 then
    begin
      // pre-parsing failed and the decision is in ResponseOK, response text already set
      AResponseInfo.ResponseNo := ResponseOK;
    end
    //don't need to authenticate if returning to a previously authenticated session
    else if (FDSHTTPAuthenticationManager <> nil) and IsNewSession and not FDSHTTPAuthenticationManager.Authenticate(
                    DATASNAP_CONTEXT, RESTContext, ARequestInfo.AuthUserName, ARequestInfo.AuthPassword,
                      ARequestInfo, AResponseInfo) then
      if ARequestInfo.AuthUserName <> EmptyStr then
        AResponseInfo.ResponseNo := 403
      else
      begin
        AResponseInfo.SetHeaderAuthentication('Basic', 'REST');
        AResponseInfo.ResponseNo := 401
      end
    else
    begin
      if Session <> nil then
      begin
        AResponseInfo.Pragma := 'dssession=' + Session.SessionName;
        AResponseInfo.Pragma := AResponseInfo.Pragma + ',dssessionexpires=' + IntToStr(Session.ExpiresIn);
      end;

      OwnService := False;
      //create the response handler for populating the response info
      RespHandler := TDSResponseHandlerFactory.CreateResponseHandler(RESTService, ARequestInfo, TDSHTTPCommandType.hcUnknown, Self);
      if RespHandler = nil then
      begin
        AResponseInfo.ResponseNo := 406; //Not Acceptable
      end
      else
      begin
        if RespHandler is  TDSServiceResponseHandler then
        begin
          TDSServiceResponseHandler(RespHandler).OnParseRequest := Self.OnParseRequest;
          TDSServiceResponseHandler(RespHandler).OnParsingRequest := Self.OnParsingRequest;
        end;

        //add the query parameters to invocation metadata
        if ARequestInfo.Params.Count > 0 then
          GetInvocationMetadata().QueryParams.AddStrings(ARequestInfo.Params);

        // dispatch to the appropriate service
        case CmdType of
          TDSHTTPCommandType.hcGET:
            RESTService.ProcessGETRequest(Request, nil, nil, OnNameMap, RespHandler);
          TDSHTTPCommandType.hcPOST:
            RESTService.ProcessPOSTRequest(Request, ARequestInfo.Params,
              ByteContent(ARequestInfo.PostStream), OnNameMap, RespHandler);
          TDSHTTPCommandType.hcPUT:
            RESTService.ProcessPUTRequest(Request, ARequestInfo.Params,
              ByteContent(ARequestInfo.PostStream), OnNameMap, RespHandler);
          TDSHTTPCommandType.hcDELETE:
            RESTService.ProcessDELETERequest(Request, nil, nil, OnNameMap, RespHandler);
          else
          begin
            GetInvocationMetadata().ResponseCode := 501;
            GetInvocationMetadata().ResponseContent := Format(SCommandNotSupported, [ARequestInfo.Command]);
          end;
        end;

        //populate the Response Info from the execution result
        RespHandler.PopulateResponse(AResponseInfo, GetInvocationMetadata());
      end;
    end;
  finally
    if RespHandler = nil then
      FreeAndNil(RESTService);

    if RespHandler <> nil then
      RespHandler.Close;

    if OwnService then
      FreeAndNil(RESTService);

                                    
    if (GetInvocationMetadata(False) <> nil) and
         GetInvocationMetadata.CloseSession and
        (TDSSessionManager.GetThreadSession <> nil) then
    begin
      if TDSSessionManager.GetThreadSession.SessionName <> '' then
        TDSSessionManager.Instance.CloseSession(TDSSessionManager.GetThreadSession.SessionName);
      TDSSessionManager.ClearThreadSession;
    end;
    // Session cleared by TDSHTTPApplication.EndDispatch
    // TDSSessionManager.ClearThreadSession;
  end;
end;

这个方法比较啰嗦，要处理各种情况和格式

自动判别命令类型并分别处理：

        // dispatch to the appropriate service
        case CmdType of
          TDSHTTPCommandType.hcGET:
            RESTService.ProcessGETRequest(Request, nil, nil, OnNameMap, RespHandler);
          TDSHTTPCommandType.hcPOST:
            RESTService.ProcessPOSTRequest(Request, ARequestInfo.Params,
              ByteContent(ARequestInfo.PostStream), OnNameMap, RespHandler);
          TDSHTTPCommandType.hcPUT:
            RESTService.ProcessPUTRequest(Request, ARequestInfo.Params,
              ByteContent(ARequestInfo.PostStream), OnNameMap, RespHandler);
          TDSHTTPCommandType.hcDELETE:
            RESTService.ProcessDELETERequest(Request, nil, nil, OnNameMap, RespHandler);
          else
          begin
            GetInvocationMetadata().ResponseCode := 501;
            GetInvocationMetadata().ResponseContent := Format(SCommandNotSupported, [ARequestInfo.Command]);
          end;
        end;

比如Get:

procedure TDSRESTService.ProcessGETRequest(const Request: string; Params: TStrings; Content: TArray<Byte>;
  const NameMapEvent: TDSRESTMethodNameMapEvent; ResponseHandler: TRequestCommandHandler);
begin
  ProcessREST('GET', Request, nil, NameMapEvent, ResponseHandler);
end;


procedure TDSRESTService.ProcessREST(const RequestType: string;
                                     const RestRequest: string;
                                     const Content: TArray<Byte>;
                                     const NameMapEvent: TDSRESTMethodNameMapEvent;
                                     const ResponseHandler: TRequestCommandHandler);

var
  Params, Segments: TStrings;
  ClassName, MethodName, DSMethodName: string;
  LHandled: Boolean;
  I: Integer;
begin
  Segments := TStringList.Create;
  Params := TStringList.Create;
  try
    try
      // get class, method name, parameters
      LHandled := False;

      ParseRequestSegments(RestRequest, Segments);
      if ResponseHandler is TDSServiceResponseHandler then
        TDSServiceResponseHandler(ResponseHandler).DoParsingRequest(Self,
          RequestType, Segments, DSMethodName, Params, LHandled);
      if not LHandled then
      begin
        if Segments.Count < 2 then
          raise TDSServiceException.Create(SInvalidRequestFormat);
        ClassName := Segments[0];
        MethodName := Segments[1];
        if (ClassName = '') or (MethodName = '') then
          raise TDSServiceException.Create(SInvalidRequestFormat);
        for I := 2 to Segments.Count - 1 do
          Params.Add(Segments[I]);
        SetMethodNameWithPrefix(RequestType, ClassName, MethodName, NameMapEvent, DSMethodName);
      end;
      if ResponseHandler is TDSServiceResponseHandler then
        TDSServiceResponseHandler(ResponseHandler).DoParseRequest(Self,
          RequestType, Segments, DSMethodName, Params);

      ProcessRequest(DSMethodName, ResponseHandler,
        procedure(var AConnection: TDBXConnection; var ACommand: TDBXCommand;
          const ResponseHandler: TRequestCommandHandler)
        begin
          ProcessParameters(DSMethodName, Params, Content, ACommand);
          ACommand.ExecuteUpdate;

          ResponseHandler.AddCommand(ACommand, AConnection); // Owns
          ACommand := nil;
          AConnection := nil;

        end);
    except
      on ex: Exception do
        ProcessException(ResponseHandler, ex);
    end;
  finally
    Params.Free;
    Segments.Free;
  end;
end;

转到：

procedure TDSService.ProcessRequest(const ACommand: string; const AResponseHandler: TRequestCommandHandler; ACallback: TExecuteCallback);
begin
  try
    Execute(ACommand, AResponseHandler, ACallback) //, ResponseHandler);
  except
    on ex: Exception do
      ProcessException(AResponseHandler, ex);
  end;
end;

                                                                                            
procedure TDSService.Execute(const ACommand: string; const AResponseHandler: TRequestCommandHandler; ACallback: TExecuteCallback);
var
    DBXConnection: TDBXConnection;
    DBXCommand: TDBXCommand;
begin
  DBXCommand := nil;

  DBXConnection := GetDBXConnection;
  try
    DBXCommand := DBXConnection.CreateCommand;
    DBXCommand.CommandType := TDBXCommandTypes.DSServerMethod;

    DBXCommand.Text := ACommand;
    DBXCommand.Prepare;

    ACallback(DBXConnection, DBXCommand, AResponseHandler);
  finally

    if DBXCommand <> nil then
      DBXCommand.Close;

    if DBXConnection <> nil then
      DBXConnection.Close;

    DBXCommand.Free;

    DBXConnection.Free;
  end;
end;

客户端的方法调用处理比较繁杂

可以看到DataSnap内部的处理还是依赖 DBX框架。