Delphi中一些DLL的运用(要传递Application和Screen,似乎还忘了传递提示控件)
dll 调用部分: {****************************************************************} { } { Project: DllDebug } { Copyright(c) 2003, 2005 } { Unit for UCommonUnit } { Create : 2003-01-05 by 林红卫 } { Modify : 2003-01-16 by 林红卫 } { } {****************************************************************} unit UCommonUnit; interface uses Windows, SysUtils, Forms; type TRunDLL = procedure(DLLName, FormName, FormCaption: PChar; aApp: TApplication; Scr: TScreen) stdcall; procedure RunDLLForm(DLLName, FormName, FormCaption: string; aApp: TApplication; Scr: TScreen) stdcall; implementation procedure RunDLLForm(DLLName, FormName, FormCaption: string; aApp: TApplication; Scr: TScreen) stdcall; var RunDLL: TRunDLL; GetDllHWND: HWND; begin GetDllHWND := LoadLibrary(PChar(DllName)); try if GetDllHWND < 32 then begin MessageBox(0, '没有找到附带DLL文件,请确认程序是否完整!', '加载DLL失败', MB_OK); Exit; end; @RunDLL := GetProcAddress(GetDllHWND, 'RunDLL'); if @RunDLL <> nil then try RunDLL(PChar(UpperCase(Trim(DLLName))), PChar(UpperCase(Trim(FormName))), PChar(FormCaption), aApp,Scr); except raise Exception.Create('T' + FormName + '不存在!'); end; finally FreeLibrary(GetDllHWND); end; end; end. dll : {****************************************************************} { } { Project: UDllTest } { Copyright(c) 2003, 2005 } { Unit for UDllTest } { Create : 2003-01-05 by 林红卫 } { Modify : 2003-01-16 by 林红卫 } { } {****************************************************************} library UDllTest; uses SysUtils, Forms, Messages, Variants, Windows, Classes, UFrmTestForm1 in 'UFrmTestForm1.pas' {Form1}, UFrmTestForm2 in 'UFrmTestForm2.pas' {Form2}; var DLLApp: TApplication; DLLScreen: TScreen; procedure RunDLL(DLLName, FormName, FormCaption: PChar; aApp: TApplication; Scr: TScreen) stdcall; var TheClass: TPersistentClass; aForm: TForm; begin Application := aApp; Screen := Scr; RegisterClasses([TForm1, TForm2]); TheClass := GetClass('T' + FormName); if (TheClass = nil) then GetLastError; if TheClass.InheritsFrom(TForm) and (TheClass <> TForm) then begin aForm := TForm(TheClass.Create).Create(nil); aForm.Caption := FormCaption; try aForm.ShowModal; finally FreeAndNil(aForm); end; end; end; procedure DLLUnloadProc(dwReason: DWORD); begin if dwReason = DLL_PROCESS_DETACH then begin Application := DLLApp; //恢复 Screen := DLLScreen; end; end; exports RunDLL; begin DLLApp := Application; //保存 DLL 中初始的 Application 对象 DLLScreen := Screen; DLLProc := @DLLUnloadProc; //保证 DLL 卸载时恢复原来的 Application DLLUnloadProc(DLL_PROCESS_DETACH); end.
http://www.cnblogs.com/kfarvid/archive/2010/07/16/1778930.html