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