DLL共享主窗口的ADOCONNECTION

begin
  DllProc := @DllEntryPoint;
  DllProc(DLL_PROCESS_ATTACH);
end.

procedure SetMappedObj(const AObj:Pointer);stdcall;
function GetMappedObj:Pointer;stdcall;

interface

implementation

//DLL从外存映像文件中取得ADOCONNECTION对象的指针
procedure TfrmPlgView.btnGetDBClick(Sender: TObject);
begin
  ADOTable1.Connection := TADOConnection(GetMappedObj);
  ADOTable1.Active := true;
end;

uses
   Windows,
  SysUtils,
  Classes,
  untMapObj in ‘untMapObj.pas’;
procedure DllEntryPoint(dwReason: DWORD);
begin
  case dwReason of
    DLL_PROCESS_ATTACH: Map(FILE_MAP_ALL_ACCESS);
    DLL_PROCESS_DETACH: Unmap();
    DLL_THREAD_ATTACH: ;
    DLL_THREAD_DETACH: ;
  end;
end;

procedure Map(const DesiredAccess: DWORD); stdcall;
var
  LSize: Integer;
begin
  try
    if HasMapped then  exit ;
    LSize := Sizeof(TMappedObj);
    MappedObjHandle := CreateFileMapping(DWORD($FFFFFFFF),nil,
PAGE_READWRITE,0,
      LSize,SMappedObjName);
    if MappedObjHandle = 0 then RaiseLastOSError();
    MappedObj := MapViewOfFile(MappedObjHandle, DesiredAccess, 0, 0,
LSize);
    if not Assigned(MappedObj) then
    begin
      CloseHandle(MappedObjHandle);
      RaiseLastOSError();
    end;
    HasMapped := true;
   except
    on Exception do
      MessageDlg(SExceptionInfo,mtError, [mbOk],0);
    end;
end;

procedure SetMappedObj(const AObj:Pointer);
begin
  if not assigned(MappedObj^.Data) then
    MappedObj^.Data := AObj;
end;

const
  SExceptionInfo = ‘Error in calling MappedObj.dll.’;
  SMappedObjName = ‘RocketGis.MappedObj’;

procedure Unmap(); stdcall;
begin
  try
    if not HasMapped then exit;
    UnmapViewOfFile(MappedObj);
    CloseHandle(MappedObjHandle);
    HasMapped := False;
  except
    on Exception do MessageDlg(SExceptionInfo, mtError, [mbOk], 0);
  end;
end;

//DLL释放时推卸载内存映像文件

unit untMapObj;

//把ADOConnection1的指针映射到一个内存映像文件中
procedure TfrmMain.btnDBMapClick(Sender: TObject);
begin
  try
    SetMappedObj(Pointer(ADOConnection1));
  except
    Raise Exception.Create(‘创制区域对象失利’);
  end;
end;

type
  PMappedObj = ^TMappedObj;
  TMappedObj = packed record
    Size: DWORD;
    Data: Pointer;
  end;

//DLL最先化时确立内存印象文件

function GetMappedObj:Pointer; stdcall;
begin
  Result := MappedObj^.data;
end;

{$R *.res}

var
  HasMapped: Boolean;
  MappedObjHandle: THandle;
  MappedObj: PMappedObj;

library MapObj;

{*******************************************************}
{                                                       }
{       内存印象文件                                    }
{                                                       }
{       版权所有 (C) 2008 咏南工作室(陈新光)            }
{                                                       }
{*******************************************************}

uses
  Windows, SysUtils, Dialogs;

end. 

exports
  Map, Unmap, GetMappedObj, SetMappedObj;

procedure Map(const DesiredAccess: DWORD = FILE_MAP_ALL_ACCESS);
stdcall;
procedure Unmap(); stdcall;

相关文章