unit DLLMain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Grids, DBGrids, Db, MemDS, StdCtrls, ExtCtrls, DBCtrls, DBAccess,
MSAccess;
type
TfmDllMain = class(TForm)
MSQuery: TMSQuery;
DBGrid: TDBGrid;
DataSource: TDataSource;
pnToolBar: TPanel;
btOpen: TButton;
btClose: TButton;
DBNavigator: TDBNavigator;
procedure btOpenClick(Sender: TObject);
procedure btCloseClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
procedure AssignConnection(MSConnection: TMSConnection); cdecl;
procedure ShowForm; cdecl;
procedure HideForms; cdecl;
implementation
{$R *.DFM}
var
ExternalMSConnection: TMSConnection;
FormList: TList;
FormCount: integer;
procedure AssignConnection(MSConnection: TMSConnection); cdecl;
begin
ExternalMSConnection:= MSConnection;
end;
procedure ShowForm; cdecl;
begin
with TfmDllMain.Create(Application) do begin
Inc(FormCount);
Caption:= IntToStr(FormCount) + '. ' + Caption;
MSQuery.Connection := ExternalMSConnection;
MSQuery.Active := True;
Show;
end;
end;
procedure HideForms; cdecl;
begin
while FormList.Count > 0 do begin
TForm(FormList[0]).Free;
FormList.Delete(0);
end;
end;
procedure TfmDllMain.FormShow(Sender: TObject);
begin
FormList.Add(Self);
end;
procedure TfmDllMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FormList.Remove(Self);
Action := caFree;
end;
procedure TfmDllMain.btOpenClick(Sender: TObject);
begin
MSQuery.Open;
end;
procedure TfmDllMain.btCloseClick(Sender: TObject);
begin
MSQuery.Close;
end;
initialization
FormCount:= 0;
FormList:= TList.Create;
finalization
HideForms;
FormList.Free;
end.
unit ExeMain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Grids, DBGrids, Db, MemDS, DBCtrls, DBAccess, SdacVcl,
MSAccess;
type
TfmExeMain = class(TForm)
MSConnection: TMSConnection;
MSConnectDialog: TMSConnectDialog;
pnToolBar: TPanel;
btLoadDLL: TButton;
btFreeDLL: TButton;
DBGrid: TDBGrid;
btConnect: TButton;
btDisconnect: TButton;
btOpen: TButton;
btClose: TButton;
MSQuery: TMSQuery;
DBNavigator: TDBNavigator;
DataSource: TDataSource;
btShowForm: TButton;
btHideForms: TButton;
procedure btLoadDLLClick(Sender: TObject);
procedure btFreeDLLClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btConnectClick(Sender: TObject);
procedure btDisconnectClick(Sender: TObject);
procedure btOpenClick(Sender: TObject);
procedure btCloseClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btShowFormClick(Sender: TObject);
procedure btHideFormsClick(Sender: TObject);
private
hDLL:HModule;
public
end;
TAssignMSConnection = procedure (MSConnection: TMSConnection); cdecl;
TShowForm = procedure; cdecl;
THideForms = procedure; cdecl;
var
fmExeMain: TfmExeMain;
implementation
{$R *.DFM}
procedure TfmExeMain.btLoadDLLClick(Sender: TObject);
var
AssignMSConnection: TAssignMSConnection;
begin
if hDLL = 0 then begin
hDLL := LoadLibrary('MS_DLL.dll');
if hDLL <> 0 then begin
@AssignMSConnection := GetProcAddress(hDLL, 'AssignConnection');
if @AssignMSConnection <> nil then
AssignMSConnection(MSConnection);
MessageDlg('DLL is loaded', mtInformation, [mbOk], 0);
end
else
MessageDlg('Cannot load DLL', mtError, [mbOk], 0);
end;
end;
procedure TfmExeMain.btShowFormClick(Sender: TObject);
var
ShowForm: TShowForm;
begin
if hDLL <> 0 then begin
@ShowForm := GetProcAddress(hDLL, 'ShowForm');
if @ShowForm <> nil then
ShowForm;
SetFocus;
end
else
MessageDlg('DLL is not loaded', mtError, [mbOk], 0);
end;
procedure TfmExeMain.btHideFormsClick(Sender: TObject);
var
HideForms: THideForms;
begin
if hDLL <> 0 then begin
@HideForms := GetProcAddress(hDLL, 'HideForms');
if @HideForms <> nil then
HideForms;
end
else
MessageDlg('DLL is not loaded', mtError, [mbOk], 0);
end;
procedure TfmExeMain.btFreeDLLClick(Sender: TObject);
begin
if hDLL <> 0 then begin
FreeLibrary(hDLL);
hDLL:= 0;
end
else
MessageDlg('DLL is not loaded', mtError, [mbOk], 0);
end;
procedure TfmExeMain.FormCreate(Sender: TObject);
begin
hDLL:= 0;
end;
procedure TfmExeMain.btConnectClick(Sender: TObject);
begin
MSConnection.Connect;
end;
procedure TfmExeMain.btDisconnectClick(Sender: TObject);
begin
MSConnection.Disconnect;
end;
procedure TfmExeMain.btOpenClick(Sender: TObject);
begin
MSQuery.Open;
end;
procedure TfmExeMain.btCloseClick(Sender: TObject);
begin
MSQuery.Close;
end;
procedure TfmExeMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if hDLL <> 0 then
FreeLibrary(hDLL);
end;
end.
library MS_DLL;
{ Important note about DLL memory management: ShareMem must be the
first unit in your library's USES clause AND your project's (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }
uses
ShareMem,
SysUtils,
Classes,
DLLMain in 'DLLMain.pas' {fmDllMain};
exports
AssignConnection,
ShowForm,
HideForms;
var
SaveExit: pointer;
procedure DllExit;
begin
ExitProc := SaveExit;
end;
begin
// SaveExit := ExitProc;
// ExitProc := @DllExit;
end.
program MS_Exe;
uses
ShareMem,
Forms,
ExeMain in 'ExeMain.pas' {fmExeMain};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TfmExeMain, fmExeMain);
Application.Run;
end.
|
