用 BPL 封装数据连接

BPL 代码：

uDM.pas

unit uDM;

interface

uses
SysUtils, Classes, uIntf, DB, ABSMain;

type
TDM = class(TDataModule, IDMSearch)
    DS: TDataSource;
    DB: TABSDatabase;
    Qry: TABSQuery;
    procedure DataModuleCreate(Sender: TObject);
    procedure DataModuleDestroy(Sender: TObject);
private
    { Private declarations }
public
    function Search(ACode: integer): TDataSource;
end;

var
DM: TDM;

implementation

{$R *.dfm}

procedure TDM.DataModuleCreate(Sender: TObject);
begin
SetCurrentDir(ExtractFilePath(ParamStr(0)));
DB.DatabaseFileName := ExtractFilePath(ParamStr(0)) + 'Demo.ABS';
DB.Open;
end;

procedure TDM.DataModuleDestroy(Sender: TObject);
begin
DB.Close;
end;

function TDM.Search(ACode: integer): TDataSource;
begin
with Qry do
begin
    Close;
    if ACode = -1 then
      SQL.Text := 'select * from [DemoTable]'
    else
      SQL.Text := Format('select * from [DemoTable] where [Code]=%d', [ACode]);
    Open;
    Result := DS;
end;
end;

initialization
RegisterClass(TDM);

finalization
UnRegisterClass(TDM);

end.

uDM.dfm

object DM: TDM
OldCreateOrder = False
OnCreate = DataModuleCreate
OnDestroy = DataModuleDestroy
Height = 175
Width = 215
object DS: TDataSource
    DataSet = Qry
    Left = 16
    Top = 112
end
object DB: TABSDatabase
    CurrentVersion = '5.11 '
    DatabaseName = 'Demo'
    Exclusive = False
    MaxConnections = 500
    MultiUser = False
    SessionName = 'Default'
    Left = 16
    Top = 8
end
object Qry: TABSQuery
    CurrentVersion = '5.11 '
    DatabaseName = 'Demo'
    InMemory = False
    ReadOnly = False
    Left = 16
    Top = 64
end
end

DBM.dpk

package DBM;

{$R *.res}
{$ALIGN 8}
{$ASSERTIONS ON}
{$BOOLEVAL OFF}
{$DEBUGINFO ON}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS ON}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION ON}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO ON}
{$SAFEDIVIDE OFF}
{$STACKFRAMES OFF}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$IMPLICITBUILD ON}

requires
rtl,
vcl,
dbrtl,
dclAbsDBd10;

contains
uDM in 'uDM.pas' {DM: TDataModule},
untIntf in '..\intf\uIntf.pas';

end.

EXE 代码：

uMain.pas

unit uMain;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,untIntf, StdCtrls, ExtCtrls, Grids, DBGrids, DB;

type
TFormMain = class(TForm)
    DBGrid1: TDBGrid;
    Panel1: TPanel;
    LabeledEdit1: TLabeledEdit;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Button1Click(Sender: TObject);
private
    { Private declarations }
public
    bplHandle: Cardinal;
    DM: IDMSearch;
end;

var
FormMain: TFormMain;

implementation

{$R *.dfm}

procedure TFormMain.Button1Click(Sender: TObject);
var
ds: TDataSource;
begin
ds:=DM.Search(StrToIntDef(LabeledEdit1.Text, -1));
DBGrid1.DataSource := ds;
end;

procedure TFormMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
DM := nil;
// UnloadPackage(bplHandle);
end;

procedure TFormMain.FormCreate(Sender: TObject);
var
c: TClass;
begin
SetCurrentDir(ExtractFilePath(ParamStr(0)));
bplHandle := LoadPackage('DBM.bpl');
c:= GetClass('TDM');
if c <> nil then
    DM := TComponentClass(c).Create(Application) as IDMSearch;
end;

end.

uMain.dfm

object FormMain: TFormMain
Left = 0
Top = 0
Caption = 'FormMain'
ClientHeight = 237
ClientWidth = 246
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnCloseQuery = FormCloseQuery
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object DBGrid1: TDBGrid
    Left = 0
    Top = 0
    Width = 246
    Height = 184
    Align = alClient
    TabOrder = 0
    TitleFont.Charset = DEFAULT_CHARSET
    TitleFont.Color = clWindowText
    TitleFont.Height = -11
    TitleFont.Name = 'Tahoma'
    TitleFont.Style = []
end
object Panel1: TPanel
    Left = 0
    Top = 184
    Width = 246
    Height = 53
    Align = alBottom
    BevelInner = bvRaised
    BevelOuter = bvLowered
    TabOrder = 1
    object LabeledEdit1: TLabeledEdit
      Left = 8
      Top = 20
      Width = 146
      Height = 21
      EditLabel.Width = 25
      EditLabel.Height = 13
      EditLabel.Caption = 'Code'
      TabOrder = 0
    end
    object Button1: TButton
      Left = 160
      Top = 16
      Width = 75
      Height = 25
      Caption = #26597#35810
      TabOrder = 1
      OnClick = Button1Click
    end
end
end

Project1.dpr

program Project1;

uses
Forms,
frmMain in 'uMain.pas' {FormMain},
uIntf in '..\intf\uIntf.pas';

{$R *.res}

begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TFormMain, FormMain);
Application.Run;
end.

通用接口单元代码：

uIntf.pas

unit uIntf;

interface

uses
Classes, SysUtils, DB;

type
IDMSearch = interface
['{494B4378-A373-4BAD-95D6-49CC12F76ADF}']
function Search(ACode: Integer): TDataSource;
end;

implementation

end.