请问各位:
我的多层分布式数据库在运行时出现异常:'project project1.exe raised exception class EOleError with message 'Method "getdatabasenames" not supported by automation object',其中getdatabasenames是我添加的一个函数用来得到所有数据库名,不知道这个异常该怎么解决?代码如下:以下是服务器程序:
unit server;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;type
TForm1 = class(TForm)
Panel1: TPanel;
Label1: TLabel;
clientcout: TLabel;
Label3: TLabel;
querycount: TLabel;
private
clientcounts:integer;
querycounts:integer;
{ Private declarations }
public
procedure updateclientcounts(incr:integer);//统计客户个数
procedure updatequerycounts;//统计查询次数
{ Public declarations }
end;var
Form1: TForm1;implementation{$R *.dfm}procedure Tform1.updateclientcounts(incr:integer);
begin
clientcounts:=clientcounts+incr;
form1.clientcout.Caption:=inttostr(clientcounts);//clientcout是一个LABLE控件,用于显示客户个数
end;procedure Tform1.updatequerycounts;
begin
inc(querycounts);
form1.querycount.Caption:=inttostr(querycounts);//querycount是一个LABLE控件,用于显示查询次数
end;
end.以下是远程数据模块的程序:
unit module;{$WARN SYMBOL_PLATFORM OFF}interfaceuses
Windows, Messages, SysUtils, Classes, ComServ, ComObj, VCLCom, DataBkr,
DBClient, Project1_TLB, StdVcl, Provider, DBTables, DB, variants, server;//server是服务器程序type
Trdm1 = class(TRemoteDataModule, Irdm1)
Query1: TQuery;
Database1: TDatabase;
Session1: TSession;
DataSetProvider1: TDataSetProvider;
procedure RemoteDataModuleCreate(Sender: TObject);
procedure RemoteDataModuleDestroy(Sender: TObject);
procedure Query1AfterOpen(DataSet: TDataSet);
private
{ Private declarations }
protected
function getdatabasenames:olevariant;//添加了一个得到所有数据库名的函数
procedure setdatabasenames(const dbname,password:widestring);//添加了一个设置数据库名的过程
class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); override;
public
{ Public declarations }
end;implementation{$R *.DFM}class procedure Trdm1.UpdateRegistry(Register: Boolean; const ClassID, ProgID: string);
begin
if Register then
begin
inherited UpdateRegistry(Register, ClassID, ProgID);
EnableSocketTransport(ClassID);
EnableWebTransport(ClassID);
end else
begin
DisableSocketTransport(ClassID);
DisableWebTransport(ClassID);
inherited UpdateRegistry(Register, ClassID, ProgID);
end;
end;function Trdm1.getdatabasenames:olevariant;
var
dbname:Tstringlist;
i:integer;
begin
dbname:=Tstringlist.Create;
try
session1.GetDatabaseNames(dbname); //得到可用数据库名
result:=vararraycreate([0,dbname.Count-1],varolestr);
for i:=0 to dbname.Count-1 do
result[i]:=dbname[i];
finally
dbname.Free;//释放临时占有的空间
end;
end;procedure Trdm1.setdatabasenames(const dbname,password:widestring);
begin
try
database1.Close;
database1.AliasName:=dbname;
if password<>'' then
database1.Params.values['password']:=password;
database1.Open;
except
on e:edbengineerror do
if password='' then
raise exception.Create('password required')
else
raise;
end;
end;procedure Trdm1.RemoteDataModuleCreate(Sender: TObject);//更新客户数
begin
form1.updateclientcounts(1);
end;procedure Trdm1.RemoteDataModuleDestroy(Sender: TObject);/更新客户数/
begin
form1.updateclientcounts(-1);
end;procedure Trdm1.Query1AfterOpen(DataSet: TDataSet);//更新查询数
begin
form1.updatequerycounts;
end;initialization
TComponentFactory.Create(ComServer, Trdm1,
Class_rdm1, ciMultiInstance, tmApartment);
end.输入完后运行了程序.
以下是客户端程序:unit client1;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, DB, DBClient, MConnect, Grids, DBGrids, module;//module是远程数据模块type
TForm3 = class(TForm)
DBGrid1: TDBGrid;
DCOMConnection1: TDCOMConnection;
ClientDataSet1: TClientDataSet;
DataSource1: TDataSource;
Memo1: TMemo;
Label1: TLabel;
ComboBox1: TComboBox;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure ComboBox1Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;var
Form3: TForm3;implementation{$R *.dfm}procedure TForm3.FormCreate(Sender: TObject);
var
dbname:olevariant;
i:integer;
begin
dcomconnection1.Connected:=true;//连接到服务器
dbname:=dcomconnection1.AppServer.getdatabasenames;//得到可用的数据库的名称列表
if varisarray(dbname) then
for i:=0 to vararrayhighbound(dbname,1) do
combobox1.Items.Add(dbname[i]);//将得到的数据库的名称列表存储到combobox1控件中
end;procedure TForm3.ComboBox1Click(Sender: TObject);
var
password:string;
begin //为服务器设置要使用的数据库名
if combobox1.Text<>'' then
begin
clientdataset1.Close;
try
dcomconnection1.AppServer.setdatabasenames(combobox1.Text,'');
except
on e:exception do
if e.Message='password required' then
begin
if inputquery(e.Message,'enter password',password) then
dcomconnection1.AppServer.setdatabasenames(combobox1.Text,password);
end
else
raise;
end;
end;
end;procedure TForm3.Button1Click(Sender: TObject);
begin
clientdataset1.Close;
clientdataset1.CommandText:=memo1.Text;//memo1控件用于输入SQL语句
clientdataset1.Open;
end;end.
我的多层分布式数据库在运行时出现异常:'project project1.exe raised exception class EOleError with message 'Method "getdatabasenames" not supported by automation object',其中getdatabasenames是我添加的一个函数用来得到所有数据库名,不知道这个异常该怎么解决?代码如下:以下是服务器程序:
unit server;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;type
TForm1 = class(TForm)
Panel1: TPanel;
Label1: TLabel;
clientcout: TLabel;
Label3: TLabel;
querycount: TLabel;
private
clientcounts:integer;
querycounts:integer;
{ Private declarations }
public
procedure updateclientcounts(incr:integer);//统计客户个数
procedure updatequerycounts;//统计查询次数
{ Public declarations }
end;var
Form1: TForm1;implementation{$R *.dfm}procedure Tform1.updateclientcounts(incr:integer);
begin
clientcounts:=clientcounts+incr;
form1.clientcout.Caption:=inttostr(clientcounts);//clientcout是一个LABLE控件,用于显示客户个数
end;procedure Tform1.updatequerycounts;
begin
inc(querycounts);
form1.querycount.Caption:=inttostr(querycounts);//querycount是一个LABLE控件,用于显示查询次数
end;
end.以下是远程数据模块的程序:
unit module;{$WARN SYMBOL_PLATFORM OFF}interfaceuses
Windows, Messages, SysUtils, Classes, ComServ, ComObj, VCLCom, DataBkr,
DBClient, Project1_TLB, StdVcl, Provider, DBTables, DB, variants, server;//server是服务器程序type
Trdm1 = class(TRemoteDataModule, Irdm1)
Query1: TQuery;
Database1: TDatabase;
Session1: TSession;
DataSetProvider1: TDataSetProvider;
procedure RemoteDataModuleCreate(Sender: TObject);
procedure RemoteDataModuleDestroy(Sender: TObject);
procedure Query1AfterOpen(DataSet: TDataSet);
private
{ Private declarations }
protected
function getdatabasenames:olevariant;//添加了一个得到所有数据库名的函数
procedure setdatabasenames(const dbname,password:widestring);//添加了一个设置数据库名的过程
class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); override;
public
{ Public declarations }
end;implementation{$R *.DFM}class procedure Trdm1.UpdateRegistry(Register: Boolean; const ClassID, ProgID: string);
begin
if Register then
begin
inherited UpdateRegistry(Register, ClassID, ProgID);
EnableSocketTransport(ClassID);
EnableWebTransport(ClassID);
end else
begin
DisableSocketTransport(ClassID);
DisableWebTransport(ClassID);
inherited UpdateRegistry(Register, ClassID, ProgID);
end;
end;function Trdm1.getdatabasenames:olevariant;
var
dbname:Tstringlist;
i:integer;
begin
dbname:=Tstringlist.Create;
try
session1.GetDatabaseNames(dbname); //得到可用数据库名
result:=vararraycreate([0,dbname.Count-1],varolestr);
for i:=0 to dbname.Count-1 do
result[i]:=dbname[i];
finally
dbname.Free;//释放临时占有的空间
end;
end;procedure Trdm1.setdatabasenames(const dbname,password:widestring);
begin
try
database1.Close;
database1.AliasName:=dbname;
if password<>'' then
database1.Params.values['password']:=password;
database1.Open;
except
on e:edbengineerror do
if password='' then
raise exception.Create('password required')
else
raise;
end;
end;procedure Trdm1.RemoteDataModuleCreate(Sender: TObject);//更新客户数
begin
form1.updateclientcounts(1);
end;procedure Trdm1.RemoteDataModuleDestroy(Sender: TObject);/更新客户数/
begin
form1.updateclientcounts(-1);
end;procedure Trdm1.Query1AfterOpen(DataSet: TDataSet);//更新查询数
begin
form1.updatequerycounts;
end;initialization
TComponentFactory.Create(ComServer, Trdm1,
Class_rdm1, ciMultiInstance, tmApartment);
end.输入完后运行了程序.
以下是客户端程序:unit client1;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, DB, DBClient, MConnect, Grids, DBGrids, module;//module是远程数据模块type
TForm3 = class(TForm)
DBGrid1: TDBGrid;
DCOMConnection1: TDCOMConnection;
ClientDataSet1: TClientDataSet;
DataSource1: TDataSource;
Memo1: TMemo;
Label1: TLabel;
ComboBox1: TComboBox;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure ComboBox1Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;var
Form3: TForm3;implementation{$R *.dfm}procedure TForm3.FormCreate(Sender: TObject);
var
dbname:olevariant;
i:integer;
begin
dcomconnection1.Connected:=true;//连接到服务器
dbname:=dcomconnection1.AppServer.getdatabasenames;//得到可用的数据库的名称列表
if varisarray(dbname) then
for i:=0 to vararrayhighbound(dbname,1) do
combobox1.Items.Add(dbname[i]);//将得到的数据库的名称列表存储到combobox1控件中
end;procedure TForm3.ComboBox1Click(Sender: TObject);
var
password:string;
begin //为服务器设置要使用的数据库名
if combobox1.Text<>'' then
begin
clientdataset1.Close;
try
dcomconnection1.AppServer.setdatabasenames(combobox1.Text,'');
except
on e:exception do
if e.Message='password required' then
begin
if inputquery(e.Message,'enter password',password) then
dcomconnection1.AppServer.setdatabasenames(combobox1.Text,password);
end
else
raise;
end;
end;
end;procedure TForm3.Button1Click(Sender: TObject);
begin
clientdataset1.Close;
clientdataset1.CommandText:=memo1.Text;//memo1控件用于输入SQL语句
clientdataset1.Open;
end;end.
在远程数据模块的EDIT-》Add to Interface 中定义啊