delphi7中corba的开发方法和delphi6不太一样，不再使用Type Library,和com的开放不同
1、先写一个MyORB.IDL文件
interface myOrb{
float aa();
};
2、New -> others -> Corba -> Corba Server Application
3、选择Console Application 或者 Windows Application 无线按钮之一
4、单击add按钮，选择你刚才写的XXX.IDL
5、单击Generate按钮,将产生如下文件：
MyORB_s.pas：（XXX_S）创建服务器主干单元{Server skeleton unit}
MyORB_i.pas：(XXX_I) 创建Pascal接口单元
MyORB_impl：（XXX_impl）创建服务器执行单元申明
MyORB_c.pas
XXX_C) 创建客户段的骨架单元{Client stub unit}
6、完成XXX_impl.pas文件，即完成在XXX.IDL文件中定义的功能函数
7、后面的太多，不再写了，给你一篇文章看看：
关于VisiBroker For Delphi的使用（1）
[02-3-8 14:42] 作者：赵普昉/中国软件
宜昌市中心人民医院 赵普昉 email: 3boy@sohu.com
一、如何创建服务器对象
在Delphi中使用了IDL2PAS向导,改变了原有的创建CORBA应用服务器的方式,不能再用Typelibrary编写接口申明，而现在我们只有通过手工编写接口来创建CORBA对象，而我们创建的CORBA不用再分发DLL形式的CORBA支持这样一来简化了我们发布CORBA的过程。
下面我们简要的来看一下如何使用IDL2PAS向导以及创建一个简单的CORBA程序
1、如果你的程序含有TdataMoudle对象,那么你可以像在开发C/S模式中一样放上自己将要使用的数据组件,当然还有数据提供者组件。注意multi_layer可不是C/S,你的用于客户端调用的应用服务器处理可不能在这个DataMoudle中申明，不过在这里你可以编写服务器自己处理的代码，而后声明你的接口方法,当然这个接口声明要写在IDL文件中,例如
文件名称：CRB.IDL
module Crb{
interface CrbDBServer{
void GetData();
};
};
上面这个申明的接口中的方法是一个无类型的方法，那么接下来就要将IDL文件转化为PAS文件了,如果你已经创建了项目,那么，你可以在Delphi6.0的菜单栏中选择Regenerate IDL file(即再次转化IDL文件),如果你还没有，请到FILE->Other中，选到CORBA页（注意：不要选择mutiler的CORBA对象），点击CORBA Server Appliction ,然后会出现一个对话框，会提示你是要创建控制台程序还是要创建窗口应用程序，并要你加入你的接口声明文件，我将CRB.IDL加入进去,会由向导创建4个基本文件，分别会以CRB为前缀创建CRB_s.pas,CRB_i.pas,CRB_impl,CRB_C文件，这些文件分别代表的意义是：
CRB_s.pas：（XXX_S）创建服务器主干单元{Server skeleton unit}
CRB_i.pas：(XXX_I) 创建Pascal接口单元
CRB_impl：（XXX_impl）创建服务器执行单元申明
CRB_c.pas
XXX_C) 创建客户段的骨架单元{Client stub unit}
其中_s,_c,_I我们都可以暂时不去看它,_impl就是我们要添加代码的地方这个单元是这样写的
TCRBDBServer = class;
TCRBDBServer = class(TInterfacedObject, CRB_i.CRBDBServer)
protected
{******************************}
{*** 在这儿加入用户自定义变量 ***}
{******************************}
public
constructor Create;
procedure GetData ;
end;
implementation
constructor TCRBDBServer.Create;
begin
inherited;
{ *************************** }
{ *** 在这儿加入初始化代码*** }
{ *************************** }
end;
procedure TCRBDBServer.GetData ;
begin
{ *************************** }
{ *** 在这儿加入过程处理代码 *** }
{ *************************** }
end;
initialization
end.
然后，在你的主控单元中写下如下代码：
1）、uses中添加CRB_c, CRB_i, CRB_impl, CRB_s；
2）、protected
//添加自定义变量
Crb_Server:CRBDBServer;
为客户段创建一个实例
3）、在procedure InitCorba;过程中填写
Crb_Server:=TCRBDBServerSkeleton.Create('Crb服务器',TCRBDBServer.Create);
BOA.ObjIsReady(Crb_Server as _Object);
好你可以激活smart agent运行一下，这样一个简单的服务器端初步完成了。虽然它什么也不干,但是却是一个CRB服务器。下一节，我们将继续讨论，如何创建一个更复杂的CRB服务器。
二、一个真实的CORBA小服务程序
我们都知道无论是Ejb,Com/Dcom/MTS/Com+,还是Midas/Corba这样一些三层体系，最重要的架构中介体系，对于理论上的东西，较为抽象没有必要在这里谈这样一些高深的理论，这些还是留给大师去述说吧，我们只需要理解大师们交给我们的工具就可以了，我们可以叫这些中介集群为中介对象群，实际上就是把我们在C/S中的公共部分或人机交互程序分为了，人与程序，程序与数据库之间的交互，这样做的目的大师们说的非常好了。经过程序系统架构师的设计，我们可以清晰的看到我们的中介对象，也就是那些以不同形式放在，应用服务器上的对象。客户程序可以完全不去理会后台过多的执行明细，服务程序不用过多的被客户程序所牵制，一切都由Interface来发布所有的衔接规则。那么剩下来的问题就非常简单了，那就是有什么样的接口，接口可以独立于客户与服务器而独立编写，这就是我们的Corba for Delphi6中强调的东西。
在我们申明接口之前我首先简要的叙述一下IDL2PAS的一些相关保留字和操作符
AND ARRAY AS ASM
begin
CASE CLASS CONST
CONSTRUCTOR DESTORY DISPINTERFACE
DIVdo
do
WNTO else
END EXCEPT EXPORTS FILE
FINALIZATION FINALLY FOR FUNCTION
GOTO IF IMPLEMENTATION IN
INHERITED INITIALIZATION INLINE INTERFACE
IS LABEL LIBARAY MOD
NIL NOT OBJECT OF
OR PACKED PROCEDURE PROGRAM
PROPERTY RAISE RECORD REPEAT RESOURCESTRING
SET SHL SHR STRING then
THREADVAR
TO TRY TYPE UNIT UNTIL USER VAR
WHILE WITH XOR
沿用的Pascal保留字
Boolean Char WideChar Shortint Smallint Integer Byte
Word Extended Pointer AnsiChar Longint Cardinal Single
Double Real Real48 Comp Currency ShortString Openstring file
Text TextFile PAnsiChar PChar PWideChar ByteBool Wordbool
LongBool AnsiString WideString TVarArrayBound PVarArray TVarData PVarData TVarArray
PShortString PAnsiString PWideString PString Pextended
PCurrency TDateTime PVarRec String Variant TObject Tclass Iunknown
TinterfaceObject TGUID PGUID Int64 Application Screen Print Printer
（将与PASCAL做一个比较,注意大小写）
数据基本类型
IDL 类型 Pascal 类型
boolean Boolean
char Char
wchar WideChar
octet Byte
string AnsiString
wstring WideString
short SmallInt
unsigned short Word
long Integer
unsigned long Cardinal
long long Int64
unsigned long long Int64
float Single
doubledo
uble
longdo
uble Extended
fixed {没有对应类型}
以上的保留字和操作符会在我的文章中足一介绍，这里就不具体描述了。
我们开始编一个小程序来说明一下
照样先申明一个接口描述：
表示我要传递一个任意类型信息
module Crb{
interface TestAny{
any getany()；//注意大小写
}；
} ；
现在按照我们上一届讲的生成框架代码，接下来我们在Crb_impl中加入
Result := StrToInt(Form1.Edit1.Text);
加在那儿呢加在Getany方法中哪,如下
function TTestAny.GetAny : ANY;
begin
Result := StrToInt(Form1.Edit1.Text);
end;
这个接口的意义是将我们的服务程序的主窗体上的Edit1上的字符串返回给接口，以便于客户程序从接口获得该字符数据。
当然必须在我们的主窗体上作如下声明
unit ServerMain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Corba,CRB_I, CRB_C, CRB_S, CRB_Impl, StdCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
Edit1: TEdit;
procedure FormCreate(Sender: TObject);
private
{ private declarations }
protected
MyAnyTest :TTestAny;
// 主干对象
procedure InitCorba;
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.InitCorba;
begin
CorbaInitialize;
//加入CRB服务代码
MyAnyTest := TTestAnySkeleton.Create('Any Test Server', TMyTest.Create);
BOA.ObjIsReady(MyAnyTest as _Object);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
InitCorba;
end;
end.
接下来我们的客户程序如何获得这个字符串呢？
那么我们只需要在客户程序中去引用这个接口方法就够了，代码如下
unit ClientMain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Corba, CRB_I, CRB_C;
type
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
FromIStr :TTestAny;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
CorbaInitialize;
FromIStr:= TTestAnyHelper.bind;//创建一个接口的实例
end;
procedure TForm1.Button1Click(Sender: TObject);
var myAny : Any;
begin
myAny := FromIStr.GetAny();//引用接口实例的方法
Label1.Caption := IntToStr(myany);
//将方法的结果转化为字符串，付给Label1.Caption
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FromIStr:= nil;
//释放接口实例对象
end;
end.
三、数组对象与简单数据对象的传递
前面提到了一些较为简单的数据操作，我们都可以想象一下，如果操作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 UnboundeSeq;
typedef sequence 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 2do
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 2do
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) - 1do
if FModules
.Module = DataModule then
FModules.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 - 1do
begin
FModules.InUse := False;
FModules.Module := FModuleClass.Create(Application);
end;
end;
for I := 0 to Length(FModules) - 1do
if not FModules.InUse then
begin
FModules.InUse := True;
Result := FModules.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等等最终都是殊途同归”
