• 设为首页
  • 点击收藏
  • 手机版
    手机扫一扫访问
    迪恩网络手机版
  • 关注官方公众号
    微信扫一扫关注
    公众号

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

原作者: [db:作者] 来自: [db:来源] 收藏 邀请
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

 


鲜花

握手

雷人

路过

鸡蛋
该文章已有0人参与评论

请发表评论

全部评论

专题导读
上一篇:
解决DelphiMDI闪烁问题(使用WM_SETREDRAW锁屏后进行处理)发布时间:2022-07-18
下一篇:
C#的DLL注册为COM,Delphi来调用发布时间:2022-07-18
热门推荐
阅读排行榜

扫描微信二维码

查看手机版网站

随时了解更新最新资讯

139-2527-9053

在线客服(服务时间 9:00~18:00)

在线QQ客服
地址:深圳市南山区西丽大学城创智工业园
电邮:jeky_zhao#qq.com
移动电话:139-2527-9053

Powered by 互联科技 X3.4© 2001-2213 极客世界.|Sitemap