1、新建Dll工程
2、Dll工程全部代码
library SubMain;{ Important note about DLL memory management: ShareMem must be thefirst unit in your library's USES clause AND your project's (selectProject-View Source) USES clause if your DLL exports any procedures orfunctions that pass strings as parameters or function results. Thisapplies to all strings passed to and from your DLL--even those thatare nested in records and classes. ShareMem is the interface unit tothe BORLNDMM.DLL shared memory manager, which must be deployed alongwith your DLL. To avoid using BORLNDMM.DLL, pass string informationusing PChar or ShortString parameters. }usesSysUtils, Forms,Classes, Windows, Dialogs,SubMain_Unit in 'SubMain_Unit.pas' {Frm_SubMain};varAppHnd: Thandle;//应用程序的句柄变量AppScr: TScreen;//应用程序的环境变量
{$R *.res}procedure DllEntryPoint(dwReason: DWord);
begincase dwReason ofDLL_PROCESS_ATTACH:beginAppHnd := Application.Handle;//备份Exe句柄AppScr := Screen;//备份Exe环境end;DLL_THREAD_ATTACH: ShowMessage('Create Thread'); //Dll文件中最好用Messagebox，ShowMessage部分环境中容易抽风DLL_THREAD_DETACH: ShowMessage('Free Thread'); //Dll文件中最好用Messagebox，ShowMessage部分环境中容易抽风 DLL_PROCESS_DETACH:beginif Frm_SubMain <> nil then FreeAndNil(Frm_SubMain);//防止Dll窗体未释放干净Application.Handle := AppHnd; //恢复Exe句柄Screen := AppScr;//恢复Exe环境end;end;
end;exportsCreateFrm,DropFrm;//输出函数接口beginDllProc := @DllEntryPoint;DllEntryPoint(DLL_PROCESS_ATTACH);
end.3、SubMain_Unit.pas源码
unit SubMain_Unit;interfaceusesWindows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, FyFun_Unit;typeTFrm_SubMain = class(TForm)procedure FormClose(Sender: TObject; var Action: TCloseAction);procedure FormDestroy(Sender: TObject);private{ Private declarations }public{ Public declarations }end;procedure CreateFrm(AppHnd: THandle);export;stdcall;//接口函数声明procedure DropFrm; export;stdcall;//接口函数声明
varFrm_SubMain: TFrm_SubMain;implementation{$R *.dfm}
procedure CreateFrm(AppHnd: THandle);//窗体创建函数
beginApplication.Handle := AppHnd;if not Assigned(Frm_SubMain) thenFrm_SubMain := TFrm_SubMain.Create(Application);Frm_SubMain.Show;
end;procedure DropFrm;//窗体释放函数
beginif Frm_SubMain <> nil thenFreeAndNil(Frm_SubMain);
end;
procedure TFrm_SubMain.FormClose(Sender: TObject; var Action: TCloseAction);
beginAction := caFree;//dll窗体关闭自动释放
end;procedure TFrm_SubMain.FormDestroy(Sender: TObject);
beginFrm_SubMain := nil;//dll窗体关闭自动释放
end;end.unit Main_Unit;interfaceusesWindows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, StdCtrls;typeTCreateFrm = procedure(AppHnd: THandle); stdcall;TDropFrm = procedure; stdcall;TFrm_Main = class(TForm)Btn_1: TButton;Btn_2: TButton;Btn_3: TButton;Btn_4: TButton;procedure Btn_1Click(Sender: TObject);procedure Btn_2Click(Sender: TObject);procedure Btn_3Click(Sender: TObject);procedure Btn_4Click(Sender: TObject);privateLibHandle: THandle;FormRef: LongInt;{ Private declarations }public{ Public declarations }end;varFrm_Main: TFrm_Main;implementation{$R *.dfm}procedure TFrm_Main.Btn_1Click(Sender: TObject); //动态加载Dll文件
beginif LibHandle = 0 thenbeginLibHandle := SafeLoadLibrary('SubMain.dll');if LibHandle = 0 thenraise Exception.Create('Not Found Dll File')elseShowMessage('Dll Loaded');end;
end;procedure TFrm_Main.Btn_2Click(Sender: TObject); //释放Dll文件
beginif LibHandle > 0 thenbeginFreeLibrary(LibHandle);LibHandle := 0;ShowMessage('Dll UnLoaded');end;
end;procedure TFrm_Main.Btn_3Click(Sender: TObject); //读取Dll文件窗体并显示
varCreateFrm: TCreateFrm;
beginif LibHandle = 0 thenraise Exception.Create('Place Load Dll File First');@CreateFrm := GetProcAddress(LibHandle,PChar('CreateFrm'));if @CreateFrm = nil thenraise Exception.Create('Function Error');CreateFrm(Application.Handle);
end;procedure TFrm_Main.Btn_4Click(Sender: TObject); //释放Dll窗体
varDropFrm: TDropFrm;
begin@DropFrm := GetProcAddress(LibHandle,PChar('DropFrm'));if @DropFrm = nil thenraise Exception.Create('Function Error');DropFrm;
end;end.
