Delphi中一些DLL的运用。

最新推荐文章于 2024-09-07 09:05:53 发布

转载最新推荐文章于 2024-09-07 09:05:53 发布 · 72 阅读

CC 4.0 BY-SA版权

原文链接：http://www.cnblogs.com/xiaobao/archive/2010/08/27/1810085.html

临时转载一些别人的代码：

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.

转载于:https://www.cnblogs.com/xiaobao/archive/2010/08/27/1810085.html