关于VisiBroker-For-Delphi的使用

1、关于VisiBroker For HYPERLINK /language/delphi/ t _blank Delphi的使用(3)-CORBA技术实践（一）email: HYPERLINK mailto:3boy 3boy3,数组对象与简单数据对象的传递前面提到了一些较为简单的数据操作，我们都可以想象一下，如果操作CORBA对象与操作C/S结构的数据对象一样的方便，那么CORBA又有什么神奇了，不知道看过李维的分布式多层应用系统的书籍时，是否留意到李维对CORBA的评价，无论你看过还是没有看过，我都要告诉正在使用CORBA编程的朋友们，CORBA比COM/COM+简单，而CORBA的跨平台特

2、性，以及与COM/COM+同样的负载平衡能力，足以让我们将这项分布式技术应用到应用体系的设计之中，其实对于使用Borland的产品开发分布式系统无论你采用CORBA或是COM/COM+其实最核心的技术就是MIDAS，因为你总可以在CORBA/COM/COM+中看到MIDAS的影子，所以我建议无论你是准备学习CORBA还是学习COM/COM+最好先学习一下MIDAS,本文不涉及MIDAS，关于MIDAS请看李维的Delphi5.X分布式多层应用系统篇。为什么我从开始就一直要大家使用文本编辑器之类的东西书写IDL，而不用TypeLibrary来书写IDL,其实我觉得只是为了让刚刚接触CORBA的程

3、序员获得一些更多的IDL方面的知识罢了，在实际的开发中你可以完全很方便的使用TypeLibrary来编写接口规则。下面我简要的列举几类IDL书写的事例与利用IDL2PAS生成的PASCAL代码。1、）常量的定义/*IDL书写*/module MyCRB const long iMyConst=1; interface myFace const long iiMyConst=2;/*Pascal*/unit MyCRB_I;interfaceuses Corba;const iMyCOnst:integer=1; myFace_iiMyConst=2;2、)不在接口中申明的常量/*IDL*/mo

4、dule MyCRB const long myconst=1;/*pascal*/unit MyCRB_I;interfaceconst myconst:integer=1;3、)枚举类型/*IDL*/enum MyCRBKindA,B,C,D,./*pascal*/myCRBkind=(A,B,C,D.);4、）结构体/*IDL*/struct mystructtype long X;string Y;boolean Z;/*pascal*/XXX_I.pastype mystructtype=interface;/XXX_C.pasmystructtype=interfacefuncti

5、on _get_X:integer;function _get_Y:string;function _get_Z:boolean;procedure _set_X(const Value:integer); procedure _set_Y(const Value:string); procedure _set_Z(const Value:boolean); property X:integer read _get_X write _Set_X;property Y:string read _get_Y write _Set_Y;property Z:boolean read _get_Z w

6、rite _Set_Z;.还有太多的代码，自己创建一个看一下，为了节约篇幅我就不做详细的翻译了下面请大家试一下以下的申明会生成什么样的Pascal代码5、）联合体union un_exp switch(long) case 1:long x; case 2:string y;case 3:st_exp Z;6、sequence(我理解为动态数组)typedef sequence UnboundeSeq;typedef sequence ShortBoundSeq7, 数组 const long ArrayBound=10;typedef long longArrayArrayBound;8,

7、抽象接口module exp interface myfacelong op(in string s);9,多重继承 module Minterface A void A1(); void A2(); ;interface B void B1(); void B2();interface AB:B,Avoid AB1()void AB2();10,交叉模型定义module m1interface if1;module m2 interface if2m1:if1 getIf1();interface if1m2:if2 getif2();以上我介绍了一些数据的定义规范,然而我们需要不仅仅是这样

8、的一些比较抽象的接口定义法则,我们要将法则应用到实际的开发中去,那么我们又是如何运用这些法则了,对于接口描述语言的翻译我前面讲到直接使用IDL2PAS就不讲了,以后的章节中也不会在去将如何转换的问题。下面我们实践一下：编写接口定义一个返回为浮点类型，输入为短整型变量数组对象的方法typedef short ArrayType3;/自定义类型定义长度为3的数组interface Account float InputArray(in ArrayType myArray);/输入为整形数组，返回类型为float的方法;/服务端程序的处理xxx_impl.pasinterfaceuses SysUt

9、ils, CORBA, account_i, account_c;type TAccount = class; TAccount = class(TInterfacedObject, account_i.Account) protected /* public constructor Create; function InputArray ( const myArray : account_i.ArrayType): Single; end;implementationuses ServerMain;constructor TAccount.Create;begin inherited;end

10、;function TAccount. InputArray (const myArray : account_i.ArrayType): Single;var j: Integer;begin/ account_i.ArrayType是指我们自定义的数组类型在account_I单元中 for j := 0 to 2 do beginForm1.Memo1.Lines.Add(myArray + IntToStr(j) + = + IntToStr(myArrayj) );/接受从客户端传递过来的数组变量并将其依次加入到主窗体的MEMO中 end; result := random * 100

11、;/返回一个随机数end;initialization randomize;end./服务端程序主单元unit ServerMain;interfaceuses HYPERLINK /os/windows/ t _blank Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Corba, Account_I, Account_C, Account_S, Account_Impl, StdCtrls;type TForm1 = class(TForm) Memo1: TMemo; procedure

12、 FormCreate(Sender: TObject); private private declarations protected protected declarations Acct : Account; / skeleton 对象 procedure InitCorba; public public declarations end;var Form1: TForm1;implementation$R *.dfmprocedure TForm1.InitCorba;begin CorbaInitialize; / Add CORBA server Code Here Acct :=

13、 TAccountSkeleton.Create(Array Server, TAccount.Create); BOA.ObjIsReady(Acct as _Object);end;procedure TForm1.FormCreate(Sender: TObject);begin InitCorba; Memo1.Lines.Add(Account object created.); Memo1.Lines.Add(Server is ready);end;end./客户端程序unit ClientMain;interfaceuses HYPERLINK /os/windows/ t _

14、blank Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Corba, StdCtrls, Account_I, Account_C;type TForm1 = class(TForm) Button1: TButton; Label1: TLabel; procedure FormCreate(Sender: TObject); procedure Button1Click(Sender: TObject); private private declarations protected pr

15、otected declarations Acct : Account; myArray : ArrayType; procedure InitCorba; public public declarations end;var Form1: TForm1;implementation$R *.dfmprocedure TForm1.InitCorba;begin CorbaInitialize; Acct := TAccountHelper.bind;end;procedure TForm1.FormCreate(Sender: TObject);var j: Integer;begin In

16、itCorba; for j := 0 to 2 do myArrayj := (j + 1) * 100;end;procedure TForm1.Button1Click(Sender: TObject);begin Label1.Caption := FormatFloat(InputArray = $#,#0.00, Acct.inputArray(myArray);end;end.上面的程序实例很简单我就不一一说明了，下面我们来看一个数据访问的实例/IDLinterface Employee any getEmployeesByName(in string name);接口方法声明单

17、元/XXX_Impl.pasinterfaceuses SysUtils, CORBA, employee_i, employee_c;type TEmployee = class; TEmployee = class(TInterfacedObject, employee_i.Employee) public constructor Create; function getEmployeesByName ( const name : AnsiString): ANY; end;implementationuses dmEmployee,DMPooler, provider,DSIntf,Se

18、rverMain;constructor TEmployee.Create;begin inherited;end;function TEmployee.getEmployeesByName ( const name : AnsiString): ANY;var DM: TdmEmploy; RecsOut: Integer; Options: TGetRecordOptions;begin Options := grMetaData,grReset; /must specify meta data DM := ModulePooler.GetModule as TdmEmploy; /Get

19、 instance of datamodule from Pool try DM.qryEmployee.Close; DM.qryEmployee.ParamByName(name).AsString:= name + %; /显示连接 HYPERLINK /server/ t _blank 服务器的数量 Inc(Form1.HitCount); Form1.Label1.Caption := Format(Hit Count = %d, Form1.HitCount); DM.qryEmployee.Open; Result:=DM.proEmployee.GetRecords(-1, R

20、ecsOut, Byte(Options); DM.qryEmployee.Close; finally ModulePooler.FreeModule(DM);/Return instance of DataModule to pool end;end;initialization /将TdmEmploy对象放入共享池中 ModulePooler.ModuleClass := TdmEmploy;end./共享池的声明单元主要描述如何提供一个多客户的访问数据提供unit DMPooler;interfaceuses SysUtils, Classes, Forms, SyncObjs, Wi

21、ndows;type/本单元用于为每个客户提供一个独立使用的DataModule对象，相当于我们在以前的CORBA DataModule中选择创建的多线程对象一样的功能 TDataModuleClass = class of TDataModule; /定义类 TPooledModule = record/声明记录类型 Module: TDataModule; /继承标准的TdataModule InUse: Boolean; /标明上面继承的TdataModule是否在使用 end; TModulePooler = class private FCSect: TCriticalSection

22、; /允许线程自己改变FModules FModuleClass: TDataModuleClass; /在共享池中类化TDataModuleFModules: array of TPooledModule; /定义一个动态的对象记录数组FSemaphore: THandle; /限定同时使用的用户规则 public property ModuleClass: TDataModuleClass read FModuleClass write FModuleClass; constructor Create; destructor Destroy; override;function GetMo

23、dule: TDataModule; procedure FreeModule(DataModule: TDataModule); end;const PoolSize = 5; var ModulePooler: TModulePooler = nil;implementationuses Dialogs; TModulePool constructor TModulePooler.Create;begin IsMultiThread := True; FCSect := TCriticalSection.Create; FSemaphore := CreateSemaphore(nil,

24、PoolSize, PoolSize, nil);end;destructor TModulePooler.Destroy;begin FCSect.Free; CloseHandle(FSemaphore);end;procedure TModulePooler.FreeModule(DataModule: TDataModule);var I: Integer;begin FCSect.Enter; try for I := 0 to Length(FModules) - 1 do if FModulesI.Module = DataModule then FModulesI.InUse

25、:= False; ReleaseSemaphore(FSemaphore, 1, nil); finally FCSect.Leave; end;end;function TModulePooler.GetModule: TDataModule;var I: Integer;begin Result := nil; if WaitForSingleObject(FSemaphore, 5000) = WAIT_TIMEOUT then raise Exception.Create(Server too busy); FCSect.Enter; try if Length(FModules)

26、= 0 then begin SetLength(FModules, PoolSize); for I := 0 to PoolSize - 1 do begin FModulesI.InUse := False; FModulesI.Module := FModuleClass.Create(Application); end; end; for I := 0 to Length(FModules) - 1 do if not FModulesI.InUse then begin FModulesI.InUse := True; Result := FModulesI.Module; Bre

27、ak; end; finally FCSect.Leave; end; /检查曾经是否连接 if not Assigned(Result) then raise Exception.Create(Pool is out of capacity);end;initialization ModulePooler := TModulePooler.Create;finalization ModulePooler.Free;end./本单元是一个通用的方法单元，当然您也可以采用其他的方法来完成这样的一个功能/DataModule单元unit dmEmployee;interfaceuses Windo

28、ws, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Db, DBTables, Provider;type TdmEmploy = class(TDataModule) Session1: TSession; EmployeeDatabase: TDatabase; qryEmployee: TQuery; proEmployee: TDataSetProvider; private Private declarations public Public declarations end;var dmEmplo

29、y: TdmEmploy;implementation$R *.DFMend./服务器的主单元unit ServerMain;interfaceuses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Grids, DBGrids, Db, DBTables, StdCtrls, Corba, Employee_I, Employee_C, Employee_S, Employee_Impl；type TForm1 = class(TForm) Label1: TLabel; procedure

30、 FormCreate(Sender: TObject); private Private declarations procedure CorbaInit; public Public declarations hitcount : integer; end;var Form1: TForm1; myDBServer : Employee;implementation$R *.DFMprocedure TForm1.CorbaInit;begin CorbaInitialize; myDBServer := TEmployeeSkeleton.Create(myServer, TEmployee.Create); Boa.ObjIsReady( myDBServer as _Object );end;procedure TForm1.FormCreate(Sen