最近阅读了SocketConn的源码和WebService 的源码，把追踪的过程写了下来，方便大家学习。毕竟这需要精力，时间和毅力。感谢煮茶待英雄博志区和三层数据库讨论区兄弟们的支持，特别是julian兄弟，不是他，我可能没耐心继续下去。如果有时间，大家可以继续完善。从socket和Websevice的底层实现细节，我们发现BORLAND的工程师们的构思和实现的过程。我觉得这对我们的学习应该是非常重要的。学会思考。学会读源码，学会分析。希望和我交往的朋友可通过QQ或Email联系我。[email protected] 11718111另见：《远程调用技术代码追踪(socket) 》 《远程调用技术代码追踪(第三方控件) 》webservice内部工作机制比较复杂，有些地方分析错误在所难免。加上时间关系，比较匆忙。有错误的地方，请斧正。学习不密闭。有些地方贴了些图片。不好贴上来，所以不是很完整，有需要的，可以QQ，或者MAIL联系我。远程调用技术内幕有关WebService的相关的知识，我就不说了，我直接分析源码。有问题的地方请参考李维的书。initializationInvRegistry.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),'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,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,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,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; tryTable := 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 beginFRegIntfs[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; FHTTPWebNode := GetDefaultWebNode;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;创建了一个THTTPReqResp，用于HTTP通信。MyHTTPRIO.URL :='http://localhost/soap/MyCGI.exe/soap/IMyFirstWS';procedure THTTPRIO.SetURL(Value: string);begin if Assigned(FHTTPWebNode) then begin FHTTPWebNode.URL := Value; if Value <> '' then begin WSDLLocation := ''; ClearDependentWSDLView; end; end;end;procedure THTTPReqResp.SetURL(const Value: string);begin if Value <> '' then FUserSetURL := True else FUserSetURL := False; InitURL(Value); Connect(False);end;procedure THTTPReqResp.InitURL(const Value: string); InternetCrackUrl(P,URLComp); FURLScheme := URLComp.nScheme; FURLPort := URLComp.nPort; FURLHost := copy(Value,URLComp.lpszHostName - P + 1,URLComp.dwHostNameLength); FURL := Value;end;设置THTTPReqResp的属性。和HTTP服务器通信。procedure THTTPReqResp.Connect(Value: Boolean);if Assigned(FInetConnect) then InternetCloseHandle(FInetConnect); FInetConnect := nil; if Assigned(FInetRoot) then InternetCloseHandle(FInetRoot); FInetRoot := nil;FConnected := False;Value 为FLASE。ShowMessage(( MyHTTPRIO As IMyFirstWS ).Getobj);利用AS转换成webservice的接口。用转换后的接口到客户端的InvRegInftEntry表格中搜寻WEBSERVICE服务接口，根据RTTL生成SOAP封包。procedure _IntfCast(var Dest: IInterface; const Source: IInterface; const IID: TGUID);先看这一句：CALL DWORD PTR [EAX] + VMTOFFSET IInterface.QueryInterfacefunction THTTPRIO.QueryInterface(const IID: TGUID; out Obj): HResult;var uddiOperator,uddiBindingKey: string;begin Result := inherited QueryInterface(IID,Obj); if Result = 0 then begin if IsEqualGUID(IID,FIID) then begin FHTTPWebNode.soapAction := InvRegistry.GetActionURIOfIID(IID); if InvRegistry.GetuddiInfo(IID,uddiOperator,uddiBindingKey) then begin FHTTPWebNode.uddiOperator := uddiOperator; FHTTPWebNode.uddiBindingKey := uddiBindingKey; end; end; end;end;Result := inherited QueryInterface(IID,Obj);//跟踪一下这一句：这句比较重要，要重点分析。这里创建了虚拟表格。function TRIO.QueryInterface(const IID: TGUID; out Obj): HResult;begin Result := E_NOINTERFACE; { IInterface,IRIOAccess } //判断接口是不是IRIOAccess类型 if IsEqualGUID(IID,IInterface) or IsEqualGUID(IID,IRIOAccess) then { ISOAPHeaders }//判断接口是不是ISOAPHeaders类型 if IsEqualGUID(IID,ISOAPHeaders) then… if GenVTable(IID) then begin Result := 0; FInterfaceBound := True; Pointer(Obj) := IntfTableP; InterlockedIncrement(FRefCount); end;看看GenVTable函数：function TRIO.GenVTable(const IID: TGUID): Boolean;Info := InvRegistry.GetInterfaceTypeInfo(IID);这个函数是去到TinvokableClassRegistry中搜寻该接口是否注册，注册过的接口则返回typeinfo信息赋给指针。function TInvokableClassRegistry.GetInterfaceTypeInfo(const AGUID: TGUID): Pointer;var I: Integer;begin Result := nil; Lock; try for I := 0 to Length(FRegIntfs) - 1 do begin if IsEqualGUID(AGUID,FRegIntfs[I].GUID) then begin Result := FRegIntfs[I].Info; Exit; end; end; finally UnLock; end;end;继续：通过infotype得到RTTL信息。 try GetIntfMetaData(Info,True); except HasRTTI := False; Exit; end;{ TProc = procedure of object; TObjFunc = function: Integer of Object; stdcall; TQIFunc = function(const IID: TGUID; out Obj): HResult of object; stdcall; PProc = ^TProc;TCracker = record case integer of 0: (Fn: TProc); 1: (Ptr: Pointer); 2: (ObjFn: TObjFunc); 3: (QIFn: TQIFunc); end;} Crack.Fn := GenericStub; StubAddr := Crack.Ptr; 地址指向函数TRIO.GenericStub函数。Crack.Fn结构的指针指向这段代码的意思是用C/stdcall等方式调用函数。从左到右，从右到左压入堆栈。调整TRIO.IntfTable的指针,最后调用TRIO.Genericprocedure TRIO.GenericStub;asm POP EAX { Return address in runtime generated stub } POP EDX { Is there a pointer to return structure on stack and which CC is used? } CMP EDX,2 JZ @@RetoNSTACKRL CMP EDX,1 JZ @@RetoNSTACKLR POP EDX { Method # pushed by stub } PUSH EAX { Push back return address } LEA ECX,[ESP+12] { Calc stack pointer to start of params } MOV EAX,[ESP+8] { Calc interface instance ptr } JMP @@CONT@@RetoNSTACKLR: POP EDX { Method # pushed by stub } PUSH EAX { Push back return address } LEA ECX,[ESP+8] { Calc interface instance ptr } JMP @@CONT@@RetoNSTACKRL: POP EDX { Method # pushed by stub } PUSH EAX { Push back return address } LEA ECX,[ESP+8] { Calc stack pointer to start of params } MOV EAX,[ESP+12] { calc interface instance ptr }@@CONT: SUB EAX,OFFSET TRIO.IntfTable; { Adjust intf pointer to object pointer } JMP TRIO.Genericend; Crack.Fn := ErrorEntry; ErrorStubAddr := Crack.Ptr;//首先分配vtable空间，接口数加3， 因为有IunkNown接口。 GetMem(IntfTable,(Length(IntfMD.MDA) + NumEntriesInIInterface) * 4); IntfTableP := @IntfTable; 然后把地址赋给IntfTableP变量 GetMem(IntfStubs,(Length( IntfMD.MDA) + NumEntriesInIInterface) * StubSize ); 分配存根接口空间。 这是解释 IntfTable: Pointer; { Generated vtable for the object } IntfTableP: Pointer; { Pointer to the generated vtable } IntfStubs: Pointer; { Pointer to generated vtable thunks}//Load the IUnkNown vtable 分配指针，加入三个接口IunkNown VTable := PPointer(IntfTable); Crack.QIFn := _QIFromIntf; QI查询指针赋值给 Crack结构体 VTable^ := Crack.Ptr; 赋给VT指针 IncPtr(VTable,4); 增加一个指针。 Crack.ObjFn := _AddRefFromIntf; VTable^ := Crack.Ptr; IncPtr(VTable,4); Crack.ObjFn := _ReleaseFromIntf; VTable^ := Crack.Ptr; IncPtr(VTable,4); VTable := AddPtr(IntfTable,NumEntriesInIInterface * 4);//增加IunKNown指针的三个方法。压入IntfTable中。 Thunk := AddPtr(IntfStubs,NumEntriesInIInterface * StubSize); //调整Thunk，加入IunKNown接口方法。//遍历所有方法：产生机器相应的汇编机器代码。 for I := NumEntriesInIInterface to Length(IntfMD.MDA) - 1 do begin CallStubIdx := 0; if not IntfMD.MDA[I].HasRTTI then begin GenByte($FF); { FF15xxxxxxxx Call [mem] } GenByte($15); Crack.Fn := ErrorEntry; GenDWORD(LongWord(@ErrorStubAddr)); end else begin { PUSH the method ID } GenPushI(I); //定位这里：看看函数做了什么：CallStub: array[0..StubSize-1] of Byte;I=3。CallStubIdx=2procedure TRIO.GenPushI(I: Integer);begin if I < 128 then begin CallStub[CallStubIdx] := $6A; CallStub[CallStubIdx + 1] := I; Inc(CallStubIdx,2); end else begin CallStub[CallStubIdx] := $68; PInteger(@CallStub[CallStubIdx + 1])^ := I; Inc(CallStubIdx,5); end;end;登记函数调用信息,数组增加一元素。遍历接口信息，函数ID号压入堆栈中。 { PUSH the info about return value location } if RetonStack(IntfMD.MDA[I].ResultInfo) then begin if IntfMD.MDA[I].CC in [ccStdcall,ccCdecl] then GenPushI(2) else GenPushI(1); end else GenPushI(0);把返回值压入堆栈中。//把返回参数压入堆栈。 接着把GenericStub压入堆栈中。 { Generate the CALL [mem] to the generic stub } GenByte($FF); { FF15xxxxxxxx Call [mem] } GenByte($15);GenDWORD(LongWord(@StubAddr));这几句是生成汇编的代码。可以产生这样的调用：ff15xxxxxx:地址： caa [mem]编号: //这里调用的。//看看里面的内容是什么： { Generate the return sequence } if IntfMD.MDA[I].CC in [ccCdecl] then begin { For cdecl calling convention,the caller will do the cleanup,so } { we convert to a regular ret. } GenRet; end else begin BytesPushed := 0; for J := 0 to IntfMD.MDA[I].ParamCount - 1 do begin if IsParamByRef(IntfMD.MDA[I].Params[J].Flags,IntfMD.MDA[I].Params[J].Info,IntfMD.MDA[I].CC) then Inc(BytesPushed,4) elseInc(BytesPushed,GetStackTypeSize(IntfMD.MDA[I].Params[J].Info,IntfMD.MDA[I].CC ));//每个参数分配空间。 end; Inc(BytesPushed,GetStackTypeSize(IntfMD.MDA[I].SelfInfo,IntfMD.MDA[I].CC ));//压入函数本身信息： { Todo: Investigate why not always 4 ?? } if RetonStack(IntfMD.MDA[I].ResultInfo) or (IntfMD.MDA[I].CC = ccSafeCall) then Inc(BytesPushed,4); if BytesPushed > 252 then raise Exception.CreateFmt(STooManyParameters,[IntfMD.MDA[I].Name]); GenRET(BytesPushed); end;end;//GenRET(BytesPushed); 分配函数参数空间。 { copy as much of the stub that we initialized over to the } { block of memory we allocated. } P := PByte(Thunk); for J := 0 to CallStubIdx - 1 do begin P^ := CallStub[J]; IncPtr(P); end;Thunk的指针，指向汇编代码相应的调用信息： { And then fill the remainder with INT 3 instructions for } { cleanliness and safety. If we do the allocated more smartly,we } { can remove all the wasted space,except for maybe alignment. } for J := CallStubIdx to StubSize - 1 do begin P^ := $CC; IncPtr(P); end;增加Thunk指向存根相应调用信息： { Finally,put the new thunk entry into the vtable slot. } VTable^ := Thunk;IncPtr(VTable,4);把thunk指针赋给vtable之后，压入堆栈。IncPtr(Thunk,StubSize);把存根相应调用信息压入堆栈。然后继续下一个函数的相应操作。 end;end;procedure IncPtr(var P; I: Integer = 1);asm ADD [EAX],EDXend;总结一下GenVTable函数，这个函数，根据注册的接口，生成了内存表格。首先遍历整个动态数组，然后，得到接口的RTTL信息，随后把Tcracker结构内存入相应的调用信息。然后再分配两块内存，一块放接口信息，一块放存根调用信息，再把接口内存的指针赋给TRIO的IntfTableP变量。IntfStubs存放存根指针IntfTable指接口信息后，又加入了IunkNown的指针空间。最近遍历接口函数，把函数信息写入CallStub数组之后（生成机器代码），再填入堆栈之中。继续：THTTPRIO.QueryInterfaceTInvokableClassRegistry.GetActionURIOfInfoif InvRegistry.GetuddiInfo(IID,uddiBindingKey) then调用之后：function TInvokableClassRegistry.GetuddiInfo(const IntfInfo: PTypeInfo; var Operator,BindingKey: string): Boolean;返回procedure _IntfCast(var Dest: IInterface; const Source: IInterface; const IID: TGUID);这里，继续：procedure TRIO.GenericStub;JMP TRIO.Generic//这里是最重要的地方：这个函数完成了。打包，传递，并返回服务器端结果。我们仔细研究一下。function TRIO.Generic(CallID: Integer; Params: Pointer): Int64;。。。。MethMD := IntfMD.MDA[CallID]; //得到方法相应的属性。FContext.SetMethodInfo(MethMD); // FContext 产生虚拟的表函数表格。procedure TInvContext.SetMethodInfo(const MD: TIntfMethEntry);begin SetLength(DataP,MD.ParamCount + 1); SetLength(Data,(MD.ParamCount + 1) * MAXINLInesIZE);end;if MethMd.CC <> ccSafeCall then begin if RetonStack(MethMD.ResultInfo) then begin RetP := Pointer(PInteger(P)^); if MethMD.ResultInfo.Kind = tkVariant then IncPtr(P,sizeof(Pointer)) else IncPtr(P,GetStackTypeSize(MethMD.ResultInfo,MethMD.CC)); if MethMD.CC in [ccCdecl,ccStdCall] then begin IncPtr(P,sizeof(Pointer)); { Step over self } end; end else RetP := @Result; FContext.SetResultPointer(RetP); end;//把相应的返回信息压入Fcontext中。for J := 0 to MethMD.ParamCount - 1 do begin FContext.SetParamPointer(ParamIdx,P); with MethMD.Params[J] do begin if (Info.Kind = tkVariant) and (MethMD.CC in [ccCdecl,ccStdCall,ccSafeCall]) and not (pfVar in Flags) and not (pfOut in Flags) then begin IncPtr(P,sizeof(tvarData)); { NOTE: better would be to dword-align!! } end else if IsParamByRef(Flags,Info,MethMD.CC) then IncPtr(P,4) else IncPtr(P,GetStackTypeSize(Info,MethMD.CC)); end; Inc(ParamIdx,LeftRightOrder); end;//把相应的参数压入Fcontext中。//转换成XML封包，并写入流中，这里就是具体打包的地方：大家看清楚了： Req := FConverter.InvContextToMsg(IntfMD,MethNum,FContext,fheadersOutBound);现在来好好研究一下它是怎么转换成XML封包的。function TOPToSoapDomConvert.InvContextToMsg(const IntfMD: TIntfMetaData; MethNum: Integer; Con: TInvContext; Headers: THeaderList): TStream;MethMD := IntfMD.MDA[MethNum];首先得到方法的动态信息。XMLDoc := NewXMLDocument; 看看这句：function TOPToSoapDomConvert.NewXMLDocument: IXMLDocument;begin Result := XMLDoc.NewXMLDocument; Result.Options := Result.Options + [doNodeAutoIndent]; Result.ParSEOptions := Result.ParSEOptions + [poPreserveWhiteSpace];end;function NewXMLDocument(Version: DOMString = '1.0'): IXMLDocument;begin Result := TXMLDocument.Create(nil); Result.Active := True; if Version <> '' then Result.Version := Version;end;创建了一个TXMLDocument对象用于读写XML。procedure TXMLDocument.SetActive(const Value: Boolean);begin 。。。。 CheckDOM; FDOMDocument := DOMImplementation.createDocument('',nil); try LoadData; except ReleaseDoc(False); raise; end; DoAfterOpen; end else begin dobeforeClose; ReleaseDoc; DoAfterClose; end; end;end;
procedure TXMLDocument.CheckDOM; begin if not Assigned(FDOMImplementation) then if Assigned(FDOMvendor) then FDOMImplementation := FDOMvendor.DOMImplementation else FDOMImplementation := GetDOM(DefaultDOMvendor); end; 在TXMLDocument内部使用了Abstract Factory模式 Abstract Factory希望不用指定具体的类，但为了找到它们，在TXMLDocument是通过指定一个字符串，也就是我们点击DOMvendor时出现的哪几个字符串． GetDOM函数如下： Result := GetDOMvendor(vendorDesc).DOMImplementation; //根据传递进去的名字，创建相应在的实例： function GetDOMvendor(vendorDesc: string): TDOMvendor; begin if vendorDesc = '' then vendorDesc := DefaultDOMvendor; if (vendorDesc = '') and (DOMvendorList.Count > 0) then Result := DOMvendorList[0] else Result := DOMvendorList.Find(vendorDesc); if not Assigned(Result) then raise Exception.CreateFmt(SNoMatchingDOMvendor,[vendorDesc]); end; 最后取得一个IDOMImplementation，它有一个createDocument（….）:IDOMDocument;函数，这个函数将返回一个IDOMDocument;接口让IXMLDoucment使用。 //由此可见，默认状态下是创建DOM，微软的XML解析器。 function DOMvendorList: TDOMvendorList; begin if not Assigned(DOMvendors) then DOMvendors := TDOMvendorList.Create; Result := DOMvendors; end; function TDOMvendorList.Getvendors(Index: Integer): TDOMvendor; begin Result := Fvendors[Index]; end; 如果为空，就返回默认的。 function TMSDOMImplementationFactory.DOMImplementation: IDOMImplementation; begin Result := TMSDOMImplementation.Create(nil); end; 再返回到函数： procedure TXMLDocument.SetActive(const Value: Boolean); FDOMDocument := DOMImplementation.createDocument('',nil); 继续： function TMSDOMImplementation.createDocument(const namespaceURI, qualifiedname: DOMString; doctype: IDOMDocumentType): IDOMDocument; begin Result := TMSDOMDocument.Create(MSXMLDOMDocumentCreate); end; 在如果使用MSXML,接口对应的是TMSDOMDocument，TMSDOMDocument是实际上是调用MSXML技术，下面是调用MS COM的代码 function CreateDOMDocument: IXMLDOMDocument; begin Result := TryObjectCreate([CLASS_DOMDocument40,CLASS_DOMDocument30, CLASS_DOMDocument26,msxml.CLASS_DOMDocument]) as IXMLDOMDocument; if not Assigned(Result) then raise DOMException.Create(SMSDOMnotinstalled); end; 再返回到函数： procedure TXMLDocument.SetActive(const Value: Boolean); .. LoadData //因为是新建的TXMLDocument，所以装内空数据,立即返回。 procedure TXMLDocument.LoadData; const UnicodeEncodings: array[0..2] of string = ('UTF-16','UCS-2','UNICODE'); var Status: Boolean; ParseError: IDOMParseError; StringStream: TStringStream; Msg: string; begin … Status := True; { No load,just create empty doc. } 创建空的文档： if not Status then begin DocSource := xdsNone; ParseError := DOMDocument as IDOMParseError; with ParseError do Msg := Format('%s%s%s: %d%s%s',[Reason,SLineBreak,SLine, Line,copy(SrcText,1,40)]); raise EDOMParseError.Create(ParseError,Msg); end; SetModified(False); end; 设置不能修改。因为空文档。 继续返回到 function NewXMLDocument(Version: DOMString = '1.0'): IXMLDocument; begin if Version <> '' then Result.Version := Version; end; procedure TXMLDocument.SetVersion(const Value: DOMString); begin SetPrologValue(Value,xpVersion); end; procedure TXMLDocument.SetPrologValue(const Value: Variant; …. PrologNode := GetPrologNode; PrologAttrs := InternalSetPrologValue(PrologNode,Value,PrologItem); NewPrologNode := CreateNode('xml',ntProcessingInstr,PrologAttrs); if Assigned(PrologNode) then Node.ChildNodes.ReplaceNode(PrologNode,NewPrologNode) else ChildNodes.Insert(0,NewPrologNode); end; NewPrologNode := CreateNode('xml',PrologAttrs); 这句调用了： function TXMLDocument.CreateNode(const NameOrData: DOMString; NodeType: TNodeType = ntElement; const AddlData: DOMString = ''): IXMLNode; begin Result := TXMLNode.Create(CreateDOMNode(FDOMDocument,NameOrData, NodeType,AddlData),nil,Self); end; 在返回到这个函数中： function TOPToSoapDomConvert.InvContextToMsg(const IntfMD: TIntfMetaData; MethNum: Integer; Con: TInvContext; Headers: THeaderList): TStream; BodyNode := Envelope.MakeBody(EnvNode); if not (soLiteralParams in Options) then begin SoapMethNS := GetSoapNS(IntfMD); ExtMethName := InvRegistry.GetMethExternalName(IntfMD.Info,MethMD.Name)； ;;;;; //创建一个SOAP的body: function TSoapEnvelope.MakeBody(ParentNode: IXMLNode): IXMLNode; begin Result := ParentNode.AddChild(SSoapNameSpacePre + ':' + SSoapBody,SSoapNameSpace); end; SoapMethNS := GetSoapNS(IntfMD); 返回：'urn:MyFirstWSIntf-IMyFirstWS' ExtMethName := InvRegistry.GetMethExternalName(IntfMD.Info,MethMD.Name); 得到调用方法名。剩下的部分就是把参数打包。生成SOAP的源文件。然后写到内存流中。 再回到函数中：InvContextToMsg Result := TMemoryStream.Create(); DOMToStream(XMLDoc,Result); 把内存块的数据，转化成XML。 具体的函数如下： procedure TOPToSoapDomConvert.DOMToStream(const XMLDoc: IXMLDocument; Stream: TStream); var XMLWString: WideString; StrStr: TStringStream; begin if (FEncoding = '') or (soUTF8EncodeXML in Options) then begin XMLDoc.SavetoXML(XMLWString); StrStr := TStringStream.Create(UTF8Encode(XMLWString)); try Stream.copyFrom(StrStr,0); finally StrStr.Free; end; end else XMLDoc.SavetoStream(Stream); end; 我们跟踪之后StrStr的结果如下： '<?xml version="1.0"?>'#$D#$A'<SOAP-ENV:Envelope xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:SOAP-ENC="http://schemas.xmlsoap.org/soap/encoding/">'#$D#$A' <SOAP-ENV:Body SOAP-ENV:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">'#$D#$A' <NS1:Getobj xmlns:NS1="urn:MyFirstWSIntf-IMyFirstWS">'#$D#$A' <a xsi:type="xsd:int">3</a>'#$D#$A' <b xsi:type="xsd:int">4</b>'#$D#$A' </NS1:Getobj>'#$D#$A' </SOAP-ENV:Body>'#$D#$A'</SOAP-ENV:Envelope>'#$D#$A 转化后继续调用Generic函数： 。。。。 FWebNode.BeforeExecute(IntfMD,MethMD,MethNum-3,nil); if (BindingType = btMIME) then begin 。。。 FWebNode.BeforeExecute(IntfMD,nil); THTTPReqResp.BeforeExecute 。。。。。 MethName := InvRegistry.GetMethExternalName(IntfMD.Info,MethMD.Name); FSoapAction := InvRegistry.GetActionURIOfInfo(IntfMD.Info,MethName,Methodindex); 得到方法名和FsoapAction FBindingType := btSOAP dobeforeExecute // TRIO. if Assigned(FOnBeforeExecute) then 退出： 继续： Resp := GetResponseStream(RespBindingType); 继续返回到TRIO.Generic函数中执行： try FWebNode.Execute(Req,Resp); 比较重要的部分： 这个函数就是THTTPReqResp向IIS发出请求。并返回信息： procedure THTTPReqResp.Execute(const Request: TStream; Response: TStream); begin … Context := Send(Request); try try Receive(Context,Response); Exit; except on Ex: ESOAPHTTPException do begin Connect(False); if not CanRetry or not IsErrorStatusCode(Ex.StatusCode) then raise; { Trigger uddi Lookup } LookUpuddi := True; PrevError := Ex.Message; end; else begin Connect(False); raise; end; end; finally if Context <> 0 then InternetCloseHandle(Pointer(Context)); end; end; {$ENDIF} end; 现在看看Send函数，看看到底如何发送数据给WEB服务器的。 function THTTPReqResp.Send(const ASrc: TStream): Integer; var Request: HINTERNET; RetVal,Flags: DWord; P: Pointer; ActionHeader: string; ContentHeader: string; BuffSize,Len: Integer; INBuffer: INTERNET_BUFFERS; Buffer: TMemoryStream; StrStr: TStringStream; begin { Connect } Connect(True); Flags := INTERNET_FLAG_KEEP_CONNECTION or INTERNET_FLAG_NO_CACHE_WRITE; if FURLScheme = INTERNET_SCHEME_HTTPS then begin Flags := Flags or INTERNET_FLAG_SECURE; if (soIgnoreInvalidCerts in InvokeOptions) then Flags := Flags or (INTERNET_FLAG_IGnorE_CERT_CN_INVALID or INTERNET_FLAG_IGnorE_CERT_DATE_INVALID); end; Request := nil; try Request := HttpOpenRequest(FInetConnect,'POST',PChar(FURLSite), nil,Flags,0{Integer(Self)}); Check(not Assigned(Request)); { Timeouts } if FConnectTimeout > 0 then Check(InternetSetoption(Request,INTERNET_OPTION_CONNECT_TIMEOUT,Pointer(@FConnectTimeout),SizeOf(FConnectTimeout))); if FSendTimeout > 0 then Check(InternetSetoption(Request,INTERNET_OPTION_SEND_TIMEOUT,Pointer(@FSendTimeout),SizeOf(FSendTimeout))); if FReceiveTimeout > 0 then Check(InternetSetoption(Request,INTERNET_OPTION_RECEIVE_TIMEOUT,Pointer(@FReceiveTimeout),SizeOf(FReceiveTimeout))); { Setup packet based on Content-Type/Binding } if FBindingType = btMIME then begin ContentHeader := Format(ContentHeaderMIME,[FMimeBoundary]); ContentHeader := Format(ContentTypeTemplate,[ContentHeader]); HttpAddRequestHeaders(Request,PChar(MIMEVersion),Length(MIMEVersion),HTTP_ADDREQ_FLAG_ADD); { SOAPAction header } { NOTE: It's not really clear whether this should be sent in the case of MIME Binding. Investigate interoperability ?? } if not (soNoSOAPActionHeader in FInvokeOptions) then begin ActionHeader:= GetSOAPActionHeader; HttpAddRequestHeaders(Request,PChar(ActionHeader),Length(ActionHeader),HTTP_ADDREQ_FLAG_ADD); end; end else { Assume btSOAP } begin { SOAPAction header } if not (soNoSOAPActionHeader in FInvokeOptions) then begin ActionHeader:= GetSOAPActionHeader; HttpAddRequestHeaders(Request,HTTP_ADDREQ_FLAG_ADD); end; if UseUTF8InHeader then ContentHeader := Format(ContentTypeTemplate,[ContentTypeUTF8]) else ContentHeader := Format(ContentTypeTemplate,[ContentTypeNoUTF8]); end; { Content-Type } HttpAddRequestHeaders(Request,PChar(ContentHeader),Length(ContentHeader),HTTP_ADDREQ_FLAG_ADD); { Before we pump data,see if user wants to handle something - like set Basic-Auth data?? } if Assigned(FOnBeforePost) then FOnBeforePost(Self,Request); ASrc.Position := 0; BuffSize := ASrc.Size; if BuffSize > FMaxSinglePostSize then begin Buffer := TMemoryStream.Create; try Buffer.SetSize(FMaxSinglePostSize); { Init Input Buffer } INBuffer.dwStructSize := SizeOf(INBuffer); INBuffer.Next := nil; INBuffer.lpcszHeader := nil; INBuffer.dwHeadersLength := 0; INBuffer.dwHeadersTotal := 0; INBuffer.lpvBuffer := nil; INBuffer.dwBufferLength := 0; INBuffer.dwBufferTotal := BuffSize; INBuffer.dwOffsetLow := 0; INBuffer.dwOffsetHigh := 0; { Start POST } Check(not HttpSendRequestEx(Request,@INBuffer, HSR_INITIATE or HSR_SYNC,0)); try while True do begin { Calc length of data to send } Len := BuffSize - ASrc.Position; if Len > FMaxSinglePostSize then Len := FMaxSinglePostSize; { Bail out if zip.. } if Len = 0 then break; { Read data in buffer and write out} Len := ASrc.Read(Buffer.Memory^,Len); if Len = 0 then raise ESOAPHTTPException.Create(SInvalidHTTPRequest); Check(not InternetWriteFile(Request,@Buffer.Memory^,Len,RetVal)); RetVal := InternetErrorDlg(GetDesktopWindow(),Request,GetLastError, FLAGS_ERROR_UI_FILTER_FOR_ERRORS or FLAGS_ERROR_UI_FLAGS_CHANGE_OPTIONS or FLAGS_ERROR_UI_FLAGS_GENERATE_DATA,P); case RetVal of ERROR_SUCCESS: ; ERROR_CANCELLED: SysUtils.Abort; ERROR_INTERNET_FORCE_RETRY: {Retry the operation}; end; { Posting Data Event } if Assigned(FOnPostingData) then FOnPostingData(ASrc.Position,BuffSize); end; finally Check(not HttpEndRequest(Request,0)); end; finally Buffer.Free; end; end else begin StrStr := TStringStream.Create(''); try StrStr.copyFrom(ASrc,0); while True do begin Check(not HttpSendRequest(Request,@StrStr.DataString[1],Length(StrStr.DataString))); RetVal := InternetErrorDlg(GetDesktopWindow(), FLAGS_ERROR_UI_FILTER_FOR_ERRORS or FLAGS_ERROR_UI_FLAGS_CHANGE_OPTIONS or FLAGS_ERROR_UI_FLAGS_GENERATE_DATA,P); case RetVal of ERROR_SUCCESS: break; ERROR_CANCELLED: SysUtils.Abort; ERROR_INTERNET_FORCE_RETRY: {Retry the operation}; end; end; finally StrStr.Free; end; end; except if (Request <> nil) then InternetCloseHandle(Request); Connect(False); raise; end; Result := Integer(Request); end; function THTTPReqResp.Send(const ASrc: TStream): Integer; 先调用了： procedure THTTPReqResp.Connect(Value: Boolean); …… if InternetAttemptConnect(0) <> ERROR_SUCCESS then SysUtils.Abort; 这个函数可以说非常 简单，只是尝试计算机连接到网络。 FInetRoot := Internetopen(PChar(FAgent),Accesstype,PChar(FProxy),PChar(FProxyByPass),0); 创建HINTERNET句柄，并初始化WinInet的API函数： Check(not Assigned(FInetRoot)); try FInetConnect := InternetConnect(FInetRoot,PChar(FURLHost),FURLPort,PChar(FUserName), PChar(FPassword),INTERNET_SERVICE_HTTP,Cardinal(Self)); //创建一个特定的会话： Check(not Assigned(FInetConnect)); FConnected := True; except InternetCloseHandle(FInetRoot); FInetRoot := nil; raise; end; 这里已经创建了一个会话： 继续返回function THTTPReqResp.Send(const ASrc: TStream): Integer;函数之中： 。。。。 Request := HttpOpenRequest(FInetConnect,0{Integer(Self)}); Check(not Assigned(Request));。 打开一个HTTP的请求。向WEB服务器提出请求： 。。 if not (soNoSOAPActionHeader in FInvokeOptions) then begin ActionHeader:= GetSOAPActionHeader; HttpAddRequestHeaders(Request,HTTP_ADDREQ_FLAG_ADD); end; 。。。 为请求添加一个或多个标头。可以看到标点的信息为： 'SOAPAction: "urn:MyFirstWSIntf-IMyFirstWS#Getobj"' HttpAddRequestHeaders(Request,HTTP_ADDREQ_FLAG_ADD); 继续加入标头'Content-Type: text/xml'信息： StrStr := TStringStream.Create(''); try StrStr.copyFrom(ASrc,Length(StrStr.DataString))); 建立到internet 的连接，并将请求发送到指定的站点。 这句执行完后的图如下（用工具跟踪的结果）： 看看前面的soap生成的字符 StrStr的结果如下，发现后半部分是一样的。 继续 function THTTPReqResp.Execute(const Request: TStream): TStream; Receive(Context,Response); procedure THTTPReqResp.Receive(Context: Integer; Resp: TStream; IsGet: Boolean); var Size,Downloaded,Status,Index: DWord; S: string; begin .. //获取请求信息： HttpQueryInfo(Pointer(Context),HTTP_QUERY_CONTENT_TYPE,@FContentType[1],Size,Index); repeat Check(not InternetQueryDataAvailable(Pointer(Context),0)); if Size > 0 then begin SetLength(S,Size); Check(not InternetReadFile(Pointer(Context),@S[1],Downloaded)); //下载数据： Resp.Write(S[1],Size); { Receiving Data event } if Assigned(FOnReceivingData) then FOnReceivingData(Size,Downloaded) end; until Size = 0; S的结果如下和刚才跟踪器里的是一模一样的： '<?xml version="1.0"?>'#$D#$A'<SOAP-ENV:Envelope xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:SOAP-ENC="http://schemas.xmlsoap.org/soap/encoding/">'#$D#$A' <SOAP-ENV:Body SOAP-ENC:encodingStyle="http://schemas.xmlsoap.org/soap/envelope/">'#$D#$A' <NS1:GetobjResponse xmlns:NS1="urn:MyFirstWSIntf-IMyFirstWS">'#$D#$A' <return xsi:type="xsd:string">12</return>'#$D#$A' </NS1:GetobjResponse>'#$D#$A' </SOAP-ENV:Body>'#$D#$A'</SOAP-ENV:Envelope>'#$D#$A 最后关闭HTTP会话句柄： InternetCloseHandle(Pointer(Context)); 在返回function TRIO.Generic(CallID: Integer; Params: Pointer): Int64;函数中继续查看： RespXML := Resp; 返回信息的内存流 FConverter.ProcessResponse(RespXML,fheadersInbound); 再次把SOAP封包转换成PASCEL调用： procedure TOPToSoapDomConvert.ProcessResponse(const Resp: TStream; const IntfMD: TIntfMetaData; const MD: TIntfMethEntry; Context: TInvContext; Headers: THeaderList); var XMLDoc: IXMLDocument; begin XMLDoc := NewXMLDocument; XMLDoc.Encoding := FEncoding; Resp.Position := 0; XMLDoc.LoadFromStream(Resp); ProcessResponse(XMLDoc,MD,Context,Headers); end; procedure TOPToSoapDomConvert.ProcessResponse(const XMLDoc: IXMLDocument; const IntfMD: TIntfMetaData; const MD: TIntfMethEntry; Context: TInvContext; Headers: THeaderList); var ProcessSuccess(RespNode,Context); ProcessSuccess函数如下： …. for I := 0 to RespNode.childNodes.Count - 1 do begin Node := RespNode.childNodes[I]; { Skip non-valid nodes } if Node.NodeType <> ntElement then continue; // 处理返回值： if I = RetIndex then begin InvData := InvContext.GetResultPointer; ByRef := IsParamByRef([pfOut],MD.ResultInfo,MD.CC); ConvertSoapToNativeData(InvData,InvContext,RespNode,Node,True,ByRef,1); ConvertSoapToNativeData(InvData,1); 把SOAP的结果，写入返回区地址空间。 procedure TSOAPDomConv.ConvertSoapToNativeData(DataP: Pointer; TypeInfo: PTypeInfo; Context: TDataContext; RootNode,Node: IXMLNode; Translate,ByRef: Boolean; NumIndirect: Integer); var TypeUri,TypeName: InvString; IsNull: Boolean; Obj: TObject; P: Pointer; I: Integer; ID: InvString; begin Node := GetDatanode(RootNode,ID); IsNull := NodeIsNull(Node); if TypeInfo.Kind = tkVariant then begin if NumIndirect > 1 then DataP := Pointer(PInteger(DataP)^); if IsNull then begin Variant(PVarData(DataP)^) := NULL; end else ConvertSoapToVariant(Node,DataP); end else if TypeInfo.Kind = tkDynArray then begin P := DataP; for I := 0 to NumIndirect - 2 do P := Pointer(PInteger(P)^); P := ConvertSoapToNativeArray(P,TypeInfo,RootNode,Node); if NumIndirect = 1 then PInteger(DataP)^ := Integer(P) else if NumIndirect = 2 then begin DataP := Pointer(PInteger(DataP)^); PInteger(DataP)^ := Integer(P); end; end else if TypeInfo.Kind = tkClass then begin Obj := ConvertSOAPToObject(RootNode,GetTypeData(TypeInfo).Classtype,TypeURI,TypeName,DataP,NumIndirect); if NumIndirect = 1 then PTObject(DataP)^ := Obj else if NumIndirect = 2 then begin DataP := Pointer(PInteger(DataP)^); PTObject(DataP)^ := Obj; end; end else begin if Translate then begin if NumIndirect > 1 then DataP := Pointer(PInteger(DataP)^); if not TypeTranslator.CastSoapToNative(TypeInfo,GetNodeAsText(Node),IsNull) then raise ESOAPDomConvertError.CreateFmt(STypeMismatchInParam,[node.nodeName]); end; end; end; 作为整型数据，处理方式为： if not TypeTranslator.CastSoapToNative(TypeInfo,IsNull) then function TTypeTranslator.CastSoapToNative(Info: PTypeInfo; const SoapData: WideString; NatData: Pointer; IsNull: Boolean): Boolean; var ParamTypeData: PTypeData; begin DecimalSeparator := '.'; Result := True; if IsNull and (Info.Kind = tkVariant) then begin Variant(PVarData(NatData)^) := NULL; Exit; end; ParamTypeData := GetTypeData(Info); case Info^.Kind of tkInteger: case ParamTypeData^.OrdType of otSByte, otUByte: PByte(NatData)^ := StrToInt(Trim(SoapData)); otSWord, otUWord: PSmallInt(NatData)^ := StrToInt(Trim(SoapData)); otSLong, otULong: PInteger(NatData)^ := StrToInt(Trim(SoapData)); end; tkFloat: case ParamTypeData^.FloatType of ftSingle: PSingle(NatData)^ := StrToFloatEx(Trim(SoapData)); ftDouble: begin if Info = TypeInfo(TDateTime) then PDateTime(NatData)^ := XMLTimetoDateTime(Trim(SoapData)) else PDouble(NatData)^ := StrToFloatEx(Trim(SoapData)); end; ftComp: PComp(NatData)^ := StrToFloatEx(Trim(SoapData)); ftCurr: PCurrency(NatData)^ := StrToFloatEx(Trim(SoapData)); ftExtended: PExtended(NatData)^ := StrToFloatEx(Trim(SoapData)); end; tkWString: PWideString(NatData)^ := SoapData; tkString: PShortString(NatData)^ := SoapData; tkLString: PString(NatData)^ := SoapData; tkChar: if SoapData <> '' then PChar(NatData)^ := Char(SoapData[1]); tkWChar: if SoapData <> '' then PWideChar(NatData)^ := WideChar(SoapData[1]); tkInt64: PInt64(NatData)^ := StrToInt64(Trim(SoapData)); tkEnumeration: { NOTE: Here we assume enums to be byte-size; make sure (specially for C++) that enums have generated with the proper size } PByte(NatData)^ := GetEnumValueEx(Info,Trim(SoapData)); tkClass: ; tkSet, tkMethod, tkArray, tkRecord, tkInterface, tkDynArray: raise ETypeTransException.CreateFmt(SUnexpectedDataType,[ KindNameArray[Info.Kind]] ); tkVariant: CastSoapToVariant(Info,SoapData,NatData); end; end; PWideString(NatData)^ := SoapData; 通过把值赋给了相应的指针地址： 另外在看一下传对象时的情况： Obj := ConvertSOAPToObject(RootNode,NumIndirect); if Assigned(Obj) and LegalRef then begin if (NodeClass <> nil) and (NodeClass <> Obj.Classtype) then Obj := NodeClass.Create; end else begin if (NodeClass <> nil) and NodeClass.InheritsFrom(AClass) then Obj := TRemotableClass(NodeClass).Create else Obj := TRemotableClass(AClass).Create; end; Result := Obj; 可以理解，经过双边注册过之后，才可以传递对象。 现在研究一下服务器端的代码： 先大概简单介绍一下WEB服务器应用程序的工作模式： 这里的WEB服务器就是IIS。 也就是说WEB服务器会把客户的HTTP请求消息，传递给CGI程序。然后由CGI进行处理： CGIApp单元中的： procedure InitApplication; begin Application := TCGIApplication.Create(nil); end; //创建一个CGI的应用程序 constructor TWebApplication.Create(AOwner: TComponent); begin WebReq.WebRequestHandlerProc := WebRequestHandler; inherited Create(AOwner); Classes.ApplicationHandleException := HandleException; if IsLibrary then begin IsMultiThread := True; OldDllProc := DLLProc; DLLProc := DLLExitProc; end else AddExitProc(DoneVclapplication); end; constructor TWebRequestHandler.Create(AOwner: TComponent); begin inherited Create(AOwner); FCriticalSection := TCriticalSection.Create; FActiveWebModules := TList.Create; FInactiveWebModules := TList.Create; FWebModuleFactories := TWebModuleFactoryList.Create; FMaxConnections := 32; FCacheConnections := True; end; procedure TCGIApplication.Run; var HTTPRequest: TCGIRequest; HTTPResponse: TCGIResponse; begin inherited Run; if IsConsole then begin Rewrite(Output); Reset(Input); end; try HTTPRequest := NewRequest; try HTTPResponse := NewResponse(HTTPRequest); try HandleRequest(HTTPRequest,HTTPResponse); finally HTTPResponse.Free; end; finally HTTPRequest.Free; end; except HandleServerException(ExceptObject,FOutputFileName); end; end; HTTPResponse := NewResponse(HTTPRequest); 调用： function TCGIApplication.GetFactory: TCGIFactory; begin if not Assigned(FFactory) then FFactory := TCGIFactory.Create; Result := FFactory; end; function TCGIFactory.NewRequest: TCGIRequest; Result := TCGIRequest.Create 。。。 end; //创建TCGIRequest HTTPResponse := NewResponse(HTTPRequest); Result := TCGIResponse.Create(CGIRequest) HandleRequest(HTTPRequest,HTTPResponse);调用 现在看看是怎么响应客户端的： function TWebRequestHandler.HandleRequest(Request: TWebRequest; Response: TWebResponse): Boolean; var I: Integer; WebModules: TWebModuleList; WebModule: TComponent; WebAppServices: IWebAppServices; GetWebAppServices: IGetWebAppServices; begin Result := False; WebModules := ActivateWebModules; 继续： function TWebRequestHandler.ActivateWebModules: TWebModuleList; begin ……………… FWebModuleFactories.AddFactory(TDefaultWebModuleFactory.Create(WebModuleClass)); 把TWebModule1加入工厂中,并创建TwebModuleList对象。 if FWebModuleFactories.ItemCount > 0 then begin Result := TWebModuleList.Create(FWebModuleFactories); ……………….. 继续： if Assigned(WebModules) then try WebModules.autocreateModules; procedure TWebModuleList.autocreateModules ….... AddModule(Factory.GetModule); 调用：TWebModule1.create并加入TwebModuleList中。 function TDefaultWebModuleFactory.GetModule: TComponent; begin Result := FComponentClass.Create(nil); end; constructor TWebModule.Create(AOwner: TComponent);调用 constructor TCustomWebdispatcher.Create(AOwner: TComponent); 之后又创建了THTTPSoapdispatcher，创建是在Treader类中创建的，有兴趣的朋友就追踪一下吧，这里实在是太麻烦。我也追了很久才发现。就懒得贴上来了。内容太多。 继续创建了TWSDLHTMLPublish 在回到TWebRequestHandler.HandleRequest函数中： 。。。 Result := WebAppServices.HandleRequest; 最后调用了： function TCustomWebdispatcher.HandleRequest( Request: TWebRequest; Response: TWebResponse): Boolean; begin FRequest := Request; FResponse := Response; Result := dispatchAction(Request,Response); end; 注意HandleRequest函数，这里是关键部分： function TCustomWebdispatcher.dispatchAction(Request: TWebRequest; Response: TWebResponse): Boolean; ………………… 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; 继续： function dispatchHandler(Sender: TObject; dispatch: IWebdispatch; Request: TWebRequest; Response: TWebResponse; DoDefault: Boolean): Boolean; begin Result := False; if (dispatch.Enabled and ((dispatch.MethodType = mtAny) or (dispatch.MethodType = dispatch.MethodType)) and dispatch.Mask.Matches(Request.InternalPathInfo)) then begin Result := dispatch.dispatchRequest(Sender,Response); end; end; http调用在到达服务器后，WebModule父类TCustomWebdispatcher 会对其进行分析，抽取参数等信息。然后在TCustomWebdispatcher.HandleRequest 方法中调用TCustomWebdispatcher.dispatchAction方法，将调用 根据其path info重定向到相应的处理方法去。而dispatchAction方法将 Action重定向到FdispatchList字段中所有的实现了IWebdispatch接口的组件。 而THTTPSoapdispatcher正是实现了IWebdispatch，其将在 TCustomWebdispatcher.InitModule方法中被自动检测到并加入FdispatchList字段 具体如下： procedure TCustomWebdispatcher.InitModule(AModule: TComponent); var I: Integer; Component: TComponent; dispatchIntf: IWebdispatch; begin if AModule <> nil then for I := 0 to AModule.ComponentCount - 1 do begin Component := AModule.Components[I]; if Supports(IInterface(Component),dispatchIntf) then FdispatchList.Add(Component); end; end; ... THTTPSoapdispatcher = class(THTTPSoapdispatchNode,IWebdispatch) 因此Web Service程序的http请求处理实际上是由THTTPSoapdispatcher进行的。 我们接着看看THTTPSoapdispatcher.dispatchRequest方法中对SOAP 协议的处理，关键代码如下 function THTTPSoapdispatcher.dispatchRequest(Sender: TObject; Request: TWebRequest; Response: TWebResponse): Boolean; var ….. http信息被封装在TwebRequest里：我们来看是怎么进行分析的： SoapAction := Request.GetFieldByName(SHTTPSoapAction); 首先得到SOAPAction信息,这个SOAPAction大家应该比较熟悉了，前面讲过，这里主要是根据相应信息调用方法：() 具体的内容例如：urn:MyFirstWSIntf-IMyFirstWS …. if SoapAction = '' then SoapAction := Request.GetFieldByName('HTTP_' + UpperCase(SHTTPSoapAction)); { do not localize } CGI或者Apache的处理方式。如果不是SOAP请求，就默认HTTP请求。 记录请求的路径。 Path := Request.PathInfo; XMLStream := TMemoryStream.Create; //把客户端的请求流化。 ReqStream := TWebRequestStream.Create(Request); 创建一个响应的流信息,以例把结果返回客户端 RStream := TMemoryStream.Create; 创建返回信息的流。 try FSoapdispatcher.dispatchSOAP(Path,SoapAction,XMLStream,RStream,BindingTypeIn); 这句是最重要的： 它把ＨＴＴＰ的调用方法，委托给THTTPSoapPascalInvoker.dispatchSOAP来处理。 FSoapdispatcher.dispatchSOAP(Path,BindingTypeIn); IHTTPSoapdispatch = interface ['{9E733EDC-7639-4DAF-96FF-BCF141F7D8F2}'] procedure dispatchSOAP(const Path,SoapAction: WideString; const Request: TStream; Response: TStream; var BindingType: TWebServiceBindingType); end; 父类实现的接口： THTTPSoapdispatchNode = class(TComponent) private procedure SetSoapdispatcher(const Value: IHTTPSoapdispatch); protected FSoapdispatcher: IHTTPSoapdispatch; procedure Notification(AComponent: TComponent; Operation: TOperation); override; public procedure dispatchSOAP(const Path,SoapAction: WideString; const Request: TStream; Response: TStream); virtual; published property dispatcher: IHTTPSoapdispatch read FSoapdispatcher write SetSoapdispatcher; end; 也被THTTPSoapPascalInvoker实现。所以THTTPSoapdispatcher中的dispatcher接口的实例其实是：THTTPSoapPascalInvoker THTTPSoapPascalInvoker = class(TSoapPascalInvoker,IHTTPSoapdispatch) public procedure dispatchSOAP(const Path,SoapAction: WideString; const Request: TStream; Response: TStream; var BindingType: TWebServiceBindingType); virtual; end; FSoapdispatcher.dispatchSOAP(Path,BindingTypeIn); 相应于调用了： procedure THTTPSoapPascalInvoker.dispatchSOAP(const Path,SoapAction: WideString; const Request: TStream; Response: TStream; var BindingType: TWebServiceBindingType); var IntfInfo: PTypeInfo; PascalBind: IHTTPSOAPToPasBind; InvClasstype: TClass; ActionMeth: String; MD: TIntfMetaData; if not PascalBind.BindToPascalByPath(Path,InvClasstype,IntfInfo,ActionMeth) or (InvClasstype = nil) then 调用: function THTTPSOAPToPasBind.BindToPascalByPath(Path: String; var AClass: TClass; var IntfInfo: PTypeInfo; var AMeth: String): Boolean; begin Result := InvRegistry.GetInfoForURI(Path,AClass,AMeth); end; 由InvRegistry的注册信息，返回相应的类名，接口信息等信息。 这了这些准备信息，下步才是真正的调用。 Invoke(InvClasstype,ActionMeth,BindingType); 函数最后一句：调用了父类：这里是真正工作的地方： 这里了仔细认真研究一下： procedure TSoapPascalInvoker.Invoke(AClass: TClass; IntfInfo: PTypeInfo; MethName: string; const Request: TStream; Response: TStream; var BindingType: TWebServiceBindingType); var Inv: TInterfaceInvoker; Obj: TObject; InvContext: TInvContext; IntfMD: TIntfMetaData; MethNum: Integer; SOAPHeaders: ISOAPHeaders; Handled: Boolean; begin try GetIntfMetaData(IntfInfo,True); 得到接口ＲＴＴＬ信息； InvContext := TInvContext.Create; 构造调用堆栈。 { Convert XML to Invoke Context } FConverter.MsgToInvContext(Request,fheadersIn); 这个函数请见前面的参考InvContextToMsg,把TinvContext内容转化成XML封包。 这个函数是逆操作，把XML内容转化成Context。 try Obj := InvRegistry.GetInvokableObjectFromClass(AClass); 搜寻注册信息，创建实例： if Obj = nil then raise Exception.CreateFmt(SNoClassRegistered,[IntfMD.Name]); …………….. Inv := TInterfaceInvoker.Create; Inv.Invoke(Obj,InvContext); 真正调用的地方： 源代码为： 这段代码，就是根据对象，接口信息等，把ＣＯＮtext的信息压入相应参数，应调用。 有时间再仔细研究。 procedure TInterfaceInvoker.Invoke(const Obj: TObject; IntfMD: TIntfMetaData; const MethNum: Integer; const Context: TInvContext); var MethPos: Integer; Unk: IUnkNown; IntfEntry: PInterfaceEntry; IntfVTable: Pointer; RetIsOnStack,RetIsInFPU,RetInAXDX: Boolean; I: Integer; RetP : Pointer; MD : TIntfMethEntry; DataP: Pointer; Temp,Temp1: Integer; RetEAX: Integer; RetEDX: Integer; TotalParamBytes: Integer; ParamBytes: Integer; begin {$IFDEF LINUX} try {$ENDIF} TotalParamBytes := 0; MD := IntfMD.MDA[MethNUm]; //得到方法的动态数组信息： if not Obj.GetInterface(IntfMD.IID,Unk) then raise Exception.CreateFmt(SNoInterfaceGUID, [Obj.ClassName,GUIDToString(IntfMD.IID)]); IntfEntry := Obj.GetInterfaceEntry(IntfMD.IID); //得到接口的动态数组信息 IntfVTable := IntfEntry.VTable; //指向VTB表的指针 MethPos := MD.Pos * 4; { Pos is absolute to whole VMT } //定位 if MD.ResultInfo <> nil then begin RetIsInFPU := RetInFPU(MD.ResultInfo); RetIsOnStack := RetonStack(MD.ResultInfo); RetInAXDX := IsRetInAXDX(MD.ResultInfo); RetP := Context.GetResultPointer; //根据context 得到返回参数的地址。 end else begin RetIsOnStack := False; RetIsInFPU := False; RetInAXDX := False; end; if MD.CC in [ccCDecl,ccSafeCall] then begin if (MD.ResultInfo <> nil) and (MD.CC = ccSafeCall) then asm PUSH DWORD PTR [RetP] end; //把函数返回参数压入堆栈中。 for I := MD.ParamCount - 1 downto 0 do //遍历参数。 begin DataP := Context.GetParamPointer(I); //指向一个参数地址： if IsParamByRef(MD.Params[I].Flags,MD.Params[I].Info,MD.CC) then {基本类型} asm PUSH DWORD PTR [DataP] //压入堆栈。 end else begin ParamBytes := GetStackTypeSize(MD.Params[I].Info,MD.CC); {特殊类型} PushStackParm(DataP,ParamBytes); Inc(TotalParamBytes,ParamBytes); end; end; asm PUSH DWORD PTR [Unk] end; //压入IunkNown指针 if RetIsOnStack and (MD.CC <> ccSafeCall) then asm PUSH DWORD PTR [RetP] end; end else if MD.CC = ccPascal then begin for I := 0 to MD.ParamCount - 1 do begin DataP := Context.GetParamPointer(I); if IsParamByRef(MD.Params[I].Flags,MD.CC) then asm PUSH DWORD PTR [DataP] end else begin // PushStackParm(DataP,GetStackTypeSize(MD.Params[I].Info,MD.CC)); ParamBytes := GetStackTypeSize(MD.Params[I].Info,MD.CC); PushStackParm(DataP,ParamBytes); end; end; if RetIsOnStack then asm PUSH DWORD PTR [RetP] end; asm PUSH DWORD PTR [Unk] end; end else raise Exception.CreateFmt(SUnsupportedCC,[CallingConventionName[MD.CC]]); if MD.CC <> ccSafeCall then begin asm MOV DWORD PTR [Temp],EAX //把ＥＡＸ保存到临时变量中 MOV DWORD PTR [Temp1],ECX //把ＥCＸ保存到临时变量中 MOV EAX,MethPos //函数定位的地方 MOV ECX,[IntfVtable] //虚拟表的入口 MOV ECX,[ECX + EAX] //真正调用的地址 CALL ECX MOV DWORD PTR [RetEAX],EAX //把结果返回的信息保存在变量RetEAX（低位） MOV DWORD PTR [RetEDX],EDX //把结果返回的信息保存在变量RetEDX（高位） MOV EAX,DWORD PTR [Temp] //恢复寄存器ＥＡＸ MOV ECX,DWORD PTR [Temp1] //恢复寄存器ＥＣＸ end; end else begin asm MOV DWORD PTR [Temp],EAX MOV DWORD PTR [Temp1],ECX MOV EAX,MethPos MOV ECX,[IntfVtable] MOV ECX,[ECX + EAX] CALL ECX CALL System.@CheckAutoResult MOV DWORD PTR [RetEAX],EAX MOV DWORD PTR [RetEDX],EDX MOV EAX,DWORD PTR [Temp] MOV ECX,DWORD PTR [Temp1] end; end; if MD.CC = ccCDecl then /如果是ＣＣＤＥＣＬ方式，必须自己清除使用的堆栈。 asm MOV EAX,DWORD PTR [TotalParamBytes] ADD ESP,EAX end; //调用后，返回参数的处理： if MD.ResultInfo <> nil then begin if MD.CC <> ccSafeCall then //返回类型不为ccSafeCall时，必须进行处理。 begin if RetIsInFPU then //tkFloat类型： begin GetFloatReturn(RetP,GetTypeData(MD.ResultInfo).FloatType); end else if not RetIsOnStack then begin if RetInAXDX then //tkInt64整型６４位类型处理： asm PUSH EAX PUSH ECX MOV EAX,DWORD PTR [RetP] MOV ECX,DWORD PTR [RetEAX] MOV [EAX],ECX MOV ECX,DWORD PTR [RetEDX] MOV [EAX + 4],ECX POP ECX POP EAX end else asm //堆栈类型： PUSH EAX //EAX入栈 PUSH ECX //ECX入栈 MOV EAX,DWORD PTR [RetP] //返回地址ＭＯＶ到ＥＡＸ MOV ECX,DWORD PTR [RetEAX] // RetEAX中是调用后得到的值 MOV [EAX],ECX //把调用后的结果写入返回的地址中 POP ECX //ECX出栈 POP EAX //EAX出栈 (先入后出) end; end; end; end; {$IFDEF LINUX} except // This little bit of code is required to reset the stack back to a more // resonable state since the exception unwinder is completely unaware of // the stack pointer adjustments made in this function. asm MOV EAX,DWORD PTR [TotalParamBytes] ADD ESP,EAX end; raise; end; {$ENDIF} end; FSoapdispatcher.dispatchSOAP(Path,BindingTypeIn); 返回调用后的内存块为。 Response.ContentStream := RStream; 然后再发送给客户端。 到这里，基本上客户端和服务器端都进行了分析。版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 [email protected] 举报，一经查实，本站将立刻删除。
