Advanced Interface Volume1 – Data Transfer Kit

Advanced Interface Volume1 – Data Transfer Kit

文/黃忠成

code6421@pchome.com.tw

Interface Again!! Now What??

在完成淺談Interface與Interface Designing 兩篇文章後，我心中一直有著寫續篇的念

頭，無奈礙於時間與主題的限制，遲遲未能下筆。不知是幸運還是不幸，去年九月我由

原公司離職，成為無業游民。當游民的好處是空閒時間很多，但壞處則是收入不固定，

一不小心就有斷炊之虞，幸好有位熱心朋友的幫忙，介紹一個兼職顧問的工作，收入雖

算多，但卻能負擔房租與部份的生活費，再加上雜誌的稿費，生活還算過得去。

既然時間有了，自然就沒有讓這篇文章無限延期的藉口了，只是心中尚有另外一個顧

慮，那就是文章的主題。在淺談Interface中，我介紹了一些在DELPHI中使用Interface

的基本知識，於Interface Designing中則將焦點放在DELPHI如何實現Interface的底層

技術上。既然基礎與底層技術都已經寫過了，Advanced Interface 大概只剩下一個主題

可用了，那就是實際的運用Interface來建構出一個程式，但是這個主題的難度不低，首

先必須思考要建構一個什麼樣的程式，有了方向後還得考慮程式的複雜度，避免讓程式

本身的複雜度掩蓋掉主軸，進而造成讀者必須先懂得相關技術方能閱讀的困擾。找出方

向並控制住程式的複雜度後，接著還得將整個建構程式的思維化為文字與圖形表現出

來。這些課題不只考驗著我的分析與設計能力，同時也考驗著實作與描述思維的能力。

隨著文章與範例的完成，心中的那塊大石終於可以放下，至於文章是好還是壞，那就交

給讀者來評斷了。這篇文章的主軸環繞著一個小型的Framework: Data Transfer

Kit(DTK)，DTK是一個完全以Interface為主軸所建構出來的Framework，為了讓使用者

能更輕鬆的駕馭她，DTK與VCL間做了一些妥協，讓使用者可以用RAD的方式來運

用，雖說如此，但這篇文章不是Component Designing，所以我刻意的將DTK與

VCL結合部份簡化，這可以降低閱讀的門檻，缺點是在使用上少掉了幾分的易用性與直

覺性。在進入主題之前，我必須提醒你幾件事，第一! 文章的主軸在DTK上，這代表

著文章中不會特別對DTK之外的元件做介紹，例如Indy、Abbrevia、XML等等。第二!

DTK並非是商業元件，也不是一個完整的程式，任何將她運用於實際專案中的動作都

必須承擔某種程度的風險。好了!讓我們進入主題吧。

TComponent vs Interface

雖然Borland 在DELPHI 6/7 加強了對Interface的支援，使得其上的BizSnap與

WebSnap 得以使用Interface來展現出另一種風貌的設計模式。只是最終Borland還是留

下了一個嚴重的破洞，那就是TComponent。如前面的兩篇文章中所提及，Interface的

生命週期是由Reference Count所控制，當你由某一個物件中取出Interface時，該物件

的Reference Count會被加1，此動作是在_AddRef中完成的。當某個Interface 指標被設

為Nil時，Reference Count 就會減1，這則是在_Release中完成，當_Release完成減1

的動作後會檢查Reference Count的值，當Reference Count 等於0時就會呼叫該物件的

Destroy函式，物件就會被釋放。

現在想像一種情況，你由某個物件中取出了一個Interface:

vIntf:=(Object as SomeInterface);

此時Object 的Reference Count會被加1，但如果vIntf在使用完畢後未被設成Nil，這

時是否會產生Memory Leak 呢?? 答案是否定的。在DELPHI的Method Finalization動

作中隱藏著一個機制，此機制會在離開Method 前將所有型別為IInterface的區域變數設

成Nil，所以這段程式碼並不會產生Memory Leak。假如這個變數是定義於Class 中，

那麼設成Nil的動作將由Destory(解構子)代勞，一樣不會造成Memory Leak，這些是

DELPHIRTL 的預設行為。以上所述的情況都是在該物件實作了IInterface之後的行為，

那麼如果該物件沒有實作Iinterface呢?? 這點倒不用擔心，因為編譯器不允許由一個未

實作IInterface的物件取出Interface。看起來似乎沒什麼大問題，那麼為何說TComponent

是一個破洞?? 其原因在於TComponent 實作了IInterface，但卻沒有實現Reference Count

機制，她所實作的IInterface 只能用來取出Interface而已。這代表著如果使用了

TComponent 作為基礎類別並實作某些Interface之後，設計者將面臨可能造成Memory

Leak的情況，思考下面這段程式碼:

Component:=TComponent.Create(Nil);

vIntf:=(Component as IInterface);

這是一段有Memory Leak 的程式碼，因為Component 並不會因為Reference Count 變

成0而釋放，事實上!Reference Count永遠不會變成0，設計者必須對它明確的下達Free

命令才能將它釋放掉。再思考另一段程式:

Component:=TComponent.Create(Self);

vIntf:=(Component as IInterface);

許多人可能認為這段程式碼也有Memory Leak，但事實上沒有!因為Component是某個

元件的子元件，父元件會在釋放自己時一併釋放它，這段程式碼充其量只能說是濫用資

源。最後看一下問題最大的程式碼:

Component:=TComponent.Create(Nil);

Component2:=TMyComponent.Create(Nil);

Component2.SomeInterface:=Component as SomeInterface;

Component.Free;

……………………..

Component2.Free;

這段程式碼中隱藏著一個難以查覺的問題，那就是RTL在Method Finalization與物件

Destroy時清空所有IInterface變數的機制。由於程式中已明確的將Component釋放掉，

但在釋放前卻未將Component2.SomeInterface的指標設為Nil，這樣會造成難以預料的

結果。因為在Component2釋放時SomeInterface會被設成Nil，這隱含著一個呼叫

Component._Release的動作，但是Component已經被釋放了，所以結果可想而知。但為

何說它難以預料呢?? 那是因為這個問題並非每次程式執行時都會發生，會不會出錯取

決於RTL內部的記憶體分配動作，沒發生問題的原因是當時SomeInterface所指的位置

湊巧是有效的。如果再加上這個Component是某元件的子元件時，問題就更難查覺了，

因為釋放子元件的順序可能剛好是正確的。

看起來問題是出在TComponent未完整實現Reference Count 機制上，那麼如果有一個

實現Reference Count機制的TComponent 類別，這些問題就全部解決了嗎?? 答案可能

令你失望，Angus Johnson 與 Anders Melander所寫的TInterfacedComponen就是一個完

整實現Reference Count的TComponent類別，但是她卻無法解決所有的問題，相反的! 使

用TInterfacedComponent將會引發另外幾個無法預料的問題。畢竟VCL設計之初，壓

根就還沒有想到今天Interface會被廣泛的運用。

那麼結論是無法使用TComponent+Interface 了嗎?? 當然不是，WebSnap/BizSnap 不是

運作的好好的嗎?? 事實上，WebSnap 與BizSnap中運用了一些小技巧，使其得以正常

運作，而代價就是實作者必須做些額外的工作，維持整個架構的平衡。在未來的

DELPHI.NET與DELPHI 8中，這些問題都已解決，這也代表著日後我們不須再為這件

事傷腦筋了。

在TComponent上實現Reference Count機制

要在TComponent上實現Reference Count機制並非是件難事，難的是如何讓這

個TComponent同時支援兩種本質上就相斥的生命週期，下面就是一個實現Reference

Count機制的TComponent:

{$I DTK.inc}

unit uDTKBaseComponent;

interface

uses

Classes,Windows,SysUtils,uDTKIntf;

type

TDTKBaseComponent=class(TComponent,IInterface)

private

FRefCount: Integer;

FOwnerIsComponent: Boolean;

protected

{ IInterface }

function _AddRef: Integer; stdcall;

function _Release: Integer; stdcall;

public

class function NewInstance: TObject; override;

procedure AfterConstruction; override;

end;

implementation

class function TDTKBaseComponent.NewInstance: TObject;

begin

Result := inherited NewInstance;

TDTKBaseComponent(Result).FRefCount := 1;

end;

procedure TDTKBaseComponent.AfterConstruction;

begin

inherited;

FOwnerIsComponent := Assigned(Owner) and (Owner is TComponent);

InterlockedDecrement(FRefCount);

end;

{ IInterface }

function TDTKBaseComponent._AddRef: Integer;

begin

Result := InterlockedIncrement(FRefCount)

end;

function TDTKBaseComponent._Release: Integer;

begin

Result := InterlockedDecrement(FRefCount);

{ If we are not being used as a TComponent, then use refcount to manage our

lifetime as with TInterfacedObject. }

if (Result = 0) and not FOwnerIsComponent then

Destroy;

end;

end.

程式相當簡單，只是單純的加上Reference Count機制而已，你可以在這段程式碼中

發現到一個有趣的現象，Reference Count的機制只作用於AOwner = Nil的情況，這是

為了讓她與VCL共存所作出來的決定。請思考一種情況，如果這個TComponent完整

實現出了Reference Count機制，這意味著不管AOwner是否是Nil，此元件的生命週期

都是由Reference Count所控制的，但是VCL中預設的TComponent行為在釋放自己之

前會先釋放子元件，這點與Reference Count生命週期產生衝突，所以結論是Reference

Count只能作用於AOwner = Nil的情況下。

補上最後的缺口

上節中所撰寫的TDTKBaseComponent雖然實現了Reference Count機制，但是依然沒

有解決所有的問題。請思考一種情況，某個元件握有TDTKBaseCompoennt的Interface

Reference，而這兩個元件是放置於FORM上，也就是說FORM是這兩個元件的父元件，

那麼TDTKBaseComponent將採用VCL的方式控制生命週期，問題來了!思考一下FORM

釋放子元件的順序，如果握有TDTKBaseComponent的元件先被釋放的話，那麼程式將

可以正常的運行，但如果TDTKBaseComponent先被釋放呢?? 答案很簡單!那就是握有

TDTKBaseComponent的元件在釋放自己時會清空手中所握的Interface Reference，可是

對應的TDTKBaseCompoent已被釋放了，結果當然是引發例外。那該如何解決這個問

題呢??答案是Holder機制，藉由兩個元件間的協調，讓被握住Reference Interface的元

件在釋放前通知握住Interface Reference 的元件清空Interface Reference:

{$I DTK.inc}

unit uDTKBaseComponent;

interface

uses

Classes,Windows,SysUtils,uDTKIntf;

type

TDTKBaseComponent=class(TComponent,IDTKObjectReference,IDTKHolder,IInterface)

private

FHolders:TThreadList;

FRefCount: Integer;

FOwnerIsComponent: Boolean;

protected

{ IDTKObjectReference }

function GetObject:TObject;

{ IDTKHolder }

procedure CleanIntf(AObject:TObject);virtual;

function GetHolders:TThreadList;

property Holders:TThreadList read FHolders;

{ IInterface }

function _AddRef: Integer; stdcall;

function _Release: Integer; stdcall;

public

constructor Create(AOwner:TComponent);override;

destructor Destroy;override;

class function NewInstance: TObject; override;

procedure AfterConstruction; override;

end;

implementation

class function TDTKBaseComponent.NewInstance: TObject;

begin

Result := inherited NewInstance;

TDTKBaseComponent(Result).FRefCount := 1;

end;

procedure TDTKBaseComponent.AfterConstruction;

begin

inherited;

FOwnerIsComponent := Assigned(Owner) and (Owner is TComponent);

InterlockedDecrement(FRefCount);

end;

{ IInterface }

function TDTKBaseComponent._AddRef: Integer;

begin

Result := InterlockedIncrement(FRefCount)

end;

function TDTKBaseComponent._Release: Integer;

begin

Result := InterlockedDecrement(FRefCount);

{ If we are not being used as a TComponent, then use refcount to manage our

lifetime as with TInterfacedObject. }

if (Result = 0) and not FOwnerIsComponent then

Destroy;

end;

constructor TDTKBaseComponent.Create(AOwner:TComponent);

begin

inherited Create(AOwner);

if Assigned(AOwner) then

FHolders:=TThreadList.Create;

end;

destructor TDTKBaseComponent.Destroy;

var

vIntf:IDTKHolder;

I:Integer;

vList:TList;

begin

if FOwnerIsComponent then

begin

vList:=FHolders.LockList;

try

for I:=0 to vList.Count-1 do

begin

if Supports(TObject(vList[I]),IDTKHolder,vIntf) then

vIntf.CleanIntf(Self);

end;

finally

FHolders.UnlockList;

end;

FHolders.Free;

end;

inherited;

end;

{ IDTKHolder }

procedure TDTKBaseComponent.CleanIntf(AObject:TObject);

begin

end;

function TDTKBaseComponent.GetHolders:TThreadList;

begin

Result:=FHolders;

end;

{ IDTKObjectReference }

function TDTKBaseComponent.GetObject:TObject;

begin

Result:=Self;

end;

end.

TDTKBaseComponent是DTK的基礎元件，目前看起來這種方法似乎已避開了這些問題

了。但是這必須做更詳細的測試，目前只能說Holder機制在DTK中是可以正常運作的。

四個有趣的範例

下面這段程式雖然看起來似乎是正確的，但事實上她會造成Memory Leak。

unit Unit1;

interface

uses

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

Dialogs, StdCtrls;

type

ITest=interface

['{B3740E93-F632-44E3-B05C-8E6583A034A7}']

procedure p;

end;

TTestObject=class(TInterfacedObject,ITest)

protected

procedure p;

public

destructor Destroy;override;

end;

TMyObject = class(TComponent)

private

Fp:TTestObject; //memory leak!!

public

destructor Destroy;override;

end;

TForm1 = class(TForm)

Button1: TButton;

procedure Button1Click(Sender: TObject);

private

FO:TMyObject;

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

destructor TTestObject.Destroy;

begin

inherited;

end;

procedure TTestObject.p;

begin

end;

destructor TMyObject.Destroy;

begin

inherited;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

I:Integer;

begin

for I:=0 to 10000 do

begin

FO:=TMyObject.Create(Self);

FO.Fp:=TTestObject.Create;

FO.Free;

end;

end.

會造成這種情況的原因是程式直接使用TTestObject作為變數的型別，這使得物件在

Destroy時不會釋放Fp，因為她並不是IInterface的子介面。改成下面這樣就可以避免

Memory Leak的發生。

unit Unit1;

interface

uses

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

Dialogs, StdCtrls;

type

ITest=interface

['{B3740E93-F632-44E3-B05C-8E6583A034A7}']

procedure p;

end;

TTestObject=class(TInterfacedObject,ITest)

protected

procedure p;

public

destructor Destroy;override;

end;

TMyObject = class(TComponent)

private

Fp:ITest; //working fine.

public

destructor Destroy;override;

end;

TForm1 = class(TForm)

Button1: TButton;

procedure Button1Click(Sender: TObject);

private

FO:TMyObject;

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

destructor TTestObject.Destroy;

begin

inherited;

end;

procedure TTestObject.p;

begin

end;

destructor TMyObject.Destroy;

begin

inherited;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

I:Integer;

begin

for I:=0 to 10000 do

begin

FO:=TMyObject.Create(Self);

FO.Fp:=TTestObject.Create;

FO.Free;

end;

end.

兩個程式的差別只在於一個使用了TTestObject，另一個則使用了ITest。這告訴我們不

該直接使用TInterfacedObject嗎?? 看看下面這段程式。

unit Unit1;

interface

uses

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

Dialogs, StdCtrls;

type

ITest=interface

['{B3740E93-F632-44E3-B05C-8E6583A034A7}']

procedure p;

end;

TTestObject=class(TInterfacedObject,ITest)

protected

procedure p;

public

destructor Destroy;override;

end;

TMyObject = class(TComponent)

private

Fp:TTestObject; //memory leak!!

public

destructor Destroy;override;

end;

TForm1 = class(TForm)

Button1: TButton;

procedure Button1Click(Sender: TObject);

private

FO:TMyObject;

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

destructor TTestObject.Destroy;

begin

inherited;

end;

procedure TTestObject.p;

begin

end;

destructor TMyObject.Destroy;

begin

inherited;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

I:Integer;

vIntf:ITest;

begin

for I:=0 to 10000 do

begin

FO:=TMyObject.Create(Self);

FO.Fp:=TTestObject.Create;

vIntf:=FO.Fp;

FO.Free;

end;

end.

上面這段程式一樣沒有Memory Leak，那麼這到底是怎麼回事??答案是TinterfacedObject

必須至少被轉成Interface一次，否則你就得手動呼叫該物件的Free函式來釋放她。

unit Unit1;

interface

uses

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

Dialogs, StdCtrls;

type

ITest=interface

['{B3740E93-F632-44E3-B05C-8E6583A034A7}']

procedure p;

end;

TTestObject=class(TInterfacedObject,ITest)

protected

procedure p;

public

destructor Destroy;override;

end;

TMyObject = class(TComponent)

private

Fp:TTestObject; //memory leak!!

public

destructor Destroy;override;

end;

TForm1 = class(TForm)

Button1: TButton;

procedure Button1Click(Sender: TObject);

private

FO:TMyObject;

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

destructor TTestObject.Destroy;

begin

inherited;

end;

procedure TTestObject.p;

begin

end;

destructor TMyObject.Destroy;

begin

inherited;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

I:Integer;

begin

for I:=0 to 10000 do

begin

FO:=TMyObject.Create(Self);

FO.Fp:=TTestObject.Create;

FO.Fp.Free;

FO.Free;

end;

end.

結論是，TInterfaceObject一天未轉為Interface，她就一天是個物件，也就必須使用Free

來釋放。

Data Transfer Kit

DTK是一個功能與架構不成正比的Framework，她的功能面相當簡單，只是將檔案

由一台電腦傳到另一台電腦，這樣的功能使用Indy來做的話，大概只需1-20行程式碼

就擺平了。重點是如此簡單的功能用得著寫這麼一大篇文章來介紹嗎?? 這個問題等到

你看完了全文後就會了解。事實上，為了完成這個看似簡單的任務，我寫了數千行程式

碼(甚至更多……我沒數行數的習慣)。

分析需求

為了這個超級簡單的程式，我們得先做個需求分析。一個網路傳檔程式的需求可以用

一句話涵蓋，那就是把檔案由一台電腦經由TCP/IP通訊協定傳輸到另一台電腦，需求

面就只是如此而已。

抽象化需求

為何要抽象化需求?? 答案通常只有一個，那就是使成品具備可重用性及延展性。如

果單以上面的分析來實作，頂多只能寫出一個使用TCP/IP的網路傳檔程式，但是若將

這個需求抽象化，那麼寫出來的東西可能遠超出你的想像。真的嗎?? 眼見為真，讓我

們開始抽象化需求吧。

第一步，讓我們複頌一次需求，將一個檔案由一台電腦經由TCP/IP通訊協定傳輸到另

一台電腦。現在開始抽象化這個需求。首先將檔案抽象化為某一個東西，那麼整個需求

就變成了，將某一個東西由一台電腦經由TCP/IP通訊協定傳輸到另一台電腦，這樣寫

出來的東西就不只是一個傳檔程式而已了，可以是個傳圖、傳DataSet、傳Message等等

之類的程式。

現在再將TCP/IP通訊協定抽象化為某種通訊協定，那麼結果就變成了，將某一個東西

由一台電腦經由某種通訊協定傳輸到另一台電腦，那麼寫出來的東西就不限制只能用

TCP/IP網路協定了是吧??

最後一個抽象化動作，將某一個東西由A點經由某種機制傳輸到B點。

有趣嗎??

需求實體化

何謂需求實體化?? 其實很簡單，需求通常都帶著某一程度的抽象色彩，一個未經過

實體化的需求是無法直接進入設計階段的。以前面這個需求來說，她缺少了一些現實情

況中需要的元素，當某個東西要被傳輸時，必定得有個機制將它先讀取出來，在傳輸前

這些資料得被轉換為可傳輸的格式，當傳輸完成後，接收者必須要經由同樣的轉換動作

將已變成傳輸格式的資料還原回原來的格式，再經由同樣的機制處理她，有時接收者也

必須回傳訊息，告知傳輸者要求已完成。那麼整個實體化後的需求就變成了，將某個東

西讀出後轉換為可傳輸的格式，經由某種機制由A點傳輸到B點，B點在收到資料後，

經由同樣的轉換機制由可傳輸格式還原資料，再經由同樣的機制處理這個資料，必要時

傳回處理結果的訊息。

需求元件化

當需求實體化後，接著就要由這些需求找出架構中所需要的元件。首先讓我們再一次

複頌需求，將某個東西讀出後轉換為可傳輸的格式，經由某種機制由A點傳輸到B點，

B點在收到資料後，經由同樣的轉換機制由可傳輸格式還原資料，再經由同樣的機制處

理這個資料，必要時傳回處理結果的訊息，那麼這個需求中包含幾個元件呢?? 第一個

元件是東西，由於系統必須經由某種機制才能取得東西，因此東西與存取的機制屬於同

一個元件，我們將她命名為DataProvider，主要功能是提供一個東西來傳輸。第二個元

件是轉換機制，因為系統必須將DataProvider所提供的東西轉換成可傳輸的格式，才能

將這個東西送出去，此元件稱之為DataFormatter，DataFormatter與DataProvider具有相依

性，因為只有DataProvider才知道如何取出東西，所以DataProvider必須依賴DataFormatter

才能將資料轉換成可傳輸的格式，基於這一點，DataFormatter必須提供出一組泛型的存

取介面，這樣DataProvider才能取出東西後經由這些介面將資料寫入DataFormatter中。

第三個元件是某種機制，用來傳輸資料，稱之為Transport。最後是A點與B點，對應到

Client與Server這兩個元件。

由圖中可以看到，多數的元素都已被化為元件了，圖中有一點需要特別解釋，那就是

Stream，這個元件會出現的原因在於我們不可能使用Transport來傳輸DataFormattet元件，

因為一個是元件，一個是資料流，兩者完全不相干。所幸多數的Transport技術都可以傳

輸Stream，而多數語言也都支援這種型別，因此DataFormatter最終必須輸出成為Stream，

以利Transport 傳輸，下一節會詳細的解釋這一部份。

用元件組成架構

前面已由需求提鍊出幾個元件，有了元件後就可以將她們組合起來，完成系統的初步

架構。由Client這個元件開始，當傳輸一個東西時Client需要一個DataProvider來取出東

西，而DataProvider則需要一個DataFormatter來將東西變成某一種格式，但這裡我們遇

到了一個問題，DataFormatter 與 Transport 之間如何連結呢?? DataFormatter 是一個元

件，任何的Transport都不可能接受一個DataFormatter元件，因此DataFormatter 必須要

有一個能力，那就是將DataFormatter轉成多數Transport可以接受的格式，答案就是

Stream，絕大多數語言都支援這種格式，結論是DataForamtter必須擁有將自己變成Stream

的能力。到這裡為止，需求的上半部已然形成。現在是下半部，Server元件必須有一個

Transport，用來接收Client端所傳輸上來的資料，但這裡有一個實作上的問題，如果照

著Client端的方式實作Server元件，那麼Server就只能有一個Transport元件，這不合理

也不夠聰明，所以必須有一個Collection 元件存在於Server端，這個元件稱之為

TransportCollection，這樣Server 就可以允許多個Transport共存了。當Transport收到Client

端送來的資料後，必須尋找對應的DataFormatter，因為只有正確的DataFormatter才懂得

如何讀取資料，因此Server 必須有另一個Collection 元件，用來註冊目前所支援的

DataFormatter，這個元件稱之為DataFormatterCollection。找出正確的DataFormatter格式後，

接著必須找出正確的DataProvider，與DataFormatter相同，只有正確的DataProvider才知

道如何處理這個資料，為了達到這一點，Server必須有另一個Collection，用來註冊目前

支援的DataProvider。

效能與同步機制的考量 (Thread-safe)

完成基礎架構後，現在必須針對這個架構做合理性的評估，此架構唯一值得擔心的是

Server的DataProvider與DataFormatter元件，由於Server必須同時服務多個Client端，如

果針對每個Client端的要求都建立一次DataProvider與DataFormatter的話，可能會造成

效能上的瓶頸。但是若只用一個DataProvider或是DataFormater的話，又會面臨同步處理

的問題，因為Server只有一個，但Client卻可以有無數個。為了解決這些問題，我們將

建立這兩個元件的動作交由另兩個元件來負責，這樣就可以視情況來變更建立的方式，

這兩個元件就是DataFormatterFactory、DataProviderFactory，因為這兩個元件的加入，之

前所規劃的DataFormatterCollection、DataProviderCollection就不能再用了，改由

DataFormatterFactoryCollection、DataProviderFactoryCollection兩個元件取代。

元件介面化

為何將元件介面化?? 答案很簡單，元件所代表的是一個已實體化的東西，直接使用

元件會有馬上進入實作面的困擾，使用介面可以避免這個情況發生。同時介面在許多語

言中都是屬於最抽象化的物種，這可以讓我們在開始實作之前有機會做出較全面性的思

考。目前大多數語言都支援介面的定義，如果你熟悉的語言沒有支援介面的機制，那麼

你可以用Abstract Class(抽象化類別)來當成介面。

IDTKDataProvider

首先由IDTKDataProvider這個介面開始，經由上面的分析後，IDTKDataProvider必須擁

有將讀取或寫入某個東西至DataFormatter中的能力，基於這一點，IDTKDataProvider

必須擁有一個DataFormatter的參考，下面是IDTKDataProvider的定義。

IDTKDataProvider=interface(IDTKObjectReference)

['{EDA63321-9BA8-4A98-B126-62CC743B4716}']

function GetProviderName:string;

procedure ProcessServer(ADataFormatter:IDTKDataFormatter);

procedure ProcessClient(ADataFormatter:IDTKDataFormatter);

procedure ProcessClientResponse(ADataFormatter:IDTKDataFormatter);

property ProviderName:string read GetProviderName;

end;

讓我稍微解釋一下IDTKDataProvider的定義，首先是GetProviderName函式，每一個

DataProvider必須要有一個唯一的ProviderName，這樣Server端才能在接到資料時知道要

使用那一個DataProvider來處理。ProcessClient則是接收一個DataFormatter介面，將東西

寫入這個DataFormatter中。ProcessClientResponse是用來讀取Server所回應的訊息，因為

這個訊息本身也是屬於DataFormatter獨有的格式，所以此函式同樣需要一個

DataFormatter 介面。最後是ProcessServer，她接收一個DataFormatter，由DataFormatter

中讀出東西後做適當的處理。那麼為何沒有ProcessServerResponse來對應

ProcessClientResponse呢?? 為何要有?? 這是個流程問題，留給你來回答。

IDTKDataFormatter

定義出IDTKDataProvider介面後，接著是定義IDTKDataFormatter，下面是完整的定義。

IDTKTypedFormatter = interface

['{E4224A38-21D5-4266-BFC7-3FC835DA83DA}']

procedure WriteBinary(AStream:TStream;const AName:string='');

procedure WriteBoolean(const ABoolean:Boolean;const AName:string='');

procedure WriteByte(const AByte:Byte;const AName:string='');

procedure WriteDateTime(const ADateTime:TDateTime;const AName:string='');

procedure WriteEnum(const Ref;const AName:string='');

procedure WriteFloat(const AFloat:double;const AName:string='');

procedure WriteInt64(const AInt64:Int64;const AName:string='');

procedure WriteInteger(const AInteger:Integer;const AName:string='');

procedure WriteObject(AClass:TClass;const Ref;const AName:string='');

procedure WriteString(const AString:string;const AName:string='');

procedure WriteVariant(AVariant:Variant;const AName:string='');

procedure WriteWideString(const AString:WideString;const AName:string='');

procedure WriteWord(const AWord:WORD;const AName:string='');

procedure ReadBinary(AStream:TStream;var AName:string);

procedure ReadBoolean(var ABoolean:Boolean;var AName:string);

procedure ReadByte(var AByte:Byte;var AName:string);

procedure ReadDateTime(var ADateTime:TDateTime;var AName:string);

procedure ReadEnum(var Ref;var AName:string);

procedure ReadFloat(var AFloat:double;var AName:string);

procedure ReadInt64(var AInt64:Int64;var AName:string);

procedure ReadInteger(var AInteger:Integer;var AName:string);

procedure ReadObject(AClass:TClass;var Ref;var AName:string);

procedure ReadString(var AString:string;var AName:string);

procedure ReadVariant(var AVariant:Variant;var AName:string);

procedure ReadWideString(var AString:WideString;var AName:string);

procedure ReadWord(var AWord:WORD;var AName:string);

end;

IDTKDataFormatter = interface

['{435B0588-5B45-4C51-A407-AF4051F1ABF8}']

function GetFormatterName:string;

procedure SetInputStream(AStream:TStream);

function GetOutputStream:TStream;

procedure ResetOutputPosition;

property FormatterName:string read GetFormatterName;

end;

這裡有兩個Interface，一個是IDTKTypedFormatter，另一個才是IDTKDataFormatter，這是

為了將DataFormatter 做一個明確切割而定義出來的，你也可以將這兩個合成一個，這不

影響整個架構。IDTKDataFormatter 繼承至IDTKTypedFormatter，而IDTKTypedFormatter

中定義了多數DELPHI內建資料型別的存取函式，這可以讓DataProvider更方便將某個

東西放入DataFormatter中。在前面的分析中，DataFormatter必須擁有一個唯一的Formattet

Name，這樣Server才能在接到資料時找出對應的DataFormatter來讀取資料。

SetInputStream/GetOutputStream則對應了分析中的Stream一環，DataFormatter必須支援輸

出某種多數Transport可以接受的格式，當送出DataFormatter之前，這個DataFormatter

必須先被轉換為Stream，這是GetOutputStream的工作。當Server回傳訊息時，使用

SetInputStream就可以將Stream轉換回DataFormatter。

IDTKTransport

IDTKTransport 介面負責送出或接收Stream類別的資料，IDTKTransport的定義如下。

TDTKDataNotifyEvent=procedure(ArequestStream:TStream;AResponseStream:TStream) of object;

TDTKDataReceivedEvent=procedure(ARequestStream:TStream;AResponseStream:TStream;var AProcessOK:Boolean) of object;

IDTKTransport = interface

['{6A26D6CC-0585-497A-918D-A06D0D42B0B8}']

function GetReceivedEvent:TDTKDataReceivedEvent;

procedure SetReceivedEvent(AValue:TDTKDataReceivedEvent);

function GetSendEvent:TDTKDataNotifyEvent;

procedure SetSendEvent(AValue:TDTKDataNotifyEvent);

function GetActive:Boolean;

procedure SetActive(AValue:Boolean);

procedure Send(AOptions:string;ARequestStream:TStream;AResponseStream:TStream);

property OnDataReceived:TDTKDataReceivedEvent read GetReceivedEvent write SetReceivedEvent;

property OnDataSend:TDTKDataNotifyEvent read GetSendEvent write SetSendEvent;

property Active:Boolean read GetActive write SetActive;

end;

IDKTransport 中定義了兩個事件，一個是OnDataReceived，這個事件在資料傳入時觸發，

另一個是OnDataSend，觸發於送出資料時。注意!這兩個事件在Client與Server兩端都會

使用，當Server接到資料時OnDataReceived會被觸發，當Server必須傳回資料時

OnDataSend則會被觸發。在Client端時，當呼叫Send函式送出資料時會觸發OnDataSend，

如有資料傳回時，OnDataReceived就會被觸發。Active屬性則只用於Server端，用來啟

動這個Transport。

IDTKDataProviderFactory 與IDTKDataFormatterFactory

在效能與同步機制一節中提過，為了讓實作者有提升效能與處理同步機制的機會，系

統必須提供Factory機制，用來建立DataProvider與DataFormtter。

IDTKDataProviderFactory=interface

['{22745ED1-B426-41A2-A1BD-DA516316880F}']

function GetProviderName:string;

function AcquireDataProvider:IDTKDataProvider;

procedure ReleaseDataProvider(var ADataProvider:IDTKDataProvider);

property ProviderName:string read GetProviderName;

end;

IDTKDataFormatterFactory=interface

['{084FC97D-69C5-4F6B-86FB-B356D15ABC5C}']

function ValidateStream(AStream:TStream;var AProviderName:string):Boolean;

function AcquireDataFormatter:IDTKDataFormatter;

procedure ReleaseDataFormatter(var ADataFormatter:IDTKDataFormatter);

end;

Server必須在建立對應的DataProvider與DataFormatter物件前知道欲使用的DataProvider

與DataFormatter型別，因此可以看到DataProviderFactory提供了ProviderName。但

DataFormatterFactory卻沒有對應的FormatterName，這是為什麼呢??

讓我們思考一個問題，假如Server不知道對應的DataFormatter，那麼該用什麼方式來讀

出FormatterName呢?? 因為懂得資料格式的只有DataFormatter不是嗎?? 所以

DataFormatter沒有必要提供FormatterName。那麼總要有個方法來找出DataFormatter吧，

答案就是ValidateStream，此函式接受一個Stream物件，並對這個Stream做出一些測試，

如果符合的話，那麼除了傳回True之外，她也順便讀出了ProviderName，這個值可以用

來取出正確的DataProviderFactory元件。

Collections

接著要定義的是DataFormatterFactoryColleciton、DataProviderFactoryCollection、

TransportColleciton三個Collection 介面。前面提過，DataFormaterFactoryColleciton與

DataProviderFactoryCollection是為了支援多種DataProvider與DataFormatter而產生的介

面，TransportCollection則是為了支援多種Transport而生。

IDTKDataFormatterFactoryCollection = interface

['{C6C4E3D7-BD2E-4981-9544-ECC371CE1BAF}']

procedure Add(AFactory:IDTKDataFormatterFactory);

function GetCount: Integer;

function GetFactory(AIndex:Integer): IDTKDataFormatterFactory;

procedure Delete(AIndex:Integer);

procedure Remove(AFactory:IDTKDataFormatterFactory);

procedure Clear;

property Count: Integer read GetCount;

property Items[AIndex:Integer]: IDTKDataFormatterFactory read GetFactory; default;

end;

IDTKDataProviderFactoryCollection = interface

['{C6C4E3D7-BD2E-4981-9544-ECC371CE1BAF}']

procedure Add(AFactory:IDTKDataProviderFactory);

function GetCount: Integer;

function GetFactory(AIndex:Integer): IDTKDataProviderFactory;

procedure Delete(AIndex:Integer);

procedure Remove(AFactory:IDTKDataProviderFactory);

procedure Clear;

property Count: Integer read GetCount;

property Items[AIndex:Integer]: IDTKDataProviderFactory read GetFactory; default;

end;

IDTKTransportCollection = interface

['{C6C4E3D7-BD2E-4981-9544-ECC371CE1BAF}']

procedure Add(ATransport:IDTKTransport);

function GetCount: Integer;

function GetTransport(AIndex:Integer): IDTKTransport;

procedure Delete(AIndex:Integer);

procedure Remove(ATransport:IDTKTransport);

procedure Clear;

property Count: Integer read GetCount;

property Items[AIndex:Integer]: IDTKTransport read GetTransport; default;

end;

Collection 只是介面的容器罷了，應該不難理解，這裡就不再多談了。

IDTKServer

完成了週邊的Interface定義後，接著就是核心的部份了，事實上核心的定義只是為了

規範實作者。

IDTKServer = interface

['{9C4C9268-1090-4E08-971A-1673F50B8D78}']

function GetTransports:IDTKTransportCollection;

function GetFormatFactorys:IDTKDataFormatterFactoryCollection;

function GetProviderFactorys:IDTKDataProviderFactoryCollection;

function GetActive:Boolean;

procedure SetActive(AActive:Boolean);

property Transports:IDTKTransportCollection read GetTransports;

property FormatFactorys:IDTKDataFormatterFactoryCollection read GetFormatFactorys;

property ProviderFactorys:IDTKDataProviderFactoryCollection read GetProviderFactorys;

property Active:Boolean read GetActive write SetActive;

end;

IDTKClient

與Server定義相同，意義不大。

IDTKClient = interface

['{D9BEF0F8-ABE7-417B-B0E7-B58DFBF75026}']

function GetTransport:IDTKTransport;

procedure SetTransport(ATransport:IDTKTransport);

function GetFormatter:IDTKDataFormatter;

procedure SetFormatter(AValue:IDTKDataFormatter);

function GetProvider:IDTKDataProvider;

procedure SetProvider(AValue:IDTKDataProvider);

procedure Send(AOptions:string);

property Transport:IDTKTransport read GetTransport write SetTransport;

property Formatter:IDTKDataFormatter read GetFormatter write SetFormatter;

property Provider:IDTKDataProvider read GetProvider write SetProvider;

end;

DTKClient 與DTKServer 的定義一方面為了規範實作者，另一方面也是為日後的

縱向延伸預留後路。

元件介面化的另一層含意

在元件介面化後，第一個得到的好處是可以對系統做出更全面性的思考，這比起直接

投入實作來的好多了。另一個好處是可以將介面交給不同的人實作，例如可以將實作

XML與Binary DataFormatter分別給兩個人來實作，或是將TCP、HTTP分給另兩個人實

作，這點可以加快程式開發的速度。在開發之初期，DataProvider可能無法馬上進入實

作，因為她與DataFormatter的關聯性相當高，因此必須等待某個DataFormatter完成後才

能進入實作。最後一個好處是延展性，因為所有的元件都已被介面化，因此替換某個元

件都不是件難事。

由Interface化為元件，實現半個架構

唔……要嘛就做一整個，那有人做半個的?? 這個嘛…如果要求每個實作者都從零開

始，那麼可能有點兒虐待人的嫌疑。因此我們先將一些可以做的部份化為基礎元件，一

方面簡化實作者的工作，另一方面也有利於設計者與實作者能更了解這個架構。由這一

節開始將進入與程式語言緊密結合的階段，本文中使用DELPHI。當然，如前面所說，

架構本身並不受語言限制，因此沒有什麼理由不能用其它語言來達到的。

TDTKBaseComponent

這是DTK中所有元件的基礎類別，雖然DTK理論上是由Interface所組成的，但是實

作上大可不必拘泥於此，適當的利用繼承與Abstract Class可以省下不少工夫。

{$I DTK.inc}

unit uDTKBaseComponent;

interface

uses

Classes,Windows,SysUtils,uDTKIntf;

type

TDTKBaseComponent=class(TComponent,IDTKObjectReference,IDTKHolder,IInterface)

private

FHolders:TThreadList;

FRefCount: Integer;

FOwnerIsComponent: Boolean;

protected

{ IDTKObjectReference }

function GetObject:TObject;

{ IDTKHolder }

procedure CleanIntf(AObject:TObject);virtual;

function GetHolders:TThreadList;

property Holders:TThreadList read FHolders;

{ IInterface }

function _AddRef: Integer; stdcall;

function _Release: Integer; stdcall;

public

constructor Create(AOwner:TComponent);override;

destructor Destroy;override;

class function NewInstance: TObject; override;

procedure AfterConstruction; override;

end;

implementation

class function TDTKBaseComponent.NewInstance: TObject;

begin

Result := inherited NewInstance;

TDTKBaseComponent(Result).FRefCount := 1;

end;

procedure TDTKBaseComponent.AfterConstruction;

begin

inherited;

FOwnerIsComponent := Assigned(Owner) and (Owner is TComponent);

InterlockedDecrement(FRefCount);

end;

{ IInterface }

function TDTKBaseComponent._AddRef: Integer;

begin

Result := InterlockedIncrement(FRefCount)

end;

function TDTKBaseComponent._Release: Integer;

begin

Result := InterlockedDecrement(FRefCount);

{ If we are not being used as a TComponent, then use refcount to manage our

lifetime as with TInterfacedObject. }

if (Result = 0) and not FOwnerIsComponent then

Destroy;

end;

constructor TDTKBaseComponent.Create(AOwner:TComponent);

begin

inherited Create(AOwner);

if Assigned(AOwner) then

FHolders:=TThreadList.Create;

end;

destructor TDTKBaseComponent.Destroy;

var

vIntf:IDTKHolder;

I:Integer;

vList:TList;

begin

if FOwnerIsComponent then

begin

vList:=FHolders.LockList;

try

for I:=0 to vList.Count-1 do

begin

if Supports(TObject(vList[I]),IDTKHolder,vIntf) then

vIntf.CleanIntf(Self);

end;

finally

FHolders.UnlockList;

end;

FHolders.Free;

end;

inherited;

end;

{ IDTKHolder }

procedure TDTKBaseComponent.CleanIntf(AObject:TObject);

begin

end;

function TDTKBaseComponent.GetHolders:TThreadList;

begin

Result:=FHolders;

end;

{ IDTKObjectReference }

function TDTKBaseComponent.GetObject:TObject;

begin

Result:=Self;

end;

end.

在TDTKBaseComponent中可以看到隱藏著三個機制，一個是IDTKObjectReferecne，

因為DELPHI的Interface並無法直接轉換為某個物件，所以必須有一個介面來做這樣的

工作，因此DTK中的所有Interface都直接繼承至IDTKObjectReference。事實上DELPHI

預設的TComponent 實作了IInterfaceComponentReference 介面，經由此介面可以取出對

應的TComponent 物件，但是DTK的架構是由Interface組成的，並不限制實作者一定要

繼承至TComponent，所以系統定義了IDTKObjectReference，用來取出真正的Object。第

二個機制是Holder，她是為了跨越DELPHI 語言的限制而存在的。第三個機制是

IInterface，這是BizSnap/WebSnap用來跨越TComponent 與Interface問題的方式。

DTK 合併了IInterface與Holder兩種技術，藉此解決之前所提的問題。

PS: 請參照TComponent vs Interface 一節。

TDTKBaseFormatter

TDTKBaseFormatter 是所有DataFormatter的基礎元件，實作者可以直接繼承至這個類

別，避免從頭實作IDTKDataFormatter介面的難度，當然! DTK的架構是由Interface組合

而成，沒有特別限制一定要繼承至某個類別。

unit uDTKBaseFormatter;

interface

uses

Windows, Messages, SysUtils, Variants, Classes,TypInfo,uDTKIntf,

uDTKBaseFactorys,uDTKBaseComponent;

type

TDTKBaseFormatter=class(TDTKBaseComponent,IDTKDataFormatter,IDTKTypedFormatter)

private

FInputStream:TStream;

FOutputStream:TStream;

protected

procedure NotSupported; //TODO we still not support all function...

{ IDTKTypedFormatter }

function GetFormatterName:string;virtual;abstract;

{ abstract member function }

procedure ReadString(var AString:string;var AName:string);virtual;abstract;

procedure ReadWideString(var AString:WideString;var AName:string);virtual;abstract;

procedure ReadByte(var AByte:Byte;var AName:string);virtual;abstract;

procedure ReadWord(var AWord:WORD;var AName:string);virtual;abstract;

procedure ReadInteger(var AInteger:Integer;var AName:string);virtual;abstract;

procedure ReadBoolean(var ABoolean:Boolean;var AName:string);virtual;abstract;

procedure ReadInt64(var AInt64:Int64;var AName:string);virtual;abstract;

procedure ReadFloat(var AFloat:double;var AName:string);virtual;abstract;

procedure ReadDateTime(var ADateTime:TDateTime;var AName:string);virtual;abstract;

procedure ReadEnum(var Ref;var AName:string);virtual;abstract;

procedure ReadBinary(AStream:TStream;var AName:string);virtual;abstract;

procedure ReadVariant(var AVariant:Variant;var AName:string);virtual;abstract;

procedure ReadObject(AClass:TClass;var Ref;var AName:string);virtual;abstract;

procedure WriteString(const AString:string;const AName:string='');virtual;abstract;

procedure WriteWideString(const AString:WideString;const AName:string='');virtual;abstract;

procedure WriteByte(const AByte:Byte;const AName:string='');virtual;abstract;

procedure WriteWord(const AWord:WORD;const AName:string='');virtual;abstract;

procedure WriteInteger(const AInteger:Integer;const AName:string='');virtual;abstract;

procedure WriteBoolean(const ABoolean:Boolean;const AName:string='');virtual;abstract;

procedure WriteInt64(const AInt64:Int64;const AName:string='');virtual;abstract;

procedure WriteFloat(const AFloat:double;const AName:string='');virtual;abstract;

procedure WriteDateTime(const ADateTime:TDateTime;const AName:string='');virtual;abstract;

procedure WriteEnum(const Ref;const AName:string='');virtual;abstract;

procedure WriteBinary(AStream:TStream;const AName:string='');virtual;abstract;

procedure WriteVariant(AVariant:Variant;const AName:string='');virtual;abstract;

procedure WriteObject(AClass:TClass;const Ref;const AName:string='');virtual;abstract;

//for descendant classes use.

property InputStream:TStream read FInputStream;

property OutputStream:TStream read FOutputStream;

public

{ IDTKFormatter }

procedure SetInputStream(AStream:TStream);virtual;

function GetOutputStream:TStream;virtual;

procedure ResetOutputPosition;virtual;

constructor Create(AOwner:TComponent);override;

destructor Destroy;override;

property FormatterName:string read GetFormatterName;

end;

implementation

constructor TDTKBaseFormatter.Create(AOwner:TComponent);

begin

inherited Create(AOwner);

FOutputStream:=TMemoryStream.Create;

end;

destructor TDTKBaseFormatter.Destroy;

begin

FOutputStream.Free;

inherited Destroy;

end;

procedure TDTKBaseFormatter.NotSupported;

begin

raise Exception.Create('Not Supported.');

end;

procedure TDTKBaseFormatter.SetInputStream(AStream:TStream);

begin

FInputStream:=AStream;

if Assigned(FInputStream) then

FInputStream.Position:=0; //reset.

end;

function TDTKBaseFormatter.GetOutputStream:TStream;

begin

FOutputStream.Position:=0; //reset.

Result:=FOutputStream;

end;

procedure TDTKBaseFormatter.ResetOutputPosition;

begin

FOutputStream.Position:=0; //reset.

FOutputStream.Size:=0;

end;

end.

TDTKBaseDataProvider

此類別實作了IDTKDataProvider，提供基本的類別簡化實作者的工作。

unit uDTKBaseProvider;

interface

uses

Windows, Messages, SysUtils, Variants, Classes,uDTKIntf,

uDTKBaseComponent;

type

TDTKBaseProvider=class(TDTKBaseComponent,IDTKDataProvider)

protected

{ Utility function }

procedure WriteHeaderInfo(ADataFormatter:IDTKDataFormatter);

procedure LoadHeaderInfo(ADataFormatter:IDTKDataFormatter);

{ IDTKDataProvider }

function GetProviderName:string;virtual;abstract;

public

{ IDTKDataProvider }

procedure ProcessServer(ADataFormatter:IDTKDataFormatter);virtual;abstract;

procedure ProcessClient(ADataFormatter:IDTKDataFormatter);virtual;abstract;

procedure ProcessClientResponse(ADataFormatter:IDTKDataFormatter);virtual;abstract;

published

{ IDTKDataProvider }

property ProviderName:string read GetProviderName;

end;

implementation

uses uDTKExceptions;

procedure TDTKBaseProvider.WriteHeaderInfo(ADataFormatter:IDTKDataFormatter);

begin

ADataFormatter.WriteString(ADataFormatter.FormatterName,DTK_FORMATTER);

ADataFormatter.WriteString(ProviderName,DTK_PROVIDER);

end;

procedure TDTKBaseProvider.LoadHeaderInfo(ADataFormatter:IDTKDataFormatter);

var

vTempStr,vTagStr:string;

begin

ADataFormatter.ReadString(vTempStr,vTagStr);

if not SameText(vTempStr,ADataFormatter.FormatterName) then

raise EDTKDataFormatterNotSupport.Create;

ADataFormatter.ReadString(vTempStr,vTagStr);

if not SameText(vTempStr,ProviderName) then

raise EDTKDataProviderNotSupport.Create;

end;

end.

TDTKBaseDataFormatterFactory、TDTKBaseDataProviderFactory

這兩個類別分別實作了IDTKDataFormatterFactory與IDTKDataProviderFactory，提供基

礎實作碼，簡化直接實作介面的困難度。

{$I DTK.inc}

unit uDTKBaseFactorys;

interface

uses

Classes,SysUtils,SyncObjs,uDTKIntf,Contnrs,uDTKBaseComponent;

type

TDTKBaseDataProviderFactory=class(TDTKBaseComponent,IDTKDataProviderFactory)

public

function GetProviderName:string;virtual;abstract;

function AcquireDataProvider:IDTKDataProvider;virtual;abstract;

procedure ReleaseDataProvider(var ADataProvider:IDTKDataProvider);virtual;

property ProviderName:string read GetProviderName;

end;

TDTKBaseDataFormatterFactory=class(TDTKBaseComponent,IDTKDataFormatterFactory)

public

{ IDTKDataFormatterFactory }

function ValidateStream(AStream:TStream;var AProviderName:string):Boolean;virtual;abstract;

function AcquireDataFormatter:IDTKDataFormatter;virtual;abstract;

procedure ReleaseDataFormatter(var ADataFormatter:IDTKDataFormatter);virtual;

end;

implementation

{ TDTKBaseDataProviderFactory }

procedure TDTKBaseDataProviderFactory.ReleaseDataProvider(var ADataProvider:IDTKDataProvider);

begin

ADataProvider:=Nil;

end;

{ TDTKBaseDataFormatterFactory }

procedure TDTKBaseDataFormatterFactory.ReleaseDataFormatter(var ADataFormatter:IDTKDataFormatter);

begin

ADataFormatter:=Nil;

end;

end.

TDTKBaseTransport

此類別實作了IDTKTransport，實作者在實作新的Transport類別時，可直接繼承至此

類別，省下撰寫重複程式碼的工作。

unit uDTKBaseTransport;

interface

uses

Classes,SysUtils,uDTKIntf,uDTKBaseComponent;

type

TDTKBaseTransport=class(TDTKBaseComponent,IDTKTransport)

private

FReceivedEvent:TDTKDataReceivedEvent;

FSendEvent:TDTKDataNotifyEvent;

protected

{ IDTKTransport }

function GetReceivedEvent:TDTKDataReceivedEvent;

procedure SetReceivedEvent(AValue:TDTKDataReceivedEvent);

function GetSendEvent:TDTKDataNotifyEvent;

procedure SetSendEvent(AValue:TDTKDataNotifyEvent);

function GetActive:Boolean;virtual;abstract;

procedure SetActive(AActive:Boolean);virtual;abstract;

public

procedure Send(AOptions:string;ARequestStream:TStream;AResponseStream:TStream);virtual;abstract;

property Active:Boolean read GetActive write SetActive;

property OnDataReceived:TDTKDataReceivedEvent read GetReceivedEvent write SetReceivedEvent;

property OnDataSend:TDTKDataNotifyEvent read GetSendEvent write SetSendEvent;

end;

implementation

{ TDTKBaseTransport }

function TDTKBaseTransport.GetReceivedEvent:TDTKDataReceivedEvent;

begin

Result:=FReceivedEvent;

end;

procedure TDTKBaseTransport.SetReceivedEvent(AValue:TDTKDataReceivedEvent);

begin

FReceivedEvent:=AValue;

end;

function TDTKBaseTransport.GetSendEvent:TDTKDataNotifyEvent;

begin

Result:=FSendEvent;

end;

procedure TDTKBaseTransport.SetSendEvent(AValue:TDTKDataNotifyEvent);

begin

FSendEvent:=AValue;

end;

end.

Collections

這個Unit 中實作了IDTKDataFormatterFactoryCollection、

IDTKDataDataProviderFactoryCollection及IDTKTransportCollection 三個介面，除非實作者

有其它特別需求，需要取代預設的Server 實作，否則這些Collection 可適用於大部份情

況。

unit uDTKCollections;

interface

uses

Classes,SysUtils,uDTKIntf,uDTKBaseComponent;

type

TDTKDataFormatterFactoryCollection=class(TDTKBaseComponent,IDTKDataFormatterFactoryCollection)

private

FList:TInterfaceList;

protected

{ IDTKDataFormatterFactoryCollection }

procedure Add(AFactory:IDTKDataFormatterFactory);

function GetCount: Integer;

function GetFactory(AIndex:Integer): IDTKDataFormatterFactory;

procedure Delete(AIndex:Integer); overload;

procedure Remove(AFactory:IDTKDataFormatterFactory); overload;

procedure Clear;

public

constructor Create(AOwner:TComponent);override;

destructor Destroy;override;

{ IDTKDataFormatterFactoryCollection }

property Count: Integer read GetCount;

property Items[AIndex:Integer]: IDTKDataFormatterFactory read GetFactory; default;

end;

TDTKDataProviderFactoryCollection=class(TDTKBaseComponent,IDTKDataProviderFactoryCollection)

private

FList:TInterfaceList;

protected

{ IDTKDataProviderFactoryCollection }

procedure Add(AFactory:IDTKDataProviderFactory);

function GetCount: Integer;

function GetFactory(AIndex:Integer): IDTKDataProviderFactory;

procedure Delete(AIndex:Integer); overload;

procedure Remove(AFactory:IDTKDataProviderFactory); overload;

procedure Clear;

public

constructor Create(AOwner:TComponent);override;

destructor Destroy;override;

{ IDTKDataProviderFactoryCollection }

property Count: Integer read GetCount;

property Items[AIndex:Integer]: IDTKDataProviderFactory read GetFactory; default;

end;

TDTKTransportCollection=class(TDTKBaseComponent,IDTKTransportCollection)

private

FList:TInterfaceList;

protected

{ IDTKDataProviderFactoryCollection }

procedure Add(ATransport:IDTKTransport);

function GetCount: Integer;

function GetTransport(AIndex:Integer): IDTKTransport;

procedure Delete(AIndex:Integer); overload;

procedure Remove(ATransport:IDTKTransport); overload;

procedure Clear;

public

constructor Create(AOwner:TComponent);override;

destructor Destroy;override;

{ IDTKTransportCollection }

property Count: Integer read GetCount;

property Items[AIndex:Integer]: IDTKTransport read GetTransport; default;

end;

implementation

{ TDTKDataFormatterFactoryCollection }

constructor TDTKDataFormatterFactoryCollection.Create(AOwner:TComponent);

begin

inherited Create(AOwner);

FList:=TInterfaceList.Create;

end;

destructor TDTKDataFormatterFactoryCollection.Destroy;

begin

FList.Free;

inherited;

end;

procedure TDTKDataFormatterFactoryCollection.Add(AFactory:IDTKDataFormatterFactory);

begin

FList.Add(AFactory);

end;

procedure TDTKDataFormatterFactoryCollection.Remove(AFactory:IDTKDataFormatterFactory);

begin

FList.Remove(AFactory);

end;

procedure TDTKDataFormatterFactoryCollection.Delete(AIndex:Integer);

begin

FList.Delete(AIndex);

end;

procedure TDTKDataFormatterFactoryCollection.Clear;

begin

FList.Clear;

end;

function TDTKDataFormatterFactoryCollection.GetFactory(AIndex:Integer):IDTKDataFormatterFactory;

begin

Result:=FList[AIndex] as IDTKDataFormatterFactory;

end;

function TDTKDataFormatterFactoryCollection.GetCount:Integer;

begin

Result:=FList.Count;

end;

{ TDTKDataProviderFactoryCollection }

constructor TDTKDataProviderFactoryCollection.Create(AOwner:TComponent);

begin

inherited Create(AOwner);

FList:=TInterfaceList.Create;

end;

destructor TDTKDataProviderFactoryCollection.Destroy;

begin

FList.Free;

inherited;

end;

procedure TDTKDataProviderFactoryCollection.Add(AFactory:IDTKDataProviderFactory);

begin

FList.Add(AFactory);

end;

procedure TDTKDataProviderFactoryCollection.Remove(AFactory:IDTKDataProviderFactory);

begin

FList.Remove(AFactory);

end;

procedure TDTKDataProviderFactoryCollection.Delete(AIndex:Integer);

begin

FList.Delete(AIndex);

end;

procedure TDTKDataProviderFactoryCollection.Clear;

begin

FList.Clear;

end;

function TDTKDataProviderFactoryCollection.GetFactory(AIndex:Integer):IDTKDataProviderFactory;

begin

Result:=FList[AIndex] as IDTKDataProviderFactory;

end;

function TDTKDataProviderFactoryCollection.GetCount:Integer;

begin

Result:=FList.Count;

end;

{ TDTKTransportCollection }

constructor TDTKTransportCollection.Create;

begin

FList:=TInterfaceList.Create;

end;

destructor TDTKTransportCollection.Destroy;

begin

FList.Free;

inherited;

end;

procedure TDTKTransportCollection.Add(ATransport:IDTKTransport);

begin

FList.Add(ATransport);

end;

procedure TDTKTransportCollection.Remove(ATransport:IDTKTransport);

begin

FList.Remove(ATransport);

end;

procedure TDTKTransportCollection.Delete(AIndex:Integer);

begin

FList.Delete(AIndex);

end;

procedure TDTKTransportCollection.Clear;

begin

FList.Clear;

end;

function TDTKTransportCollection.GetTransport(AIndex:Integer):IDTKTransport;

begin

Result:=FList[AIndex] as IDTKTransport;

end;

function TDTKTransportCollection.GetCount:Integer;

begin

Result:=FList.Count;

end;

end.

事實上，DTK為了讓使用者能夠以RAD方式使用DTKServer元件，提供了另一個

TDTKVCLServer元件來取代DTKServer，她不但跳出了IDKServer的定義，同時也不再

使用這三個Collection，這是為了降低程式複雜度的選擇。其實我們可以運用OTA撰

寫一些屬性編輯器來保有IDTKServer與這些Collection，只是這樣程式碼將會變的更複

雜。

TDTKClient

這個類別是整個架構的Client端核心，她接收使用者所設定的DataFormatter、

DataProvider、Transport三個元件，並使用這些元件來完成指定的工作。

{$I DTK.inc}

unit uDTKClient;

interface

uses

Classes,SysUtils,uDTKIntf,uDTKBaseComponent;

type

TDTKClient=class(TDTKBaseComponent,IDTKClient)

private

FTransport:IDTKTransport;

FFormatter:IDTKDataFormatter;

FProvider:IDTKDataProvider;

FOnReceived:TDTKReceiveNotifyEvent;

FOnSend:TDTKDataNotifyEvent;

procedure InternalOnReceived(ARequestStream:TStream;AResponseStream:TStream;var AProcessOK:Boolean);

procedure InternalOnSend(ARequestStream:TStream;AResponseStream:TStream);

protected

{ IDTKHolder }

procedure CleanIntf(AObject:TObject);override;

{ IDTKClient }

function GetTransport:IDTKTransport;

procedure SetTransport(ATransport:IDTKTransport);

function GetFormatter:IDTKDataFormatter;

procedure SetFormatter(AValue:IDTKDataFormatter);

function GetProvider:IDTKDataProvider;

procedure SetProvider(AValue:IDTKDataProvider);

public

destructor Destroy;override;

procedure Send(AOptions:string);

published

property Transport:IDTKTransport read GetTransport write SetTransport;

property Formatter:IDTKDataFormatter read GetFormatter write SetFormatter;

property Provider:IDTKDataProvider read GetProvider write SetProvider;

property OnReceived:TDTKReceiveNotifyEvent read FOnReceived write FOnReceived;

property OnSend:TDTKDataNotifyEvent read FOnSend write FOnSend;

end;

implementation

uses Dialogs;

{ TDTKClient }

destructor TDTKClient.Destroy;

begin

if Assigned(FTransport) then

(FTransport as IDTKHolder).Holders.Remove(Self);

if Assigned(FFormatter) then

(FFormatter as IDTKHolder).Holders.Remove(Self);

if Assigned(FProvider) then

(FProvider as IDTKHolder).Holders.Remove(Self);

inherited;

end;

procedure TDTKClient.CleanIntf(AObject:TObject);

begin

if Assigned(FTransport) and

((FTransport as IDTKObjectReference).GetObject = AObject) then

FTransport:=Nil

else if Assigned(FFormatter) and

((FFormatter as IDTKObjectReference).GetObject = AObject) then

FFormatter:=Nil

else if Assigned(FProvider) and

((FProvider as IDTKObjectReference).GetObject = AObject) then

FProvider:=Nil;

end;

function TDTKClient.GetTransport:IDTKTransport;

begin

Result:=FTransport;

end;

procedure TDTKClient.SetTransport(ATransport:IDTKTransport);

begin

if Assigned(FTransport) then

begin

FTransport.OnDataReceived:=Nil;

FTransport.OnDataSend:=Nil;

(FTransport as IDTKHolder).Holders.Remove(Self);

end;

FTransport:=ATransport;

if Assigned(FTransport) then

begin

FTransport.OnDataReceived:=InternalOnReceived;

FTransport.OnDataSend:=InternalOnSend;

(FTransport as IDTKHolder).Holders.Add(Self);

end;

function TDTKClient.GetFormatter:IDTKDataFormatter;

begin

Result:=FFormatter;

end;

procedure TDTKClient.SetFormatter(AValue:IDTKDataFormatter);

begin

if Assigned(FFormatter) then

(FFormatter as IDTKHolder).Holders.Remove(Self);

FFormatter:=AValue;

if Assigned(FFormatter) then

(FFormatter as IDTKHolder).Holders.Add(Self);

end;

function TDTKClient.GetProvider:IDTKDataProvider;

begin

Result:=FProvider;

end;

procedure TDTKClient.SetProvider(AValue:IDTKDataProvider);

begin

if Assigned(FProvider) then

(FProvider as IDTKHolder).Holders.Remove(Self);

FProvider:=AValue;

if Assigned(FProvider) then

(FProvider as IDTKHolder).Holders.Add(Self);

end;

procedure TDTKClient.InternalOnReceived(ARequestStream:TStream;AResponseStream:TStream;var AProcessOK:Boolean);

begin

FFormatter.SetInputStream(AResponseStream);

if Assigned(FOnReceived) then

FOnReceived(FFormatter,FProvider);

AProcessOK:=True;

end;

procedure TDTKClient.InternalOnSend(ARequestStream:TStream;AResponseStream:TStream);

begin

if Assigned(FOnSend) then

FOnSend(ARequestStream,AResponseStream);

end;

procedure TDTKClient.Send(AOptions:string);

var

vRep:TStream;

begin

FFormatter.ResetOutputPosition; //reset position for output stream.

vRep:=TMemoryStream.Create;

try

FProvider.ProcessClient(FFormatter);

FTransport.Send(AOptions,FFormatter.GetOutputStream,vRep);

if vRep.Size <> 0 then

begin

FFormatter.SetInputStream(vRep);

FProvider.ProcessClientResponse(FFormatter);

end;

finally

vRep.Free;

end;

end.

在DTKClient中可以看到Holder的機制的運作模式，這使得DTKClient可相容於DELPHI

IDE中。

TDTKServer

這個類別是Server端的核心，利用使用者所設定的DataFormatterFactory、

DataProviderFactory及Transport 元件來完成工作。與Client端不同的是，為了處理多Client

端的情況，DTKServer使用Collection 模式來讓使用者設定這些物件:

{$I DTK.inc}

unit uDTKServer;

interface

uses

Classes,SysUtils,uDTKIntf,uDTKBaseComponent;

type

TDTKServer=class(TDTKBaseComponent,IDTKServer)

private

FActive:Boolean;

FTransports:IDTKTransportCollection;

FFormatFactorys:IDTKDataFormatterFactoryCollection;

FProviderFactorys:IDTKDataProviderFactoryCollection;

FReceivedEvent:TDTKReceiveNotifyEvent;

FSendEvent:TDTKDataNotifyEvent;

procedure SyncEvent;

procedure SetReceivedEvent(AEvent:TDTKReceiveNotifyEvent);

procedure SetSendEvent(AEvent:TDTKDataNotifyEvent);

procedure InternalOnReceived(ARequestStream:TStream;AResponseStream:TStream;var AProcessOK:Boolean);

procedure InternalOnSend(ARequestStream:TStream;AResponseStream:TStream);

procedure FindFormatterAndProvider(AStream:TStream;var AFormatter:IDTKDataFormatterFactory;var AProvider:IDTKDataProviderFactory);

protected

{ IDTKServer }

function GetTransports:IDTKTransportCollection;

function GetFormatFactorys:IDTKDataFormatterFactoryCollection;

function GetProviderFactorys:IDTKDataProviderFactoryCollection;

function GetActive:Boolean;

procedure SetActive(AActive:Boolean);

public

constructor Create(AOwner:TComponent);override;

destructor Destroy;override;

{ IDTKServer}

property Active:Boolean read GetActive write SetActive;

property OnReceived:TDTKReceiveNotifyEvent read FReceivedEvent write SetReceivedEvent;

property OnSend:TDTKDataNotifyEvent read FSendEvent write SetSendEvent;

property Transports:IDTKTransportCollection read GetTransports;

property FormatFactorys:IDTKDataFormatterFactoryCollection read GetFormatFactorys;

property ProviderFactorys:IDTKDataProviderFactoryCollection read GetProviderFactorys;

end;

implementation

uses uDTKCollections;

{ TDTKServer }

constructor TDTKServer.Create(AOwner:TComponent);

begin

inherited Create(AOwner);

FTransports:=TDTKTransportCollection.Create(Self);

FFormatFactorys:=TDTKDataFormatterFactoryCollection.Create(Self);

FProviderFactorys:=TDTKDataProviderFactoryCollection.Create(Self);

end;

destructor TDTKServer.Destroy;

begin

inherited;

end;

procedure TDTKServer.SyncEvent;

var

I:Integer;

begin

for I := 0 to FTransports.Count-1 do // Iterate

begin

(FTransports[I] as IDTKTransport).OnDataReceived:=InternalOnReceived;

(FTransports[I] as IDTKTransport).OnDataSend:=InternalOnSend;

end;// for

end;

procedure TDTKServer.FindFormatterAndProvider(AStream:TStream;var AFormatter:IDTKDataFormatterFactory;var AProvider:IDTKDataProviderFactory);

var

I,J:Integer;

vProviderName:string;

begin

for I := 0 to FFormatFactorys.Count-1 do // Iterate

begin

if (FFormatFactorys[I] as IDTKDataFormatterFactory).ValidateStream(AStream,vProviderName) then

begin

for J := 0 to FProviderFactorys.Count-1 do // Iterate

begin

if SameText(vProviderName,(FProviderFactorys[I] as IDTKDataProviderFactory).ProviderName) then

begin

AFormatter:=(FFormatFactorys[I] as IDTKDataFormatterFactory);

AProvider:=(FProviderFactorys[I] as IDTKDataProviderFactory);

break;

end;

end; // for

end;

end; // for

end;

procedure TDTKServer.InternalOnReceived(ARequestStream:TStream;AResponseStream:TStream;var AProcessOK:Boolean);

var

vFormatterFactory:IDTKDataFormatterFactory;

vProviderFactory:IDTKDataProviderFactory;

vFormatter:IDTKDataFormatter;

vProvider:IDTKDataProvider;

begin

FindFormatterAndProvider(ARequestStream,vFormatterFactory,vProviderFactory);

if Assigned(vFormatterFactory) and Assigned(vProviderFactory) then

begin

vFormatter:=vFormatterFactory.AcquireDataFormatter;

try

vProvider:=vProviderFactory.AcquireDataProvider;

try

ARequestStream.Position:=0;

vFormatter.SetInputStream(ARequestStream);

if Assigned(FReceivedEvent) then

FReceivedEvent(vFormatter,vProvider);

vProvider.ProcessServer(vFormatter);

//TODO may be we need 2 way(before/after) to handle this,

finally

vProviderFactory.ReleaseDataProvider(vProvider);

end;

finally

vFormatterFactory.ReleaseDataFormatter(vFormatter);

end;

procedure TDTKServer.InternalOnSend(ARequestStream:TStream;AResponseStream:TStream);

begin

if Assigned(FSendEvent) then

FSendEvent(ARequestStream,AResponseStream);

end;

procedure TDTKServer.SetReceivedEvent(AEvent:TDTKReceiveNotifyEvent);

begin

FReceivedEvent:=AEvent;

SyncEvent;

end;

procedure TDTKServer.SetSendEvent(AEvent:TDTKDataNotifyEvent);

begin

FSendEvent:=AEvent;

SyncEvent;

end;

function TDTKServer.GetTransports:IDTKTransportCollection;

begin

Result:=FTransports;

end;

function TDTKServer.GetFormatFactorys:IDTKDataFormatterFactoryCollection;

begin

Result:=FFormatFactorys;

end;

function TDTKServer.GetProviderFactorys:IDTKDataProviderFactoryCollection;

begin

Result:=FProviderFactorys;

end;

function TDTKServer.GetActive:Boolean;

begin

Result:=FActive;

end;

procedure TDTKServer.SetActive(AActive:Boolean);

var

I:Integer;

begin

for I := 0 to FTransports.Count-1 do // Iterate

(FTransports[I] as IDTKTransport).Active:=AActive;

FActive:=AActive;

end;

end.

TDTKServer實際上並未運用於DTK中，為了讓使用者可以在DELPHI IDE中使用

DTKServer，我額外撰寫了一個DTKVCLServer來取代DTKServer。

完成整個架構

在完成架構的基礎面之後，現在可以開始實作一些較有用的功能了，這一節中實作了

BinaryFormatter、FileProvider與Indy TCP Transport三個元件，這可以允許使用者使用TCP來上傳或下載檔案。

TDTKFileProvider

TDTKFileProvider繼承至TDTKBaseProvider，這使得她可以直接密合入此架構中，不

須從頭開始，此類別的主要功能是提供存取檔案的能力。

{$I DTK.inc}

unit uDTKFileProvider;

interface

uses

Windows, Messages, SysUtils, Variants, Classes,uDTKIntf,Contnrs,SyncObjs,uDTKBaseFactorys,

uDTKBaseProvider;

type

TDTKFileNotifyEvent=procedure(var AFileName:string) of object;

TDTKFileMode=(dtfpUpload,dtfpDownload,dtfpServer);

TDTKFileProvider=class(TDTKBaseProvider)

private

FFileName:string;

FMode:TDTKFileMode;

FFileLoadEvent,FFileSaveEvent:TDTKFileNotifyEvent;

{ Internal Utility functions }

procedure LoadFile(AFileName:string;ADataFormatter:IDTKDataFormatter);

procedure WriteFile(AFileName:string;ADataFormatter:IDTKDataFormatter);

procedure ProcessServerDownload(ADataFormatter:IDTKDataFormatter);

procedure ProcessServerUpload(ADataFormatter:IDTKDataFormatter);

protected

{ IDTKDataProvider }

function GetProviderName:string;override;

public

{ IDTKDataProvider }

procedure ProcessServer(ADataFormatter:IDTKDataFormatter);override;

procedure ProcessClient(ADataFormatter:IDTKDataFormatter);override;

procedure ProcessClientResponse(ADataFormatter:IDTKDataFormatter);override;

property ProviderName:string read GetProviderName;

published

property FileName:string read FFileName write FFileName;

property OnFileLoad:TDTKFileNotifyEvent read FFileLoadEvent write FFileLoadEvent;

property OnFileSave:TDTKFileNotifyEvent read FFileSaveEvent write FFileSaveEvent;

property Mode:TDTKFileMode read FMode write FMode;

end;

TDTKFileProviderSingleCallFactory=class(TDTKBaseDataProviderFactory)

private

FFileLoadEvent,FFileSaveEvent:TDTKFileNotifyEvent;

public

{ IDTKDataProviderFactory }

function GetProviderName:string;override;

function AcquireDataProvider:IDTKDataProvider;override;

property ProviderName:string read GetProviderName;

published

property OnFileLoad:TDTKFileNotifyEvent read FFileLoadEvent write FFileLoadEvent;

property OnFileSave:TDTKFileNotifyEvent read FFileSaveEvent write FFileSaveEvent;

end;

implementation

uses StrUtils,uDTKExceptions;

const

DTK_FILE_PROVIDER_NAME='FILE PROVIDER 1.0';

DTK_FILE_REQUEST_MODE='MODE';

DTK_FILE_FILENAME='FILENAME';

DTK_FILE_DATA='DATA';

{ TDTKFileProvider }

function TDTKFileProvider.GetProviderName:string;

begin

Result:=DTK_FILE_PROVIDER_NAME;

end;

procedure TDTKFileProvider.ProcessClient(ADataFormatter:IDTKDataFormatter);

begin

case FMode of

dtfpUpload :

begin

WriteHeaderInfo(ADataFormatter);

ADataFormatter.WriteEnum(FMode,DTK_FILE_REQUEST_MODE);

ADataFormatter.WriteString(ExtractFileName(FFileName),DTK_FILE_FILENAME);

LoadFile(FFileName,ADataFormatter);

end;

dtfpDownload :

begin

WriteHeaderInfo(ADataFormatter);

ADataFormatter.WriteEnum(FMode,DTK_FILE_REQUEST_MODE);

ADataFormatter.WriteString(ExtractFileName(FFileName),DTK_FILE_FILENAME);

end;

procedure TDTKFileProvider.ProcessClientResponse(ADataFormatter:IDTKDataFormatter);

var

vTagStr:string;

vMode:TDTKFileMode;

vFileName:string;

begin

case FMode of

dtfpDownload :

begin

LoadHeaderInfo(ADataFormatter);

ADataFormatter.ReadEnum(vMode,vTagStr);

if not SameText(vTagStr,DTK_FILE_REQUEST_MODE) then

raise EDTKInvalidRequest.Create;

ADataFormatter.ReadString(vFileName,vTagStr);

WriteFile(vFileName,ADataFormatter);

end;

procedure TDTKFileProvider.ProcessServer(ADataFormatter:IDTKDataFormatter);

var

vTagStr:string;

begin

if FMode = dtfpServer then

begin

LoadHeaderInfo(ADataFormatter);

ADataFormatter.ReadEnum(FMode,vTagStr);

if not SameText(vTagStr,DTK_FILE_REQUEST_MODE) then

raise EDTKInvalidRequest.Create;

case FMode of //

dtfpUpload :

ProcessServerUpload(ADataFormatter);

dtfpDownload :

ProcessServerDownload(ADataFormatter);

end;

FMode:=dtfpServer; //reset.

end;

procedure TDTKFileProvider.LoadFile(AFileName:string;ADataFormatter:IDTKDataFormatter);

var

vStream:TFileStream;

begin

if Assigned(FFileLoadEvent) then FFileLoadEvent(AFileName);

vStream:=TFileStream.Create(AFileName,fmOpenRead);

try

WriteHeaderInfo(ADataFormatter);

ADataFormatter.WriteEnum(FMode,DTK_FILE_REQUEST_MODE);

ADataFormatter.WriteString(ExtractFileName(AFileName),DTK_FILE_FILENAME);

ADataFormatter.WriteBinary(vStream,DTK_FILE_DATA);

finally

vStream.Free;

end;

procedure TDTKFileProvider.WriteFile(AFileName:string;ADataFormatter:IDTKDataFormatter);

var

vTagStr:string;

vStream:TFileStream;

begin

if Assigned(FFileSaveEvent) then FFileSaveEvent(AFileName);

vStream:=TFileStream.Create(AFileName,fmCreate);

try

ADataFormatter.ReadBinary(vStream,vTagStr);

finally

vStream.Free;

end;

procedure TDTKFileProvider.ProcessServerUpload(ADataFormatter:IDTKDataFormatter);

var

vFileName,vTagStr:string;

begin

ADataFormatter.ReadString(vFileName,vTagStr);

if FFileName <> '' then

vFileName:=FFileName; //TODO in fact,we need trust event call,right?

WriteFile(vFileName,ADataFormatter);

end;

procedure TDTKFileProvider.ProcessServerDownload(ADataFormatter:IDTKDataFormatter);

var

vFileName,vTagStr:string;

begin

ADataFormatter.ReadString(vFileName,vTagStr);

LoadFile(vFileName,ADataFormatter);

end;

{ TDTKFileProviderSingleCallFactory }

function TDTKFileProviderSingleCallFactory.GetProviderName:string;

begin

Result:=DTK_FILE_PROVIDER_NAME;

end;

function TDTKFileProviderSingleCallFactory.AcquireDataProvider:IDTKDataProvider;

var

vProvider:TDTKFileProvider;

begin

vProvider:=TDTKFileProvider.Create(Nil);

vProvider.OnFileLoad:=FFileLoadEvent;

vProvider.OnFileSave:=FFileSaveEvent;

vProvider.Mode:=dtfpServer;

Result:=vProvider;

end;

end.

這個Unit 中同時定義了TDTKFileProviderSingleCallFactory 類別，此類別繼承至

TDTKBaseDataProviderFactory，這賦與了她可設定至DTKServer的

DataProviderFactoryCollection中的能力，簡單的說，只要實作了IDTKProvider，那麼對應

的DataProviderFactory也要被實作。

TCP Transport

繼承至TDTKBaseTransoprt，運用Indy TCP元件來傳輸資料，由於架構中並未將

Transport細分為Client與Server，因此無法以直接繼承至TIdTCPClient方式來實作，

另外若採用直接繼承的方式會引發之前所提的TComponent vs Interface問題。

unit uDTKIndyTCPTransport;

interface

uses

SysUtils, Windows, Messages, Classes, Graphics, Controls,

IdBaseComponent, IdTCPClient,IdTCPServer,uDTKIntf,uDTKBaseTransport;

type

TDTKIndyTCPTransport=class(TDTKBaseTransport)

private

FTCPClient:TIdTCPClient;

FTCPServer:TIdTCPServer;

procedure InternalOnExecute(AThread: TIdPeerThread);

procedure SetTCPServer(AServer:TIdTCPServer);

protected

{ IDTKTransport }

function GetActive:Boolean;override;

procedure SetActive(AActive:Boolean);override;

public

constructor Create(AOwner:TComponent);override;

destructor Destroy;override;

{ IDTKTransport }

procedure Send(AOptions:string;ARequestStream:TStream;AResponseStream:TStream);override;

property Active:Boolean read GetActive write SetActive;

published

property TCPClient:TIdTCPClient read FTCPClient write FTCPClient;

property TCPServer:TIdTCPServer read FTCPServer write SetTCPServer;

end;

implementation

uses IdException;

constructor TDTKIndyTCPTransport.Create(AOwner:TComponent);

begin

inherited;

FTCPClient:=TIdTCPClient.Create(Self);

FTCPServer:=TIdTCPServer.Create(Self);

FTCPClient.SetSubComponent(True);

FTCPServer.SetSubComponent(True);

FTCPServer.OnExecute:=InternalOnExecute;

end;

destructor TDTKIndyTCPTransport.Destroy;

begin

if Assigned(FTCPClient) then

FTCPClient.Free;

if Assigned(FTCPServer) then

FTCPServer.Free;

inherited;

end;

procedure TDTKIndyTCPTransport.SetTCPServer(AServer:TIdTCPServer);

begin

if Assigned(FTCPServer) then

FTCPServer.OnExecute:=Nil; //clean event.

FTCPServer:=AServer;

FTCPServer.OnExecute:=InternalOnExecute;

end;

procedure TDTKIndyTCPTransport.SetActive(AActive:Boolean);

begin

//not support design-time active.

if Assigned(FTCPServer) and not (csDesigning in ComponentState) then

FTCPServer.Active:=AActive;

end;

function TDTKIndyTCPTransport.GetActive:Boolean;

begin

Result:=False;

if Assigned(FTCPServer) then

Result:=FTCPServer.Active;

end;

procedure TDTKIndyTCPTransport.InternalOnExecute(AThread: TIdPeerThread);

var

vReq,vRep:TStream;

vOK:Boolean;

begin

vReq:=TMemoryStream.Create;

vRep:=TMemoryStream.Create;

try

with AThread do

begin

Connection.ReadStream(vReq);

if Assigned(OnDataReceived) then

Self.OnDataReceived(vReq,vRep,vOK);

if vRep.Size > 0 then

Connection.WriteStream(vRep,True,True);

Connection.Disconnect;

end;

finally

vReq.Free;

vRep.Free;

end;

procedure TDTKIndyTCPTransport.Send(AOptions:string;ARequestStream:TStream;AResponseStream:TStream);

var

vOK:Boolean;

begin

FTCPClient.Connect;

try

if Assigned(Self.OnDataSend) then

Self.OnDataSend(ARequestStream,Nil);

FTCPClient.WriteStream(ARequestStream,True,True);

AResponseStream.Size:=0;

AResponseStream.Position:=0;

try

FTCPClient.ReadStream(AResponseStream);

if AResponseStream.Size > 0 then

Self.OnDataReceived(Nil,AResponseStream,vOK);

except on e : EIdConnClosedGracefully do

//nothing need do.

end;

finally

FTCPClient.Disconnect;

end;

end.

TDTKBinaryFormatter

繼承至TDTKBaseFormatter，提供二進位格式的讀寫能力，DataProvider利用她來讀取

與寫入資料。

{$I DTK.inc}

unit uDTKBinaryFormatter;

interface

uses

Windows, Messages, SysUtils, Variants, Classes,TypInfo,uDTKIntf,uDTKBaseFactorys,

uDTKBaseFormatter;

const

DTK_BINARY_FORMATTER='BINARY FORMATTER 1.0';

type

TDTKBinaryFormatter=class(TDTKBaseFormatter)

private

{ Utility functions }

procedure WriteAllString(const AString:string);

procedure WriteAllWideString(const AString:WideString);

function ReadAllString:string;

function ReadAllWideString:WideString;

protected

{ IDTKFormatter }

function GetFormatterName:string;override;

{ IDTKTypedFormatter }

{ type reader }

procedure ReadString(var AString:string;var AName:string);override;

procedure ReadWideString(var AString:WideString;var AName:string);override;

procedure ReadByte(var AByte:Byte;var AName:string);override;

procedure ReadWord(var AWord:WORD;var AName:string);override;

procedure ReadInteger(var AInteger:Integer;var AName:string);override;

procedure ReadBoolean(var ABoolean:Boolean;var AName:string);override;

procedure ReadInt64(var AInt64:Int64;var AName:string);override;

procedure ReadFloat(var AFloat:double;var AName:string);override;

procedure ReadDateTime(var ADateTime:TDateTime;var AName:string);override;

procedure ReadEnum(var Ref;var AName:string);override;

procedure ReadBinary(AStream:TStream;var AName:string);override;

procedure ReadVariant(var AVariant:Variant;var AName:string);override;

procedure ReadObject(AClass:TClass;var Ref;var AName:string);override;

{ type writer }

procedure WriteString(const AString:string;const AName:string='');override;

procedure WriteWideString(const AString:WideString;const AName:string='');override;

procedure WriteByte(const AByte:Byte;const AName:string='');override;

procedure WriteWord(const AWord:WORD;const AName:string='');override;

procedure WriteInteger(const AInteger:Integer;const AName:string='');override;

procedure WriteBoolean(const ABoolean:Boolean;const AName:string='');override;

procedure WriteInt64(const AInt64:Int64;const AName:string='');override;

procedure WriteFloat(const AFloat:double;const AName:string='');override;

procedure WriteDateTime(const ADateTime:TDateTime;const AName:string='');override;

procedure WriteEnum(const Ref;const AName:string='');override;

procedure WriteBinary(AStream:TStream;const AName:string='');override;

procedure WriteVariant(AVariant:Variant;const AName:string='');override;

procedure WriteObject(AClass:TClass;const Ref;const AName:string='');override;

end;

TDTKBinaryFormatterSingleCallFactory=class(TDTKBaseDataFormatterFactory)

public

{ IDTKDataFormatterFactory }

function ValidateStream(AStream:TStream;var AProviderName:string):Boolean;override;

function AcquireDataFormatter:IDTKDataFormatter;override;

end;

implementation

const

MAX_BUFF_SIZE=8192; //default buffer size for stream read/write.

{ TDTKBinaryFormatter }

function TDTKBinaryFormatter.GetFormatterName:string;

begin

Result:=DTK_BINARY_FORMATTER;

end;

function TDTKBinaryFormatter.ReadAllString:string;

var

vLen:Integer;

begin

InputStream.Read(vLen,SizeOf(Integer));

if vLen > 0 then

begin

SetLength(Result,vLen);

InputStream.Read(Result[1],vLen);

end

else

Result:='';

end;

function TDTKBinaryFormatter.ReadAllWideString:WideString;

var

vLen:Integer;

begin

InputStream.Read(vLen,SizeOf(Integer));

if vLen > 0 then

begin

SetLength(Result,vLen);

InputStream.Read(Result[1],vLen * 2);

end

else

Result:='';

end;

procedure TDTKBinaryFormatter.ReadString(var AString:string;var AName:string);

begin

AName:=ReadAllString;

AString:=ReadAllString;

end;

procedure TDTKBinaryFormatter.ReadByte(var AByte:Byte;var AName:string);

begin

AName:=ReadAllString;

InputStream.Read(AByte,SizeOf(Byte));

end;

procedure TDTKBinaryFormatter.ReadWideString(var AString:WideString;var AName:string);

begin

AName:=ReadAllString;

AString:=ReadAllWideString;

end;

procedure TDTKBinaryFormatter.ReadWord(var AWord:WORD;var AName:string);

begin

AName:=ReadAllString;

InputStream.Read(AWord,SizeOf(WORD));

end;

procedure TDTKBinaryFormatter.ReadInteger(var AInteger:Integer;var AName:string);

begin

AName:=ReadAllString;

InputStream.Read(AInteger,SizeOf(Integer));

end;

procedure TDTKBinaryFormatter.ReadBoolean(var ABoolean:Boolean;var AName:string);

var

vByte:Byte;

begin

AName:=ReadAllString;

InputStream.Read(vByte,SizeOf(Byte));

ABoolean := (vByte = 0);

end;

procedure TDTKBinaryFormatter.ReadInt64(var AInt64:Int64;var AName:string);

begin

AName:=ReadAllString;

InputStream.Read(AInt64,SizeOf(Int64));

end;

procedure TDTKBinaryFormatter.ReadFloat(var AFloat:double;var AName:string);

begin

AName:=ReadAllString;

InputStream.Read(AFloat,SizeOf(double));

end;

procedure TDTKBinaryFormatter.ReadDateTime(var ADateTime:TDateTime;var AName:string);

begin

AName:=ReadAllString;

InputStream.Read(ADateTime,SizeOf(TDateTime));

end;

procedure TDTKBinaryFormatter.ReadEnum(var Ref;var AName:string);

var

vByte:Byte;

begin

AName:=ReadAllString;

InputStream.Read(vByte,SizeOf(Byte));

Byte(Ref):=vByte;

end;

procedure TDTKBinaryFormatter.ReadBinary(AStream:TStream;var AName:string);

var

vCount,vMax,vBuffSize:Integer;

vBuff:PChar;

begin

AName:=ReadAllString;

InputStream.Read(vMax,SizeOf(Integer));

if vMax > MAX_BUFF_SIZE then

vBuffSize:=MAX_BUFF_SIZE

else

vBuffSize:=vMax;

GetMem(vBuff,vBuffSize);

try

repeat

vCount:=InputStream.Read(vBuff[0],vBuffSize);

AStream.Write(vBuff[0],vCount);

vMax:=vMax-vCount

until (vMax = 0);

finally

FreeMem(vBuff);

end;

procedure TDTKBinaryFormatter.ReadVariant(var AVariant:Variant;var AName:string);

begin

NotSupported;

end;

procedure TDTKBinaryFormatter.ReadObject(AClass:TClass;var Ref;var AName:string);

begin

NotSupported;

end;

procedure TDTKBinaryFormatter.WriteAllString(const AString:string);

var

vLen:Integer;

begin

vLen:=Length(AString);

OutputStream.Write(vLen,SizeOf(Integer));

if vLen > 0 then

OutputStream.Write(AString[1],vLen);

end;

procedure TDTKBinaryFormatter.WriteAllWideString(const AString:WideString);

var

vLen:Integer;

begin

vLen:=Length(AString);

OutputStream.Write(vLen,SizeOf(Integer));

if vLen > 0 then

OutputStream.Write(AString[1],vLen * 2);

end;

procedure TDTKBinaryFormatter.WriteString(const AString:string;const AName:string='');

begin

WriteAllString(AName);

WriteAllString(AString);

end;

procedure TDTKBinaryFormatter.WriteByte(const AByte:Byte;const AName:string='');

begin

WriteAllString(AName);

OutputStream.Write(AByte,SizeOf(Byte));

end;

procedure TDTKBinaryFormatter.WriteWideString(const AString:WideString;const AName:string='');

begin

WriteAllString(AName);

WriteAllWideString(AString);

end;

procedure TDTKBinaryFormatter.WriteWord(const AWord:WORD;const AName:string='');

begin

WriteAllString(AName);

OutputStream.Write(AWord,SizeOf(WORD));

end;

procedure TDTKBinaryFormatter.WriteInteger(const AInteger:Integer;const AName:string='');

begin

WriteAllString(AName);

OutputStream.Write(AInteger,SizeOf(Integer));

end;

procedure TDTKBinaryFormatter.WriteBoolean(const ABoolean:Boolean;const AName:string='');

var

vByte:Byte;

begin

WriteAllString(AName);

if ABoolean then

vByte:=1

else

vByte:=0;

OutputStream.Write(vByte,SizeOf(Byte));

end;

procedure TDTKBinaryFormatter.WriteInt64(const AInt64:Int64;const AName:string='');

begin

WriteAllString(AName);

OutputStream.Write(AInt64,SizeOf(Int64));

end;

procedure TDTKBinaryFormatter.WriteFloat(const AFloat:double;const AName:string='');

begin

WriteAllString(AName);

OutputStream.Write(AFloat,SizeOf(double));

end;

procedure TDTKBinaryFormatter.WriteDateTime(const ADateTime:TDateTime;const AName:string='');

begin

WriteAllString(AName);

OutputStream.Write(ADateTime,SizeOf(TDateTime));

end;

procedure TDTKBinaryFormatter.WriteEnum(const Ref;const AName:string='');

var

vByte:Byte;

begin

WriteAllString(AName);

vByte:=Byte(Ref);

OutputStream.Write(vByte,SizeOf(Byte));

end;

procedure TDTKBinaryFormatter.WriteBinary(AStream:TStream;const AName:string='');

var

vCount,vSize,vBuffSize:Integer;

vBuff:PChar;

begin

WriteAllString(AName);

vSize:=AStream.Size;

OutputStream.Write(vSize,SizeOf(Integer));

if vSize > MAX_BUFF_SIZE then

vBuffSize:=MAX_BUFF_SIZE

else

vBuffSize:=vSize;

GetMem(vBuff,vBuffSize);

try

repeat

vCount:=AStream.Read(vBuff[0],vBuffSize);

OutputStream.Write(vBuff[0],vCount);

vSize:=vSize-vCount;

until (vSize = 0);

finally

FreeMem(vBuff);

end;

procedure TDTKBinaryFormatter.WriteVariant(AVariant:Variant;const AName:string='');

begin

NotSupported;

end;

procedure TDTKBinaryFormatter.WriteObject(AClass:TClass;const Ref;const AName:string='');

begin

NotSupported;

end;

{ TDTKBinaryFormatterSingleCallFactory }

function TDTKBinaryFormatterSingleCallFactory.ValidateStream(AStream:TStream;var AProviderName:string):Boolean;

var

vValue:string;

vLen:Integer;

begin

AStream.Position:=0; //reset.

try

AStream.Read(vLen,SizeOf(Integer)); // first word is string length;

if vLen <> Length(DTK_FORMATTER) then

Result:=False

else

begin

SetLength(vValue,vLen);

AStream.Read(vValue[1],vLen); //read variable name,it should be DTK_FORMATTER.

AStream.Read(vLen,SizeOf(Integer));

SetLength(vValue,vLen);

AStream.Read(vValue[1],vLen); //read formatter name.

if not SameText(vValue,DTK_BINARY_FORMATTER) then

Result:=False

else

begin

//TODO now we sure formatter is BinaryFormatter,

// may be we can make ReadAllString function global

// to avoid write same code 2 times.

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

//read name,it should be DTK_PROVIDER.

AStream.Read(vLen,SizeOf(Integer));

SetLength(vValue,vLen);

AStream.Read(vValue[1],vLen);

//this provider name.

AStream.Read(vLen,SizeOf(Integer));

SetLength(AProviderName,vLen);

AStream.Read(AProviderName[1],vLen);

Result:=True;

end;

finally

AStream.Position:=0; //reset.

end;

function TDTKBinaryFormatterSingleCallFactory.AcquireDataFormatter:IDTKDataFormatter;

begin

Result:=TDTKBinaryFormatter.Create(Nil);

end;

end.

First Beta Test

架構完成後，當然得先撰寫個小程式進行一些測試:

unit Unit1;

interface

uses

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

Dialogs,uDTKBinaryFormatter,uDTKFileProvider, StdCtrls,uDTKIntf;

type

TForm1 = class(TForm)

Button1: TButton;

Button2: TButton;

Button3: TButton;

procedure Button2Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

private

procedure MyTigger(ADataFormatter:IDTKDataFormatter;ADataProvider:IDTKDataProvider);

procedure MyClientTigger(ADataFormatter:IDTKDataFormatter;ADataProvider:IDTKDataProvider);

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

uses uDTKClient,uDTKServer,uDTKIndyTCPTransport,uDTKCollections;

{$R *.dfm}

procedure TForm1.MyTigger(ADataFormatter:IDTKDataFormatter;ADataProvider:IDTKDataProvider);

var

vIntf:IDTKObjectReference;

begin

if Supports(ADataProvider,IDTKObjectReference,vIntf) then

TDTKFileProvider(vIntf.GetObject).FileName:='D:\TempInst\T11\TV.ZIP';

end;

procedure TForm1.MyClientTigger(ADataFormatter:IDTKDataFormatter;ADataProvider:IDTKDataProvider);

var

vIntf:IDTKObjectReference;

begin

if Supports(ADataProvider,IDTKObjectReference,vIntf) then

TDTKFileProvider(vIntf.GetObject).FileName:='D:\TempInst\T11\T11.ZIP';

end;

procedure TForm1.Button2Click(Sender: TObject);

var

vFormatterFactory:TDTKBinaryFormatterSingleCallFactory;

vProviderFactory:TDTKFileProviderSingleCallFactory;

vTransport:TDTKIndyTCPTransport;

vServer:TDTKServer;

begin

//active server.

vFormatterFactory:=TDTKBinaryFormatterSingleCallFactory.Create(Self);

vProviderFactory:=TDTKFileProviderSingleCallFactory.Create(Self);

vTransport:=TDTKIndyTCPTransport.Create(Self);

vTransport.TCPServer.DefaultPort:=8888;

vServer:=TDTKServer.Create(Self);

vServer.FormatFactorys.Add(vFormatterFactory);

vServer.ProviderFactorys.Add(vProviderFactory);

vServer.Transports.Add(vTransport);

vServer.Active:=True;

vServer.OnReceived:=MyTigger;

end;

procedure TForm1.Button3Click(Sender: TObject);

var

vFormatter:TDTKBinaryFormatter;

vProvider:TDTKFileProvider;

vTransport:TDTKIndyTCPTransport;

vClient:TDTKClient;

begin

//send file from client.

vFormatter:=TDTKBinaryFormatter.Create(Self);

vProvider:=TDTKFileProvider.Create(Self);

vProvider.Mode:=dtfpUpload;

vTransport:=TDTKIndyTCPTransport.Create(Nil);

vTransport.TCPClient.Host:='127.0.0.1';

vTransport.TCPClient.Port:=8888;

vProvider.FileName:='D:\TempInst\T11\T11.ZIP';

vClient:=TDTKClient.Create(Self);

vClient.Formatter:=vFormatter;

vClient.Provider:=vProvider;

vClient.Transport:=vTransport;

vClient.OnReceived:=MyClientTigger;

vClient.Send('');

end;

end.

這個程式建立了一個Server，並由Client端上傳一個檔案至Server端，程式很簡單。

DTK與 DELPHI IDE

在範例程式中你可以找到一個DELPHI 7 的Package，安裝好後就可以在IDE 上找到

DTK的所有元件了。拜RAD之賜，使用者不需土法練鋼般的用手Key 程式碼。在DTK

上的元件盤中，你會發現TDTKServer缺席了，取而代之的是TDTKVCLServer。這是

為了讓使用者能更方便的使用RAD方式來設定Server。

Extend it、TDTKIndyHTTPTransport

為了證明DTK的架構是可延伸的，這一節中實作了一個HTTP Transport元件，使整個

架構支援HTTP、TCP 兩種傳輸協定。

unit uDTKIndyHTTPTransport;

interface

uses

SysUtils, Windows, Messages, Classes, Graphics, Controls,

uDTKIntf,IdTCPServer, IdComponent, IdThreadMgr, IdSocketHandle, IdIntercept,

uDTKBaseTransport,IdHTTPServer,IdCustomHTTPServer,IdHTTP,IdException;

type

TDTKIndyHTTPTransport = class(TDTKBaseTransport)

private

FHTTPServer:TIdHTTPServer;

FHTTPClient:TIdHTTP;

procedure InternalServerCommandGet(AThread: TIdPeerThread;

RequestInfo: TIdHTTPRequestInfo; ResponseInfo: TIdHTTPResponseInfo);

procedure SetHTTPServer(AServer:TIdHTTPServer);

protected

{ IDTKTransport }

procedure SetActive(AActive:Boolean);override;

function GetActive:Boolean;override;

public

constructor Create(AOwner:TComponent);override;

destructor Destroy;override;

{ IDTKTransport }

procedure Send(AOptions:string;ARequestStream:TStream;AResponseStream:TStream);override;

property Active:Boolean read GetActive write SetActive;

published

property HTTPClient:TIdHTTP read FHTTPClient write FHTTPClient;

property HTTPServer:TIdHTTPServer read FHTTPServer write SetHTTPServer;

end;

implementation

{ TDTKIndyHTTPTransport }

constructor TDTKIndyHTTPTransport.Create(AOwner:TComponent);

begin

inherited Create(AOwner);

FHTTPServer:=TIdHTTPServer.Create(Self);

FHTTPClient:=TIdHTTP.Create(Self);

FHTTPClient.SetSubComponent(True);

FHTTPServer.SetSubComponent(True);

FHTTPServer.OnCommandGet:=InternalServerCommandGet;

end;

destructor TDTKIndyHTTPTransport.Destroy;

begin

if Assigned(FHTTPServer) then

FHTTPServer.Free;

if Assigned(FHTTPClient) then

FHTTPClient.Free;

inherited;

end;

procedure TDTKIndyHTTPTransport.SetActive(AActive:Boolean);

begin

//not support design-time active.

if Assigned(FHTTPServer) and not (csDesigning in ComponentState) then

FHTTPServer.Active:=AActive;

end;

function TDTKIndyHTTPTransport.GetActive:Boolean;

begin

Result:=False;

if Assigned(FHTTPServer) then

Result:=FHTTPServer.Active;

end;

procedure TDTKIndyHTTPTransport.SetHTTPServer(AServer:TIdHTTPServer);

begin

if Assigned(FHTTPServer) then FHTTPServer.OnCommandGet:=Nil;

FHTTPServer:=AServer;

FHTTPServer.OnCommandGet:=InternalServerCommandGet;

end;

procedure TDTKIndyHTTPTransport.InternalServerCommandGet(AThread: TIdPeerThread;

RequestInfo: TIdHTTPRequestInfo; ResponseInfo: TIdHTTPResponseInfo);

var

vReq,vRep:TStream;

vOK:Boolean;

begin

vReq:=TStringStream.Create(RequestInfo.UnparsedParams);

vRep:=TMemoryStream.Create;

try

if Assigned(OnDataReceived) then

Self.OnDataReceived(vReq,vRep,vOK);

ResponseInfo.ResponseNo:=200;

if vRep.Size > 0 then

begin

vRep.Position:=0;

ResponseInfo.ContentStream:=vRep;

end;

finally

vReq.Free;

// vRep.Free; // Indy will release ContentStream by default.

end;

procedure TDTKIndyHTTPTransport.Send(AOptions:string;ARequestStream:TStream;AResponseStream:TStream);

var

vOK:Boolean;

begin

FHTTPClient.Connect;

try

if Assigned(Self.OnDataSend) then

Self.OnDataSend(ARequestStream,Nil);

FHTTPClient.Post(AOptions,ARequestStream,AResponseStream);

AResponseStream.Position:=0;

if AResponseStream.Size > 0 then

Self.OnDataReceived(Nil,AResponseStream,vOK);

finally

FHTTPClient.Disconnect;

end;

end.

這個程式是運用Indy 的HTTP 元件來完成，請參考Indy 的Help。

Extend it、TDTKDataSnapProvider

單單只有傳檔功能看起來有點兒單調，這一節中實作了個較不一樣的DataProvider，

DataSnap Provider，她提供了將DataSet傳送至Client端的能力，同時允許使用者將編修

後的資料經由同樣的機制上傳至Server端寫入資料庫中。

{$I DTK.inc}

unit uDTKDataSnapProvider;

interface

uses

Windows, Messages, SysUtils, Variants, Classes,uDTKIntf,Contnrs,SyncObjs,uDTKBaseFactorys,

uDTKBaseProvider,db,dbclient;

const

DTK_DATASNAP_PROVIDER_NAME='DATASNAP PROVIDER 1.0';

type

TDTKDataSnapRequestMode=(dtdsDataSetList,dtdsDataSet,dtdsServer,dtdsDelta);

TDTKDataSnapProvider=class(TDTKBaseProvider)

private

FDataSetName:string;

FDataModule:TDataModule;

FMode:TDTKDataSnapRequestMode;

FDataSetList:TStrings;

FDataSet:TDataSet;

FDeltaDataSet:TClientDataSet;

function GetDataSetList:TStrings;

function GetDataSet:TDataSet;

procedure ProcessDataSetList(ADataFormatter:IDTKDataFormatter);

procedure ProcessDataSet(ADataFormatter:IDTKDataFormatter);

procedure ProcessDelta(ADataFormatter:IDTKDataFormatter);

protected

{ IDTKDataProvider }

function GetProviderName:string;override;

public

destructor Destroy;override;

{ IDTKDataProvider }

procedure ProcessServer(ADataFormatter:IDTKDataFormatter);override;

procedure ProcessClient(ADataFormatter:IDTKDataFormatter);override;

procedure ProcessClientResponse(ADataFormatter:IDTKDataFormatter);override;

property DataSetList:TStrings read GetDataSetList;

property DataSet:TDataSet read GetDataSet;

published

property ProviderName:string read GetProviderName;

property DataSetName:string read FDataSetName write FDataSetName;

property Mode:TDTKDataSnapRequestMode read FMode write FMode;

property DataModule:TDataModule read FDataModule write FDataModule;

property DeltaDataSet:TClientDataSet read FDeltaDataSet write FDeltaDataSet;

end;

TDTKDataSnapProviderSingleCallFactory=class(TDTKBaseDataProviderFactory)

private

FDataModule:TDataModule;

public

{ IDTKDataProviderFactory }

function GetProviderName:string;override;

function AcquireDataProvider:IDTKDataProvider;override;

property ProviderName:string read GetProviderName;

published

property DataModule:TDataModule read FDataModule write FDataModule;

end;

implementation

uses StrUtils,Provider,uDTKExceptions;

const

DTK_DATASET_REQUEST_MODE='MODE';

DTK_DATASET_COUNT='DATASET_COUNT';

DTK_DATASET_DATA='DATASET_DATA';

DTK_DATASET='DATASET_%d';

DTK_DELTA_DATA='DELTA_DATA';

DTK_DATASET_NAME='DATASET_NAME';

{ TDTKDataSnapProvider }

destructor TDTKDataSnapProvider.Destroy;

begin

if Assigned(FDataSetList) then

FDataSetList.Free;

if Assigned(FDataSet) then

FDataSet.Free;

inherited;

end;

function TDTKDataSnapProvider.GetDataSetList:TStrings;

begin

Result:=FDataSetList;

end;

function TDTKDataSnapProvider.GetDataSet:TDataSet;

begin

Result:=FDataSet;

end;

procedure TDTKDataSnapProvider.ProcessDataSetList(ADataFormatter:IDTKDataFormatter);

var

I:Integer;

vList:TStrings;

vMode:TDTKDataSnapRequestMode;

begin

vMode:=dtdsDataSetList;

WriteHeaderInfo(ADataFormatter);

ADataFormatter.WriteEnum(vMode,DTK_DATASET_REQUEST_MODE);

if Assigned(FDataModule) then

begin

vList:=TStringList.Create;

try

for I:=0 to FDataModule.ComponentCount-1 do

begin

if FDataModule.Components[I] is TDataSet then

vList.Add(TDataSet(FDataModule.Components[I]).Name);

end;

ADataFormatter.WriteInteger(vList.Count,DTK_DATASET_COUNT);

for I:=0 to vList.Count-1 do

ADataFormatter.WriteString(vList[I],Format(DTK_DATASET,[I]));

finally

vList.Free;

end;

procedure TDTKDataSnapProvider.ProcessDataSet(ADataFormatter:IDTKDataFormatter);

function FindDataSet(const ADataSetName:string):TDataSet;

var

I:Integer;

begin

Result:=Nil;

for I:=0 to FDataModule.ComponentCount-1 do

begin

if (FDataModule.Components[I] is TDataSet) and

(SameText(TDataSet(FDataModule.Components[I]).Name,ADataSetName)) then

begin

Result:=TDataSet(FDataModule.Components[I]);

exit;

end;

var

vDataSetName,vTagStr:string;

vDataSet:TDataSet;

vProvider:TDataSetProvider;

vCDS:TClientDataSet;

vStream:TMemoryStream;

vMode:TDTKDataSnapRequestMode;

begin

ADataFormatter.ReadString(vDataSetName,vTagStr);

vDataSet:=FindDataSet(vDataSetName);

if Assigned(vDataSet) then

begin

vMode:=dtdsDataSet;

WriteHeaderInfo(ADataFormatter);

ADataFormatter.WriteEnum(vMode,DTK_DATASET_REQUEST_MODE);

vProvider:=TDataSetProvider.Create(Nil);

vCDS:=TClientDataSet.Create(Nil);

vStream:=TMemoryStream.Create;

try

vProvider.DataSet:=vDataSet;

vCDS.Data:=vProvider.Data;

vCDS.SaveToStream(vStream);

vStream.Position:=0;

ADataFormatter.WriteBinary(vStream,DTK_DATASET_DATA);

finally

vCDS.Free;

vProvider.Free;

vStream.Free;

end;

procedure TDTKDataSnapProvider.ProcessDelta(ADataFormatter:IDTKDataFormatter);

function FindDataSet(const ADataSetName:string):TDataSet;

var

I:Integer;

begin

Result:=Nil;

for I:=0 to FDataModule.ComponentCount-1 do

begin

if (FDataModule.Components[I] is TDataSet) and

(SameText(TDataSet(FDataModule.Components[I]).Name,ADataSetName)) then

begin

Result:=TDataSet(FDataModule.Components[I]);

exit;

end;

var

vDataSetName,vTagStr:string;

vDataSet:TDataSet;

vProvider:TDataSetProvider;

vCDS:TClientDataSet;

vStream:TMemoryStream;

vError:Integer;

begin

ADataFormatter.ReadString(vDataSetName,vTagStr);

vDataSet:=FindDataSet(vDataSetName);

if Assigned(vDataSet) then

begin

vProvider:=TDataSetProvider.Create(Nil);

vCDS:=TClientDataSet.Create(Nil);

vStream:=TMemoryStream.Create;

try

vProvider.DataSet:=vDataSet;

ADataFormatter.ReadBinary(vStream,vTagStr);

vStream.Position:=0; //reset.

vCDS.LoadFromStream(vStream);

//TODO write error to client.

vProvider.ApplyUpdates(vCDS.Delta,0,vError);

finally

vCDS.Free;

vProvider.Free;

vStream.Free;

end;

function TDTKDataSnapProvider.GetProviderName:string;

begin

Result:=DTK_DATASNAP_PROVIDER_NAME;

end;

procedure TDTKDataSnapProvider.ProcessClient(ADataFormatter:IDTKDataFormatter);

procedure InternalProcessDelta;

var

vStream:TMemoryStream;

vCDS:TClientDataSet;

begin

if Assigned(FDeltaDataSet) then

begin

if FDeltaDataSet.ChangeCount = 0 then

raise Exception.Create('no changes!');

vStream:=TMemoryStream.Create;

vCDS:=TClientDataSet.Create(Nil);

try

vCDS.Data:=FDeltaDataSet.Delta;

vCDS.SaveToStream(vStream);

vStream.Position:=0; //reset

ADataFormatter.WriteBinary(vStream,DTK_DELTA_DATA);

finally

vStream.Free;

vCDS.Free;

end;

begin

WriteHeaderInfo(ADataFormatter);

ADataFormatter.WriteEnum(FMode,DTK_DATASET_REQUEST_MODE);

case FMode of

dtdsDataSetList :

begin

//nothing need do.

end;

dtdsDataSet :

ADataFormatter.WriteString(FDataSetName,DTK_DATASET_NAME);

dtdsDelta :

begin

ADataFormatter.WriteString(FDataSetName,DTK_DATASET_NAME);

InternalProcessDelta;

end;

procedure TDTKDataSnapProvider.ProcessClientResponse(ADataFormatter:IDTKDataFormatter);

procedure LoadDataSetList;

var

I,vCount:Integer;

vTempName,vTagStr:string;

begin

if not Assigned(FDataSetList) then

FDataSetList:=TStringList.Create

else

FDataSetList.Clear;

ADataFormatter.ReadInteger(vCount,vTagStr);

for I:=0 to vCount-1 do

begin

ADataFormatter.ReadString(vTempName,vTagStr);

FDataSetList.Add(vTempName)

end;

procedure LoadDataSet;

var

vTagStr:string;

vStream:TMemoryStream;

begin

if not Assigned(FDataSet) then

FDataSet:=TClientDataSet.Create(Nil);

vStream:=TMemoryStream.Create;

try

ADataFormatter.ReadBinary(vStream,vTagStr);

vStream.Position:=0;

TClientDataSet(FDataSet).LoadFromStream(vStream);

finally

vStream.Free;

end;

var

vTagStr:string;

vMode:TDTKDataSnapRequestMode;

begin

LoadHeaderInfo(ADataFormatter);

ADataFormatter.ReadEnum(vMode,vTagStr);

if not SameText(vTagStr,DTK_DATASET_REQUEST_MODE) then

raise EDTKInvalidRequest.Create;

case FMode of

dtdsDataSetList :

LoadDataSetList;

dtdsDataSet :

LoadDataSet;

end;

procedure TDTKDataSnapProvider.ProcessServer(ADataFormatter:IDTKDataFormatter);

var

vTagStr:string;

begin

if FMode = dtdsServer then

begin

LoadHeaderInfo(ADataFormatter);

ADataFormatter.ReadEnum(FMode,vTagStr);

if not SameText(vTagStr,DTK_DATASET_REQUEST_MODE) then

raise EDTKInvalidRequest.Create;

case FMode of //

dtdsDataSetList :

ProcessDataSetList(ADataFormatter);

dtdsDataSet :

ProcessDataSet(ADataFormatter);

dtdsDelta:

ProcessDelta(ADataFormatter);

end;

FMode:=dtdsServer; //reset.

end;

{ TDTKDataSnapProviderSingleCallFactory }

function TDTKDataSnapProviderSingleCallFactory.GetProviderName:string;

begin

Result:=DTK_DATASNAP_PROVIDER_NAME;

end;

function TDTKDataSnapProviderSingleCallFactory.AcquireDataProvider:IDTKDataProvider;

var

vProvider:TDTKDataSnapProvider;

begin

vProvider:=TDTKDataSnapProvider.Create(Nil);

vProvider.Mode:=dtdsServer;

vProvider.DataModule:=DataModule;

Result:=vProvider;

end;

end.

範例中附了一個使用DataSnap Provider 的範例程式。

Extend it、TDTKCompressedDataFormatter

截至目前為止，我們已經撰寫了許多延伸的元件，除了Transport、DataProvider之外，

架構中的DataFormatter也是可替換的元件，這一節讓我們以一個傳送壓縮資料格式的

DataFormatter做一個延伸之行的終點。

{$I DTK.inc}

unit uDTKCompressFormatter;

interface

uses

Windows, Messages, SysUtils, Variants, Classes,TypInfo,uDTKIntf,uDTKBaseFactorys,

uDTKBinaryFormatter,SyncObjs;

type

TDTKCompressedFormatter=class(TDTKBinaryFormatter)

private

FCompressedOutputStream:TStream;

protected

function GetFormatterName:string;override;

public

destructor Destroy;override;

procedure SetInputStream(AStream:TStream);override;

function GetOutputStream:TStream;override;

end;

TDTKCompressedFormatterSingleCallFactory=class(TDTKBaseDataFormatterFactory)

private

FCacheFormatter:TDTKCompressedFormatter;

FCrit:TCriticalSection;

public

{ IDTKDataFormatterFactory }

function ValidateStream(AStream:TStream;var AProviderName:string):Boolean;override;

function AcquireDataFormatter:IDTKDataFormatter;override;

constructor Create(AOwner:TComponent);override;

destructor Destroy;override;

end;

implementation

uses AbUnzPrc,AbZipPrc;

const

DTK_COMPRESSED_FORMATTER='ZIP COMPRESSED FORMATTER 1.0';

destructor TDTKCompressedFormatter.Destroy;

begin

if Assigned(FCompressedOutputStream) then

FCompressedOutputStream.Free;

inherited;

end;

function TDTKCompressedFormatter.GetFormatterName:string;

begin

Result:=DTK_COMPRESSED_FORMATTER;

end;

{------------------------------------------------------------------------------

well,abbrevia is not very good compress component for on the fly compress,

because it not handle stream position and size,so we need becaful about position

and size(many reset action need to do).

PS:abbrevia do not raise any exception,if we try to decompresss a non-compress

stream. that's very bad design,it should be provide ValidateStream function,

or raise a exception to notify user.

-------------------------------------------------------------------------------}

procedure TDTKCompressedFormatter.SetInputStream(AStream:TStream);

var

vInputStream:TStream;

begin

if not Assigned(InputStream) then

begin

vInputStream:=TMemoryStream.Create;

InflateStream(AStream,vInputStream);

AStream.Position:=0;

if vInputStream.Size = 0 then

DeflateStream(vInputStream,AStream);

inherited SetInputStream(vInputStream);

end

else

begin

vInputStream:=InputStream;

vInputStream.Position:=0;

vInputStream.Size:=0;

InflateStream(AStream,vInputStream);

AStream.Position:=0;

if vInputStream.Size = 0 then

DeflateStream(vInputStream,AStream);

end;

InputStream.Position:=0;

end;

function TDTKCompressedFormatter.GetOutputStream:TStream;

begin

if not Assigned(FCompressedOutputStream) then

FCompressedOutputStream:=TMemoryStream.Create;

OutputStream.Position:=0;

FCompressedOutputStream.Position:=0;

if OutputStream.Size > 0 then

DeflateStream(OutputStream,FCompressedOutputStream);

FCompressedOutputStream.Position:=0;

OutputStream.Position:=0;

Result:=FCompressedOutputStream;

end;

{ TDTKCompressedFormatterSingleCallFactory }

constructor TDTKCompressedFormatterSingleCallFactory.Create(AOwner:TComponent);

begin

inherited Create(AOwner);

FCrit:=TCriticalSection.Create;

end;

destructor TDTKCompressedFormatterSingleCallFactory.Destroy;

begin

FCrit.Free;

inherited Destroy;

end;

{-----------------------------------

because we wan't decompress same stream 2 times,

so we use cache mechanics to accomplish decompress 1 time,

and use many time.

because we only have 1 Factory in server-side,

but we need cache 1 formatter,so thread-safe is a problem,

see Critical Section,in theory! it's solve thread-safe problem.

------------------------------------}

function TDTKCompressedFormatterSingleCallFactory.ValidateStream(AStream:TStream;var AProviderName:string):Boolean;

var

vValue,vTagStr:string;

vFormatter:TDTKCompressedFormatter;

begin

vFormatter:=TDTKCompressedFormatter.Create(Nil);

try

FCrit.Enter;

vFormatter.SetInputStream(AStream);

vFormatter.ReadString(vValue,vTagStr); //formater.

if not SameText(vValue,DTK_COMPRESSED_FORMATTER) then

begin

FCrit.Leave;

vFormatter.Free;

Result:=False;

exit;

end;

vFormatter.ReadString(AProviderName,vTagStr);

FCacheFormatter:=vFormatter;

Result:=True;

except

AStream.Position:=0;

FreeAndNil(vFormatter);

FCrit.Leave;

Result:=False;

exit;

end;

function TDTKCompressedFormatterSingleCallFactory.AcquireDataFormatter:IDTKDataFormatter;

begin

if Assigned(FCacheFormatter) then

begin

FCacheFormatter.InputStream.Position:=0;

Result:=FCacheFormatter;

FCacheFormatter:=Nil;

FCrit.Leave;

end

else

Result:=TDTKCompressedFormatter.Create(Nil);

end;

end.

TDTKCompressedFormatter使用了TurboPower的Abbrevia元件來完成壓縮的動作，這套

元件目前已是Open Source了，可在http://sourceforge.net/users/tpsfadmin/ 下載。

Need XML?? TDTKXMLDataFormatter

你可以在壓縮檔中找到這個元件，她使用XML 做為傳輸格式，由於時間的關係，我

使用了較簡單的方式實作這個元件，你可以嘗試實作較複雜的XML格式。

Interface and Abstract Class

由DTK中可以發現，Abstract Class 與Inteface 彼此合作的很好，藉由她們的合作，

我們保有了在實作前窺探系統全貌的機會，也得到了漸進式實作的好處。

Interface 是諸家語言開發者拋棄多重繼承的理由，同時也是近代語言中大量使用的技

術，微軟的.NET Framework 就是由Interface架起底層的大範例之一，可以想見的，日

後的各家開發工具廠商的Framework 中，Interface 必然會有相當份量的演出。

Next Volume……

DTK並不算是一個完整的實作品，有一些功能我還來不及實作，例如DataFormatter

的WriteObject、WriteVariant 等等。另外在一些細部的控制上也不算完美，例如錯誤處

理機制等等，這些會在日後補上，只是我無法對此做出承諾，因為在我的計劃中還有其

它的Framework進行。下一篇有關Interface的文章主題是Data Access Framework，她是以

C#所完成的，日期預定於今年的11 月，但這只是暫定的日期，我食言而肥是出了名的，

所以別太認真。

相关阅读:
Windows下使用nmake编译C/C++的makefile
poj 1228
poj 1039
poj 1410
poj 3304
poj 1113
poj 2074
uva 1423 LA 4255
poj 1584
poj 3277

原文地址：https://www.cnblogs.com/fuyingke/p/228372.html