Dll 中封装多窗体;参考了各位高手的文章。
主程序：
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 63 do begin
if LoadCon[i].Connr=false then
Continue;
CheckRet:=UnloadConnection_ex6(i);
if (CheckRet=0)or (CheckRet=$7030) then
LoadCon[i].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 63 do
LoadCon[i].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.
