基于 midas 的三层开发

最新推荐文章于 2026-03-03 02:09:45 发布

转载最新推荐文章于 2026-03-03 02:09:45 发布 · 798 阅读

收录于

DELPHI编程

本文介绍了一种使用DCOM进行三层开发的具体实现方法。首先创建服务器端应用程序，并定义了获取数据库表名的功能。接着创建客户端应用程序，通过DCOM连接到服务器端并获取表名列表。整个过程简单高效。

本程序仅仅是一个 midas 程序的演示，真正要完成一些功能，还得花力气写较多的代码

一、创建服务器
新建一个 Application，然后添加 RemoteDataModule，在RemoteDataModule 中放置 Database，Query，Session，DataSetProvider 控件各一个。
代码如下：

unit RemoteServer;
{$WARN SYMBOL_PLATFORM OFF}
interface
uses
Windows, Messages, SysUtils, Classes, ComServ, ComObj, VCLCom, DataBkr,
DBClient, Server_TLB, StdVcl, DBTables, DB, Variants, Provider;
type
TServerModule = class(TRemoteDataModule, IServerModule)
    Session1: TSession;
    Database1: TDatabase;
    Query1: TQuery;
    Provide: TDataSetProvider;
    procedure RemoteDataModuleCreate(Sender: TObject);
private
    { Private declarations }
protected
    class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID:
      string); override;
    function GetTableNames: OleVariant; safecall;
public
    { Public declarations }
end;
var
ServerModule      : TServerModule;
implementation
{$R *.DFM}
function TServerModule.GetTableNames: OleVariant;
var
I                 : Integer;
TableNames        : TStrings;
begin
TableNames := TStringList.Create;
try
    Session1.GetTableNames(Database1.DatabaseName, '*.*', True,
      False, TableNames);
    result := VarArrayCreate([0, TableNames.Count - 1],
      varOleStr);
    for I := 0 to TableNames.Count - 1 do
      result[I] := TableNames[I];
finally
    TableNames.Free;
end;
end;
class procedure TServerModule.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;
procedure TServerModule.RemoteDataModuleCreate(Sender: TObject);
begin
end;
initialization
TComponentFactory.Create(ComServer, TServerModule,
    Class_ServerModule, ciMultiInstance, tmApartment);
end.
然后保存，编译服务器程序
二、创建客户端
新建一个Application，然后添加 DComConnection，ClientDataSet，DateSource，ListBox，DBGrid，Memo，Button 各一个。用 DComConnection 可以自动连上远程服务器程序，然后控件之间进行关联
代码如下：
unit frmMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DB, StdCtrls, DBClient, MConnect, Grids, DBGrids, ComCtrls;
type
TForm1 = class(TForm)
    DCOMConnection1: TDCOMConnection;
    ClientDataSet1: TClientDataSet;
    ListBox1: TListBox;
    DataSource1: TDataSource;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    DBGrid1: TDBGrid;
    Memo1: TMemo;
    GroupBox1: TGroupBox;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
private
    { Private declarations }
public
    { Public declarations }
end;
var
Form1             : TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var
I                 : Integer;
TableNames        : OleVariant;
begin
DCOMConnection1.Connected := True;
TableNames := DCOMConnection1.AppServer.GetTableNames;
if VarIsArray(TableNames) then
    for I := 0 to VarArrayHighBound(TableNames, 1) do
      ListBox1.Items.Add(TableNames[I]);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ClientDataSet1.Close;
ClientDataSet1.CommandText := Memo1.Lines.Text;
ClientDataSet1.Open;
end;
procedure TForm1.ListBox1Click(Sender: TObject);
begin
end;
end.