《关于VisiBroker For Delphi的使用》(3)

-CORBA技术实践（一）

宜昌市中心人民医院            赵普昉

email: 3boy@sohu.com

3,数组对象与简单数据对象的传递

前面提到了一些较为简单的数据操作，我们都可以想象一下，如果操作CORBA对象与操作C/S结构的数据对象一样的方便，那么CORBA又有什么神奇了，不知道看过李维的分布式多层应用系统的书籍时，是否留意到李维对CORBA的评价，无论你看过

还是没有看过，我都要告诉正在使用CORBA编程的朋友们，CORBA比COM/COM+简单，而CORBA的跨平台特性，以及与COM/COM+同样的负载平衡能力，足以让我们将这项分布式技术应用到应用体系的设计之中，其实对于使用Borland的产品开发分布式系统无论你采用CORBA或是COM/COM+其实最核心的技术就是MIDAS，因为

你总可以在CORBA/COM/COM+中看到MIDAS的影子，所以我建议无论你是准备学习CORBA还是学习COM/COM+最好先学习一下MIDAS,本文不涉及MIDAS，关于MIDAS请看李维的《Delphi5.X分布式多层应用—系统篇》。

为什么我从开始就一直要大家使用文本编辑器之类的东西书写IDL，而不用TypeLibrary

来书写IDL,其实我觉得只是为了让刚刚接触CORBA的程序员获得一些更多的IDL方面的知识罢了，在实际的开发中你可以完全很方便的使用TypeLibrary来编写接口规则。

下面我简要的列举几类IDL书写的事例与利用IDL2PAS生成的PASCAL代码。

1、）常量的定义

/**IDL书写**/

module MyCRB{

 const long iMyConst=1;

 interface myFace {

 const long iiMyConst=2;

};

};

/**Pascal**/

unit MyCRB_I;

interface

uses Corba;

const

 iMyCOnst:integer=1;

 myFace_iiMyConst=2;

2、)不在接口中申明的常量

/**IDL**/

module MyCRB{

 const long  myconst=1;

};

/*pascal*/

unit MyCRB_I;

interface

const myconst:integer=1;

3、)枚举类型

/*IDL*/

enum MyCRBKind{A,B,C,D,……..}

/*pascal*/

myCRBkind=(A,B,C,D……..);

4、）结构体

/*IDL*/

struct mystructtype{

  long X;

string Y;

boolean Z;

};

/*pascal*/

//XXX_I.pas

type  mystructtype=interface;

//XXX_C.pas

mystructtype=interface

function  _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 write _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 <long> UnboundeSeq;

typedef sequence <long,42> ShortBoundSeq

7, 数组

 const long ArrayBound=10;

typedef long longArray[ArrayBound];

8, 抽象接口

module exp{

 interface myface{

long op(in string s);

};

};

9,多重继承

  module M{

interface A{

 void A1();

 void A2();

 };

interface B{

 void B1();

 void B2();

};

interface AB:B,A{

void AB1()

void AB2();

};

};

10,交叉模型定义

module m1{

interface if1;

module m2{

 interface if2{

m1::if1 getIf1();

};

interface if1{

m2::if2 getif2()

};

};

};

以上我介绍了一些数据的定义规范,然而我们需要不仅仅是这样的一些比较抽象的接口定义法则,我们要将法则应用到实际的开发中去,那么我们又是如何运用这些法则了,对于接口描述语言的翻译我前面讲到直接使用IDL2PAS就不讲了,以后的章节中也不会在去将如何转换的问题。下面我们实践一下：

编写接口定义一个返回为浮点类型，输入为短整型变量数组对象的方法

typedef  short   ArrayType[3];

//自定义类型定义长度为3的数组

interface Account {

       float InputArray(in ArrayType myArray);//输入为整形数组，返回类型为float的方法

};

//服务端程序的处理xxx_impl.pas

interface

uses

  SysUtils,

  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;

implementation

uses ServerMain;

constructor TAccount.Create;

begin

  inherited;

end;

function  TAccount. InputArray (const myArray : account_i.ArrayType): Single;

var

  j: Integer;

begin

// account_i.ArrayType是指我们自定义的数组类型在account_I单元中

  for j := 0 to 2 do

  begin

Form1.Memo1.Lines.Add('myArray[' + IntToStr(j) + '] = ' + IntToStr(myArray[j]) );

//接受从客户端传递过来的数组变量并将其依次加入到主窗体的MEMO中

  end;

  result := random * 100;//返回一个随机数

end;

initialization

  randomize;

end.

//服务端程序主单元

unit ServerMain;

interface

uses

  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 FormCreate(Sender: TObject);

  private

  { private declarations }

  protected

  { protected declarations }

    Acct : Account; // skeleton 对象

    procedure InitCorba;

  public

  { public declarations }

  end;

var

  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.InitCorba;

begin

  CorbaInitialize;

  // Add CORBA server Code Here

  Acct := 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;

interface

uses

  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

  { protected declarations }

    Acct : Account;

    myArray : ArrayType;

    procedure InitCorba;

  public

  { public declarations }

  end;

var

  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.InitCorba;

begin

  CorbaInitialize;

  Acct := TAccountHelper.bind;

end;

procedure TForm1.FormCreate(Sender: TObject);

var

  j: Integer;

begin

  InitCorba;

  for j := 0 to 2 do

    myArray[j] := (j + 1) * 100;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

  Label1.Caption := FormatFloat('InputArray = $#,##0.00', Acct.inputArray(myArray));

end;

end.

上面的程序实例很简单我就不一一说明了，下面我们来看一个数据访问的实例

//IDL

interface Employee {

  any getEmployeesByName(in string name);

};

接口方法声明单元

//XXX_Impl.pas

interface

uses

  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;

implementation

uses dmEmployee,DMPooler, provider,DSIntf,ServerMain;

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 instance of datamodule from Pool

  try

    DM.qryEmployee.Close;

    DM.qryEmployee.ParamByName('name').AsString:= name + '%';

    //显示连接服务器的数量

    Inc(Form1.HitCount);

    Form1.Label1.Caption := Format('Hit Count = %d', [Form1.HitCount]);

    DM.qryEmployee.Open;

    Result:=DM.proEmployee.GetRecords(-1, RecsOut, 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;

interface

uses SysUtils, Classes, Forms, SyncObjs, Windows;

type

//本单元用于为每个客户提供一个独立使用的DataModule对象，相当于我们在以前的CORBA DataModule中选择创建的多线程对象一样的功能

  TDataModuleClass = class of TDataModule; //定义类

  TPooledModule = record//声明记录类型

    Module: TDataModule; //继承标准的TdataModule

    InUse: Boolean;      //标明上面继承的TdataModule是否在使用

  end;

  TModulePooler = class

  private

    FCSect: TCriticalSection;       //允许线程自己改变FModules

    FModuleClass: TDataModuleClass; //在共享池中类化TDataModule

FModules: array of TPooledModule; //定义一个动态的对象记录数组

FSemaphore: THandle;            //限定同时使用的用户规则

  public                           

    property ModuleClass: TDataModuleClass read FModuleClass write FModuleClass;

    constructor Create;

    destructor Destroy; override;

function GetModule: TDataModule;   

procedure FreeModule(DataModule: TDataModule);

  end;

const

  PoolSize = 5;  

var

  ModulePooler: TModulePooler = nil;

implementation

uses Dialogs;

{ TModulePool }

constructor TModulePooler.Create;

begin

  IsMultiThread := True;

  FCSect := TCriticalSection.Create;

  FSemaphore := CreateSemaphore(nil, 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 FModules[I].Module = DataModule then

        FModules[I].InUse := 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) = 0 then

    begin

      SetLength(FModules, PoolSize);

      for I := 0 to PoolSize - 1 do

        begin

          FModules[I].InUse := False;

          FModules[I].Module := FModuleClass.Create(Application);

        end;

    end;

    for I := 0 to Length(FModules) - 1 do

      if not FModules[I].InUse then

      begin

        FModules[I].InUse := True;

        Result := FModules[I].Module;

        Break;

      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;

interface

uses

  Windows, 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

  dmEmploy: TdmEmploy;

implementation

{$R *.DFM}

end.

//服务器的主单元

unit ServerMain;

interface

uses

  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 FormCreate(Sender: TObject);

  private

    { Private declarations }

    procedure CorbaInit;

  public

    { Public declarations }

    hitcount : integer;

  end;

var

  Form1: TForm1;

 myDBServer :  Employee;

implementation

{$R *.DFM}

procedure TForm1.CorbaInit;

begin

  CorbaInitialize;

  myDBServer := TEmployeeSkeleton.Create('myServer', TEmployee.Create);

  Boa.ObjIsReady( myDBServer as _Object );

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

  CorbaInit;

end;

end.

//客户端程序

interface

uses

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

  StdCtrls, Grids, Corba, Employee_i, Employee_c, Db, DBClient, ExtCtrls,

  DBCtrls, DBGrids;

type

  TForm1 = class(TForm)

    Button1: TButton;

    DBGrid1: TDBGrid;

    cdsEmployee: TClientDataSet;

    DataSource1: TDataSource;

    edtEmployeeName: TEdit;

    Memo1: TMemo;

    Label1: TLabel;

    procedure FormCreate(Sender: TObject);

    procedure Button1Click(Sender: TObject);

     private

    { Private declarations }

    myEmployee : Employee;

  public

    { Public declarations }

  end;

var

  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

begin

  myEmployee := TEmployeeHelper.bind;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

  cdsEmployee.Data := myEmployee.getEmployeesByName(edtEmployeeName.Text);

  cdsEmployee.Open;

end;

end.

我想大家应该可以看得懂上面的程序，如果看不懂也不要紧，下一次我将围绕这个实例展开一系列的问题描述并会同时于COM+/MIDAS进行比较说明，为了让大家留下一个思维的空间我在这里就不多说了。还是那一句话下次再见

我的哲学：“无论是CORBA还是COM+异或是EJB等等最终都是殊途同归”