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 endDBM.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 '..intfuIntf.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 '..intfuIntf.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.