Delphi中一些DLL的运用(要传递Application和Screen,似乎还忘了传递提示控件)

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

 

posted @ 2016-10-12 00:37  findumars  Views(1531)  Comments(0Edit  收藏  举报