Interface Designing

 

Interface Designing

                                            Write By Code6421

                                                                               2001/11/04

                                                                               2001/11/07(Update)

 

前言

  離上次我發佈的淺談 Interface 到現在，已經過了一兩個月了，或許更久了吧 ? 我一直想寫更深入的

Interface 運用，但總是找不出時間來，一方面是公司的工作，一方面是手上的幾篇文章。隨著幾篇文章

的完成，我開始寫這部份的文章，開始之前，我一直在思考，我該寫些什麼主題呢 ? 是要寫一堆理論呢 ?

還是針對一些特定的運用來介紹呢 ? 唔 .. 我很躊躇 ! 最後我決定將文章分成兩部份，一部份用來介紹

DELPHI 6 如何運用 Interface ，一部份則是用來介紹我的想法及實作經驗，我希望這兩者都能給你某種

程度的幫助，好了 ! 讓我們起程吧 !

 

 

第一章、 Interface in DELPHI Part 2

  在我的上一篇文章中，我對 DELPHI 6 的 Interface 有概觀型態的介紹，所以在這篇文章中，我就不再

重複了。 在這一章，我們將觀察 Interface 與 Object 在記憶體中的佈局，以及 Interface RTTI 部份。

 

1-1 、      Interface RTTI 資訊

 

  DELPHI 6 中新增了 Interface RTTI 的功能，我們可以利用這個功能來取得某個 Interface 的詳細資訊，

例如取得 Interface 中所包含的 Method Information ，或是每個參數與傳回值的型別。這些資訊都可以經由

DELPHI 6 所提供的 RTTI Support Function 來取得，同時 Interface RTTI Support 也是 BizSnap 所依賴的重要

功能之一。 預設情況下， DELPHI 並不會為 Interface 產生 RTTI 資訊，這是因為 RTTI 需要額外記憶體空

間，如果為不必要的 Interface 產生 RTTI 資訊，那將會浪費這些記憶體，因此 DELPHI 提供了編譯器選項，

讓程式設計師選擇是否為該 Interface 產生 RTTI 資訊。 :

 

{$M+}

  IMyTestInter>

    ['{533579FA-8D09-4F42-8F4B-79B2D6126A66}']

    function SayHello(InputStr:string):string;stdcall;

    procedure Go;stdcall;

  end;

{$M-}

 

上面的片段程式將會產生出 IMyTestInterface 的 Interface RTTI 資訊，有了這些資訊，我們就可以使用

IntfInfo.pas 中的 GetIntfMetaData 函式來取出 RTTI 資訊 :

 

unit Unit1;

 

interface

 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls;

 

type

{$M+}

  IMyTestInter>

    ['{533579FA-8D09-4F42-8F4B-79B2D6126A66}']

    function SayHello(InputStr:string):string;stdcall;

    procedure Go;stdcall;

  end;

{$M-}

  TForm1 = class(TForm)

    ListBox1: TListBox;

    Button1: TButton;

    procedure Button1Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

var

  Form1: TForm1;

 

implementation

uses IntfInfo,TypInfo;

 

{$R *.dfm}

 

procedure TForm1.Button1Click(Sender: TObject);

 function GetCallConv(Conv:TCallConv):string;

 begin

   case Conv of

        ccReg:

              Result:='register';

        ccCdecl:

              Result:='cdecl';

        ccPascal:

              Result:='pascal';

        ccStdCall:

              Result:='stdcall';

        ccSafeCall:

              Result:='safecall';

   end;

 end;

 function GetParamFlag(AFlag:TParamFlags):string;

 begin

   if pfVar in AFlag then

      Result:='var';

   if pfConst in AFlag then

      Result:='const';

   if pfReference in AFlag then

      Result:=Result+' ref';

   if pfOut in AFlag then

      Result:=Result+' out';

   if pfArray in AFlag then

      Result:=Result+' array';

   if pfAddress in AFlag then

      Result:=Result+' Pointer';

 end;

 

 function GetTypeKind(AKind:TTypeKind):string;

 begin

   case AKind of

         tkUnknown:

                 Result:='Unknown';

         tkInteger:

                 Result:='Integer';

         tkChar:

                 Result:='char';

         tkEnumeration:

                 Result:='Enum';

         tkFloat:

                 Result:='float';

         tkString:

                 Result:='string';

         tkSet:

                 Result:='set';

         tkClass:

                 Result:='class';

         tkMethod:

                 Result:='method';

         tkWChar:

                 Result:='WideChar';

         tkLString:

                 Result:='string';

         tkWString:

                 Result:='WideString';

         tkVariant:

                 Result:='Variant';

         tkArray:

                 Result:='Array';

         tkRecord:

                 Result:='record';

         tkInterface:

                 Result:='interface';

         tkInt64:

                 Result:='Int64';

         tkDynArray:

                 Result:='DynArray';

   end;

 end;

 

var

  IntfMD:TIntfMetaData;

  I,v:Integer;

  MethodStr:string;

begin

  GetIntfMetaData(TypeInfo(IMyTestInterface),IntfMD);

  ListBox1.Items.Add('Name      ='+IntfMD.Name);

  ListBox1.Items.Add('Unit Name = '+IntfMD.UnitName);

  ListBox1.Items.Add('------------Method-----------');

  for I:=0 to High(IntfMD.MDA) do

   begin

     if Assigned(IntfMD.MDA[I].ResultInfo) then

        MethodStr:='function '

     else

        MethodStr:='procedure ';

     MethodStr:=MethodStr+IntfMD.MDA[I].Name+'(';

     //get params

     for v:=0 to High(IntfMD.MDA[I].Params)-1 do

      begin

        MethodStr:=MethodStr+GetParamFlag(IntfMD.MDA[I].Params[v].Flags)+

                   IntfMD.MDA[I].Params[v].Name+':'+

                   GetTypeKind(IntfMD.MDA[I].Params[v].Info.Kind);

      end;

     if Assigned(IntfMD.MDA[I].ResultInfo) then

        MethodStr:=MethodStr+'):'+GetTypeKind(IntfMD.MDA[I].ResultInfo.Kind)+';'

     else

        MethodStr:=MethodStr+');';

 

     MethodStr:=MethodStr+GetCallConv(IntfMD.MDA[I].CC)+

                '; VMT Index:'+IntToStr(IntfMD.MDA[I].Pos);

     ListBox1.Items.Add(MethodStr);

   end;

end;

 

end.

 

執行畫面如下 :

 

 

{M+} 這個編譯指令不只會為 IMyTestInterface 產生 RTTI 資訊，同時也會為她的衍生 Interface

產生 RTTI 資訊。這也就是說，一旦介面被標示為需要產生 RTTI 資訊，那麼她的衍生介面同

樣會產生出 RTTI 資訊， BizSnap 中的 IInvokable 介面就是一個例子。

 

 

1-1 、      Interface 的繼承

 

  在上一篇文章中，我曾經提到 Interface 是可以繼承的，只是其中的細節我並不是描述的很清楚，

現在就讓我們以一個範例程式開始，一步一步的觀察 DELPHI 中的 Interface 繼承行為 :

 

unit Unit1;

 

interface

uses

 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

 Dialogs, StdCtrls;

type

 {$M+}

 IMyInter>

 ['{0FE4801F-B0B6-4B1D-A71C-64B969187876}']

   function SayHello:string;

 end;

 {$M-}

 IMyInterface2=interface(IMyInterface)

 ['{72976F3F-B53A-48A8-BDA0-0532FF127ADD}']

   function SayHello2:string;

 end;

 

 TMyObject=class(TInterfacedObject,IMyInterface2)

 public

   function SayHello:string;

   function SayHello2:string;

 end;

 

 TForm1 = class(TForm)

    Button1: TButton;

    procedure Button1Click(Sender: TObject);

 private

    { Private declarations }

 public

    { Public declarations }

 end;

 

var

 Form1: TForm1;

implementation

{$R *.dfm}

 

function TMyObject.SayHello:string;

begin

 Result:='Hello';

end;

 

function TMyObject.SayHello2:string;

begin

 Result:='Hello2';

end;

 

procedure TForm1.Button1Click(Sender: TObject);

var

 vObj:TMyObject;

 vIntf:IMyInterface2;

begin

 vObj:=TMyObject.Create;

 if Supports(vObj,IMyInterface2,vIntf) then

     ShowMessage(vIntf.SayHello2);

end;

end. 

 

請注意紅色部份，我們定義了一個物件，並且實作了 IMyInterface2 這個介面，而 IMyInterface2 是繼

承至 IMyInterface ， OK! 執行程式後你可以得到正確的結果。但問題來了， IMyInterface2 是不是

IMyInterface 呢 ? 如果是的話，那以下這段程式碼應該可以執行 :

 

procedure TForm1.Button1Click(Sender: TObject);

var

  vObj:TMyObject;

  vIntf:IMyInterface2;

  vIntf1:IMyInterface;

begin

  vObj:=TMyObject.Create;

  if Supports(vObj,IMyInterface2,vIntf) then

     ShowMessage(vIntf.SayHello2);

  if Supports(vObj,IMyInterface,vIntf1) then

     ShowMessage(vIntf1.SayHello);

end;

 

答案是， TMyObject 是 IMyInterface2 ，但不是 IMyInterface! 因為她實作的是 IMyInterface2 ，而不是 IMyInterface ，

因此 Interface Table 中所存的 GUID 值是 IMyInterface2 的，所以當 QueryInterface 比對 GUID 時，結果

當然就是不支援 IMyInterface 。再看看下面這個畫面 :

 

 

圖中你可以很明顯的察覺到，物件與 Interface 的記憶體位址並不相同，也就是 IMyInterface

不等於 TMyObject ，因為兩者的記憶體位址不同，因此你不能由一個 Interface 轉型為實作該 Interface

的物件，但你可以經由該 Interface 取得實作該 Interface 的物件中的其它 Interface 。 那這種不對稱的

觀念是那來的呢 ? 呵 ! 那就是 COM Interface 的概念， COM 本身不支援繼承，詳細的定義是不支援

Interface 層級的繼承，但你可以在實作部份使用繼承，其中的原因是繼承體系會改變二進位的記憶體

佈局，使得跨語言元件設計近乎不可能達到， DELPHI 的 Interface 似乎還未脫離 COM Interface 的概念。

第一個問題較好解決，你只要將宣告部份改成下列的模式就可以了 :

 

TMyObject=class(TInterfacedObject,IMyInterface,IMyInterface2)

 

第二個問題較麻煩，先看下面這段定義 :

 

TComponent = class(TPersistent, IInterface, IInterfaceComponentReference)

 

這是在 DELPHI 6 中的 TComponent 元件的定義，你可以發現她實作了兩個 Interface ，

一個是 IInterface ，她等同於 IUnknown( 用法不同，但觀念相同 ) ，另一個就是我們要討論的主角，

我們繼續看這個 Interface 的宣告部份 :

 

IInterfaceComponentReference = interface

    ['{E28B1858-EC86-4559-8FCD-6B4F824151ED}']

    function GetComponent: TComponent;

end;

 

這個介面可以讓我們經由 Interface 取得實作該 Interface 的實體物件，有了她，我們可以使用兩種

方式來解決第二個問題，一是依樣畫葫蘆 :

 

IObjectReference=interface

  ['{4C1C1783-3A07-402E-BD83-2D9B565A5D4E}']

   function GetObject:TObject;

end;

 

接著多實作一個 Interface:

 

TMyObject=class(TInterfacedObject,IObjectReference,IMyInterface,IMyInterface2)

  protected

   function GetObject:TObject;

  public

   function SayHello:string;

   function SayHello2:string;

  end;

 

這樣下面的程式碼就可以正常運作了 :

 

procedure TForm1.Button1Click(Sender: TObject);

var

  vObj:TMyObject;

  vIntf:IMyInterface2;

  vIntf1:IMyInterface;

  vRefObj:IObjectReference;

begin

  vObj:=TMyObject.Create;

  if Supports(vObj,IMyInterface2,vIntf) then

     ShowMessage(vIntf.SayHello2);

  if Supports(vObj,IMyInterface,vIntf1) then

     ShowMessage(vIntf1.SayHello);

  if Supports(vIntf,IObjectReference,vRefObj) then

     ShowMessage(vRefObj.GetObject.ClassName);

end;

 

另外一個方法就是直接將 TInterfacedObject 改成 TComponent ，使用 IInterfaceComponentReference

介面。

 

 

1-3 、 介面的記憶體佈局

 

要完全領會上面所提的兩個問題，首先我們得知道，我們是如何由一個物件中取出 Interface 的，

上一篇文章我們討論過 QueryInterface 、 GetInterface 這兩個函式，這裡我們將要討論 GetInterface

是如何取出 Interface 的。 要了解她的行為，我們必須從 Interface 的記憶體佈局開始 :

 

{ Virtual method table entries }

  vmtSelfPtr           = -76;

  vmtIntfTable         = -72;

  vmtAutoTable         = -68;

  vmtInitTable         = -64;

  vmtTypeInfo          = -60;

  vmtFieldTable        = -56;

  vmtMethodTable       = -52;

  vmtDynamicTable      = -48;

  vmtClassName         = -44;

  vmtInstanceSize      = -40;

  vmtParent            = -36;

  vmtSafeCallException = -32;

  vmtAfterConstruction = -28;

  vmtBeforeDestruction = -24;

  vmtDispatch          = -20;

  vmtDefaultHandler    = -16;

  vmtNewInstance       = -12;

  vmtFreeInstance      = -8;

  vmtDestroy           = -4;

  vmtQueryInterface    = 0;

  vmtAddRef            = 4;

  vmtRelease           = 8;

  vmtCreateObject      = 12;

 

上面這段程式來自於 System.pas ，這是 VMT Table Offset 的定義，這裡我們只對 vmtIntfTable 有興趣，

因為她正是 GetInterface 所依賴的部份，在這個 vmtIntfTable Offset 位址中放著一個指向 Interface Table

的指標，也就是這個物件所實作的 Interfaces 資訊， GetInterface 會取得這個 Table ，並逐一比對 GUID

來判斷該物件是否實作了你所要的介面，這裡必須注意一點，物件本身有繼承體系，如果該物件有父物件，

而你所要的介面是由父物件所實作時，那麼 GetInterface 必須經由 vmtParent 往上回朔，簡單的說，

TMyObject 繼承至 TMyParentObject ， TMyParentObject 實作了 IMyInterface ，那麼 TMyObject 的

Interface Table 中將不會有 IMyInterface 的資訊，因此 GetInterface 必須經由 vmtParent 往上回朔至

TMyParentObject 取得 IMyInterface 。 那這個 Interface Table 格式為何呢 ?

 

PInterfaceEntry = ^TInterfaceEntry;

  TInterfaceEntry = packed record

    IID: TGUID;

    VTable: Pointer;

    IOffset: Integer;

    ImplGetter: Integer;

  end;

 

  PInterfaceTable = ^TInterfaceTable;

  TInterfaceTable = packed record

    EntryCount: Integer;

    Entries: array[0..9999] of TInterfaceEntry;

  end;

 

上面這段程式同樣來自 System.Pas ，其中有幾樣我們應該很容易理解， IID 是 Interface 的 GUID ，

EntryCount 代表這個 Interface Table 內含有多少個 Interface 的資訊， VTable 則是 Interface 的 VTable

資訊。 除了這些之外，我較感興趣的是 lOffset 以及 ImplGetter ， lOffset 代表這個 Interface Pointer

是在該物件的記憶體 +lOffset 的位址，要弄清楚這一點，我們得寫個小程式 :

 

procedure TForm1.Button1Click(Sender: TObject);

var

  vObj:TMyObject;

  vIntf:IMyInterface2;

  vIntf1:IMyInterface;

  vRefObj:IObjectReference;

  PIntfTbl:PInterfaceTable;

  I:Integer;

begin

  vObj:=TMyObject.Create;

  vIntf:=(vObj as IMyInterface2);

  vIntf1:=(vObj as IMyInterface);

  vRefObj:=(vObj as IObjectReference);

  PIntfTbl:=PPointer(Integer(Pointer(vObj)^)-72)^;

  for I:=0 to PIntfTbl.EntryCount-1 do

   begin

     ListBox1.Items.Add('GUID:'+GUIDToString(PIntfTbl.Entries[I].IID));

     ListBox1.Items.Add('Offset:'+IntToStr(PIntfTbl.Entries[I].IOffset));

     ListBox1.Items.Add('-------------');

   end;

end;

 

上面這段程式我放了一個 ListBox 元件到 Form 上，用來顯示 Interface Table 資訊，下面是執行結果 :

 

 

上圖中你可以看到 TMyObject 所實作的三個 Interface 的 GUID ，以及 Offset 值，現在看第二個畫面 :

 

 

看出來沒 ? Offset 與 vObj 的 Pointer 位址相加，等於 Interface 記憶體位址。 由這個實驗中，我們可以

解釋上面兩個問題發生的原因，第一、 GetInterface 經由 Interface Table 來判斷物件是否實作了某個 Interface ，

而 Interface Table 中儲存的是 Interface GUID ，當我們繼承一個 Interface 時，事實上只有一個 GUID 被

存放於 Interface Table 中，因此我們無法取得這個 Interface 的父 Interface ，因為 Interface Table 中沒有這

個父 Interface GUID ，所以 GetInterface 也必定失敗。 第二、 當我們由一個物件中取出某個 Interface 時，

事實上我們所取得的記憶體位址是物件的 Pointer+Interface.Offset ，因此我們無法由 Interface 轉型回原物件，

必須做迂迴轉型。

 

第二章 、破冰之旅 -1: 由一個字串喚起物件中的介面的 Method

  前面的章節主要是建立你對 Interface 底層運作的觀念，由這一章開始，我們將進入真正的低階運用，

Interface 可以用在設計一組具有相當延展性的元件組，如 WebSnap! 同時也可以用在完成一些看起來

很神奇的運用，如 BizSnap! 這一章中，我們將討論 BizSnap 如何運用 Interface 來完成一些看起來很

神奇的技術。

 

2-1 、 神奇的BizSnap Server

 

  在我第一次撰寫 BizSnap Server 時，我對她的內部動作產生了極大的興趣，因為她可以只憑藉著

Client 端送過來的 SOAP Request Message 來喚起對應的 Object Method ，而且期間完全是自動化的，

不需要程式師的介入或是輔助，這正是我們這一章要介紹的技術。

從這一節開始，我們將從表象的 PASCAL 進入實體的 Compiler 低階行為，我們的目的是要從一個字串

喚起某個介面的 Method ，就像是 BizSnap Server 一樣。

 

上圖是 BizSnap Server 以 Soap Message 呼叫 WebService Object 的大概流程，首先我們先看到第三個

部份，這裡 BizSnap 使用 RTTI 資訊來取得呼叫該 WebService Object 的相關資訊，接著以這些資訊

經由 Dynamic Invoker Object 來喚起真正的 WebService Object 。 由這個流程中我們大慨可以分析出我

們必需要克服的問題，一、如何取得 RTTI 資訊 : 由於 SOAP Message 中只有呼叫的 Service Name 以

及 Server Method Name 兩個資訊，因此我們必須要建立一個機制，讓設計師可以用字串的方式註冊

她的 Web Service Object ，這樣我們才能夠以比對字串的方式找出對應的 WebService Object 。

二、如何以字串來建立 Object: 這個問題較簡單，我們可以在註冊函式中要求設計師提供一個建構

函式，或是直接傳入對應物件的 TClass ，接著就可以使用她們來建立物件。 三、如何使用字串來

喚起 Method: 在第一章時我們討論過 Interface RTTI 資訊，我們可以利用她來取得要呼叫的 Method

Pointer ，經由 Call 命令來呼叫起這個 Method 。 四、如何處理呼叫 Method 所需的參數以及傳回值 :

由於我們直接使用組合語言來喚起 Method ，所以我們得利用組合語言來將參數以及傳回值推入堆

疊。 下面的程式中介紹了這四個步驟的實作方式 :

 

 

unit Unit1;

 

interface

 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls,TypInfo,IntfInfo;

 

type

{$M+}

  ITestInter>

  ['{F3338FF9-C31C-43D8-8C39-754E7A39DBDD}']

  function SayHello(s:string):string;stdcall;

  function SayHello2(s:string;v:Integer;var sv:string):string;stdcall;

  end;

{$M-}

  TInvokerTest=class(TInterfacedObject,ITestInterface)

  private

    FStr:string;

  public

    function SayHello(s:string):string;stdcall;

    function SayHello2(s:string;v:Integer;var sv:string):string;stdcall;

  end;

 

  TForm1 = class(TForm)

    ListBox1: TListBox;

    Button2: TButton;

    procedure Button2Click(Sender: TObject);

  private

    { Private declarations }

  public

    procedure Invoker;stdcall;

    function GetCallPointer(vObj:TObject;MethodName:string):Pointer;

    { Public declarations }

  end;

 

var

  Form1: TForm1;

  CallSelf:Pointer;

  CallAddr:Pointer;

  Params:array of Pointer;

  RetParam:Integer;

 

  InterfaceInfo:PTypeInfo;

 

procedure ptRegisterInvokableInterface(AInterfaceInfo:PTypeInfo);

implementation

 

 

{$R *.dfm}

 

procedure ptRegisterInvokableInterface(AInterfaceInfo:PTypeInfo);

begin

  InterfaceInfo:=AInterfaceInfo;

end;

 

function TInvokerTest.SayHello(s:string):string;

var

  ss:string;

begin

  FStr:=s;

  ShowMessage(s);

  Result:='Hello! I am Return ';

end;

 

function TInvokerTest.SayHello2(s:string;v:Integer;var sv:string):string;

begin

  ShowMessage(s);

end;

 

 

function TForm1.GetCallPointer(vObj:TObject;MethodName:string):Pointer;

 function GetMethodIndex:Integer;

 var

  IntfData:TIntfMetaData;

  I,MethodIndex:Integer;

 begin

  GetIntfMetaData(InterfaceInfo,IntfData);

  MethodIndex:=-1;

  for I:=0 to High(IntfData.MDA) do

   begin

     if IntfData.MDA[I].Name = MethodName then

      begin

        MethodIndex:=I;

        break;

      end;

   end;

  Result:=MethodIndex;

 end;

var

  MethodIndex:Integer;

  TypeData:PTypeData;

  pIntf:Pointer;

begin

  MethodIndex:=GetMethodIndex;

  if MethodIndex = -1 then Result:=Nil;

  TypeData:=GetTypeData(InterfaceInfo);

  if Supports(vObj,TypeData.Guid,pIntf) then

     Result:=PPointer(Integer(Pointer(pIntf)^)+12+(MethodIndex*4))^;

end;

 

procedure TForm1.Invoker;

var

  I,Max:Integer;

  ExBp:Integer;

asm

   mov eax,[Params];

   call System.@DynArrayHigh;

   test eax,eax;

   jl  @L2;

   inc eax;

   mov [Max],eax;

   mov [I],$00000000;

@L1:

   mov eax,[Params];

   mov edx,[I];

   mov eax,[eax+edx*4];

   push [eax];

   inc dword ptr [I];

   dec dword ptr[Max];

   jnz @L1;

@L2:

   push CallSelf;

   push [RetParam];

   call [CallAddr];

@L3:

end;

 

 

procedure TForm1.Button2Click(Sender: TObject);

var

  s,s1:string;

  vCall:Pointer;

  vObj:TInvokerTest;

  p2:Pointer;

begin

  s:='Hello Param';

  s1:='ddsfjk';

  SetLength(Params,1);

  Params[0]:=@s;

  RetParam:=Integer(@s1);

  vObj:=TInvokerTest.Create;

  CallAddr:=GetCallPointer(vObj,'SayHello');

  CallSelf:=Pointer(Integer(Pointer(vObj))+16);

  Invoker;

  ShowMessage(PChar(Pointer(RetParam)^));

end;

 

initialization

  ptRegisterInvokableInterface(TypeInfo(ITestInterface));

 

end.

 

你可以猜到這個程式的執行結果嗎 ?

 

 

有趣嗎 ? 我們經由幾個步驟以一個字串來喚起某個介面中的 Method ，下面就讓我一個一個的解釋 :

 

ptRegisterInvokableInterface(TypeInfo(ITestInterface));

 

上面這一行程式位於 Initialization 區段，我們利用她來儲存 Interface 的 TypeInfo ，因為 GetIntfMetaData

函式需要她來取出 RTTI 資訊，這個部份對應到我們的第一個問題，這裡我並未提供設計師指定建構方

式的功能，而使用手動的方式建立這個物件。 你可以參考 BizSnap 的 註冊方式來提供這個功能。

 

function TForm1.GetCallPointer(vObj:TObject;MethodName:string):Pointer;

 function GetMethodIndex:Integer;

 var

  IntfData:TIntfMetaData;

  I,MethodIndex:Integer;

 begin

  GetIntfMetaData(InterfaceInfo,IntfData);

  MethodIndex:=-1;

  for I:=0 to High(IntfData.MDA) do

   begin

     if IntfData.MDA[I].Name = MethodName then

      begin

        MethodIndex:=I;

        break;

      end;

   end;

  Result:=MethodIndex;

 end;

var

  MethodIndex:Integer;

  TypeData:PTypeData;

  pIntf:Pointer;

begin

  MethodIndex:=GetMethodIndex;

  if MethodIndex = -1 then Result:=Nil;

  TypeData:=GetTypeData(InterfaceInfo);

  if Supports(vObj,TypeData.Guid,pIntf) then

     Result:=PPointer(Integer(Pointer(pIntf)^)+12+(MethodIndex*4))^;

end;

 

GetMethodIndex 是用來比對傳入的 MethodName ，她利用了我們之前所儲存的 Interface TypeInfo 來取得

Interface RTTI 資訊，進而比對出正確的 Method ，接著傳回 Method Index 。而我們就可以以這個 Index

來取出正確的 Method Call Address ，這裡有個數字你可能不太能理解， 12 是扣除掉三個 Method:

AddRef 、 Release 、 QueryInterface ，每個 Call Pointer 是 4 個 Byte ，理解了嗎 ?

這個部份對應了我們的第三個問題。

 

procedure TForm1.Invoker;

var

  I,Max:Integer;

  ExBp:Integer;

asm

   mov eax,[Params];

   call System.@DynArrayHigh;

   test eax,eax;

   jl  @L2;

   inc eax;

   mov [Max],eax;

   mov [I],$00000000;

@L1:

   mov eax,[Params];

   mov edx,[I];

   mov eax,[eax+edx*4];

   push [eax];

   inc dword ptr [I];

   dec dword ptr[Max];

   jnz @L1;

@L2:

   push CallSelf;

   push [RetParam];

   call [CallAddr];

@L3:

end;

 

喔 …. 最低階的東西來了，這是核心，非紅色的部份是我用 CPU Windows 抄下來的，原本是一個

迴圈。作用是用來將傳入的參數推入堆疊中，紅色的部份則是將 SelfPtr 以及 傳回值的變數推入

堆疊中。

這個部份對應了我們的第四個問題。

 

procedure TForm1.Button2Click(Sender: TObject);

var

  s,s1:string;

  vCall:Pointer;

  vObj:TInvokerTest;

  p2:Pointer;

begin

  s:='Hello Param';

  s1:='ddsfjk';

  SetLength(Params,1);

  Params[0]:=@s;

  RetParam:=Integer(@s1);

  vObj:=TInvokerTest.Create;

  CallAddr:=GetCallPointer(vObj,'SayHello');

  CallSelf:=Pointer(Integer(Pointer(vObj))+16);

  Invoker;

  ShowMessage(PChar(Pointer(RetParam)^));

end;

 

最後這段就是呼叫的部份了，我們只憑一個 SayHello 字串就喚起了 SayHello Method 了。

 

PS: 這並不是一個完整的技術，如果你想要使用這種技術，你應該更深入的追縱，例如

參數值並不一定是以 4-Byte 為單位，不同的型別有不同的推法， Float 就是個例子。

 

 

第三章、 破冰之旅 -2 : 動態建立類別，並且實作介面 !

  有一就有二，上一章我們以一個字串來呼叫某個 Method ，這一節中我們將使用另一種

方式，由一個介面產生出一個實作這個介面的物件 :

 

上圖是 BizSnap Client 呼叫 BizSnap Server 的大概流程，其中最重要的部份在於第四個步驟，

在這個步驟中，我們需要為 THTTPRIO 產生出一個新的 Class ，接著為她實作對應的

Interface ，最後以這個 Class 來建立一個物件，傳回給設計師。 而這個 Object 會將 Method

Call 轉換為 SOAP Request Message 送給 BizSnap Server 。

下面是這個流程的實作版，不過我沒有實作轉成 SOAP Request Message 這一段。

 

unit Unit1;

 

interface

 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls,TypInfo,IntfInfo,ptRIO;

 

type

{$M+}

  ITestInter>

  ['{F3338FF9-C31C-43D8-8C39-754E7A39DBDD}']

  function SayHello(s:string):string;stdcall;

  function SayHello2(s:string;v:Integer;var sv:string):string;stdcall;

  end;

{$M-}

 

  TForm1 = class(TForm)

    Button1: TButton;

    ListBox1: TListBox;

    procedure Button1Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

var

  Form1: TForm1;

 

implementation

 

{$R *.dfm}

 

procedure TForm1.Button1Click(Sender: TObject);

var

  spt:TptRIO;

  iData:ITestInterface;

  sss:string;

begin

  spt:=TptRIO.Create(Self);

  iData:=spt as ITestInterface;

  sss:='123';

  iData.SayHello2(sss,12,sss);

  spt.Free;

end;

 

initialization

  ptRegisterInvokeInterface(TypeInfo(ITestInterface));

finalization

end.

 

上面這段程式的執行結果如下 :

 

 

那你一定很好奇， TptRIO 是如何寫成的 :

 

unit ptRIO;

 

interface

uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

     Dialogs, StdCtrls,TypInfo,IntfInfo;

 

type

   TTestPtr=procedure of object;

   TAddRefPtr=function:Integer of object;stdcall;

   TQueryPtr=function(const IID:TGUID;out Obj):HResult of object;stdcall;

   TptRIO=class(TComponent)

   private

     ImplIntfData:PInterfaceTable;

     ImplIntfVTable:Pointer;

     OldIntfData:PInterfaceTable;

     InnerClass:TClass;

     InnerComp,InnerComp1:TComponent;

     RP:Pointer;

     FRefCount:Integer;

     procedure Generic;

     procedure GenericStub;

     function GenVTable(obj:TObject):Pointer;

     procedure GenIntfTable(obj:TObject;IntfData:PIntfMetaData);

   protected

     function QueryInterface(const IID: TGUID; out Obj): HResult; override;

     function AddRef: Integer;stdcall;

     function Release: Integer;stdcall;

   public

     constructor Create(AOwner:TComponent);override;

     destructor Destroy;override;

   end;

var

  FRetPoint,FBx,FdX,FStack:Pointer;

  FNumMeth,FCallBase:Integer;

  FParams:array of Integer;

  ConvIntfInfo:PTypeInfo;

 

procedure ptRegisterInvokeInterface(Info:PTypeInfo);

 

implementation

 

procedure ptRegisterInvokeInterface(Info:PTypeInfo);

begin

  ConvIntfInfo:=Info;

end;

 

constructor TptRIO.Create(AOwner:TComponent);

begin

  inherited Create(AOwner);

  InnerComp1:=TComponent.Create(AOwner);

  RP:=GenVTable(InnerComp1);

  InnerComp:=Nil;

  InnerClass:=Pointer(Integer(RP)+76);

  FRefCount:=0;

end;

 

destructor TptRIO.Destroy;

var

  P:Pointer;

begin

  InnerComp1.Free;

  if Assigned(InnerComp) then

     InnerComp.Free;

  FreeMem(RP);

  FreeMem(ImplIntfVTable);

  inherited;

end;

 

function TptRIO.AddRef:Integer;

begin

  Inc(FRefCount);

  Result:=FRefCount;

end;

 

function TptRIO.Release:Integer;

begin

  Dec(FRefCount);

  Result:=FRefCount;

end;

 

 

function TptRIO.QueryInterface(const IID: TGUID; out Obj): HResult;

var

  IntfData:TIntfMetaData;

  ii:IInterface;

begin

  Result:=inherited QueryInterface(IID,Obj);

  if Result <> 0 then

   begin

     if InnerComp = Nil then

      begin

        InnerComp:=TComponent(InnerClass.NewInstance);

        GetIntfMetaData(ConvIntfInfo,IntfData);

        GenIntfTable(InnerComp,@IntfData);

      end;

     if Supports(InnerComp,IInterface,ii) then

        Result:=ii.QueryInterface(IID,Obj);

     if Result = 0 then Integer(Obj):=Integer(Obj)-8;

   end;

end;

 

function TptRIO.GenVTable(obj:TObject):Pointer;

var

   P,LP,vmt:Pointer;

begin

   vmt:=PPointer(obj)^;

   P:=Pointer(Integer(vmt)-76);

   GetMem(LP,obj.InstanceSize+76);

   CopyMemory(LP,P,76+obj.InstanceSize);

   Integer(LP^):=Integer(LP);

   Result:=LP;

end;

 

procedure TptRIO.GenIntfTable(obj:TObject;IntfData:PIntfMetaData);

var

   P:Pointer;

   PIntf:Pointer;

   I:Integer;

   fptr:TTestPtr;

   aptr:TAddRefPtr;

   qptr:TQueryPtr;

begin

   P:=PPointer(obj)^;

   fptr:=GenericStub;

   Integer(OldIntfData):=Integer(Pointer(Integer(P)-72)^);

   GetMem(PIntf,(OldIntfData.EntryCount+1)*sizeof(TInterfaceEntry)+4);

   GetMem(ImplIntfVTable,12+(High(IntfData.MDA)*4)+4);

   qptr:=QueryInterface;

   aptr:=AddRef;

   Pointer(Pointer(Integer(ImplIntfVTable))^):=@qptr;

   Pointer(Pointer(Integer(ImplIntfVTable)+4)^):=@aptr;

   aptr:=Release;

   Pointer(Pointer(Integer(ImplIntfVTable)+8)^):=@aptr;

   for I:=0 to High(IntfData.MDA) do

    begin

     Pointer(Pointer(Integer(ImplIntfVTable)+12+(I*4))^):=@fptr;

    end;

   Pointer(Pointer(Integer(P)+88)^):=ImplIntfVTable;

 

   ImplIntfData:=PIntf;

   ImplIntfData.EntryCount:=OldIntfData.EntryCount;

   for I:=0 to OldIntfData.EntryCount-1 do

      ImplIntfData.Entries[I]:=OldIntfData.Entries[I];

   for I:=OldIntfData.EntryCount to ImplIntfData.EntryCount do

    begin

      ImplIntfData.Entries[I].IID:=IntfData.IID;

      ImplIntfData.Entries[I].VTable:=ImplIntfVTable;

      ImplIntfData.Entries[I].IOffset:=44;

      ImplIntfData.Entries[I].ImplGetter:=0;

    end;

   Inc(ImplIntfData.EntryCount);

   Integer(Pointer(Integer(P)-72)^):=Integer(ImplIntfData);

end;

 

procedure TptRIO.GenericStub;

 asm

   pop FRetPoint;

   pop Fbx;

   pop FCallBase;

   mov FStack,esp;

   mov FNumMeth,eax;

   push FCallBase;

   push Fbx;

   push FRetPoint;

   CALL Generic;

end;

 

procedure TptRIO.Generic;

var

  IntfData:TIntfMetaData;

  MethNum:Integer;

  MethEntry:TIntfMethEntry;

  I:Integer;

  vs:string;

begin

  MethNum:=Byte(PPointer(Integer(FRetPoint)-1)^);

  MethNum:=(MethNum-12) div 4;

  GetIntfMetaData(ConvIntfInfo,IntfData);

  MethEntry:=IntfData.MDA[MethNum];

  SetLength(FParams,MethEntry.ParamCount+1);

  FParams[MethEntry.ParamCount]:=Integer(Pointer(Integer(FStack)-8)^);

  for I:=0 to MethEntry.ParamCount-1 do

   begin

     FParams[I]:=Integer(Pointer(Integer(FStack)+I*4)^);

   end;

 

  ShowMessage('Param1:'+PChar(FParams[0]));

  ShowMessage('Param2:'+IntToStr(FParams[1]));

  Pointer(vs):=PPointer(FParams[2])^;

  ShowMessage('Param3(by Ref):'+vs);

  vs:='124444';

  PPointer(FParams[2])^:=Pointer(vs);

  Pointer(vs):=PPointer(FParams[3])^;

  vs:='Show Return';

  PPointer(FParams[3])^:=Pointer(vs);

 

end;

 

end.

 

OK ，那重點在哪 ? 呵 ! 仔細看一下， TptRIO 實作了 ITestInterface 了嗎 ? 沒有是吧。

這就是這個程式的重點， TptRIO 動態的實作了某個介面 ? 喔 ! 不是的，嚴格說起來

是 TptRIO 產生了一個物件實作了 ITestInterface 並傳回給你的程式，下面我就一步

一步的解釋這是如何辦到的。

 

function TptRIO.QueryInterface(const IID: TGUID; out Obj): HResult;

var

  IntfData:TIntfMetaData;

  ii:IInterface;

begin

  Result:=inherited QueryInterface(IID,Obj);

  if Result <> 0 then

   begin

     if InnerComp = Nil then

      begin

        InnerComp:=TComponent(InnerClass.NewInstance);

        GetIntfMetaData(ConvIntfInfo,IntfData);

        GenIntfTable(InnerComp,@IntfData);

      end;

     if Supports(InnerComp,IInterface,ii) then

        Result:=ii.QueryInterface(IID,Obj);

     if Result = 0 then Integer(Obj):=Integer(Obj)-8;

   end;

end;

 

我們都知道，當我們將一個物件轉型為某個 Interface 時，會經過該物件的 QueryInterface ，

因此我們可以在這裡處理建立物件以及為它實作 Interface 的動作，這裡你可以看到我利用

InnerClass 來產生一個物件。這有一個重點， InnerClass 並非是 TComponent ，她是我動態產

生出來的 Class:

 

constructor TptRIO.Create(AOwner:TComponent);

begin

  inherited Create(AOwner);

  InnerComp1:=TComponent.Create(AOwner);

  RP:=GenVTable(InnerComp1);

  InnerComp:=Nil;

  InnerClass:=Pointer(Integer(RP)+76);

  FRefCount:=0;

end;

 

function TptRIO.GenVTable(obj:TObject):Pointer;

var

   P,LP,vmt:Pointer;

begin

   vmt:=PPointer(obj)^;

   P:=Pointer(Integer(vmt)-76);

   GetMem(LP,obj.InstanceSize+76);

   CopyMemory(LP,P,76+obj.InstanceSize);

   Integer(LP^):=Integer(LP);

   Result:=LP;

end;

 

GenVTable 函式會複製一份與傳入的 obj 相同的 VMT Table ，這就是我產生出來的 Class ，

因為我必須在這個 VMT Table 中動態實作一個 Interface ，因此我必須使用我自己的 Class ，

而不能使用 TComponent 。

 

procedure TptRIO.GenIntfTable(obj:TObject;IntfData:PIntfMetaData);

var

   P:Pointer;

   PIntf:Pointer;

   I:Integer;

   fptr:TTestPtr;

   aptr:TAddRefPtr;

   qptr:TQueryPtr;

begin

   P:=PPointer(obj)^;

   fptr:=GenericStub;

   Integer(OldIntfData):=Integer(Pointer(Integer(P)-72)^);

   GetMem(PIntf,(OldIntfData.EntryCount+1)*sizeof(TInterfaceEntry)+4);

   GetMem(ImplIntfVTable,12+(High(IntfData.MDA)*4)+4);

   qptr:=QueryInterface;

   aptr:=AddRef;

   Pointer(Pointer(Integer(ImplIntfVTable))^):=@qptr;

   Pointer(Pointer(Integer(ImplIntfVTable)+4)^):=@aptr;

   aptr:=Release;

   Pointer(Pointer(Integer(ImplIntfVTable)+8)^):=@aptr;

   for I:=0 to High(IntfData.MDA) do

    begin

     Pointer(Pointer(Integer(ImplIntfVTable)+12+(I*4))^):=@fptr;

    end;

   Pointer(Pointer(Integer(P)+88)^):=ImplIntfVTable;

 

   ImplIntfData:=PIntf;

   ImplIntfData.EntryCount:=OldIntfData.EntryCount;

   for I:=0 to OldIntfData.EntryCount-1 do

      ImplIntfData.Entries[I]:=OldIntfData.Entries[I];

   for I:=OldIntfData.EntryCount to ImplIntfData.EntryCount do

    begin

      ImplIntfData.Entries[I].IID:=IntfData.IID;

      ImplIntfData.Entries[I].VTable:=ImplIntfVTable;

      ImplIntfData.Entries[I].IOffset:=44;

      ImplIntfData.Entries[I].ImplGetter:=0;

    end;

   Inc(ImplIntfData.EntryCount);

   Integer(Pointer(Integer(P)-72)^):=Integer(ImplIntfData);

end;

 

GenIntfTable 函式則是開始為 ptRIO 中的 Class 產生 Interface 資訊，也就是實作 Interface ，

這裡有幾個 magic Number ，這是我由 CPU Window 觀察而來。

在這裡你同時可以發現，我將所有的 Interface Method Pointer 都指向同一個函式 :GenericStub 。

 

procedure TptRIO.GenericStub;

 asm

   pop FRetPoint;

   pop Fbx;

   pop FCallBase;

   mov FStack,esp;

   mov FNumMeth,eax;

   push FCallBase;

   push Fbx;

   push FRetPoint;

   CALL Generic;

end;

 

procedure TptRIO.Generic;

var

  IntfData:TIntfMetaData;

  MethNum:Integer;

  MethEntry:TIntfMethEntry;

  I:Integer;

  vs:string;

begin

  MethNum:=Byte(PPointer(Integer(FRetPoint)-1)^);

  MethNum:=(MethNum-12) div 4;

  GetIntfMetaData(ConvIntfInfo,IntfData);

  MethEntry:=IntfData.MDA[MethNum];

  SetLength(FParams,MethEntry.ParamCount+1);

  FParams[MethEntry.ParamCount]:=Integer(Pointer(Integer(FStack)-8)^);

  for I:=0 to MethEntry.ParamCount-1 do

   begin

     FParams[I]:=Integer(Pointer(Integer(FStack)+I*4)^);

   end;

 

  ShowMessage('Param1:'+PChar(FParams[0]));

  ShowMessage('Param2:'+IntToStr(FParams[1]));

  Pointer(vs):=PPointer(FParams[2])^;

  ShowMessage('Param3(by Ref):'+vs);

  vs:='124444';

  PPointer(FParams[2])^:=Pointer(vs);

  Pointer(vs):=PPointer(FParams[3])^;

  vs:='Show Return';

  PPointer(FParams[3])^:=Pointer(vs);

 

end;

 

GenericStub 取出一些必要的參數後，她就將執行權轉給 Generic ，在 Generic 中我們將參數

取出，並且使用 ShowMessage 來顯示。

 

本章後記

 

  破冰之旅代表兩件事，一是 TRIO 如何動態實作一個 Interface ，二是 Service Server 如何只

憑藉一個 SOAP Request 就可以 Invoke Interface Method 。

PS: 我只想模擬類似的技術，因此如果你實務上用到這些資訊的話，那你應該更深入的探討一

些 Magic Number 。

PS:PS: Kylix 2 Enterprise 以及日後的 DELPHI 6 Patch 中應該會公開 Invoker.pas 、 InvRule.pas 、

RIO.pas 三個主要的 Unit 原始碼。

 

 

第四章、 疑惑 ! Abstract Classes V.S Interface

  Interface 的到來絕對不是偶然，也非毫無意義，她與抽象類別 (Abstract Classes) 的最大差別

在於 Abstract Classes 是可以有實作的，而 Interface 則不可以，這有著相當大的意義，舉例來

說，我設計了一個飛機類別，我提供了下面這個 Abstract Classes:

 

type

  TAbstractFly=class(TComponent)

  public

      function Speed:Integer;virtual;

      function PrepareLength:Integer;virtual;

  end;

 

這個類別是一個未完成的抽象類別，因此我可以繼承她，加上 747 的實作 :

 

type

  TFly_747=class(TAbstractFly)

  public

      function Speed:Integer;override;

      function PrepareLength:Integer;override;

  end;

implementation

function TFly_747.Speed:Integer;

 begin

   Result:=1400;

end; 

 

funfction TFly_747.PrepareLength:Integer;

begin

  Result:=2;

end;

 

到目前為止，這個程式工作的很正常， 747 時速是 1400 公里，起飛跑道至少需要 2 公里，一切

都很正常，直到我們接到了新的工作，該公司推出了另一款飛機，她的時速高達 1600 公里，但

助跑距離需要 2.5 公里，我們某個天才程式設計師寫下了下面這段碼 :

 

type

  TFly_757=class(TFly_747)

  public

    funciton Speed:Integer;override;

  end;

implementation

function TFly_757.Speed:Integer;

begin

  Result:=1600;

end;

 

嗯 ! 我想這台飛機起飛不了了，的確，我們的天才設計師不該寫下這樣的程式碼，但誰知道呢 ?

在一個龐大的 Component Library 中，一個類別擁有數十個虛擬函式不算稀奇，如果缺乏完整的

說明，這樣的錯誤是很容易犯下的。更甚之，即使你說明了所有的虛擬函式，但如果你未說明

所有的關聯，那錯誤可能會更嚴重。我指的是 Self-Call 的情況，在某些情況，我們會利用某個

虛擬函式來喚起另外幾個虛擬函式，這個時候就是夢魘的開始，接手人必須清楚的知道，那個

虛擬函式會喚起那幾個虛擬函式，如果他覆載了一個虛擬函式，他應該連帶著覆載那幾個虛擬

函式才能讓程式運作正常，哦 ! 我們進入了繼承最美也最醜惡的部份了。

Interface 在某種程度上減輕了這些負擔，她沒有實作，實作者必須實作所有的定義函式，因此

上面的飛機問題不存在了，關聯性操在實作者手裡，因此也不存在了，那 Interface 比 Abstract

Classes 好嗎 ? 任何一種技術都有他存在的價值，你不能夠妄下斷語， Abstract Classes 可以有效

的減少程式碼的重覆性，逐步的完成特質也可以運用在一些特定的地方，這是 Interface 所不及的，

因此了解你想建構的系統，針對需求來使用兩個技術，例如 : 使用 Abstract Classes 來實現一些

元件操作者，意思是她是一堆元件的組合體，使用者真正接觸到的是她，而她內部所使用的元

件則以 Interface 方式來設計，這樣我們將整個系統劃分為兩部份，一個是基礎元件的實作者，

他們所面對的大多是 Interface ，跟小部份的 Abstract Classes ，另一部份是元件的使用者，她們

接觸到的是 Abstract Classes ，與完成後的元件。

 

 

第五章、 DLL 與 Interface

 

5-1 、DELPHI -> DELPHI

 

  要在 DLL 中輸出物件一直是個麻煩的問題，其中牽扯到各家 C++ 編譯器的實作不同，各語言

之間缺乏二進位的標準所致，為了解決語言間的差異， MS 提出了 COM 架構，姑且不論 COM

架構的好與壞，就事實上來看，她的確解決了這部份的問題，但 COM 有一個問題沒有解決，那

就是平台的問題，使用 COM 使我們的程式限制於 Windows 平台之上，的確，在目前而言，這沒

什麼不好，但你若考慮到以 DELPHI+Kylix 來撰寫跨平台程式時，你勢必得回過頭來審視這個問

題，那麼有什麼方法可以擁有 COM 的特性，又不被 COM 所限制呢 ? 答案很簡單，如果我們可以

將 COM 的理念偷過來，直接實作在我們的 DLL 或是 Linux 的 SO 動態聯結檔之中，那我們就擁

有了二進位的相容性，又不會因為 COM 而遭受到平台的限制。 吆 ! 說的簡單， COM 又不是小孩

子的玩具，這麼大的東東要實作，那得花上多少時間啊 ? 唔 ! 我們大可不必實作整個 COM 架構，

我們只需要她的運作理念。 熟悉 COM 的人都知道，在你撰寫 COM Object 之前，你必需定義

COM Interface ，並賦與她一個 GUID ，接著撰寫實作碼，最後編譯並向系統註冊。 那其它人就可以

使用你的 COM Object 了， COM Interface 的定義是為了維護二進位的標準，簡單的說，她指向一個

結構體，這個結構體中主要有三個既定函式 :AddRef,Release,QueryInterface ，整個結構體格式如下 :

 

上圖中我們可以發現， COM Interface 中的各個函式指標都指向了實體物件中的函式位址，因此當我

們呼叫了 COM Interface 中的某個函式時，事實上我們真正呼叫的是實體物件中的函式，因此只要語

言可以產生出這個結構體，且支援 Windows DLL ，那她就可以撰寫 COM 物件，這個結構體就是 COM

的二進位標準。 那如果我們將這個慨念運用到我們的程式中，那我們就可以實作出類似 COM 這種架構

了，進而完成我們由 DLL 中取出物件的目的，哦 ! 不是的，我們依然沒有從 DLL 中輸出物件，我們是由

DLL 中輸出一個 Interface ，接下來我們就用兩種語言，三個編譯器來試著實作一下。 首先我們使用

DELPHI 來撰寫一個 DLL ，並由這個 DLL 輸出一個 Interface ，接著再撰寫另一個程式來運用這個 DLL:

 

unit Unit2;

 

interface

uses SysUtils;

 

type

  IInvokeInter>

    function SayHello:PChar;stdcall;

  end;

  PInvokeInter>

 

  TInvokeInter>

    function SayHello:PChar;stdcall;

  end;

 

function GetInvokeIntf(out Obj:IInvokeInterface):HRESULT;stdcall;

implementation

 

function GetInvokeIntf(out Obj:IInvokeInterface):HRESULT;

var

  p:TInvokeInterface;

begin

  p:=TInvokeInterface.Create;

  Obj:=p;

end;

 

function TInvokeInterface.SayHello:PChar;

begin

  Result:='Hello!!';

end;

 

end.

 

這個程式很簡單，她定義了一個 Interface:IInvokeInterface ，接著以 TInvokeInterface 來實作這個

Interface ，另外定義了一個函式，用來建立該物件，並傳回給呼叫端，這個函式必需要宣告在

DLL Exports 區，這樣呼叫端才能夠呼叫她 :

 

library Project2;

 

{ Important note about DLL memory management: ShareMem must be the

  first unit in your library's USES clause AND your project's (select

  Project-View Source) USES clause if your DLL exports any procedures or

  functions that pass strings as parameters or function results. This

  applies to all strings passed to and from your DLL--even those that

  are nested in records and classes. ShareMem is the interface unit to

  the BORLNDMM.DLL shared memory manager, which must be deployed along

  with your DLL. To avoid using BORLNDMM.DLL, pass string information

  using PChar or ShortString parameters. }

 

uses

  SysUtils,

  Classes,

  Unit2 in 'Unit2.pas';

 

exports

  GetInvokeIntf;

{$R *.res}

 

begin

end.

 

編譯完成後，我們要開始撰寫使用她的程式 :

 

unit Unit1;

 

interface

 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls,SqlExpr;

 

type

  IInvokeInter>

    function SayHello:PChar;stdcall;

  end;

  PInvokeInter>

  TGetInvokeIntfProc=function(out Obj):HRESULT;stdcall;

  TForm1 = class(TForm)

    Button1: TButton;

    OpenDialog1: TOpenDialog;

    procedure Button1Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

var

  Form1: TForm1;

 

implementation

 

{$R *.dfm}

 

procedure TForm1.Button1Click(Sender: TObject);

var

  hDll:THandle;

  IntfProc:TGetInvokeIntfProc;

  Intf:IInvokeInterface;

begin

  if OpenDialog1.Execute then

   begin

     hDll:=LoadLibrary(PChar(OpenDialog1.FileName));

     try

     IntfProc:=GetProcAddress(hDll,'GetInvokeIntf');

     IntfProc(Intf);

     ShowMessage(Intf.SayHello);

     Intf:=Nil;

     finally

     FreeLibrary(hDll);

     hDll:=0;

     end;

   end;

end;

end.

 

我們在這個程式中使用了動態聯結的方式來使用 DLL ，並使用 GetProcAddress 來取得

GetInvokeIntf 函式的位址，然後呼叫她來取得 DLL 所輸出的 Interface ，由於我們希望

這個程式也能讀取別的語言或編譯器所產生的 DLL ，因此我們重新宣告了一次 Interface

定義，編譯後執行結果如下 :

 

 

很好，我們順利的從 DLL 中輸出 Interface 了，但事情還沒完，別忘了 ! 我們的程式還必須要

能夠讀取別的語言或編譯器所產生的 DLL ，接著我們就用 C++ Builder 5 來建立 DLL 。

 

 

5-2 、 DELPHI -> C++ Builder

 

由於 C++ 中並沒有詳細的定義 Interface ，因此我們選用與她相容的 struct 來宣告 Interface:

 

 

//---------------------------------------------------------------------------

 

#ifndef CUnit2H

#define CUnit2H

//---------------------------------------------------------------------------

#endif

#include "windows.h"

struct IInterface {

  virtual HRESULT __stdcall QueryInterface(LPUNKNOWN ps,const IID & riid,void *ppvObj)=0;

  virtual ULONG __stdcall AddRef(void)=0;

  virtual ULONG __stdcall Release(void)=0;

};

 

struct IInvokeInterface:public IInterface {

  public:

        virtual unsigned char * __stdcall SayHello(void)=0;

};

 

class TInvokeInterface:public IInvokeInterface {

  private:

        int RefCount;

  public:

        virtual HRESULT __stdcall QueryInterface(LPUNKNOWN ps,const IID & riid,void *ppvObj);

        virtual ULONG __stdcall AddRef(void);

        virtual ULONG __stdcall Release(void);

        unsigned char * __stdcall SayHello(void);

        TInvokeInterface();

};

 

extern "C" HRESULT  __stdcall __export GetInvokeIntf(IInvokeInterface** Obj);

 

 

上面的程式碼中，你可以發現我使用了類似 COM 的宣告，這是因為 DELPHI 需要這些函式來

處理 Reference Count ，下面是 cpp 檔。

 

 

//---------------------------------------------------------------------------

 

#pragma hdrstop

 

#include "CUnit2.h"

 

//---------------------------------------------------------------------------

#pragma package(smart_init)

 

extern "C" HRESULT  __stdcall __export GetInvokeIntf(IInvokeInterface **Obj)

{

 *Obj=new TInvokeInterface();

}

 

 

HRESULT __stdcall TInvokeInterface::QueryInterface(LPUNKNOWN ps,const IID & riid,void *ppvObj)

{

}

 

ULONG __stdcall   TInvokeInterface::AddRef(void)

{

 RefCount++;

 return RefCount;

}

 

ULONG __stdcall TInvokeInterface::Release(void)

{

 int FRefCount=--RefCount;

 if(RefCount==0)

   delete this;

 return FRefCount;

}

 

TInvokeInterface::TInvokeInterface()

{

 RefCount=0;

}

 

unsigned char * __stdcall TInvokeInterface::SayHello(void)

{

 return "Test";

}

 

將她編譯完成後，回到 DELPHI 中執行我們的運用 DLL 程式，你會看到下面的結果 :

 

 

很好，我們成功的使用 C++ Builder 所建構的 DLL ，接著我們再利用 VC++ 來試試 :

 

 

5-3 、 DELPHI -> Visual C++( 使用Visual Studio .NET B2)

 

#pragma once

 

struct IInterface {

  virtual HRESULT __stdcall QueryInterface(LPUNKNOWN ps,const IID & riid,void *ppvObj)=0;

  virtual ULONG __stdcall AddRef(void)=0;

  virtual ULONG __stdcall Release(void)=0;

};

 

struct IInvokeInterface:public IInterface {

  public:

        virtual unsigned char * __stdcall SayHello(void)=0;

};

 

class TInvokeInterface:public IInvokeInterface {

  private:

        int RefCount;

  public:

        virtual HRESULT __stdcall QueryInterface(LPUNKNOWN ps,const IID & riid,void *ppvObj);

        virtual ULONG __stdcall AddRef(void);

        virtual ULONG __stdcall Release(void);

        unsigned char * __stdcall SayHello(void);

        TInvokeInterface();

};

 

extern "C" HRESULT  __stdcall  GetInvokeIntf(IInvokeInterface** Obj);

 

VC++ 的程式碼與 C++ Builder 稍微有點不一樣，這是保留字上的差異性，下面是 cpp 檔 :

#include "stdafx.h"

#include "VCProject.h"

 

#ifdef _DEBUG

#define new DEBUG_NEW

#endif

 

//

//   Note!

//

//         If this DLL is dynamically linked against the MFC

//         DLLs, any functions exported from this DLL which

//         call into MFC must have the AFX_MANAGE_STATE macro

//         added at the very beginning of the function.

//

//         For example:

//

//         extern "C" BOOL PASCAL EXPORT ExportedFunction()

//         {

//              AFX_MANAGE_STATE(AfxGetStaticModuleState());

//              // normal function body here

//         }

//

//         It is very important that this macro appear in each

//         function, prior to any calls into MFC.  This means that

//         it must appear as the first statement within the

//         function, even before any object variable declarations

//         as their constructors may generate calls into the MFC

//         DLL.

//

//         Please see MFC Technical Notes 33 and 58 for additional

//         details.

//

 

// CVCProjectApp

 

BEGIN_MESSAGE_MAP(CVCProjectApp, CWinApp)

END_MESSAGE_MAP()

 

 

// CVCProjectApp construction

 

CVCProjectApp::CVCProjectApp()

{

     // TODO: add construction code here,

     // Place all significant initialization in InitInstance

}

 

 

// The one and only CVCProjectApp object

 

CVCProjectApp theApp;

 

 

// CVCProjectApp initialization

 

BOOL CVCProjectApp::InitInstance()

{

     CWinApp::InitInstance();

 

     return TRUE;

}

 

接著我們必需修改.Def 檔，將GetInvokeIntf 標示為DLL 輸出函式:

 

; VCProject.def : Declares the module parameters for the DLL.

 

LIBRARY      "VCProject"

 

EXPORTS

    ; Explicit exports can go here

    GetInvokeIntf;

 

編譯完成後，我們用DELPHI 程式來讀取這個DLL:

 

 

成功了，基本上我們已經可以由三個編譯器中輸出Interface 了，這也代表

著撰寫DLL 的人至少可以使用這三種編譯器來撰寫DLL，再由我們的程式來運

用她們。

由於我的電腦上已經沒有Visual Studio 6.0 了，因此我不能以Visual C++ 6

來測試這個程式，如果你使用VC 6，你應該可以在MSDN 中查到export function

的一些注意事項。

 

 

5-4、Kylix 2 -> Kylix 2

 

  Borland 在最近推出了Kylix 2，其中新增了許多功能，如BizSnap,DataSnap,

WebSnap 等強大的元件都一一出現在Kylix 2 Enterprise 中，不過這些不是我

們這一篇文章的重點，我計劃在日後寫一篇文章來介紹Kylix 2，這裡讓我們延

續這個主題，在Windows 環境中我們可以使用DLL 輸出Interface，在Linux 中

我們一樣可以使用Shared Object 來輸出Interface。

請開啟你的Kylix，並選擇建立一個Shared Object:

 

 

接著新增一個 Unit，並增加以下的程式碼:

 

 

unit Unit1;

 

interface

 uses Classes,SysUtils;

 

type

  ISayHello=interface

    function SayHello:string;stdcall;

  end;

 

  TSayHello=class(TInterfacedObject,ISayHello)

    function SayHello:string;stdcall;

  end;

 

function GetDllIntf:ISayHello;stdcall;

 

implementation

 

function GetDllIntf:ISayHello;

begin

  Result:=TSayHello.Create;

end;

 

function TSayHello.SayHello:string;

begin

  Result:='Hello! Kylix2';

end;

end.

 

然後在Project1.dpr 中加入exports 的程式碼:

 

program Project1;

 

uses

  QForms,

  uMain in 'uMain.pas' {Form1};

 

{$R *.res}

 

begin

  Application.Initialize;

  Application.CreateForm(TForm1, Form1);

  Application.Run;

end.

 

編譯完成後，我們建立一個新專案來使用這個.so 檔:

 

unit uMain;

 

interface

 

uses

  SysUtils, Types, Classes, Variants, QGraphics, QControls, QForms, QDialogs,

  QStdCtrls,Libc;

 

type

  ISayHello=interface

   function SayHello:string;stdcall;

  end;

  TGetDllIntf=function:ISayHello;stdcall;

 

  TForm1 = class(TForm)

    Button1: TButton;

    procedure Button1Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

var

  Form1: TForm1;

 

implementation

 

{$R *.xfm}

 

procedure TForm1.Button1Click(Sender: TObject);

var

  vIntf:ISayHello;

  GetFunc:TGetDllIntf;

  libHandle: Pointer;

begin

  libHandle:=dlopen('libProject2.so',1);

  GetFunc:=dlsym(libHandle,'GetDllIntf');

  vIntf:=GetFunc;

  ShowMessage(vIntf.SayHello);

  vIntf:=Nil;

  dlclose(libHandle);

end;

end.

 

在Linux 中，我們可以使用dlopen 函式來讀入一個Shared Object，接著

使用dlsym 來取出輸出函式，這個程式的執行畫面如下:

 

 

有趣吧，如果我告訴你這個Shared DLL 可以直接拿到DELPHI 6 上編譯的話，相

信你會找出更棒的運用方式的(當然，CLX 是跨平台的，也就是說這個測試程式可

以加上一些編譯條件後，在DELPHI 6 中完成編譯並執行)。

 

 

第六章、 我的故事

 

6-1、 JDBTools Professional Story

  大概是在三年前吧，我開始撰寫一組元件，這組元件用來簡化資料庫程式的設計，

由最簡單的可視型元件到最複雜的查詢器都有，在撰寫的過程中，我無時不在與

VCL 中複雜且強大的元件奮戰，有時我很疑惑VCL 為何會設計成這樣，為何我會陷

入這個美麗的元件叢林中而無法自拔。 歷經三年來的設計及演化，這組元件目前

已經是我所任職的公司內所有程式所依賴的，但她不完美! 因為她的內在有著許多

醜陋的運作模式，她們跨越了物件導向的原則、她們凌駕於VCL 的物件階層之上，

她們是我最不想見到的程式碼，也是我最害怕會出錯的程式碼，但是我無計可施!

缺少了她們，我的元件組將無法完成。 現在這組元件已經進入了維護狀態，我無

力再更改她，我只能為她添加新的功能，而對她的內部! 唔 … 那是個惡夢! 但我卻

非從未想過改造她，將她打造成可延伸、可抽換、又易於維護的元件組，在D5 時，

我曾經想以Interface 重新打造她的內在，可是當時我失敗了，失敗的原因你可能

已從我的第一篇文章中找到些端倪。 當我看到DELPHI 6 中對Interface 的支援時，

我只能說! 時不我予! 我依然不會對這組元件進行改造的工作，因為我計劃重新設

計一次，以Interface 來設計出一組新的元件! 喔! 你害怕了! 你這樣說著! 唔!

沒錯，我害怕了! 請看看下面這些圖形，相信你會了解我心中的恐懼!

 

JDBTools Profession Data Access Component

JDBTools Profession Control

JDBTools Profession Manager Component

JDBTools Profession Dialog Component

JDBTools Profession IE Style Control

 

很多吧! 其中最複雜的是Dialog 中的JPSearchDialog 元件，這個元件可以讓你

以相當簡單的方式設計出一個強力的查詢對話盒，下面是她的設計以及執行畫面:

 

 

 

 

上圖中你可以發現，我只指定了一行SQL 命令，設定了我所想要的查詢欄位後，這個查詢器

會自行分解這些資訊，組合成一個可供使用者查詢的對話盒，接著再將使用者所輸入的條件

組合成一個正確的SQL 指令，執行查詢並傳回結果。 但是這還不足以讓她成為我們公司所

撰寫的程式共有的查詢器，因為SQL 指令沒有這麼簡單，有時我們的指令會Join 多個資料

表，這時該如何做呢? 很簡單，那就是這個查詢器必須能夠分解出SQL 中的所有命令!

 

 

 

事實上，這個元件中分解了整個SQL 命令，並存入一個結構體中，當使用者輸入查詢條件後，

這個查詢器再以結構體中的資訊以及使用者的條件進而組合出一個正確的SQL 命令，當然!

這還不足夠，因為這個元件看來似乎受限於只查詢一個欄位，如果我們需要查詢一個欄位，

但實際所下的SQL 命令卻是兩個欄位時，又該如何呢?

上圖中用紅色框起來的部份就是答案，這個元件允許我們以一串SQL 命令來取代產生出來的SQL 命令，

當然，如果你眼睛夠利的話，你應該已經發現到了NoFieldxxxx 之類的屬性，是的! 這個元件接受

虛擬式欄位，這也使得她不受限於欄位，同時! 這個元件中的EditStyle 可以讓我們控制對話盒中的

控制項樣式，你可以使用適應該查詢條件的控制項:

 

 

甚至她還支援在查詢器中再開出一個查詢器。 OK! 很好! 那重點在那裡呢?

重點在於這個查詢器支援BDE,ADO,IBExpress,DBISAM,dbExpress,MIDAS!

因為她內部只針對TDataSet 操作。 等等! 用TDataSet 如何取出SQL 指令? 使用

IProviderSupport 嗎? 唔 … 我倒希望是! 可惜的是沒有! 原因是我開始寫她時，

IProviderSupport 還沒出現! 更別說她的能力是否可勝任如此複雜的操作方式了，

這個元件中使用了訊息導向的設計方式，也就是說，她會送出一些訊息給DataSet

元件，只要這個DataSet 元件可以回應這些訊息，那查詢器就可以正常運作，那我

只需要繼承想要支援的元件，並為她撰寫訊息處理程式即可，不需要改變查詢器

元件中的程式碼，當然! 這只是概觀的討論，事實上她內部的處理遠超過於此，

基本上查詢器與DataSet 之間還有一個Proxy 物件，因為她還得為不同的SQL 命

令做修正及替換的動作。 討論到這裡，你大概可以想像我會如何重新設計這個

元件了吧，首先我會定義一個Interface，裡面有所有查詢器會用到的功能函式，

接著再繼承想支援的DataSet 類元件，為她實作這個Interface，並使用Delegation

技術來簡化實作上的困難度，這樣查詢器可以獨立於資料庫元件之外，也不需要

維護之前版本中的數十個訊息，延伸及維護的工作變得很簡單了。 或許你會疑惑，

如果只是這麼簡單的目的，那又何必大費週章的重新設計一份呢? 唔 … 有件事我

忘了告訴你，JDBTools Data Access 元件有額外的能力，包括在新增時Enable

連結至該Data Access 元件所有的Control，並在瀏覽時Disable，也提供了跳號

的功能，例如以日期、以字元、以序號。 這些功能都是為了讓Control 擁有額

外的能力所設計的。 這些功能都必需經由DataSet 直接以訊息送達，所有的

Controls 才能獨立於DataSet 類元件之外。 這些個功能使我無法以現行架構

來改造，而必須以一個新的開始來設計，相信許多的元件商有著與我一樣的困擾，

不過這次我會用Interface 來設計她，將所有功能分成幾個Interface，分別定義，

在你看到這篇文章時，這個元件組已經正式進入我的客戶的辦公室中了。 很抱歉，我

無法公開這個元件組中的程式碼，因為她正是我公司目前所仰賴生存的元件組。

 

 

6-2 、 Orphean MIDAS Components Story

 

  在今年初，我的公司開始計劃撰寫一個套裝程式，她必須擁有幾個特性。 一、她

必須能夠跨 Internet 使用，二、她必須能在數據機上運作，並且速度要很快，三、最

好程式設計師能夠延用 Client/Server 的觀念，如果不行 ! 那我得保證這個程式能很快

的開發出來，並且日後的相同程式都必須以很快的速度開發出來。 喔 ! 我必須說 !

或許是我的老板太高估我了，也可能是這個天才認為這件事很簡單吧。 或許你會說，

這有何困難，使用 MIDAS 一切就搞定了。 唔 …. 可能是吧 ! 但事實呢 ? 你如何處理

自動跳號的欄位 ? 你如何處理一個程式中開啟多個同樣的 Provider/ClientDataSet? 你

如何處理各 Client 端的資料更新動作 ? 你如何減少網路流量 ? 你如何處理離線狀況 ?

你如何處理跳號欄位，例如日期、字元、序號 ? 你如何處理 Lookup 類的欄位 ? 你

如何處理開查詢窗 ? 你如何使用 Locate 查詢到最新的資料 ? 最後我還得把這些功

能封裝在一組元件中，讓同事們不需要太多的學習就可以上手，最好能夠延用

JDBTools Professional 中所有的元件以及同樣的設計模式。 有了 JDBTools 的慘痛

經驗，我這次學乖了，我使用了 Interface 來設計這組元件，我將這些功能分成

幾個 Interface ，並且使用一個 Interface 來取得她們，接著撰寫一個物件，傳回

這個主 Interface ，最後開放一個全域函式來註冊這個物件，這樣我就可以在

不修改專案程式的情況下抽換這些核心功能，下面是這組元件 :

 

 

這組元件中有幾個重要的 Interface ，表面上可看到的部份是第 7 到 10 個，

她們是 IQueryProvider 的實作者，主要是提供建立新的 Query 物件用，

DataSetProvider 元件中利用她們來建立同步 Client 端資料用的 Query 物件，

主要在於隔離 DataSetProvider 與實體 DataSet 元件。 第 5 個元件是記錄

器 :IlogManager ，她的目的在於記錄所有 Client 更新的動作，並保存在資料

庫中，並提供一組函式讓 DataSetProvider 可以取出並使用 IQueryProvider

來取得更新的資料後傳回給 Client 端。 第六個元件是 IDataFactory ，主要

的功能是提供自動跳號欄位的處理能力，她同時實作了 ISerialFactory 來處

理跳號欄位，如日期、字元、序號等功能。 這些元件都使用了 Delegation

技術，將實體運作與專案隔離，這樣我就可以在不更動專案的情況下修改

或延伸這些實體功能。 而取得這些實體功能的介面就是 IServerUtils 。

與 IServerUtils 相對的就是 IClientUtils 介面，她是運用在 ClientDataSet 之中，

ClientDataSet 利用她來與 AP-Server 溝通，她與 IServerUtils 相同，也是一

個 Proxy Interface ，負責傳回其它的介面。

這些就是我在 Orphean 中使用介面的方式， Orphean 目前是我公司主要的

元件之一，使用她的專案有 3 個已開發完成，並投入使用中。

其實 Orphean 是一組規格，所以我正計畫將這組規格公開，只是這還不確

定的。

 

Orphean Client

Orphean Server

OrpServerUtils 以及 OrpClientUtils 分別實作了 IOrpServerUtils 、 IOrpClientUtils 做為中介型 Interface 。

PS: 實在是無法放下所有的架構圖，這只是大略型的。

 

 

6-3 、 Libra Web Components

  這組元件目前還在開發中，主要是延伸 WebSnap 並加上許多便利的功能，

與之前兩組元件不同， Libra 會有一個 Lite Version ，簡單的說 ! 這個版本將

是 Freeware 的 ( 也可能會 Open Source) 。

 

6-4 、 故事的背後

  

還記得我曾經與同事及朋友聊過，業界是個殘酷的地方，許多的技術並

非如你想像的那麼簡單，例如 MIDAS 就是一個例子 ! 我看過無數個失敗的

專案，當然 ! 也有成功的案例，可惜不多 ! 或許你身邊，甚至是你曾經開發

過耀眼的 MIDAS 程式，並且客戶們也用的很高興，我所指的並不是那些小

小的程式，我指的是例如進銷存、會計、人事、物流、貿易等大型程式，

在我的經驗中，我面臨過許多的瓶頸，或許是我的資質不夠，常常有坐

擁千書，但卻無一字可用的窘境。 MIDAS 中有著許多的秘密，甚至可以

說是臭蟲，這些只有在你真正用她來建構專案時才會發覺。 許多技術有

著同樣的情形，如 Interbase Objects 、 ADO 、 Interbase Express 都是，所以

在你使用某種技術時，要審慎評估她，老板不會給你後悔的機會。

 

 

全文後記

  這篇文章經過特殊的編排，你可以直接以印表機印出來，日後所發表的

文章儘量比照辦理，除非是特殊情況。

列印時請將邊界設為 1 ，大概是 75 頁左右，你可以使用雙面列印或是 FinePrinter

來減少頁數。

 

 

範例程式

  嘿 ! 這篇文章沒有範例程式哦 !

 

與我聯絡

 

深度論壇是我常去的網站，你可以在那找到我，亦或是直接 mail 給我，你

對我的批評或是指教是我所珍惜的。