• 用 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 '..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.

  • 相关阅读:
    css3样式二
    CSS3样式
    css基础样式四
    css样式基础三
    CSS样式基础二
    Css样式基础
    html(二)
    html(一)
    Linux 下 Memcached 缓存服务器安装配置
    java.lang.OutOfMemoryError: Java heap space解决方法
  • 原文地址:https://www.cnblogs.com/xieyunc/p/9126557.html
Copyright © 2020-2023  润新知