Delphi - объектно-ориентированный язык программирования, разработанный компанией Borland в 1995 году. Он основан на языке программирования Pascal, но имеет более расширенные возможности и добавлены новые функции.
Delphi является интегрированной средой разработки (IDE), которая позволяет разрабатывать программное обеспечение для различных платформ, включая Windows, macOS, Android и iOS. 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 } programmaindb; uses
Forms, mainform in
'mainform.pas'
{DBMainForm}; {$R *.RES} beginApplication.Initialize; Application.CreateForm(TDBMainForm, DBMainForm); Application.Run; end
.
{ MAINFORM.PAS } unitmainform; 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; // {или} functionEditData(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. ifEditData(DBHandle, Handle) then
Resync([]); end
; end
; procedure
TDBMainForm.DBGrid1DblClick(Sender: TObject); begin
EditButton.Click; end
; end
.
// Проект EDIT DLL { EDITDLL.DPR } libraryeditdll; uses
SysUtils, Classes, editform in
'editform.pas'
{DBEditForm}; exportsEditData; begin
end
.
{ EDITFORM.PAS } uniteditform; 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 } procedureTTableClone.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 } objectDBEditForm: 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