Delphi DataSnap 流程分析(一)

DataSnap 有三种方式:

1、DataSnap REST Application: Create a DataSnap Server with support for REST Communication and with pages that invoke server methods using Java Script and JSON.

2、DataSnap Server: The DataSnap Server Wizard provides an easy way to implenent a server application using DataSnap technology.

3、DataSnap Webbroker Application: The DataSnap WebBroker Application Wizard provides an easy way to implenent a server application using both The WebBroker and DataSnap technology.

1方式是最新的也是主要的运用方式。只支持HTTP。有WebModule，有TDSHTTPWebDispatcher。

2方式传统的运用方式，支持TCP和HTTP。没有WebModule，TDSHTTPService代替了TDSHTTPWebDispatcher。

3方式和1方式类似，比较"原始"，也比较灵活。只支持HTTP。

早期的DataSnap只有方式2和3，方式2只支持TCP传输的。方式3的运用要自己处理许多细节，所以方式3用的不多。

现在的方式2添加了HTTP支持，但是其实现方式不是直接通过WebModule来实现，而是转了个弯，通过桥接Indy的Http来实现。

因为方式2没有了TWebModule，所以和其它两种方式的区别比较大。

我们先来简要分析下方式2的流程，然后主要分析方式1的流程，方式3的流程类似方式1，就不做分析了。

DataSnap Server 流程：

向导生成时，选择支持TCP和HTTP服务。服务器是自动启动的，ServerContainerUnit1.ServerContainer1.DSServer1.AutoStart := True;

只要运行服务端程序，就可以开始提供服务。如果要手动启动，则设置：

ServerContainerUnit1.ServerContainer1.DSServer1.AutoStart := False;

启动：

ServerContainerUnit1.ServerContainer1.DSServer1.Start;

停止：

ServerContainerUnit1.ServerContainer1.DSServer1.Stop;

TCP通信流程不管，看看HTTP通信流程。

向导生成的ServerContainer单元，包含了TDSServer（服务控制组件），TDSServerClass（用于导出方法到客户端），TDSTCPServerTransport（用于TCP通信），TDSHTTPService（HTTP服务），以及其它的辅助组件，用的是TDataMudule：

当用TDataMudule时，如果要提供HTTP服务，肯定要提供一个WebDisptcher。

（见：Delphi Web Server 流程分析_看那山瞧那水的博客-CSDN博客） 

TDSTCPServerTransport和TDSHTTPService都有一个Server属性，指向TDSServer。

当DSServer1.Start时，是如何启动HTTP服务的？

procedure TDSServer.Start;
begin
  inherited;
  // Add a DBX "driver" for the server component
  TDBXDriverRegistry.RegisterDriverClass(Name, TDSServerDriver);

end;
这里没有什么，只是添加了DBX驱动，DATASNAP的TCP通信是通过DBX框架实现的。

类继承关系：

TDSServer->TDSCustomServer->TComponent:

procedure TDSCustomServer.Start;
begin
  if not FStarted then
    try
      StartTransports;
      FServerMethodProvider := TDSServerMethodProvider.Create;
      FServerMethodProvider.Server := self;
      FServerMethodProvider.Open;
      FStarted := True;
    finally
      if not FStarted then
      begin
        StopTransports;
        if FServerMethodProvider <> nil then
        begin
          FServerMethodProvider.Close;
          FreeAndNil(FServerMethodProvider);
        end;
      end;
    end;
end;

这里只看到关于TCP的组件，HTTP在哪里呢？

没找到，先看看TDSHTTPService的继承关系:

TDSHTTPService->TCustomDSHTTPServerTransport->TCustomDSRESTServerTransport->TDSServerTransport->TDSServerComponent->TComponent

好像和HTTP都没什么关系，和TDSServerTransport有关系，TCP的有个组件TDSTCPServerTransport，也看看它的继承关系

TDSTCPServerTransport->TDSServerTransport，看到了，TDSHTTPService和TDSTCPServerTransport都是TDSServerTransport的子类。

前面看到了，TDSServer.Start，要启动了TDSTCPServerTransport:

StartTransports:

procedure TDSCustomServer.StartTransports;
var
  Transport: TDSServerTransport;
  ServerComponent: TObject;
  Index: Integer;
begin
  for Index := 0 to FComponentList.Count - 1 do
  begin
    ServerComponent := FComponentList[Index];
    if ServerComponent is TDSServerTransport then
    begin
      Transport := TDSServerTransport(ServerComponent);
      Transport.DbxContext := FDbxContext;
      Transport.Start;
    end;
  end;
end;

调用了TDSServerTransport.Start:

但是TDSServerTransport本身没有这个方法，其父类的Start:

procedure TDSServerComponent.Start;
begin
//
end;
哎，是空的，看来是子类实现。代码里的Transport是TDSServerTransport，是TDSTCPServerTransport的父类，这个方法肯定是在TDSTCPServerTransport:

procedure TDSTCPServerTransport.Start;
var
  Scheduler: IIPSchedulerOfThreadPool;
  LSocketHandle: IIPSocketHandle;
begin
  inherited;
  FTcpServer := CreateTcpServer;
  FTcpServer.OnConnect := DoOnConnect;
  FTcpServer.OnDisconnect := DoOnDisconnect;
  FTcpServer.OnExecute := DoOnExecute;
  FTcpServer.UseNagle := false;
  FTcpServer.Bindings.Add.Port := FPort; //default IPv4
  if GStackPeers(IPImplementationID).SupportsIPv6 then
  begin
    LSocketHandle := FTcpServer.Bindings.Add;
    LSocketHandle.Port := FPort; //default IPv4
    LSocketHandle.IPVersion := TIPVersionPeer.IP_IPv6
  end;
  Scheduler := PeerFactory.CreatePeer(IPImplementationID, IIPSchedulerOfThreadPool, FTCPServer.GetObject as TComponent) as IIPSchedulerOfThreadPool;
  Scheduler.MaxThreads := MaxThreads;
  Scheduler.PoolSize := PoolSize;
  FTCPServer.Scheduler := Scheduler;
  FTcpServer.Active := True;
end;

这里还是没有涉及到HTTP，回头看看TDSHTTPService这边，

TDSHTTPService->TCustomDSHTTPServerTransport->TCustomDSRESTServerTransport->TDSServerTransport 这中间某个肯定实现了和HTTP的挂钩。

TDSHTTPService.Start:

procedure TDSHTTPService.Start;
begin
  inherited;
  RequiresServer;
  if Assigned(FHttpServer) then
  begin
    if FCertFiles <> nil then
      FCertFiles.SetServerProperties(FHttpServer);
    TDSHTTPServerIndy(FHttpServer).Active := True;
  end;
end;

就是这个

RequiresServer()方法在父类TCustomDSRESTServerTransport，CreateRESTServer()在TCustomDSHTTPServerTransport，CreateHttpServer()在TDSHTTPService:

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;

CreateHttpServer()方法里出现了TDSHTTPServerIndy，看看它是什么,前面的Start()里有这一行代码：

TDSHTTPServerIndy(FHttpServer).Active := True;

TDSHTTPServerIndy = class(TDSHTTPServer), 是TDSHTTPServer的子类，启动代码：

procedure TDSHTTPServerIndy.SetActive(const Value: Boolean);
begin
  if Value and (FServer = nil) then
  begin
    FServer := PeerFactory.CreatePeer(FIPImplementationID, IIPHTTPServer, nil) as IIPHTTPServer;
    InitializeServer;
  end;
  if FServer <> nil then
    FServer.Active := Value;
end;

有个名称叫 PeerIP(本意是对等IP)，INDY里一些组件采用多端口技术时，有2组参数：

 IP 、Port：代表本地IP地址和端口；

PeerIP、PeerPort：代表远端IP地址和端口；

服务端可以向PeerIP和PeerPort回应数据，这里是HTTP服务端。

(PeerIP的技术原理还没搞明白）

支持IIPHTTPServer接口的实现在IPPeerServer.pas(路径:D:\Program Files (x86)\Embarcadero\Studio\22.0\source\indy\implementation\IPPeerServer.pas)

部分代码：

  TIdHTTPServerIP = class(TIdHTTPServer)
  private
    FSetDestroyedProc: procedure of object;
  public
    destructor Destroy; override;
  end;

  TIdHTTPServerPeer = class(TIdClassIP, IIPHTTPServer, IIPObject)
  private
    FHTTPServer: TIdHTTPServerIP;
    FContexts: TDictionary<TIdContext, IIPContext>;

.....................................

FHTTPServer => FHTTPServer =>TIdHTTPServer

本质上也是一个HTTPSERVER,只是通过PeerIP技术来实现了。

procedure TDSHTTPServerIndy.InitializeServer;
begin
  if FServer <> nil then
  begin
    FServer.UseNagle := False;
    FServer.KeepAlive := True;
    FServer.ServerSoftware := FServerSoftware;
    FServer.DefaultPort := FDefaultPort;

    FServer.OnCommandGet := Self.DoIndyCommand;
    FServer.OnCommandOther := Self.DoIndyCommand;
  end;
end;

                                   
procedure TDSHTTPServerIndy.DoIndyCommand(AContext: IIPContext; ARequestInfo: IIPHTTPRequestInfo;
                                AResponseInfo: IIPHTTPResponseInfo);
var
  LContext: TDSHTTPContextIndy;
begin
  LContext := TDSHTTPContextIndy.Create(AContext, ARequestInfo, AResponseInfo);
  try
    DoCommand(LContext, LContext.FRequest, LContext.FResponse);
  finally
    LContext.Free;
  end;
end;

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;

开始引入了Dispatch，到这里基本就明白了，后面的处理方式和一般的HTTP类似，只是简化了(DataSnap专用)。

可以看出，和一般的使用WebModule也就是WebReq方式还是有大的区别的。