library FrmDLL2;{ 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 SysUtils, Classes, Forms, ADODB, windows, ufrmDll2 in 'ufrmDll2.pas' {Form2}, uSysVar in 'uSysVar.pas';{$R *.res}function ShowForm(App:TApplication; conn:TADOConnection; userid:shortstring; userName:shortstring; title:shortstring; CallProc
ointer; CallID : Integer; parentform:TForm):Longint;stdcall;begin Application := App; @FreeProc := CallProc; ProcID := CallID; Form2:=TForm2.Create(parentform); Result:=Longint(Form2); Form2.Caption:=title; Form2.Top:=0; Form2.Left:=0; Form2.Show; Form2.BringToFront;end;function CloseForm: LongInt; StdCall;begin if assigned(Form2) then begin Form2.Close; // FreeAndNil(Form2); end; Result := 0;end;function ActiveForm:LongInt;StdCall;begin if assigned(Form2) then begin Form2.BringToFront; Form2.SetFocus; end; Result := 0;end;exports ShowForm,CloseForm,ActiveForm;procedure ExitDLL(Reason: Integer);begin if Reason = DLL_PROCESS_DETACH then begin Application := DllApp; end;end; begin DllApp:=Application; DLLProc:=@ExitDLL;end.主窗体代码{项目名称: MDI程序调用dll中的子窗体的例子;技术要点: mdi主程序调用子窗体; mdi调用dll中的子窗体; dll工程的建立和使用方法; dll的动态调用方法;}unit ufrmMain;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Menus, jpeg, ExtCtrls, ComCtrls, DB, ADODB;const WM_MyDLL = WM_APP+20;type TShowForm = Function(App:TApplication; conn:TADOConnection; //主程序中公用 ADOConnection userid:shortstring; //操作员 ID userName:shortstring; //操作员 姓名 title:shortstring; //子窗体Caption CallProc
ointer; //主程回调函数 FormID : Integer; //子窗体编号 parentform:TForm):Longint; stdcall; TCloseForm = function : LongInt; StdCall; TActiveForm = function : LongInt; StdCall; EDlllOadError = class(Exception); TfrmMain = class(TForm) MainMenu1: TMainMenu; N1: TMenuItem; N2: TMenuItem; N3: TMenuItem; N4: TMenuItem; frm11: TMenuItem; N5: TMenuItem; N6: TMenuItem; N7: TMenuItem; SBar: TStatusBar; ADOConnection1: TADOConnection; procedure N4Click(Sender: TObject); procedure frm11Click(Sender: TObject); procedure N5Click(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); private DllHandle ,DllHandle2 : THandle; ShowForm,ShowForm2 : TShowForm; CloseForm, CloseForm2: TCloseForm; ActiveForm,ActiveForm2:TActiveForm; procedure CallPostMessage(ID:Integer); procedure ReceFreeMSG(var ms: tMessage);message WM_MyDLL; { Private declarations } public { Public declarations } end;var frmMain: TfrmMain;implementation{$R *.dfm}procedure CallBackProc(ID:Integer); stdcall;begin frmMain.CallPostMessage(ID);end;procedure TfrmMain.N4Click(Sender: TObject);begin Close;end;procedure TfrmMain.frm11Click(Sender: TObject);var LibHandle : Thandle; ProcAddr : FarProc; {函数地址}begin if DllHandle = 0 then begin try LibHandle := LoadLibrary(PChar(extractfilepath(application.ExeName)+'FrmDLL1.dll')); if LibHandle = 0 then raise EDLLLoadError.Create('不能载入'+extractfilepath(application.ExeName)+'Dll.dll 文件！'); except end; if LibHandle <> 0 then begin DllHandle := LibHandle; ProcAddr := GetProcAddress(LibHandle, 'ShowForm'); ShowForm := ProcAddr; ProcAddr := GetProcAddress(LibHandle, 'CloseForm'); CloseForm := ProcAddr; ProcAddr := GetProcAddress(LibHandle, 'ActiveForm'); ActiveForm := ProcAddr; try if Assigned(ShowForm) then begin ShowForm(Application,ADOConnection1,'0','00','Test DLL Form',@CallBackProc,1,frmMain); end; except FreeLibrary(libHandle); end; end; end else begin if Assigned(ActiveForm) then begin ActiveForm; end; end;end;procedure TfrmMain.CallPostMessage(ID: Integer);begin PostMessage(Self.Handle,WM_MyDLL,ID, 0);end;procedure TfrmMain.ReceFreeMSG(var ms: tMessage);var FormID:integer;begin ShowMessage(IntToStr(FORMID)); if (ms.Msg = WM_MyDLL) then begin // if (ms.WParam >0) then begin FormID:=integer(ms.WParam); try // CloseForm; finally if FormID = 1 then begin if DllHandle<>0 then FreeLibrary(DllHandle); DllHandle:=0; end else if FormID = 2 then begin if DllHandle2<>0 then FreeLibrary(DllHandle2); DllHandle2:=0; end; end; end; end;end;procedure TfrmMain.N5Click(Sender: TObject);var LibHandle : Thandle; ProcAddr : FarProc; {函数地址}begin if DllHandle2 = 0 then begin try LibHandle := LoadLibrary(PChar(extractfilepath(application.ExeName)+'FrmDLL2.dll')); if LibHandle = 0 then raise EDLLLoadError.Create('不能载入'+extractfilepath(application.ExeName)+'Dll.dll 文件！'); except end; if LibHandle <> 0 then begin DllHandle2 := LibHandle; ProcAddr := GetProcAddress(LibHandle, 'ShowForm'); ShowForm2 := ProcAddr; ProcAddr := GetProcAddress(LibHandle, 'CloseForm'); CloseForm2:= ProcAddr; ProcAddr := GetProcAddress(LibHandle, 'ActiveForm'); ActiveForm2 := ProcAddr; try if Assigned(ShowForm2) then begin ShowForm2(Application,ADOConnection1,'0','00','Test DLL Form 2 ',@CallBackProc,2,frmMain); end; except FreeLibrary(libHandle); end; end; end else begin if Assigned(ActiveForm2) then begin ActiveForm2; end; end;end;procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);begin if DllHandle <> 0 then begin CloseForm; end; if DllHandle2 <> 0 then begin CloseForm2; end;end;end.
