RO代码跟踪 之 服务端工作原理

  在服务端,主窗体的Create事件中有一行关键代码:ROServer.Active := true;在TROServer基类中找到Active属性的定义,其中SetActive方法调用了虚方法IntSetActive,继承类中实现IntSetActive方法的时候,负责激活IndyServer(TIdHTTPServer控件的子类).开始或停止监听网络.
  在XXX_Invf.pas单元中,可以看到与服务方法对应的一下函数,如:
procedure TFirstSampleService_Invoker.Invoke_Nicknames(const __Instance:IInterface; const __Message:IROMessage; const __Transport:IROTransport; out __oResponseOptions:TROResponseOptions);
{ function Nicknames(const FullName: Widestring): Widestring; }
var
  FullName: Widestring;
  lResult: Widestring;
begin
  try
    __Message.Read('FullName', TypeInfo(Widestring), FullName, []);

    lResult := (__Instance as IFirstSampleService).Nicknames(FullName);//调用

    __Message.InitializeResponseMessage(__Transport, 'FirstSample', 'FirstSampleService', 'NicknamesResponse');
    __Message.Write('Result', TypeInfo(Widestring), lResult, []);
    __Message.Finalize;
    __Message.UnsetAttributes(__Transport);

  finally
  end;
end;
  从代码中可以猜到,这些函数和XXX_Intf.pas单元对应的函数相反,负责从网络中接收客户端传来的
调用,读取其中的函数参数,并调用服务端的实现,最后将函数的返回值传回客户端.现在可以猜测一下
__Instance应该是从对象池中获取的实例.而__Message应该还是MainForm中指定的消息控件.
__Transport是传输通道.
  在看看XXX_Impl.pas单元,在其initialization小节中创建负责实例化TXXXX_Impl对象的工厂类:
TROClassFactory.Create('FirstSampleService', Create_FirstSampleService, TFirstSampleService_Invoker);
跟踪TROClassFactory.Create方法,创建了TROClassFactory实例后(对象中的Field中保存了TXXX_Invoker类型和
创建TXXXX_Impl实例的方法),调用RegisterClassFactory(Self);将自己注册到全局变量_ClassFactoryList: TROClassFactoryList;
中.分析到这里,准备工作应该都完成了,剩下就看IndyServer监控网络并调用工厂类对象工作了.直觉上感觉应该是
IndyServer开一个线程监控网络并在接收新连接时开新线程,接收信息后调用工厂类生成接口实现对象来响应请求.
  思路很简单了,我们直接跟踪代码.首先去找IndyHttpServer的OnCommandGet事件吧,在uROIndyHTTPServer单元的133行
找到
function TROIndyHTTPServer.CreateIndyServer: TComponent;
begin
  result := TROIdHTTPServer.Create(Self);//TIdHTTPServer.Create(Self);
  TROIdHTTPServer(result).OnCommandGet := InternalServerCommandGet;
  TROIdHTTPServer(result).OnConnect := InternalServerConnect;
  TROIdHTTPServer(result).DefaultPort := 8099;
end;
  跟踪InternalServerCommandGet;方法,这个方法实现很复杂,看着头痛,不过前面都是
写怎么读参数的,后面就开始处理响应信息了.中间有个让人怀疑的东东:
ok := IntDispatchMessage(disp, transport, req, resp, lIgnore).跟上去看看,其中
进行了压缩,并调用result := dispatcher.ProcessMessage(aTransport, aRequeststream, aResponsestream, oResponseOptions);
应该是处理消息的吧.看看代码.哈哈,看到了MainProcessMessage函数的调用.
  function MainProcessMessage(const aMessage: IROMessage; const aTransport: IROTransport; aRequestStream, aResponseStream: TStream; out oResponseOptions: TROResponseOptions): boolean;
var
  factory: IROClassFactory;
  moduleinfo: IROModuleInfo;
  dataformat: TDataFormat;
  http: IROHTTPTransport;
begin
  oResponseOptions := [];
//  result := FALSE; // reenabled because of a compiler warning

  try
    if (aMessage = nil) then RaiseError(err_NILMessage, []);

    case aRequestStream.Size of
      // Metadata retrieval
      MetadataRequestIDLength : begin
        oResponseOptions := oResponseOptions + [roDontEncrypt];
        DataFormat := 'text/xml';
        if Supports(aMessage, IROModuleInfo, moduleinfo) then
          moduleinfo.GetRodlInfo(aResponseStream, aTransport, dataformat)
        else
          RaiseError(err_InvalidRequestStream, [aRequestStream.Size]);
        if supports(aTransport, IROHttpTransport, http) then
          http.ContentType := dataformat;

        result := TRUE;
      end;
      0 : begin
        oResponseOptions := oResponseOptions + [roDontEncrypt];
        DataFormat := 'text/xml';
        if Supports(aMessage, IROModuleInfo, moduleinfo) then
          moduleinfo.GetModuleInfo(aResponseStream, aTransport, dataformat)
        else
          RaiseError(err_InvalidRequestStream, [aRequestStream.Size]);
        if supports(aTransport, IROHttpTransport, http) then
          http.ContentType := dataformat;
        result := TRUE;
      end;

      // Probing
      ProbeRequestIDLength : begin
        aResponseStream.Write(ProbeResponseID, ProbeResponseIDLength);
        Result := TRUE;
      end;

      // Messages
      else begin
        aMessage.InitializeRead(aTransport);
        aMessage.ReadFromStream(aRequestStream);

        case aMessage.MessageType of
          mtPoll: begin
              if IsEqualGUID(aMessage.ClientID, EmptyGUID) then
                raise EROServerException.Create('Poll messages may not be sent with empty Client ID.');

              raise EROServerException.Create('.NET-style polling is not implemented in RO/Delphi, yet.');
            end;

          mtRequest, mtResponse: begin
              if (aMessage.InterfaceName = '') then
                RaiseError(err_UnspecifiedInterface, [])
              else if (aMessage.MessageName = '') then
                RaiseError(err_UnspecifiedMessage, [])
              else if IsEqualGUID(aMessage.ClientID, EmptyGUID) then
                aMessage.ClientID := NewGuid();

              if IsEqualGUID(aMessage.ClientID, EmptyGUID) then
                aMessage.ClientID := NewGuid();

              factory := GetClassFactory(aMessage.InterfaceName);  //根据客户端传过来的接口名称查找工厂对象
              //调用XXX_Invoker中的方法
       //这里实现时使用了RTTI信息来根据函数名称动态获取VMT中方法的地址,并调用
       //详见TROInvoker.CustomHandleMessage方法
              result := factory.Invoker.HandleMessage(factory, aMessage, aTransport, oResponseOptions);
     

              aMessage.WriteToStream(aResponseStream);
            end;

          else begin
            raise EROServerException.CreateFmt('Unsupported messages type %d.', [integer(aMessage.MessageType)]);
          end;

        end;

      end;
    end;
  except
    on E: EROSendNoResponse do begin
      result := FALSE;
      oResponseOptions := oResponseOptions + [roNoResponse];
      aMessage.InitializeExceptionMessage(aTransport, '', aMessage.InterfaceName, aMessage.MessageName);
      aMessage.WriteException(aResponseStream, E);
    end;
    on E: Exception do begin
      result := FALSE;
      aMessage.InitializeExceptionMessage(aTransport, '', aMessage.InterfaceName, aMessage.MessageName);
      aMessage.WriteException(aResponseStream, E);
    end;
  end;
end;

//使用RTTI根据函数名称获取函数地址并调用
function TROInvoker.CustomHandleMessage(const aFactory: IROClassFactory;
  const aMessage: IROMessage;
  const aTransport: IROTransport;
  out oResponseOptions: TROResponseOptions): boolean;
var
  //看看XXXX_Invoker.pas单元中定义的函数都一个模样,就是为了在这里处理方便吧
  mtd: TMessageInvokeMethod;
  instance: IInterface;
begin
  result := FALSE;
  if FAbstract then RaiseError(err_AbstractService, [aFactory.InterfaceName]);

  mtd := nil;
  instance := nil;

  //看看下面函数调用传的参数 Invoke_XXXX,在回去找找XXXX_Invoker.pas单元中定义的函数，
  //哈哈,这个技巧在这里.
  @mtd := MethodAddress('Invoke_' + aMessage.MessageName);
  if (@mtd <> nil) then try
    try
      aFactory.CreateInstance(aMessage.ClientID, instance);

      if (instance = nil) then RaiseError(err_ClassFactoryDidNotReturnInstance, [aMessage.InterfaceName]);

      BeforeInvoke(mtd, instance, aFactory, aMessage, aTransport);
      mtd(instance, aMessage, aTransport, oResponseOptions);
      AfterInvoke(mtd, instance, aFactory, aMessage, aTransport, nil);

      result := TRUE;
    except
      on E: Exception do begin
        AfterInvoke(mtd, instance, aFactory, aMessage, aTransport, E);
        raise;
      end;
    end;
  finally
    if (instance <> nil) then aFactory.ReleaseInstance(aMessage.ClientID, instance);
  end
  else
    RaiseError(err_UnknownMethod, [aMessage.MessageName, aFactory.InterfaceName]);
end;