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

最新推荐文章于 2023-06-02 22:30:14 发布

shsh1234567890

最新推荐文章于 2023-06-02 22:30:14 发布

阅读量113

点赞数

文章标签： web Powered by 金山文档

原文链接：https://blog.csdn.net/hejishan/article/details/2530377

版权

最近阅读了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;

看研究一下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;

Inc(Result);

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;

前面都是说系统类型的注册。下面看看我们自己定义的接口，是如何注册的：

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;

finally

Unlock;

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;

注意这里：

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;

可以看到和注册接口非常相似。在调用上面方法时，会传入实现类的指针及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;

设置接口的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;

————————————————

原文链接：https://blog.csdn.net/hejishan/article/details/2530377

shsh1234567890

关注

0
点赞
踩
0

收藏

觉得还不错? 一键收藏
0
评论
复制链接

分享到 QQ

分享到新浪微博

扫一扫