1. 程式人生 > >遠端呼叫技術程式碼追蹤(webservice)

遠端呼叫技術程式碼追蹤(webservice)

 
最近閱讀了SocketConn的原始碼和WebService 的原始碼,把追蹤的過程寫了下來,方便大家學習。畢竟這需要精力,時間和毅力。感謝煮茶待英雄博志區和三層資料庫討論區兄弟們的支援,特別是julian兄弟,不是他,我可能沒耐心繼續下去。如果有時間,大家可以繼續完善。從socket和Websevice的底層實現細節,我們發現BORLAND的工程師們的構思和實現的過程。我覺得這對我們的學習應該是非常重要的。學會思考。學會讀原始碼,學會分析。希望和我交往的朋友可通過QQ或Email聯絡我。[email protected]另見:《遠端呼叫技術程式碼追蹤(socket) 》關注我的:《遠端呼叫技術程式碼追蹤(第三方控制元件) 》遠端呼叫技術內幕有關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封包型別的轉換開發人員在使用這種自定義資料型別前必須對其進行註冊,分別是RegisterXSClassRegisterXSInfo。前一個方法是註冊從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; 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, 0, 0, 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, IntfMD, 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+12] { Calc stack pointer to start of params }        MOV     EAX, [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, UDDIOperator, 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, SLineBreak, 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', ntProcessingInstr, 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''#$D#$A' '#$D#$A'    '#$D#$A'      3'#$D#$A'      4'#$D#$A'    '#$D#$A' '#$D#$A''#$D#$A轉化後繼續呼叫Generic函式:。。。。FWebNode.BeforeExecute(IntfMD, MethMD, MethNum-3, nil);if (BindingType = btMIME) thenbegin。。。FWebNode.BeforeExecute(IntfMD, MethMD, MethNum-3, nil);THTTPReqResp.BeforeExecute。。。。。MethName := InvRegistry.GetMethExternalName(IntfMD.Info, MethMD.Name);FSoapAction := InvRegistry.GetActionURIOfInfo(IntfMD.Info, MethName, MethodIndex);得到方法名和FsoapActionFBindingType := btSOAPDoBeforeExecute // 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