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

Written on . Posted in [Delphi] Работа с 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
стиральные машины форум