Delphi中一些DLL的运用（要传递Application和Screen，似乎还忘了传递提示控件）

Posted 2020-08-14 朝闻道

dll 调用部分：

{****************************************************************}
{ }
{　Project: DllDebug                      　　　　　　　　　　　 }
{　Copyright(c) 2003, 2005 　 　　　　　　　　　　　　　 }
{　Unit for UCommonUnit  　　　      　　　　　　　　　　　　　  }
{　Create  :　2003-01-05 by 林红卫 　　　　　　　　　　　 }
{　Modify  :　2003-01-16 by 林红卫 　　　　　　　　　　　 }
{                                                                }
{****************************************************************}

unit UCommonUnit;

interface

uses
  Windows,
  SysUtils,
  Forms;

type
  TRunDLL = procedure(DLLName, FormName, FormCaption: PChar;
    aApp: TApplication; Scr: TScreen) stdcall;

procedure RunDLLForm(DLLName, FormName, FormCaption: string;
  aApp: TApplication; Scr: TScreen) stdcall;

implementation

procedure RunDLLForm(DLLName, FormName, FormCaption: string;
  aApp: TApplication; Scr: TScreen) stdcall;
var
  RunDLL: TRunDLL;
  GetDllHWND: HWND;
begin
  GetDllHWND := LoadLibrary(PChar(DllName));
  try
    if GetDllHWND < 32 then
    begin
      MessageBox(0, \'没有找到附带DLL文件，请确认程序是否完整！\',
        \'加载DLL失败\', MB_OK);
      Exit;
    end;

    @RunDLL := GetProcAddress(GetDllHWND, \'RunDLL\');
    if @RunDLL <> nil then
    try
      RunDLL(PChar(UpperCase(Trim(DLLName))), PChar(UpperCase(Trim(FormName))),
        PChar(FormCaption), aApp,Scr);
    except
      raise Exception.Create(\'T\' + FormName + \'不存在！\');
    end;
  finally
    FreeLibrary(GetDllHWND);
  end;
end;

end.

dll ：

{****************************************************************}
{ }
{　Project: UDllTest 　        　　　　　　　　　　　 }
{　Copyright(c) 2003, 2005 　 　　　　　　　　　　　　　 }
{　Unit for UDllTest     　　　      　　　　　　　　　　　　　  }
{　Create  :　2003-01-05 by 林红卫 　　　　　　　　　　　 }
{　Modify  :　2003-01-16 by 林红卫 　　　　　　　　　　　 }
{                                                                }
{****************************************************************}

library UDllTest;

uses
  SysUtils,
  Forms,
  Messages,
  Variants,
  Windows,
  Classes,
  UFrmTestForm1 in \'UFrmTestForm1.pas\' {Form1},
  UFrmTestForm2 in \'UFrmTestForm2.pas\' {Form2};

var
  DLLApp: TApplication;
  DLLScreen: TScreen;

procedure RunDLL(DLLName, FormName, FormCaption: PChar;
  aApp: TApplication; Scr: TScreen) stdcall;
var
  TheClass: TPersistentClass;
  aForm: TForm;
begin
  Application := aApp;
  Screen := Scr;
  RegisterClasses([TForm1, TForm2]);

  TheClass := GetClass(\'T\' + FormName);
  if (TheClass = nil) then
    GetLastError;

  if TheClass.InheritsFrom(TForm)
    and (TheClass <> TForm) then
  begin
    aForm := TForm(TheClass.Create).Create(nil);
    aForm.Caption := FormCaption;
    try
      aForm.ShowModal;
    finally
      FreeAndNil(aForm);
    end;
  end;
end;

procedure DLLUnloadProc(dwReason: DWORD);
begin
  if dwReason = DLL_PROCESS_DETACH then
  begin
    Application := DLLApp; //恢复
    Screen := DLLScreen;
  end;
end;

exports
  RunDLL;

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

http://www.cnblogs.com/kfarvid/archive/2010/07/16/1778930.html