先行知識：Delphi /COM/OLE Automation/ SQL Server
難度：★★☆☆☆
在前幾篇文章中我們已經討論過關于VCL和OLE的知識。在這篇文章中我們將完成一個比較有實際意義的OLE Automation服務器程序，最后我們把他們封裝為Delphi中使用的VCL組件。
首先我們來做一個實際的程序，在它沒有變為服務器之前，這是個用來管理客戶購買記錄的程序（它自己與SQL Server連接），它可以錄入和刪除客戶的購買記錄并直觀的顯示出來，所有的數據都存放在SQL Server中。我們將它做為OLE Automation出于這樣一種考慮，假設我們是一家大型的供貨公司，我們可能有很多系統需要使用這個客戶購買記錄程序并用它處理SQL Server中相應的數據，但我們不愿意每次都重復的編寫同樣的處理代碼，我們更希望能把這個處理程序獨立出來，并向其它程序提供服務。那么在下面的工作中我們完成了這個服務器程序，界面如下：（注意，這僅僅是一個例子，我們不評價其數據庫設計的好壞J）
我們不過多的討論這個程序的代碼（因為這和開發一般的程序沒有任何不同，你可以按照最后的地址給我來信索取這篇文章的全部代碼）。然后我們來把它變為一個服務器。選擇FileàNewàOthersàActiveXàAutomation Object。接下來delphi為我們定義了類型庫和實現文件，我們要做的只是在類型庫中添加相應的我們要用到的服務器屬性和事件。我們簡單的給出定義這個OLE Automation功能的接口（來自類型庫所產生的Object Pascal代碼）：
ICustFormOLE = interface(IDispatch)
['{D7AE75F9-F838-4702-A8EB-EAD0EED242DE}']
function Get_CustName: WideString; safecall;
PRocedure Set_CustName(const Value: WideString); safecall;
function Get_ProductName: WideString; safecall;
procedure Set_ProductName(const Value: WideString); safecall;
function Get_ProductNum: Integer; safecall;
procedure Set_ProductNum(Value: Integer); safecall;
function Get_Remark: WideString; safecall;
procedure Set_Remark(const Value: WideString); safecall;
//下面的方法和屬性都對應著原程序中相應的方法和屬性
procedure AddToData; safecall;
procedure DelData; safecall;
property CustName: WideString read Get_CustName write Set_CustName;
property ProductName: WideString read Get_ProductName write Set_ProductName;
property ProductNum: Integer read Get_ProductNum write Set_ProductNum;
property Remark: WideString read Get_Remark write Set_Remark;
end;
ICustFormOLEDisp = dispinterface
['{D7AE75F9-F838-4702-A8EB-EAD0EED242DE}']
property CustName: WideString dispid 201;
property ProductName: WideString dispid 202;
property ProductNum: Integer dispid 203;
property Remark: WideString dispid 204;
procedure AddToData; dispid 205;
procedure DelData; dispid 206;
end;
我們現在回到接口的實現文件，注意代碼中的注釋，事實上這段代碼相當的簡單：
unit CustOLEImpUnit;
{$WARN SYMBOL_PLATFORM OFF}
interface
uses
ComObj, ActiveX, CustViewOLE_TLB, StdVcl,windows;
type
TCustFormOLE = class(TAutoObject, ICustFormOLE)
//注意這里實現了我們在前面定義的ICustFormOLE接口
protected
function Get_CustName: WideString; safecall;
function Get_ProductName: WideString; safecall;
function Get_ProductNum: Integer; safecall;
function Get_Remark: WideString; safecall;
procedure AddToData; safecall;
procedure DelData; safecall;
procedure Set_CustName(const Value: WideString); safecall;
procedure Set_ProductName(const Value: WideString); safecall;
procedure Set_ProductNum(Value: Integer); safecall;
procedure Set_Remark(const Value: WideString); safecall;
end;
implementation
uses ComServ,CustFormUnit;
function TCustFormOLE.Get_CustName: WideString;
begin
result:=CustForm.CustomEdit.Text;
//可以看到，我們只是用了最初程序窗體的控件和屬性，這里的接口實現相當于
//只是簡單的封狀了我們的原始程序，下面的代碼情況類似。
end;
function TCustFormOLE.Get_ProductName: WideString;
begin
result:=CustForm.ProductEdit.Text;
end;
function TCustFormOLE.Get_ProductNum: Integer;
begin
result:=CustForm.ProNumEdit.Value;
end;
function TCustFormOLE.Get_Remark: WideString;
begin
result:=CustForm.Memo1.Lines.Text;
end;
procedure TCustFormOLE.AddToData;
begin
CustForm.AddButton.Click;
end;
procedure TCustFormOLE.DelData;
begin
CustForm.DelButton.Click;
end;
procedure TCustFormOLE.Set_CustName(const Value: WideString);
begin
CustForm.CustomEdit.Text:=Value;
end;
procedure TCustFormOLE.Set_ProductName(const Value: WideString);
var
i:integer;
begin
i:=CustForm.ProductEdit.Items.IndexOf(Value);
if i<>-1 then
CustForm.ProductEdit.ItemIndex:=i
else
begin
messagebox(CustForm.Handle,'你在客戶程序指定的商品類型并不存在！','CustProOLE常規錯誤',MB_ICONWARNING);
CustForm.ProductEdit.ItemIndex:=0;
end;
end;
procedure TCustFormOLE.Set_ProductNum(Value: Integer);
begin
CustForm.ProNumEdit.Value:=Value;
end;
procedure TCustFormOLE.Set_Remark(const Value: WideString);
begin
CustForm.Memo1.Lines.Text:=Value;
end;
initialization
TAutoObjectFactory.Create(ComServer, TCustFormOLE, Class_CustFormOLE,
ciMultiInstance, tmApartment);
end.
現在我們就可以實際的測試和使用這個服務器了，我們可以新建立一個工程，選擇Project-->Import Type Library…可以發現這里已經有我們剛才建立的服務器信息了（當然前提是你已經運行過服務器程序），然后Create Unit將相應的類型文件所生成的pascal文件加入我們的工程中，一但我們啟動了服務器我們就可以很輕松的使用接口中的屬性和方法了：
function TForm1.GetDefaultInterface:ICustFormOLE;
begin
if not assigned(FInterface) then
FInterface:=CoCustFormOLE.Create;//注意這里，你可以在類型庫文件產生的pascal文件中找到CoCustFormOLE的含義
result:=FInterface;
end;
由于篇幅原因，我們不能給出測試程序的全部代碼（事實上有了服務器程序，我們的測試客戶程序想要處理SQL Server中的相應數據就相當的簡單了。），可以照后文的地址向我索取（說明一下，本文中的數據庫用到SQL Server，所以我發給你們的程序中你們需要還原其中的數據庫備份到你們的SQL Server，并修改相應的連接字符串，否則程序不能運行）。
在本文的最后，我們介紹一種更簡單的使用我們剛才所開發的服務器的方法，那就是把它封裝為delphi中的組件，選擇Project-->Import Type Library…中我們開發的服務器，然后Install將它安裝到一個已經存在的包或你新建的組件包中，delphi將為我們做很多工作，最后你可以從你指定的面板找到安裝的新的組件，現在你就可以象使用普通VCL組件一樣使用我們開發的服務器了。（注意，delphi為我們定義了一個繼承自ToleContol的類，這一切復雜的工作都是由delphi在背后為我們完成的，如果你有興趣，建議研究一下這個組件中delphi自動為我們生成的大量代碼）。
索取地址：hk.barton@sohu.com
新聞熱點
疑難解答
