寻一个在动态库中显示FORM的例程

Question

动态数据交换的例子：project1里包含两个form，第一个设置密码，第二个验证，testproject是测试程序，自己把project1生成一下。

Answer 1

function UserLogin(pUserName,pUserPassword:PChar):Integer;stdcall;
begin
  result:=0;
  dlgLogin:=TdlgLogin.Create(Application);
  try
    dlgLogin.ShowModal;
    result:=1;
  finally
    freeandnil(dlglogin);
  end;
end;exports
    UserLogin index 1 name 'UserLogin',

Answer 2

//DLL
library Func;uses
  ShareMem,
  SysUtils,
  Classes,
  Forms,
  Windows,
  MConnect,
  Child2 in 'Child2.pas' {FormChild2};{$R *.RES}procedure CallModule();stdcall;export;
begin
    if not Assigned(FormChild2) then
        FormChild2 := TFormChild2.Create(Application);
    FormChild2.Show;
end;exports
   CallModule;begin
end;//MDIChild单元：procedure TFormChild2.N9Click(Sender: TObject);
begin
    Close;
end;procedure TFormChild2.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
    Action := caFree;
end;procedure TFormChild2.FormDestroy(Sender: TObject);
begin
    FormChild2 := nil;
end; 
 
//主程序：
type
  TCallModule =  procedure();stdcall;var
    FormMain: TFormMain;
    LibHandle: HModule;
    procedure LoadModule(AModuleName: String);implementation{$R *.DFM}
procedure LoadModule(AModuleName: String);
var
    CallModule: TCallModule;
begin
    LibHandle := LoadLibrary(PChar(AModuleName));
    if LibHandle = 0 then Exit;
        @CallModule := GetProcAddress(LibHandle,'CallModule');
    if @CallModule <> nil then
        CallModule();
end;procedure TFormMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
    iCount: Integer;
begin
    if MessageDLG('是否退出？',mtConfirmation,[mbYes,mbNO],0) = mrYes then
    begin
        for iCount := 0 to MDIChildCount - 1 do
            MDIChildren[iCount].Close;       
        CanClose := True;
        if not (LibHandle = 0) then
            FreeLibrary(LibHandle);
    end else
        CanClose := False;
end;关键是无论DLL还是EXE都要带运行时间包VCL50.bpl编译 
 
这是一个调用DLL中MDICHILDFORM的例子，改成其他窗体类型，一样能用 

Answer 3

dll代码：
library Project1;uses
  SysUtils,
  Classes,
  Unit1 in 'Unit1.pas' {SetPassWordForm},
  Unit2 in 'Unit2.pas' {GetPasswordForm};exports
  GetPassword, SetPassword;{$R *.RES}begin
end.unit1和unit2：
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons;type
  TSetPassWordForm = class(TForm)
    Label1: TLabel;
    Edit1: TEdit;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    procedure FormCreate(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
    Verified:Boolean;
  public
    { Public declarations }
    PassWord:PChar;
  end;  function SetPassWord(Pword:Pchar):boolean;implementation{$R *.DFM}procedure TSetPassWordForm.FormCreate(Sender: TObject);
begin
Verified:=false;
PassWord:=StrAlloc(40);
bitbtn1.Enabled:=false;
label1.Caption:='Please Input PassWord:';
end;function SetPassWord(Pword:Pchar):boolean;
var
SetPassWordForm:TSetPassWordForm;
begin
result:=false;
SetPassWordForm:=TSetPassWordForm.Create(application);
  try
  with SetPasswordform do
  if showmodal = mrok then
    begin
    strcopy(pword,strUpper(password));
    result:=true;
    end;
  finally
  setpasswordform.Free;
  end;
end;procedure TSetPasswordForm.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if Edit1.Text = '' then Exit;
if Key=#13 then
  begin
  if Verified then
      if strpas(PassWord) = Edit1.Text then
        begin
        bitbtn1.Enabled:=true;
        Edit1.Enabled:=false;
        bitbtn1.SetFocus;
        end
      else
        begin
        Verified:=false;
        Messagedlg('PassWord is InValid.',mtwarning,[mbok],0);
        edit1.Text:='';
        Password:= nil;
        PassWord:= StrAlloc(40);
        label1.Caption:='Please Input PassWord:'
        end
  else
    begin
    Verified:=true;
    strPCopy(Password,edit1.text);
    Edit1.Text:='';
    label1.Caption:='Please Verify PassWord:';
    end;
  Key:=#0;
  end;
end;end.
unit Unit2;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons;type
  TGetPasswordForm = class(TForm)
    Edit1: TEdit;
    Label1: TLabel;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
  private
    { Private declarations }
  public
    { Public declarations }
  end;function GetPassword(Password: PChar): Boolean;implementation{$R *.DFM}{ TGetPasswordForm }function GetPassword(Password: PChar): Boolean;
var
  GetPasswordForm: TGetPasswordForm;
begin
  Result:= False;
  GetPasswordForm:= TGetPasswordForm.Create(Application);
  try
    with GetPasswordForm do
      if ShowModal = mrOK then
        if UpperCase(Edit1.Text) <> StrPas(StrUpper(Password)) then
          MessageDlg('Invalid Password', mtWarning, [mbok], 0)
        else
          Result:= True;
  finally
    GetPasswordForm.free;
  end;
end;end.
测试程序：
program TestProject;uses
  Forms,
  TestUnit in 'TestUnit.pas' {Form1};{$R *.RES}begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.
unit TestUnit;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;
  Password: PChar;function SetPassWord(Pword:Pchar):boolean; external 'Project1.dll';
function GetPassword(Password: PChar): Boolean; external 'Project1.dll';
implementation{$R *.DFM}procedure TForm1.Button1Click(Sender: TObject);
begin
  PassWord:= StrAlloc(40);
  if SetPassWord(PassWord) = False then
    MessageDlg('PassWord is not set', mtInformation, [mbok],0);
end;procedure TForm1.Button2Click(Sender: TObject);
begin
  if PassWord = nil then
  begin
    MessageDlg('Set password first', mtInformation, [mbok], 0);
    Button1.SetFocus;
    Exit;
  end;
  if GetPassword(Password) then
    Label1.Caption:= 'Your are Wellcome!'
  else
    Label1.Caption:= 'Sorry, Your are InValid User.';
end;end.