library Project1;
{ 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,
Windows,
dialogs,
SysUtils,
Classes;
const
cMMFileName: PChar = 'ShareMapData';
{$I G:/Delphi/应用程序/DLL/共享数据的DLL/DLLDATA.INC }
{$R *.res}
var
GlobalData : PGlobalDLLData;
MapHandle : THandle;
flag:integer=0;
//GetDLLData 是DLL 的导出函数
procedure GetDLLData(var AGlobalData:PGlobalDLLData);stdcall;
begin
// 让变量AGlobalData 与 GlobaData 指向同一个内存地址
AGlobalData:= GlobalData;
end;
procedure OpenSharedData;
var
Size:Integer;
begin
Size := SizeOf(TGlobalDllData);
//获得内存的映射文件对象
MapHandle := CreateFileMapping(DWord(-1),nil,PAGE_READWRITE,0,size,cMMFileName);
if MapHandle = 0 then
raiseLastWin32Error;
//将数据映射到调用进程的地址空间并获得首地址的指针
GlobalData:= MapViewOfFile(MapHandle,FILE_MAP_ALL_ACCESS,0,0,size);
//数据初始化
GlobalData^.S := 'ShareLib';
GlobalData^.I := 1;
if GlobalData = nil then
begin
CloseHandle(MapHandle);
RaiseLastWin32Error;
end;
end;
procedure CloseSharedData;
//该进程取消内存映射文件并释放内存映射文件的句柄
begin
UnmapViewOfFile(GlobalData);
CloseHandle(MapHandle);
end;
procedure DLLEntryPoint(dwReason:DWord);
begin
case dwReason of
DLL_PROCESS_ATTACH : begin
OpenSharedData;
flag:=flag+1;
messagedlg('load DLL ...'+inttostr(flag),mtinformation,[mbok],0);
end;
DLL_PROCESS_DETACH : begin
CloseSharedData;
flag:=flag-1;
messagedlg('free DLL ...'+inttostr(flag),mtinformation,[mbok],0);
end;
end;
end;
exports
GetDLLData;
begin
DllProc := @DLLEntryPoint;
DllEntryPoint(DLL_PROCESS_ATTACH);
end.
//以上是dll
//以下是 exe 调用上面的dll.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
PGlobalDLLData=^TGlobalDLLData;
TGlobalDLLData= record
S:string[50];
i:integer;
end;
type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
Button2: TButton;
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
Button3: TButton;
procedure FormCreate(Sender: TObject);
procedure AttchDll(DllName: string);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
TGetShare = procedure (var AGlobalData:PGlobalDLLData) stdcall;
const
DLLPATH='G:/Delphi/应用程序/DLL/共享数据的DLL/Project1.dll';
var
Form1: TForm1;
getshare1:TGetShare;
attch:Thandle;
ifgetshare1:boolean=false;
loadDll : boolean=false;
SharePoint:PGlobalDLLData;
implementation
{$R *.dfm}
procedure TForm1.AttchDll(DllName: string);
begin
attch:= LoadLibrary(PChar(DllName));
if attch <= 0 then
begin
raise exception.Create ('调用DLL失败!');
loadDll:=false;
end;
loadDll:=true;
@getShare1:=GetProcAddress(attch,'GetDLLData');
if not Assigned(getShare1) then begin
raise exception.Create('GetProcAddress 调用失败!');
ifgetshare1:=false;
end;
ifgetshare1:=true;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
try
AttchDll(DLLPATH);
SharePoint:=nil;
except
raise exception.Create('加载DLL失败!');
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
s,s1:string;
begin
if not loadDLL then begin
showmessage('还没有加载DLL,请先加载DLL再进行此操作!');
exit;
end;
getshare1(SharePoint);
memo1.Lines.add('load Share data...'+datetimetostr(now));
memo1.Lines.Add('SharePoint.S SharePoint.I');
s:=SharePoint.s;
s1:=inttostr(SharePoint.i);
while length(s)<12 do s:=' '+s;
while length(s1)<16 do s1:=' '+s1;
memo1.Lines.Add(s+s1);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if not loadDLL then begin
showmessage('还没有加载DLL,请先加载DLL再进行此操作!');
exit;
end;
if assigned(SharePoint) then
getShare1(SharePoint);
SharePoint.S:=Edit2.text;
try
SharePoint.i:=strtoint(Edit1.text);
except
messagedlg('类型转换错误!',mterror,[mbok],0);
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
if loadDLL then
freelibrary(attch);
close;
end;
end.