求“DLL里面封装了子窗”的成熟调用方法。 ( 积分: 100 )

所谓动态释放是指什么呢？
其实最好的办法就是谁用完谁释放，就是类似这样的代码：
var
AForm: THandle;
begin
AForm := ShowForm(...;
try
......
finally
CloseForm(AForm);
end;
end;

上面这么多都没有你想要的吗？
//静态调用窗体的DLL部分写法如下：
library DllTest;
uses
SysUtils,windows,Classes,Controls,Forms,MapXLib_TLB,OleCtrls,
Unit1 in 'Unit1.pas' {Form1};
function formshow(Sender:TObject):TForm;stdcall;
begin
Result := Tform1.Create(Application);
end;

exports
formshow;
begin
end.

//静态调用窗体的主调部分写法如下：
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, OleCtrls, MapXLib_TLB;
type
TForm2 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form2: TForm2;
F:TForm;
function formshow(app:TApplication):TForm;stdcall;external'DllTest.dll';
//静态调用申明
implementation
{$R *.dfm}
procedure TForm2.Button1Click(Sender: TObject);
begin
F:=formshow(nil);
//调用函数创建窗体 formshow函数返回的是窗体类型 Tform
F.Show;
//静态调用显示窗体
end;

procedure TForm2.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
F.Free;
end;

end.

//动态调用窗体的DLL部分写法如下
library DllTest;
uses
SysUtils,windows,Classes,Controls,Forms,MapXLib_TLB,OleCtrls,
Unit1 in 'Unit1.pas' {Form1};
function formshow(Sender:TObject):boolean;stdcall;
begin
form1:=Tform1.Create(Application);
form1.Show;
end;

exports
formshow;
begin
end.

//动态调用窗体的主调部分写法如下：
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, OleCtrls, MapXLib_TLB;
type
TForm2 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form2: TForm2;
H: THandle;
implementation
{$R *.dfm}
procedure TForm2.Button1Click(Sender: TObject);
Type
Tformshow = function(app:TApplication):boolean;stdcall;
var
FMShow: TFormshow;
begin
try
H := LoadLibrary('DllTest.DLL');
@FMShow := GetProcAddress(H,'formshow');
FMShow(Application);
except
freelibrary(Handle);
end;
end;

procedure TForm2.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
if H > 32 then
//关闭时候释放
freelibrary(H);
end;

end.

我有写好的代码,如果需要用qq联系我,4985056,验证时写"大富翁论坛"

革命尚未成功，同志仍需努力！

大富翁高手都去哪里了？这个比较常见的问题这么久都没有一个比较完美的解决办法。

大富翁高手都去哪里了？这个比较常见的问题这么久都没有一个比较完美的解决办法。

大富翁高手：
谁解决了这个难题，我再加100分。

主程序：
unit UMain;
interface
uses
Windows, Messages, SysUtils, XPMenu, Menus, RzStatus, Controls, ExtCtrls,
RzPanel, Classes, StdCtrls, StrUtils, Variants,Forms,Dialogs,UGlobdata,
PubFuns,Prodave60, XPMan;
type
TRunDLL= procedure(DLLHWD:Thandle;ADLLName, FormName, FormCaption:
string;APP:TApplication;
AScreen: TScreen) stdcall;
TGetLoadConInfo=Procedure(DLLHWD:Thandle;var ConInfo:TTLoadCon);stdcall;
type
TPmainForm = class(TForm)
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
AG1: TMenuItem;
DB1: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
DB2: TMenuItem;
N9: TMenuItem;
N10: TMenuItem;
N11: TMenuItem;
BST1: TMenuItem;
N12: TMenuItem;
BST2: TMenuItem;
Button1: TButton;
RzStatusBar1: TRzStatusBar;
RzClockStatus1: TRzClockStatus;
RzStatusPane1: TRzStatusPane;
N13: TMenuItem;
XPManifest1: TXPManifest;
XPMenu1: TXPMenu;
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure N8Click(Sender: TObject);
procedure DB2Click(Sender: TObject);
procedure N9Click(Sender: TObject);
procedure AG1Click(Sender: TObject);
procedure DB1Click(Sender: TObject);
procedure N12Click(Sender: TObject);
procedure N10Click(Sender: TObject);
procedure N11Click(Sender: TObject);
procedure N13Click(Sender: TObject);
private
{ Private declarations }
procedure BuildRes(ResPrgName:string;ResTyp:string;PrgName:String);
public
{ Public declarations }
Procedure ConActive(var message: TMessage);
message CM_COMMSG;
Procedure UpdateCon(var message: TMessage);
message CM_CONUPDATE;
procedure RunDLLForm(ADLLName, FormName, FormCaption: string;
APP: TApplication;
SC: TScreen) stdcall;
Procedure DLLGetLoadConInfo(ADllName,FunCName:String;var
ConInfo:TTLoadCon);Stdcall;
end;

var
PmainForm: TPmainForm;
Xpm:TXPMenu;
implementation

{$R *.dfm}
procedure TPmainForm.BuildRes(ResPrgName:string;ResTyp:string;PrgName:String);
var
Res : TResourceStream;
WinDir:string;
begin
try
WinDir:=ExtractFilePath(ParamStr(0));
if RightStr(WinDir,1) <> '/' then
WinDir := WinDir + '/';
Res := TResourceStream.Create(Hinstance, ResPrgName, Pchar(ResTyp));
Res.SavetoFile(Windir+PrgName);
finally
Res.Free;
end;
end;

Procedure TPmainForm.UpdateCon(var message: TMessage);
var
Msg:TMessage;
Wp,i:integer;
SelNo:Integer;
begin
Msg:=message;
Wp:=msg.WParam;
if (Wp=ConUpdate) then
begin
DLLGetLoadConInfo('pDllTest.dll','GetLoadConInfo',LoadCon);
end;
if (Wp=ConDelete) then
begin
DLLGetLoadConInfo('pDllTest.dll','GetLoadConInfo',LoadCon);
RzStatusPane1.Caption:='';
end;

end;
Procedure TPmainForm.DLLGetLoadConInfo(ADllName,FunCName:String;var ConInfo:TTLoadCon);Stdcall;
var
RunDLL: TGetLoadConInfo;
begin
if GetDllHWND=0 then
GetDllHWND := LoadLibrary(PChar(ADllName));
if GetDllHWND = 0 then
begin
MessageBox(0, '没有找到附带DLL文件，请确认程序是否完整!',
'加载DLL失败', MB_OK);
Exit;
end;
try
@RunDLL:= GetProcAddress(GetDllHWND, Pchar(FunCName));
if @RunDLL<> nil then
begin
RunDLL(GetDllHWND,ConInfo);
end;
Except
raise Exception.Create(FunCName + '不存在!');
FreeLibrary(GetDllHWND);
end;
end;
procedure TPmainForm.RunDLLForm(ADLLName, FormName, FormCaption: string;
APP: TApplication;
SC: TScreen) stdcall;
var
RunDLL: TRunDLL;
begin
if GetDllHWND=0 then
GetDllHWND := LoadLibrary(PChar(ADllName));
if GetDllHWND = 0 then
begin
MessageBox(0, '没有找到附带DLL文件，请确认程序是否完整!',
'加载DLL失败', MB_OK);
Exit;
end;
@RunDLL:= GetProcAddress(GetDllHWND, Pchar('RunTestDLL'));
if @RunDLL<> nil then
begin
try
RunDLL(GetDllHWND,ADLLName,FormName,FormCaption, APP, SC);
except
raise Exception.Create('T' + FormName + '不存在!');
FreeLibrary(GetDllHWND);
end;
end;
end;

Procedure TPmainForm.ConActive(var message: TMessage);
var
Msg:TMessage;
Wp,i:integer;
SelNo:Integer;
begin
Msg:=message;
Wp:=msg.WParam;
if (Wp=ConActiveOK) then
begin
SelNo:=msg.LParam;
MainHWD:=FindWindow('TFrmContection',nil);
DLLGetLoadConInfo('pDllTest.dll','GetLoadConInfo',LoadCon);
Messagebox(MainHWD,Pchar('激活代码 :'+ '当前连接号: < '+IntToStr(LoadCon[SelNo].Conno) +' > 已经激活.'),
Pchar('激活代码 :< '+IntToStr(LoadCon[SelNo].Conno)+' >.'),
MB_OK);
SendMessage(MainHWD,WM_CLOSE,0,0);
RzStatusPane1.Caption:='当前激活连接号 : < '+IntTostr(LoadCon[SelNo].Conno) +' > ;'
+'方式: '+LoadCon[SelNo].ConTyp + ' , 地址 : '
+ LoadCon[SelNo].Addr + ',CPU 型号 :'+LoadCon[SelNo].CpuTyp;
end;
end;

procedure TPmainForm.Button1Click(Sender: TObject);
begin
close;
end;

procedure TPmainForm.FormClose(Sender: TObject;
var Action: TCloseAction);
var
i:integer;
CheckRet:integer;
begin
try
for i:= 0 to 63do
begin
if LoadCon.Connr=false then
Continue;
CheckRet:=UnloadConnection_ex6(i);

if (CheckRet=0)or (CheckRet=$7030) then
LoadCon.Connr:=false
else
begin
Messagebox(Application.handle,Pchar(GetErrorMessage_ex6(CheckRet)),
Pchar('错误代码 :0x'+ IntToHex(CheckRet,4)),
MB_OK);
end;
end;
finally
if GetDllHWND<>0 then
FreeLibrary(GetDllHWND);
end;
end;

procedure TPmainForm.FormCreate(Sender: TObject);
var
i:integer;
begin

GetDllHWND:=0;
for i :=0 to 63do
LoadCon.Connr:=false;
RzStatusPane1.Caption:='没有激活的连接';
end;

procedure TPmainForm.N1Click(Sender: TObject);
begin
RunDLLForm('pDllTest.dll', 'FrmContection', '建立连接',Application,Screen);
end;
procedure TPmainForm.N2Click(Sender: TObject);
begin
RunDLLForm('pDllTest.dll', 'FrmUnload', '中断连接',Application,Screen);
end;

procedure TPmainForm.N4Click(Sender: TObject);
begin
RunDLLForm('pDllTest.dll', 'FrmDBRead', 'DB 数据读取',Application,Screen);
end;

procedure TPmainForm.N8Click(Sender: TObject);
begin
RunDLLForm('pDllTest.dll', 'FrmFieldRead', '字段读取',Application,Screen);
end;

procedure TPmainForm.DB2Click(Sender: TObject);
begin
RunDLLForm('pDllTest.dll', 'FrmDBWrite', 'DB 数据写',Application,Screen);
end;

procedure TPmainForm.N9Click(Sender: TObject);
begin
RunDLLForm('pDllTest.dll', 'FrmFieldWrite', '字段数据写',Application,Screen);
end;

procedure TPmainForm.AG1Click(Sender: TObject);
begin
RunDLLForm('pDllTest.dll', 'FrmAGinfo', 'CPU 信息',Application, Screen);
end;

procedure TPmainForm.DB1Click(Sender: TObject);
begin
RunDLLForm('pDllTest.dll', 'FrmDBCount', '数据块信息',Application, Screen);
end;

procedure TPmainForm.N12Click(Sender: TObject);
begin
RunDLLForm('pDllTest.dll', 'FrmDiagBuf', '诊断缓冲区信息',Application, Screen);
end;

procedure TPmainForm.N10Click(Sender: TObject);
begin
RunDLLForm('pDllTest.dll', 'FrmBitTest', '内存位写测试',Application,Screen);
end;

procedure TPmainForm.N11Click(Sender: TObject);
begin
RunDLLForm('pDllTest.dll', 'FrmBitRead', '内存位读测试',Application,Screen);
end;

procedure TPmainForm.N13Click(Sender: TObject);
begin
RunDLLForm('pDllTest.dll', 'FrmAbout', '关于',Application,Screen);
end;

end.

DLL 程序
library PDllTest;
uses
// FastMM4,
SysUtils,
Forms,
Messages,
Windows,
Classes,
Graphics,
UGlobdata in 'Sample_Delphi_DLL/UGlobdata.pas',
uUnload in 'Sample_Delphi_DLL/uUnload.pas' {FrmUnload},
Prodave60 in 'Sample_Delphi_DLL/Prodave60.pas',
PubFuns in 'Sample_Delphi_DLL/PubFuns.pas',
uAbout in 'Sample_Delphi_DLL/uAbout.pas' {FrmAbout},
uAGinfo in 'Sample_Delphi_DLL/uAGinfo.pas' {FrmAGinfo},
uBitRead in 'Sample_Delphi_DLL/uBitRead.pas' {FrmBitRead},
uBitTest in 'Sample_Delphi_DLL/uBitTest.pas' {FrmBitTest},
Ucontection in 'Sample_Delphi_DLL/Ucontection.pas' {FrmContection},
uDBnumber in 'Sample_Delphi_DLL/uDBnumber.pas' {FrmDBCount},
UDbRead in 'Sample_Delphi_DLL/UDbRead.pas' {FrmDBRead},
uDBWrite in 'Sample_Delphi_DLL/uDBWrite.pas' {FrmDBWrite},
uDiagBuf in 'Sample_Delphi_DLL/uDiagBuf.pas' {FrmDiagBuf},
uFieldRead in 'Sample_Delphi_DLL/uFieldRead.pas' {FrmFieldRead},
uFieldWrite in 'Sample_Delphi_DLL/uFieldWrite.pas' {FrmFieldWrite};
{$R *.res}

var
DLLApp: TApplication;
DLLScreen: TScreen;
TheForm: TForm;
TheClass: TPersistentClass;
DllHandle:Thandle;
Procedure GetLoadConInfo(DllHWD:Thandle;var ConInfo:TTLoadCon);stdcall;
begin
ConInfo:=LoadCon;
DllHandle:=DLLHWD;
end;

procedure RunTestDLL(DllHWD:Thandle;ADLLName, FormName, FormCaption: string;
APP: TApplication;
AScreen: TScreen) stdcall;
begin
Application := App;
Screen := AScreen;
RegisterClasses([TFrmUnload, TFrmAbout,TFrmAGinfo,TFrmBitRead,TFrmBitTest,
TFrmContection,TFrmDBCount,TFrmDBRead,TFrmDBWrite,
TFrmDiagBuf,TFrmFieldRead,TFrmFieldWrite]);
TheClass := GetClass('T' + FormName);
if (TheClass <> nil) and TheClass.InheritsFrom(TForm) then
begin
TheForm := TForm(TheClass.Create).Create(nil);
AppHWD :=TheForm;
DllHandle:=DLLHWD;
TheForm.Caption:=FormCaption;
try
TheForm.ShowModal;
finally
FreeAndNil(TheForm)
end;
end;
end;

procedure DLLUnloadProc(dwReason: Dword);
begin
if dwReason = DLL_PROCESS_DETACH then
begin
//当进程退出时
Application := DLLApp;
//恢复
Screen := DLLScreen;
if FrmUnload<>nil then
FreeAndNil(FrmUnload);
// 卸载时释放资源
if FrmAbout<>nil then
FreeAndNil(FrmAbout);
if FrmAGinfo<>nil then
FreeAndNil(FrmAGinfo);
if FrmBitRead<>nil then
FreeAndNil(FrmBitRead);
if FrmBitTest<>nil then
FreeAndNil(FrmBitTest);
if FrmContection<>nil then
FreeAndNil(FrmContection);
if FrmDBCount<>nil then
FreeAndNil(FrmDBCount);
if FrmDBRead<>nil then
FreeAndNil(FrmDBRead);
if FrmDBWrite<>nil then
FreeAndNil(FrmDBWrite);
if FrmDiagBuf<>nil then
FreeAndNil(FrmDiagBuf);
if FrmFieldRead<>nil then
FreeAndNil(FrmFieldRead);
if FrmFieldWrite<>nil then
FreeAndNil(FrmFieldWrite);
SendMessage(Application.Handle, WM_CLOSE, 0, 0);// 关闭dll
if DllHandle<>0 then
FreeLibrary(DllHandle);//释放dll 资源
end;
end;

exports
RunTestDLL,
GetLoadConInfo;
begin
DLLApp := Application;
//保存 DLL 中初始的 Application 对象
DLLScreen := Screen;
DLLProc := @DLLUnloadProc;
//保证 DLL 卸载时恢复原来的 Application
end.

谢谢dorry的无私奉献精神，希望大家向他学习。

dorry：
请问一下，你的dll里面封装的是模式窗体还是非模式窗体？我想要的是非模式窗体。

我现在解决了这个方案。
1、主程序EXE和DLL业务模块是分开的。
2、EXE + MDI + DLL(Form) + DCOM 架构。
3、动态释放FREE的DLL。
4、变量可以在EXE或DLL相互使用。
我这里有商品源代码。Delphi2005@163.com

bbscom:
贴点代码出来，大家一起学习。

听课.

大家好：
我在delphi盒子（http://www.2ccc.com/article.asp?articleid=836）上面找到一个基本实现我的要求的例子，不过我还是弄不太明白。请高手指点。

散分