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);
varI: Integer;Component: TComponent;SetAppDispatcher: ISetAppDispatcher;
begin
{$IFDEF MSWINDOWS}
{$ENDIF}FDispatchList := TObjectList<TComponent>.Create;//TComponentList.Create;FDispatchList.OwnsObjects := False;FOnException := nil;if AOwner <> nil thenif AOwner is TCustomWebDispatcher thenraise EWebBrokerException.Create(sOnlyOneDispatcher)elsefor I := 0 to AOwner.ComponentCount - 1 doif AOwner.Components[I] is TCustomWebDispatcher thenraise EWebBrokerException.Create(sOnlyOneDispatcher);inherited CreateNew(AOwner, -1);FActions := TWebActionItems.Create(Self, TWebActionItem);if Owner <> nil thenfor I := 0 to Owner.ComponentCount - 1 dobeginComponent := Owner.Components[I];if Supports(IInterface(Component), ISetAppDispatcher, SetAppDispatcher) thenSetAppDispatcher.SetAppDispatcher(Self)else if Supports(IInterface(Component), IWebDispatch) thenFDispatchList.Add(Component);end;
end;

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

TDSHTTPWebDispatcher = class(TDSHTTPServerTransport, IWebDispatch) 

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

 
function TCustomWebDispatcher.DispatchAction(Request: TWebRequest;Response: TWebResponse): Boolean;
varI: Integer;Action, Default: TWebActionItem;Dispatch: IWebDispatch;
beginFRequest := Request;FResponse := Response;I := 0;Default := nil;if Response.Sent thenbeginResult := 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) dobeginAction := FActions[I];Result := Action.DispatchAction(Request, Response, False);if Action.Default then Default := Action;Inc(I);end;// Dispatch to self registering componentsI := 0;while not Result and (I < FDispatchList.Count) dobeginif Supports(IInterface(FDispatchList.Items[I]), IWebDispatch, Dispatch) thenbeginResult := DispatchHandler(Self, Dispatch,Request, Response, False);end;Inc(I);end;if not Result and Assigned(Default) thenResult := Default.DispatchAction(Request, Response, True);if Result and not Response.Sent thenResult := 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;
beginResult := False;if (Dispatch.Enabled and ((Dispatch.MethodType = mtAny) or(Request.MethodType = Dispatch.MethodType)) andDispatch.Mask.Matches(string(Request.InternalPathInfo))) thenbeginResult := Dispatch.DispatchRequest(Sender, Request, Response);end;
end;

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

function TDSHTTPWebDispatcher.DispatchRequest(Sender: TObject;Request: TWebRequest; Response: TWebResponse): Boolean;
begintryif Owner is TWebModule thenDataSnapWebModule := TWebModule(Owner);trytryRequiresServer;TDSHTTPServerWebBroker(Self.FHttpServer).DispatchDataSnap(Request, Response);Result := True;excepton E: Exception dobegin{ 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;
beginif FRestServer = nil thenbeginFRESTServer := CreateRESTServer;InitializeRESTServer;end;
end;function TCustomDSHTTPServerTransport.CreateRESTServer: TDSRESTServer;
beginFHttpServer := CreateHttpServer;Result := FHttpServer;
end;function TDSHTTPService.CreateHttpServer: TDSHTTPServer;
varLHTTPServer: TDSHTTPServerIndy;
beginif Assigned(FCertFiles) thenLHTTPServer := TDSHTTPSServerIndy.Create(Self.Server, IPImplementationID)elseLHTTPServer := TDSHTTPServerIndy.Create(Self.Server, IPImplementationID);Result := LHTTPServer;LHTTPServer.HTTPOtherContext := HTTPOtherContext;
end;

获得RestServer和httpServer。然后调用：

procedure TDSHTTPServerWebBroker.DispatchDataSnap(ARequest: TWebRequest;AResponse: TWebResponse);
varLDispatch: TDSHTTPDispatch;LContext: TDSHTTPContextWebBroker;
beginLDispatch := TDSHTTPApplication.Instance.HTTPDispatch;if LDispatch <> nil thenDoCommand(LDispatch.Context, LDispatch.Request, LDispatch.Response)elsebeginLContext := TDSHTTPContextWebBroker.Create(ARequest, AResponse);tryDoCommand(LContext, LContext.FRequest, LContext.FResponse);finallyLContext.Free;end;end;
end;

又到了DoCommand()方法了

DoCommand():

procedure TDSRESTServer.DoCommand(AContext: TDSHTTPContext; ARequestInfo: TDSHTTPRequest;AResponseInfo: TDSHTTPResponse);
varRequest: string;NextRequest: string;NextContext: string;RestCtxt: string;StartDispatch: Boolean;
begin// HTTPDispatch object if necessaryStartDispatch := not TDSHTTPApplication.Instance.Dispatching;if StartDispatch thenTDSHTTPApplication.Instance.StartDispatch(AContext, ARequestInfo, AResponseInfo);try
{$IFNDEF POSIX}if CoInitFlags = -1 thenCoInitializeEx(nil, COINIT_MULTITHREADED)elseCoInitializeEx(nil, CoInitFlags);
{$ENDIF}try// check for context, if not found send the appropriate error messageRequest := ARequestInfo.URI;if Consume(FDSContext, Request, NextRequest) thenbeginRequest := NextRequest;if Consume(FRESTContext, Request, NextRequest) thenbegin// datasnap/restDoDSRESTCommand(ARequestInfo, AResponseInfo, NextRequest);endelse if ConsumeOtherContext(Request, NextContext, NextRequest) thenbeginDoDSOtherCommand(AContext, ARequestInfo, AResponseInfo, NextContext, NextRequest, FDSServerName <> EmptyStr);endelsebeginRestCtxt := Trim(FRESTContext);if RestCtxt = EmptyStr thenRestCtxt := SProtocolRestEmpty;AResponseInfo.ResponseNo := 501; {rest or other service not found in URI}AResponseInfo.ContentText := Format(SProtocolNotSupported, [Request, RestCtxt]);AResponseInfo.CloseConnection := true;end;endelsebegin// This may dispatch .js files for exampleDoCommandOtherContext(AContext, ARequestInfo, AResponseInfo, Request);end;if Assigned(Self.FTrace ) thenbeginFTrace(Self, AContext, ARequestInfo, AResponseInfo);end;finallyClearInvocationMetadata();
{$IFNDEF POSIX}CoUnInitialize;
{$ENDIF}end;finallyif StartDispatch thenTDSHTTPApplication.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);
varCmdType: TDSHTTPCommandType;ResponseOk: Integer;RESTService: TDSRESTService;Len: Integer;ParamName: string;SessionID: string;Session: TDSSession;IsNewSession: Boolean;SessionFailure: Boolean;RespHandler: TDSServiceResponseHandler;OwnService: Boolean;
beginOwnService := True;RespHandler := nil;CmdType := ARequestInfo.CommandType;ResponseOk := 200;RESTService := CreateRESTService(ARequestInfo.AuthUserName, ARequestInfo.AuthPassword);// process query parametersLen := 0;while (Len < ARequestInfo.Params.Count) and (ResponseOk < 300) dobeginParamName := ARequestInfo.Params.Names[Len];//check for session ID parameter in the URLif (Uppercase(ParamName) = 'SESSIONID') or (Uppercase(ParamName) = 'SID') thenbeginSessionID := ARequestInfo.Params.Values[ParamName]endelse if not RESTService.ProcessQueryParameter(ParamName, ARequestInfo.Params.ValueFromIndex[Len]) thenbeginResponseOK := 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 thenbegin// 409 - Indicates that the request could not be processed because of conflict in the requestAResponseInfo.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 fieldif SessionID = EmptyStr thenbeginSessionID := TDSHTTPApplication.Instance.GetRequestSessionId(aRequestInfo, False);end;//Try to load the session with the given session ID into the current threadSessionFailure :=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 executionif Session <> nil thenbeginSession.LastResultStream.Free;Session.LastResultStream := nil;if not SessionFailure thenUpdateSessionTunnelHook(Request, Session, ARequestInfo);end;if not SessionFailure and IsClosingSession(Request) thenbegintryCloseRESTSession(Session, AResponseInfo);finallyFreeAndNil(RESTService);TDSSessionManager.ClearThreadSession;end;exit;end;tryif SessionFailure thenbeginAResponseInfo.ResponseNo := 403; //ForbiddenAResponseInfo.ResponseText := SESSION_EXPIRED;AResponseInfo.ContentText := '{"SessionExpired":"' + SSessionExpiredMsg + '"}';endelse if ResponseOK >= 300 thenbegin// pre-parsing failed and the decision is in ResponseOK, response text already setAResponseInfo.ResponseNo := ResponseOK;end//don't need to authenticate if returning to a previously authenticated sessionelse if (FDSHTTPAuthenticationManager <> nil) and IsNewSession and not FDSHTTPAuthenticationManager.Authenticate(DATASNAP_CONTEXT, RESTContext, ARequestInfo.AuthUserName, ARequestInfo.AuthPassword,ARequestInfo, AResponseInfo) thenif ARequestInfo.AuthUserName <> EmptyStr thenAResponseInfo.ResponseNo := 403elsebeginAResponseInfo.SetHeaderAuthentication('Basic', 'REST');AResponseInfo.ResponseNo := 401endelsebeginif Session <> nil thenbeginAResponseInfo.Pragma := 'dssession=' + Session.SessionName;AResponseInfo.Pragma := AResponseInfo.Pragma + ',dssessionexpires=' + IntToStr(Session.ExpiresIn);end;OwnService := False;//create the response handler for populating the response infoRespHandler := TDSResponseHandlerFactory.CreateResponseHandler(RESTService, ARequestInfo, TDSHTTPCommandType.hcUnknown, Self);if RespHandler = nil thenbeginAResponseInfo.ResponseNo := 406; //Not Acceptableendelsebeginif RespHandler is  TDSServiceResponseHandler thenbeginTDSServiceResponseHandler(RespHandler).OnParseRequest := Self.OnParseRequest;TDSServiceResponseHandler(RespHandler).OnParsingRequest := Self.OnParsingRequest;end;//add the query parameters to invocation metadataif ARequestInfo.Params.Count > 0 thenGetInvocationMetadata().QueryParams.AddStrings(ARequestInfo.Params);// dispatch to the appropriate servicecase CmdType ofTDSHTTPCommandType.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);elsebeginGetInvocationMetadata().ResponseCode := 501;GetInvocationMetadata().ResponseContent := Format(SCommandNotSupported, [ARequestInfo.Command]);end;end;//populate the Response Info from the execution resultRespHandler.PopulateResponse(AResponseInfo, GetInvocationMetadata());end;end;finallyif RespHandler = nil thenFreeAndNil(RESTService);if RespHandler <> nil thenRespHandler.Close;if OwnService thenFreeAndNil(RESTService);if (GetInvocationMetadata(False) <> nil) andGetInvocationMetadata.CloseSession and(TDSSessionManager.GetThreadSession <> nil) thenbeginif TDSSessionManager.GetThreadSession.SessionName <> '' thenTDSSessionManager.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);
beginProcessREST('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);varParams, Segments: TStrings;ClassName, MethodName, DSMethodName: string;LHandled: Boolean;I: Integer;
beginSegments := TStringList.Create;Params := TStringList.Create;trytry// get class, method name, parametersLHandled := False;ParseRequestSegments(RestRequest, Segments);if ResponseHandler is TDSServiceResponseHandler thenTDSServiceResponseHandler(ResponseHandler).DoParsingRequest(Self,RequestType, Segments, DSMethodName, Params, LHandled);if not LHandled thenbeginif Segments.Count < 2 thenraise TDSServiceException.Create(SInvalidRequestFormat);ClassName := Segments[0];MethodName := Segments[1];if (ClassName = '') or (MethodName = '') thenraise TDSServiceException.Create(SInvalidRequestFormat);for I := 2 to Segments.Count - 1 doParams.Add(Segments[I]);SetMethodNameWithPrefix(RequestType, ClassName, MethodName, NameMapEvent, DSMethodName);end;if ResponseHandler is TDSServiceResponseHandler thenTDSServiceResponseHandler(ResponseHandler).DoParseRequest(Self,RequestType, Segments, DSMethodName, Params);ProcessRequest(DSMethodName, ResponseHandler,procedure(var AConnection: TDBXConnection; var ACommand: TDBXCommand;const ResponseHandler: TRequestCommandHandler)beginProcessParameters(DSMethodName, Params, Content, ACommand);ACommand.ExecuteUpdate;ResponseHandler.AddCommand(ACommand, AConnection); // OwnsACommand := nil;AConnection := nil;end);excepton ex: Exception doProcessException(ResponseHandler, ex);end;finallyParams.Free;Segments.Free;end;
end;

转到：

procedure TDSService.ProcessRequest(const ACommand: string; const AResponseHandler: TRequestCommandHandler; ACallback: TExecuteCallback);
begintryExecute(ACommand, AResponseHandler, ACallback) //, ResponseHandler);excepton ex: Exception doProcessException(AResponseHandler, ex);end;
end;procedure TDSService.Execute(const ACommand: string; const AResponseHandler: TRequestCommandHandler; ACallback: TExecuteCallback);
varDBXConnection: TDBXConnection;DBXCommand: TDBXCommand;
beginDBXCommand := nil;DBXConnection := GetDBXConnection;tryDBXCommand := DBXConnection.CreateCommand;DBXCommand.CommandType := TDBXCommandTypes.DSServerMethod;DBXCommand.Text := ACommand;DBXCommand.Prepare;ACallback(DBXConnection, DBXCommand, AResponseHandler);finallyif DBXCommand <> nil thenDBXCommand.Close;if DBXConnection <> nil thenDBXConnection.Close;DBXCommand.Free;DBXConnection.Free;end;
end;

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

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

少先队网