远程调用技术代码追踪(webservice)

最近阅读了SocketConn的源码和WebService 的源码，把追踪的过程写了下来，方便大家学习。毕竟这需要精力，时间和毅力。感谢煮茶待英雄博志区和三层数据库讨论区兄弟们的支持，特别是julian兄弟，不是他，我可能没耐心继续下去。如果有时间，大家可以继续完善。从socket和Websevice的底层实现细节，我们发现BORLAND的工程师们的构思和实现的过程。我觉得这对我们的学习应该是非常重要的。学会思考。学会读源码，学会分析。
希望和我交往的朋友可通过QQ或Email联系我。Wu_yanan2003@yahoo.com.cn
另见：《远程调用技术代码追踪(socket) 》
关注我的：《远程调用技术代码追踪(第三方控件) 》
 
 
 
远程调用技术内幕
有关WebService的相关的知识，我就不说了，我直接分析源码。有问题的地方请参考李维的书。
initialization
InvRegistry.RegisterInterface(TypeInfo(IMyFirstWS), 'urn:MyFirstWSIntf-IMyFirstWS', 'utf-8');
看过李维的分布式架构的应该都知道，WEB服务端对类和接口进行了注册，客户端这里也进行了注册。然后客户端把数据通过HTTP传输到服务器端，服务器端通过拆包，去到注册管理的类中寻找相应的接口，并创建一个相应的对象，把客户端的数据压进去，调用后，把数据再传回来。
在调用这句的时候，TinvokableClassRegistry类已经创建了，由于inquire_v1也引用了InvRegistry注册，所以在哪里被引用的时候已经被创建了。
function InvRegistry: TInvokableClassRegistry;
begin
 if not Assigned(InvRegistryV) then
    InitIR;
 Result := InvRegistryV;
end;
初次引用会调用InitIR方法。
procedure InitIR;
begin
 InvRegistryV := TInvokableClassRegistry.Create;
 RemTypeRegistryV := TRemotableClassRegistry.Create;
 RemClassRegistryV:= RemTypeRegistry;
 InitBuiltIns; //定们到这一句：
 InitXSTypes;
 InitMoreBuiltIns;
end;
 
先看InvRegistryV := TInvokableClassRegistry.Create;，这个类是用来注册，相应的接口及类，
并能够根据soap封包内容找到相应的接口及方法。
TRemotableClassRegistry        = TRemotableTypeRegistry;
所对应的是TremotableTypeRegistry, 这个类主要是对数据类型进行注册。
 
大致来了解一下这个类。
TInvokableClassRegistry = class(TInterfacedObject)
 private
    FLock: TRTLCriticalSection;
    FRegClasses: array of InvRegClassEntry;
FRegIntfs: array of InvRegIntfEntry;
这里可以看到，声明了两个动态数组。分别用来放接口注册，及类注册信息。
TCreateInstanceProc = procedure(out obj: TObject);
InvRegClassEntry = record
    ClassType: TClass;
    Proc: TCreateInstanceProc;
    URI: string;
 end;
它包含了webservice实现类的指针，以建立实现类的factory函数指针。
 
InvRegIntfEntry = record
    Name: string;                             { Native name of interface    }
    ExtName: Widestring;                      { PortTypeName                }
    UnitName: string;                         { Filename of interface       }
    GUID: TGUID;                              { GUID of interface           }
    Info: PTypeInfo;                          { Typeinfo of interface       }
    DefImpl: TClass;                          { Metaclass of implementation }
    Namespace: Widestring;                    { XML Namespace of type       }
    WSDLEncoding: WideString;                 { Encoding                    }
    Documentation: string;                    { Description of interface    }
    SOAPAction: string;                       { SOAPAction of interface     }
    ReturnParamNames: string;                 { Return Parameter names      }
    InvokeOptions: TIntfInvokeOptions;        { Invoke Options              }
    MethNameMap: array of ExtNameMapItem;             { Renamed methods     }
    MethParamNameMap: array of MethParamNameMapItem; { Renamed parameters }
    IntfHeaders: array of IntfHeaderItem;      { Headers                    }
    IntfExceptions: array of IntfExceptionItem;{ Exceptions                 }
    UDDIOperator: String;                      { UDDI Registry of this porttype }
    UDDIBindingKey: String;                    { UDDI Binding key           }
 end;
 
看到它里面有很多东西，接口名称，单元名，GUID等信息。
 
 procedure InitBuiltIns;
begin
 { DO NOT LOCALIZE }
 RemClassRegistry.RegisterXSInfo(TypeInfo(System.Boolean), XMLSchemaNameSpace, 'boolean');
对于处理结构型数据，需要进行 SOAP 封包类型的转换
开发人员在使用这种自定义数据类型前必须对其进行注册，分别是 RegisterXSClass 和 RegisterXSInfo 。前一个方法是注册从 Tremotable 继承下来的类，后一个不需要是从 TremotablXS 继承下来的类。
 
InitBuiltIns;   
 InitXSTypes;
 InitMoreBuiltIns;
这三个函数类似，都是注册一些基本类型等。
看看到底怎么处理的,(这里注册一个BOOLEAN类型)
RemClassRegistry.RegisterXSInfo(TypeInfo(System.Boolean), XMLSchemaNameSpace, 'boolean');
procedure TRemotableTypeRegistry.RegisterXSInfo(Info: PTypeInfo; const URI: WideString = '';
                                                const Name: WideString = '';
                                                const ExtName: WideString = ''); 
…
Index := GetEntry(Info, Found, Name);
 
    if Found then
      Exit;
    if AppNameSpacePrefix <> '' then
      AppURI := AppNameSpacePrefix + '-';
    if URI = '' then
    begin
      if Info.Kind = tkDynArray then
      begin
        UnitName := GetTypeData(Info).DynUnitName;
        URIMap[Index].URI := 'urn:' + AppURI + UnitName;
      end
      else if Info.Kind = tkEnumeration then
      begin
        UnitName := GetEnumUnitName(Info);
        URIMap[Index].URI := 'urn:' + AppURI + UnitName;
      end
      else if Info.Kind = tkClass then
        URIMap[Index].URI := 'urn:' + AppURI + GetTypeData(Info).UnitName
      else
        URIMap[Index].URI := 'urn:' + AppURI;
    end
    else
      URIMap[Index].URI := URI;
    if Name <> '' then
      URIMap[Index].Name := Name
    else
    begin
      URIMap[Index].Name := Info.Name;
    end;
    URIMap[Index].ExtName := ExtName;
    URIMap[Index].Info := Info;
    if Info.Kind = tkClass then
      URIMap[Index].ClassType := GetTypeData(Info).ClassType;
 finally
    UnLock;
 end;
end;
 
看研究一下GetEntry函数，这里以后多次用到，发现这个函数是TremotableClassRegistry类的，说明实际的注册还是在TremotableClassRegistry这个类完成的。
 
function TRemotableClassRegistry.GetEntry(Info: PTypeInfo; var Found: Boolean; const Name: WideString): Integer;
begin
 Result := FindEntry(Info, Found, Name);
 if not Found then
    SetLength(URIMap, Result + 1);
end;
这个函数功能是搜索类型是否已注册，否则，动态数组加1，分配空间进行注册。
 
看看FindEntry (这里传进来的info是TypeInfo(System.Boolean), name: Boolean)
function TRemotableClassRegistry.FindEntry(Info: PTypeInfo; var Found: Boolean; const Name: WideString): Integer;
begin
 Result := 0;
 Found := False;
 while Result < Length(URIMap) do
 begin
    if (Info <> nil) and (URIMap[Result].Info = Info) then
    begin
      if (Name = '') or (URIMap[Result].Name = Name) then
      begin
        Found := True;
        Exit;
      end;
    end;
    Inc(Result);
 end;
end;
这个函数的功能是遍历整个动态数组TremRegEntry，利用TypeInfo信息和名字进行搜索，查看是否已进行注册。
 
看看URIMAP的定义：
URIMAP:    array of TRemRegEntry;
 TObjMultiOptions = (ocDefault, ocMultiRef, ocNoMultiRef);
 TRemRegEntry = record
    ClassType: TClass; //类信息
    Info: PtypeInfo;    // typeInfo信息（RTTL）
    URI: WideString;   //
    Name: WideString; //
    ExtName: WideString; //
    IsScalar: Boolean;    //
    MultiRefOpt: TObjMultiOptions; //
    SerializationOpt: TSerializationOptions;
    PropNameMap: array of ExtNameMapItem;             { Renamed properties }
 end;
继续RegisterXSInfo函数：
这是对动态数组的uri赋值：
if AppNameSpacePrefix <> '' then
      AppURI := AppNameSpacePrefix + '-';
    if URI = '' then
    begin
      if Info.Kind = tkDynArray then
      begin
        UnitName := GetTypeData(Info).DynUnitName;
        URIMap[Index].URI := 'urn:' + AppURI + UnitName;
      end
      else if Info.Kind = tkEnumeration then
      begin
        UnitName := GetEnumUnitName(Info);
        URIMap[Index].URI := 'urn:' + AppURI + UnitName;
      end
      else if Info.Kind = tkClass then
        URIMap[Index].URI := 'urn:' + AppURI + GetTypeData(Info).UnitName
      else
        URIMap[Index].URI := 'urn:' + AppURI;
    end
    else
      URIMap[Index].URI := URI;
    if Name <> '' then
      URIMap[Index].Name := Name
    else
    begin
      URIMap[Index].Name := Info.Name;
end;
 
这句比较关键：
URIMap[Index].Info := Info;
把RTTL信息保存在URL动态数组中。
 
总结一下：一些基本类型，都是通过这种方式，把URI，及INFO信息保存在动态数组中的。
为什么要进行登记，因为WEBSERVICE中的数据类型要转换成DELPHI的PAS类型，用URI标记的XML文件，传输之后，根据这张对照表，就可以分配相应的空间。另外这些类型的注册信息是放在：TremRegEntry动态数组中的。和我们自己定义的接口及类是不同的。
FRegClasses: array of InvRegClassEntry;
 FRegIntfs: array of InvRegIntfEntry; 这是注册自己定义接口及类的动态数组。
 
再来分析：
InitBuiltIns函数中的：
RemClassRegistry.RegisterXSClass(TSOAPAttachment, XMLSchemaNamespace, 'base64Binary', '', False, ocNoMultiRef);
大致和基本类型差不多。
procedure TRemotableTypeRegistry.RegisterXSClass(AClass: TClass; const URI: WideString = '';
                                                 const Name: WideString = '';
                                                 const ExtName: WideString = '';
                                                 IsScalar: Boolean = False;
                                                 MultiRefOpt: TObjMultiOptions = ocDefault);
var
 Index: Integer;
 Found: Boolean;
 AppURI: WideString;
begin
 Lock;
 try
    Index := GetEntry(AClass.ClassInfo, Found, Name);
    if not Found then
    begin
      if AppNameSpacePrefix <> '' then
        AppURI := AppNameSpacePrefix + '-';
      if URI = '' then
        URIMap[Index].URI := 'urn:' + AppURI + GetTypeData(AClass.ClassInfo).UnitName { do not localize }
      else
        URIMap[Index].URI := URI;
      if Name <> '' then
        URIMap[Index].Name := Name
      else
      begin
        URIMap[Index].Name := AClass.ClassName;
       end;
      URIMap[Index].ExtName := ExtName;
      URIMap[Index].ClassType := AClass;
      URIMap[Index].Info := AClass.ClassInfo;
      URIMap[Index].IsScalar := IsScalar;
      URIMap[Index].MultiRefOpt := MultiRefOpt;
    end;
 finally
    UnLock;
 end;
end;
 
 
前面都是说系统类型的注册。下面看看我们自己定义的接口，是如何注册的：
procedure TInvokableClassRegistry.RegisterInterface(Info: PTypeInfo; const Namespace: InvString;
                    const WSDLEncoding: InvString; const Doc: string; const ExtName: InvString);
 
    for I := 0 to Length(FRegIntfs) - 1 do
      if FRegIntfs[I].Info = Info then
        Exit;
 
Index := Length(FRegIntfs);
SetLength(FRegIntfs, Index + 1);
 
GetIntfMetaData(Info, IntfMD, True);
    FRegIntfs[Index].GUID := IntfMD.IID;
    FRegIntfs[Index].Info := Info;
    FRegIntfs[Index].Name := IntfMD.Name;
    FRegIntfs[Index].UnitName := IntfMD.UnitName;
    FRegIntfs[Index].Documentation := Doc;
    FRegIntfs[Index].ExtName := ExtName;
    FRegIntfs[Index].WSDLEncoding := WSDLEncoding;
 
    if AppNameSpacePrefix <> '' then
      URIApp := AppNameSpacePrefix + '-';
 
    { Auto-generate a namespace from the filename in which the interface was declared and
      the AppNameSpacePrefix }
    if Namespace = '' then
      FRegIntfs[Index].Namespace := 'urn:' + URIApp + IntfMD.UnitName + '-' + IntfMD.Name
    else
    begin
      FRegIntfs[Index].Namespace := Namespace;
      FRegIntfs[Index].InvokeOptions := FRegIntfs[Index].InvokeOptions + [ioHasNamespace];
    end;
 
    if FRegIntfs[Index].DefImpl = nil then
    begin
      { NOTE: First class that implements this interface wins!! }
      for I := 0 to Length(FRegClasses) - 1 do
      begin
 
        Table := FRegClasses[I].ClassType.GetInterfaceTable;
        if (Table = nil) then
        begin
          Table := FRegClasses[I].ClassType.ClassParent.GetInterfaceTable;
        end;
        for J := 0 to Table.EntryCount - 1 do
        begin
          if IsEqualGUID(IntfMD.IID, Table.Entries[J].IID) then
          begin
            FRegIntfs[Index].DefImpl := FRegClasses[I].ClassType;
            Exit;
          end;
        end;
      end;
    end;
 finally
    Unlock;
 end;
end;
 
功能：
for I := 0 to Length(FRegIntfs) - 1 do
      if FRegIntfs[I].Info = Info then
        Exit;
遍历FRegIntfs: array of InvRegIntfEntry;数组，根据TypeInfo信息判断该接口是否已注册。
Index := Length(FRegIntfs);
SetLength(FRegIntfs, Index + 1);
新增一个数组元素。
GetIntfMetaData(Info, IntfMD, True);
//得到接口的RTTL信息，然后动态增加到注册的动态数组中。
    FRegIntfs[Index].GUID := IntfMD.IID;
    FRegIntfs[Index].Info := Info;
    FRegIntfs[Index].Name := IntfMD.Name;
    FRegIntfs[Index].UnitName := IntfMD.UnitName;
    FRegIntfs[Index].Documentation := Doc;
    FRegIntfs[Index].ExtName := ExtName;
FRegIntfs[Index].WSDLEncoding := WSDLEncoding;
 
DefImpl里存放的是classType信息：
if FRegIntfs[Index].DefImpl = nil then
    begin
      for I := 0 to Length(FRegClasses) - 1 do
      begin
 
        Table := FRegClasses[I].ClassType.GetInterfaceTable;
        if (Table = nil) then
        begin
          Table := FRegClasses[I].ClassType.ClassParent.GetInterfaceTable;
        end;
        for J := 0 to Table.EntryCount - 1 do
        begin
          if IsEqualGUID(IntfMD.IID, Table.Entries[J].IID) then
          begin
            FRegIntfs[Index].DefImpl := FRegClasses[I].ClassType;
            Exit;
          end;
        end;
      end;
    end;
注意这里：
FRegClasses: array of InvRegClassEntry;
到注册类的动态数组中去搜寻接口的实现类是否注册，如果注册，便把实现类的指针拷贝到DefImpl数据字段。
 
顺便看一下类是怎么注册的：
procedure TInvokableClassRegistry.RegisterInvokableClass(AClass: TClass; CreateProc: TCreateInstanceProc);
var
 Index, I, J: Integer;
 Table: PInterfaceTable;
 
begin
 Lock;
 try
Table := AClass.GetInterfaceTable;
     。。。。。。
    Index := Length(FRegClasses);
    SetLength(FRegClasses, Index + 1);
    FRegClasses[Index].ClassType := AClass;
    FRegClasses[Index].Proc := CreateProc;
 
    for I := 0 to Table.EntryCount - 1 do
    begin
      for J := 0 to Length(FRegIntfs) - 1 do
        if IsEqualGUID(FRegIntfs[J].GUID, Table.Entries[I].IID) then
          if FRegIntfs[J].DefImpl = nil then
            FRegIntfs[J].DefImpl := AClass;
    end;
 finally
    UnLock;
 end;
end;
可以看到和注册接口非常相似。在调用上面方法时，会传入实现类的指针及factory函数指针，调用GetInterfaceTable判断是否实现接口。否则为NIL， 然后在FregClasses增加一元素，把值写入。最后再到FregIntfs是搜寻此实现类的接口是否已经注册。是的话，就把指针储存在FRegIntfs[J].DefImpl中。
继续：
InvRegistry.RegisterDefaultSOAPAction(TypeInfo(IMyFirstWS), 'urn:MyFirstWSIntf-IMyFirstWS#%operationName%');
 
procedure TInvokableClassRegistry.RegisterDefaultSOAPAction(Info: PTypeInfo; const DefSOAPAction: InvString);
var
 I: Integer;
begin
    I := GetIntfIndex(Info);
    if I >= 0 then
    begin
FRegIntfs[I].SOAPAction := DefSOAPAction; 
//值为：urn:MyFirstWSIntf-IMyFirstWS#%operationName
 
      FRegIntfs[I].InvokeOptions := FRegIntfs[I].InvokeOptions + [ioHasDefaultSOAPAction];
      Exit;
    end;
end;
 
设置接口的SOAPAction, 及InvokeOptions属性。
上面讲了用户接口及自定义类注册的实现。
 
看看这几句为何如此神奇，竟然可以实现对象的远程调用？
MyHTTPRIO := THTTPRIO.Create(nil);
MyHTTPRIO.URL :='http://localhost/soap/MyCGI.exe/soap/IMyFirstWS';
ShowMessage(( MyHTTPRIO As IMyFirstWS ).GetObj);
 
研究一下客户端代码：
constructor THTTPRIO.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 { Converter }
  FDomConverter := GetDefaultConverter;
 FConverter := FDomConverter as IOPConvert;
 { WebNode }
 FHTTPWebNode := GetDefaultWebNode;
 FWebNode := FHTTPWebNode as IWebNode;
end;
 
继续到父类中TRIO查看相应代码：
constructor TRIO.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 FInterfaceBound := False;
 FContext := TInvContext.Create;
 
 FSOAPHeaders := TSOAPHeaders.Create(Self);
 FHeadersInbound := THeaderList.Create;
 FHeadersOutBound:= THeaderList.Create;
 FHeadersOutbound.OwnsObjects := False;
 (FSOAPHeaders as IHeadersSetter).SetHeadersInOut(FHeadersInbound, FHeadersOutBound);
end;
 
创建了TinvContext，这个对象是用来创建一个和服务器端一样的调用环境。
客户端的参数信息一个个的填入这个环境中。
创建一个TSOAPHeaders头对象。
 
回到
constructor THTTPRIO.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 { Converter }
 FDomConverter := GetDefaultConverter;
 FConverter := FDomConverter as IOPConvert;
 { WebNode }
 FHTTPWebNode := GetDefaultWebNode;
 FWebNode := FHTTPWebNode as IWebNode;
end;
 
function THTTPRIO.GetDefaultConverter: TOPToSoapDomConvert;
begin
 if (FDefaultConverter = nil) then
 begin
    FDefaultConverter := TOPToSoapDomConvert.Create(Self);
    FDefaultConverter.Name := 'Converter1';                 { do not localize }
    FDefaultConverter.SetSubComponent(True);
 end;
 Result := FDefaultConverter;
end;
而TOPToSoapDomConvert可以把Object Pascal的呼叫和參數自動轉換為SOAP封裝的格式資訊，再藉由THTTPReqResp傳送HTTP封包。
 
function THTTPRIO.GetDefaultWebNode: THTTPReqResp;
begin
 if (FDefaultWebNode = nil) then
 begin
    FDefaultWebNode := THTTPReqResp.Create(Self);
    FDefaultWebNode.Name := 'HTTPWebNode1';                { do not localize }
    FDefaultWebNode.SetSubComponent(True);
 end;
 Result := FDefaultWebNode;
end;
//用来传送HTTP的封包。
 
 
function THTTPRIO.GetDefaultConverter: TOPToSoapDomConvert;
begin
 if (FDefaultConverter = nil) then
 begin
    FDefaultConverter := TOPToSoapDomConvert.Create(Self);
    FDefaultConverter.Name := 'Converter1';                 { do not localize }
    FDefaultConverter.SetSubComponent(True);
 end;
 Result := FDefaultConverter;
end;
 
 
————————————————
版权声明：本文为CSDN博主「hejishan」的原创文章，遵循CC 4.0 BY-SA版权协议，转载请附上原文出处链接及本声明。
原文链接：https://blog.csdn.net/hejishan/article/details/2530377