Синхронизация DLL с открытым набором данных. Статьи по Delphi (017)…

Статьи по Delphi (017)…

Синхронизация DLL с открытым набором данных.

Тема: Синхронизация DLL с открытым набором данных В данном совете показано как с помощью Object Pascal динамически, на лету, связать DLL с активной базой данных, таким образом дающей программисту возможность воспользоваться Modularize-характеристикой. (Независимо от текущего режима, будь то разработка приложения, или его выполнение) Технология динамической линковки DLL к EXE полезна во многих случаях. Например, работа с пакетами для создания 'plug-in' модулей (A/R, A/P, General Ledger и др.) или Point of Sale package с Current Stock, FIFO/LIFO Ordering, Vendor Tracking, и пр. модули. Данная статья дает работающий пример того, как это сделать с единственной dll, 'Editdll.dll', и предоставит разработчику материал, расказывающий о том, как организовать в вашем приложении подключаемые модули. Предварительные условия: Хорошее знание работы компонента TTable, умение использовать DLL, BDE API и знание BDE hCursor. *WIN API для динамической загрузки любых DLL. Пример приложения

Приведенная ниже форма, EditForm, работает с таблицей COUNTRY, расположенной в каталоге DBDEMO. При нажатии пользователем кнопки 'Edit' или при двойном щелчке на записи (строке), возникает диалоговое окно, расположенное в 'EditDll.dll' и демонстрирующее специфическую информацию, относящуюся к данной записи. В этой "точке" DLL синхронизирует себя не только с набором данных (и сессией), но и с текущей записью. Это означает, что полозователь изменяет те же самые данные, что он видит в EditForm! Ну а теперь углубимся в код демонстрационного приложения. (Для удобства просто скопируйте отсюда эти файлы и вставьте в ваше приложение).

// Проект главной формы
{ MAINDB.DPR }
program maindb;
uses
  Forms,
  mainform in 'mainform.pas' {DBMainForm};
{$R *.RES}
begin
  Application.Initialize;
  Application.CreateForm(TDBMainForm, DBMainForm);
  Application.Run;
end.
{ MAINFORM.PAS }
unit mainform;
interface
uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls,
  StdCtrls, Forms, DBCtrls, DB, DBGrids, DBTables, Grids, ExtCtrls, BDE;
type
  TDBMainForm = class(TForm)
    Table1Name: TStringField;
    Table1Capital: TStringField;
    Table1Continent: TStringField;
    Table1Area: TFloatField;
    Table1Population: TFloatField;
    DBGrid1: TDBGrid;
    DBNavigator: TDBNavigator;
    Panel1: TPanel;
    DataSource1: TDataSource;
    Panel2: TPanel;
    Table1: TTable;
    EditButton: TButton;
    procedure FormCreate(Sender: TObject);
    procedure EditButtonClick(Sender: TObject);
    procedure DBGrid1DblClick(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;
var
  DBMainForm: TDBMainForm;
implementation
{$R *.DFM}
procedure TDBMainForm.FormCreate(Sender: TObject);
begin
  Table1.Open;
end;
// {ПРИМЕЧАНИЕ: DBHandle - дескриптор базы данных & DSHandle - курсор
//  рассматриваемой записи. Кроме того, если вы имеете цель в
//  динамической загрузке DLL во время выполнения приложения,
//  используйте вызовы API LoadLibrary, GetProcAddress и
//  FreeLibrary вместо подразумевающихся вызовов загрузки при
//  запуске. Пример использования API для динамической загрузки: }
// Type
//  {Для GetProcAddress}
//  BDEDataSync =
//    function(const DBHandle: HDBIDB; const DSHandle: HDBICur): Boolean;
//             stdcall;
//  {Организация перехвата ошибок загрузки DLL}
//  EDLLLoadError = class(Exception);
// var h: hwnd;
//     p: BDEDataSync;
//     LastError: DWord;
// begin
// UpdateCursorPos;
// Try
//   h := loadLibrary('EDITDLL.DLL');
//   {Примечание для пользователей Delphi 1.0: Поскольку Win32
//    LoadLibrary при неудачной загрузке DLL возвращает NULL,
//    поэтому для поиска ошибки необходим вызов GetLastError,
//    Win16 LoadLibrary возвращает значение ошибки (меньше чем
//    HINSTANCE_ERROR), которая для выяснения причин неудачной
//    загрузки может затем провериться с помощью Win16API SDK.}
//   if h = 0 then begin
//      LastError := GetLastError;
//      Raise EDLLLoadError.create(IntToStr(LastError) +
//                                 ': Невозможно загрузить DLL');
//      end;
//   try
//      p := getProcAddress(h, 'EditData');
//      if p(DBHandle, Handle) then Resync([]);
//   finally
//      freeLibrary(h);
//   end;
// Except
//   On E: EDLLLoadError do
//     MessageDLG(E.Message, mtInformation, [mbOk],0);
// end;
// end;
// {или}
function EditData(const DBHandle: HDBIDB; const DSHandle: HDBICur):
  Boolean; stdcall external 'EDITDLL.DLL' name 'EditData';
procedure TDBMainForm.EditButtonClick(Sender: TObject);
begin
  with Table1 do
  begin
    UpdateCursorPos;
    // Вызываем процедуру EditData из EditDll.dll.
    if EditData(DBHandle, Handle) then
      Resync([]);
  end;
end;
procedure TDBMainForm.DBGrid1DblClick(Sender: TObject);
begin
  EditButton.Click;
end;
end.
// Проект EDIT DLL
{ EDITDLL.DPR }
library editdll;
uses
  SysUtils,
  Classes,
  editform in 'editform.pas' {DBEditForm};
exports
  EditData;
begin
end.
{ EDITFORM.PAS }
unit editform;
interface
uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, StdCtrls,
  Forms, DBCtrls, DB, DBTables, Mask, ExtCtrls, BDE;
type
  TTableClone = class;
  TDBEditForm = class(TForm)
    ScrollBox: TScrollBox;
    Label1: TLabel;
    EditName: TDBEdit;
    Label2: TLabel;
    EditCapital: TDBEdit;
    Label3: TLabel;
    EditContinent: TDBEdit;
    Label4: TLabel;
    EditArea: TDBEdit;
    Label5: TLabel;
    EditPopulation: TDBEdit;
    DBNavigator: TDBNavigator;
    Panel1: TPanel;
    DataSource1: TDataSource;
    Panel2: TPanel;
    Database1: TDatabase;
    OKButton: TButton;
  private
    TableClone: TTableClone;
  end;
  { TTableClone }
  TTableClone = class(TTable)
  private
    SrcHandle: HDBICur;
  protected
    function CreateHandle: HDBICur; override;
  public
    procedure OpenClone(ASrcHandle: HDBICur);
  end;
function EditData(const DBHandle: HDBIDB; const DSHandle: HDBICur): Boolean;
  stdcall;
var
  DBEditForm: TDBEditForm;
implementation
{$R *.DFM}
{ Экспорт }
function EditData(const DBHandle: HDBIDB; const DSHandle: HDBICur): Boolean;
  stdcall;
var
  DBEditForm: TDBEditForm;
begin
  DBEditForm := TDBEditForm.Create(Application);
  with DBEditForm do
  try
    // Устанавливаем дескриптор Database1 на открытую в текущий момент базу данных
    Database1.Handle := DBHandle;
    TableClone := TTableClone.Create(DBEditForm);
    try
      TableClone.DatabaseName := 'DB1';
      DataSource1.DataSet := TableClone;
      TableClone.OpenClone(DSHandle);
      Result := (ShowModal = mrOK);
      if Result then
      begin
        TableClone.UpdateCursorPos;
        DbiSetToCursor(DSHandle, TableClone.Handle);
      end;
    finally
      TableClone.Free;
    end;
  finally
    Free;
  end;
end;
{ TTableClone }
procedure TTableClone.OpenClone(ASrcHandle: HDBICur);
begin
  SrcHandle := ASrcHandle;
  Open;
  DbiSetToCursor(Handle, SrcHandle);
  Resync([]);
end;
function TTableClone.CreateHandle: HDBICur;
begin
  Check(DbiCloneCursor(SrcHandle, False, False, Result));
end;
end.
{ EDITFORM.DFM }
object DBEditForm: TDBEditForm
  Left = 201
    Top = 118
    Width = 354
    Height = 289
    ActiveControl = Panel1
    Caption = 'DBEditForm'
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'MS Sans Serif'
    Font.Style = []
    Position = poScreenCenter
    PixelsPerInch = 96
    TextHeight = 13
    object Panel1: TPanel
    Left = 0
      Top = 0
      Width = 346
      Height = 41
      Align = alTop
      TabOrder = 0
      object DBNavigator: TDBNavigator
      Left = 8
        Top = 8
        Width = 240
        Height = 25
        DataSource = DataSource1
        Ctl3D = False
        ParentCtl3D = False
        TabOrder = 0
    end
    object OKButton: TButton
      Left = 260
        Top = 8
        Width = 75
        Height = 25
        Caption = 'OK'
        default = True
        ModalResult = 1
        TabOrder = 1
    end
  end
  object Panel2: TPanel
    Left = 0
      Top = 41
      Width = 346
      Height = 221
      Align = alClient
      BevelInner = bvLowered
      BorderWidth = 4
      Caption = 'Panel2'
      TabOrder = 1
      object ScrollBox: TScrollBox
      Left = 6
        Top = 6
        Width = 334
        Height = 209
        HorzScrollBar.Margin = 6
        HorzScrollBar.Range = 147
        VertScrollBar.Margin = 6
        VertScrollBar.Range = 198
        Align = alClient
        AutoScroll = False
        BorderStyle = bsNone
        TabOrder = 0
        object Label1: TLabel
        Left = 6
          Top = 6
          Width = 28
          Height = 13
          Caption = 'Name'
          FocusControl = EditName
      end
      object Label2: TLabel
        Left = 6
          Top = 44
          Width = 32
          Height = 13
          Caption = 'Capital'
          FocusControl = EditCapital
      end
      object Label3: TLabel
        Left = 6
          Top = 82
          Width = 45
          Height = 13
          Caption = 'Continent'
          FocusControl = EditContinent
      end
      object Label4: TLabel
        Left = 6
          Top = 120
          Width = 22
          Height = 13
          Caption = 'Area'
          FocusControl = EditArea
      end
      object Label5: TLabel
        Left = 6
          Top = 158
          Width = 50
          Height = 13
          Caption = 'Population'
          FocusControl = EditPopulation
      end
      object EditName: TDBEdit
        Left = 6
          Top = 21
          Width = 135
          Height = 21
          DataField = 'Name'
          DataSource = DataSource1
          MaxLength = 0
          TabOrder = 0
      end
      object EditCapital: TDBEdit
        Left = 6
          Top = 59
          Width = 135
          Height = 21
          DataField = 'Capital'
          DataSource = DataSource1
          MaxLength = 0
          TabOrder = 1
      end
      object EditContinent: TDBEdit
        Left = 6
          Top = 97
          Width = 135
          Height = 21
          DataField = 'Continent'
          DataSource = DataSource1
          MaxLength = 0
          TabOrder = 2
      end
      object EditArea: TDBEdit
        Left = 6
          Top = 135
          Width = 65
          Height = 21
          DataField = 'Area'
          DataSource = DataSource1
          MaxLength = 0
          TabOrder = 3
      end
      object EditPopulation: TDBEdit
        Left = 6
          Top = 173
          Width = 65
          Height = 21
          DataField = 'Population'
          DataSource = DataSource1
          MaxLength = 0
          TabOrder = 4
      end
    end
  end
  object DataSource1: TDataSource
    Left = 95
      Top = 177
  end
  object Database1: TDatabase
    DatabaseName = 'DB1'
      LoginPrompt = False
      SessionName = 'Default'
      Left = 128
      Top = 176
  end
end

Оглавление.