码迷,mamicode.com
首页 > 移动开发 > 详细

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

时间:2016-10-12 07:00:10      阅读:213      评论:0      收藏:0      [点我收藏+]

标签:

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

 

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

标签:

原文地址:http://www.cnblogs.com/findumars/p/5951318.html

(0)
(0)
   
举报
评论 一句话评论(0
登录后才能评论!
© 2014 mamicode.com 版权所有  联系我们:gaon5@hotmail.com
迷上了代码!