unit DLLMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, DBGrids, Db, MemDS, StdCtrls, ExtCtrls, DBCtrls, DBAccess,
  MSAccess, Buttons;

type
  TfmDllMain = class(TForm)
    MSQuery: TMSQuery;
    DBGrid: TDBGrid;
    DataSource: TDataSource;
    pnToolBar: TPanel;
    Panel1: TPanel;
    btOpen: TSpeedButton;
    btClose: TSpeedButton;
    DBNavigator: TDBNavigator;
    MSConnection: TMSConnection;
    procedure btOpenClick(Sender: TObject);
    procedure btCloseClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

procedure AssignConnection(MSConnection: TMSConnection); cdecl;
procedure ShowForm; cdecl;
procedure HideForms; cdecl;

implementation
{$IFNDEF FPC}
{$IFDEF CLR}
{$R *.nfm}
{$ELSE}
{$R *.dfm}
{$ENDIF}
{$ENDIF}

{$IFNDEF VER130}
{$IFNDEF VER140}
{$IFNDEF CLR}
  {$DEFINE XPMAN}
  {$R WindowsXP.res}
{$ENDIF}
{$ENDIF}
{$ENDIF}

{$IFDEF XPMAN}
uses
  UxTheme;
{$ENDIF}
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;
    MSConnection.AssignConnect(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;

procedure TfmDllMain.FormCreate(Sender: TObject);
{$IFDEF XPMAN}
  procedure UpdateStyle(Control: TWinControl);
  var
    Panel: TPanel;
    i: integer;
  begin
    for i := 0 to Control.ControlCount - 1 do begin
      if Control.Controls[i] is TSpeedButton then
        TSpeedButton(Control.Controls[i]).Flat := False
      else
      if Control.Controls[i] is TDBNavigator then
        TDBNavigator(Control.Controls[i]).Flat := False;
      if Control.Controls[i] is TWinControl then begin
        if (Control.Controls[i] is TPanel) then begin
            Panel := TPanel(Control.Controls[i]);
            Panel.ParentBackground := False;
            Panel.Color := clBtnFace;
          end;
        UpdateStyle(TWinControl(Control.Controls[i]));
      end;
    end;
  end;
{$ENDIF}
begin
{$IFDEF XPMAN}
  if UseThemes then
    UpdateStyle(Self);
{$ENDIF}
end;

initialization
  FormCount:= 0;
  FormList:= TList.Create;
finalization
  HideForms;
  FormList.Free;
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.


unit ExeMain;

interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Grids, DBGrids, Db, MemDS, DBCtrls, DBAccess, SdacVcl,
  MSAccess, Buttons;

type
  TfmExeMain = class(TForm)
    MSConnection: TMSConnection;
    MSConnectDialog: TMSConnectDialog;
    pnToolBar: TPanel;
    DBGrid: TDBGrid;
    MSQuery: TMSQuery;
    DataSource: TDataSource;
    Panel2: TPanel;
    btFreeDLL: TSpeedButton;
    btLoadDLL: TSpeedButton;
    btShowForm: TSpeedButton;
    btHideForms: TSpeedButton;
    DBNavigator: TDBNavigator;
    Panel1: TPanel;
    btConnect: TSpeedButton;
    btDisconnect: TSpeedButton;
    btOpen: TSpeedButton;
    btClose: TSpeedButton;
    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
{$IFNDEF FPC}
{$IFDEF CLR}
{$R *.nfm}
{$ELSE}
{$R *.dfm}
{$ENDIF}
{$ENDIF}

{$IFNDEF VER130}
{$IFNDEF VER140}
{$IFNDEF CLR}
  {$DEFINE XPMAN}
  {$R WindowsXP.res}
{$ENDIF}
{$ENDIF}
{$ENDIF}

{$IFDEF XPMAN}
uses UxTheme;
{$ENDIF}

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;
    MessageDlg('DLL is unloaded', mtInformation, [mbOk], 0);
  end
  else
    MessageDlg('DLL is not loaded', mtError, [mbOk], 0);
end;

procedure TfmExeMain.FormCreate(Sender: TObject);
{$IFDEF XPMAN}
  procedure UpdateStyle(Control: TWinControl);
  var
    Panel: TPanel;
    i: integer;
  begin
    for i := 0 to Control.ControlCount - 1 do begin
      if Control.Controls[i] is TSpeedButton then
        TSpeedButton(Control.Controls[i]).Flat := False
      else
      if Control.Controls[i] is TDBNavigator then
        TDBNavigator(Control.Controls[i]).Flat := False;
      if Control.Controls[i] is TWinControl then begin
        if (Control.Controls[i] is TPanel) then begin
            Panel := TPanel(Control.Controls[i]);
            Panel.ParentBackground := False;
            Panel.Color := clBtnFace;
          end;
        UpdateStyle(TWinControl(Control.Controls[i]));
      end;
    end;
  end;
{$ENDIF}

begin
{$IFDEF XPMAN}
  if UseThemes then
    UpdateStyle(Self);
{$ENDIF}
  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.