计算机编程

这是DLL的代码
library MyDll;
uses  SysUtils,  Dialogs,  Classes;
procedure ShowInfo(info:PChar);stdcall;begin  ShowMessage('您选择了【'+info+'】');end;
function GetCaption:Pchar;begin  Result := '中国';end;
exports ShowInfo,                GetCaption;
{$R *.res}
beginend.

type
  TfrmMain = class(TForm)

这是调用窗体的代码本例只使用了一个DLL,所以当有多个DLL时,需要循环DLL所在目录,依次加载DLL
unit Main;
interface
uses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs, StdCtrls, Menus, ExtCtrls;
type  TShowInfo = procedure (info:PChar);stdcall;  TGetCaption = function : PChar;stdcall;

……

  TForm1 = class(TForm)    Button1: TButton;    Button2: TButton;    MainMenu1: TMainMenu;    Image1: TImage;    procedure Button2Click(Sender: TObject);  private    { Private declarations }    FHandel : THandle;     //DLL句柄    FProAddress: Pointer;  //DLL中ShowInfo的地址    showinfo: TShowInfo;   //为动态加载DLL而设    procedure LoadPlusIn;  //加载插件(DLL)    procedure ItemClick(Sender: TObject);   //自定义菜单点击事件  public    { Public declarations }  end;
var  Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button2Click(Sender: TObject);begin  LoadPlusIn;end;
procedure TForm1.ItemClick(Sender: TObject);begin  @showinfo := FProAddress;     //取地址  if @showinfo <> nil then    showinfo(PWideChar(TMenuItem(Sender).Caption));  //执行DLL中的ShowInfoend;
procedure TForm1.LoadPlusIn;var  getcaption: TGetCaption;  item : TMenuItem;begin  FHandel := LoadLibrary('MyDll.dll');   //加载  if FHandel = 0 then  begin    ShowMessage('加载失败!');    Exit;  end  else  begin    @getcaption := GetProcAddress(FHandel,'GetCaption');    //取DLL中GetCaption地址    if @getcaption <> nil then    begin      item := TMenuItem.Create(MainMenu1);    //创建一个菜单      item.Caption := getcaption;             //取Caption,即调用DLL中的GetCaption      FProAddress := GetProcAddress(FHandel,'ShowInfo');  //取得DLL中ShowInfo的地址      item.OnClick := ItemClick;              //赋予菜单项的点击事件      MainMenu1.Items.Add(item);              //添加到主菜单    end;
  end;end;
end.

private:

    procedure LoadPlugin(sr: TSearchRec);
    procedure LoadPlugins;
    procedure PlugInClick(Sender: TObject);
  public
    { Public declarations }
  end;

type
  TPluginInit = procedure(AHandle: THandle;vConn: TADOConnection); stdcall;
  TPluginDescribe = procedure(var Desc: PChar); stdcall;

var
  frmMain: TfrmMain;
  LibHandle:THandle;

const
  cPLUGIN_DESCRIBE:PAnsiChar='MyPlugInDescript';
  cPLUGIN_INIT = 'PluginInit';
  cPLUGIN_MASK='*.dll';

 

{ 在应用程序目录下查找插件文件 }
procedure TfrmMain.LoadPlugins;
var
  sr:     TSearchRec;
  path:   string;
  Found: Integer;
begin
  lstPlugin.Items.Clear;
  path := ExtractFilePath(Application.Exename)+'PlugIn';
   try
    Found := FindFirst(path + cPLUGIN_MASK, 0, sr);
     while Found = 0 do begin
      LoadPlugin(sr);
      Found := FindNext(sr);
     end;
   finally
    FindClose(sr);
   end;
end;

// {加载指定的插件DLL. }
procedure TfrmMain.LoadPlugin(sr: TSearchRec);
var
  Description:   PChar;
  DescribeProc: TPluginDescribe;
  InitProc:      TPluginInit;
  LItem:TListItem;
  MItem:TMenuItem;
  s:String;
begin
  s:=ExtractFilePath(Application.Exename)+'PlugIn'+sr.Name;
  LibHandle := LoadLibrary(PChar(s));
//  FreeLibrary(LibHandle);
   if LibHandle <> 0 then
   begin
     // 查找 DescribePlugin.
     @DescribeProc := GetProcAddress(LibHandle,cPLUGIN_DESCRIBE);
     //if Assigned(DescribeProc) then
     if @DescribeProc<>nil then
     if true then
     begin
       // 调用 DescribePlugin.
       DescribeProc(Description);
       LItem:=lstPlugin.Items.Add ;
       LItem.Caption:=Description;
       LItem.SubItems.Add(sr.Name);

       MItem:=TMenuItem.Create(self);
       MItem.Caption := Description+'('+sr.Name+')';
       MItem.OnClick := PlugInClick;
       MItem.Tag:=lstPlugin.Items.Count ;
       MainMenu2.Items[3].Add(MItem);

       //FreeLibrary(LibHandle);
       //查找InitPlugin.

     end
     else
     begin
      MessageDlg('文件 "' + sr.Name +'" 不是插件.', mtInformation, [mbOK], 0);
      //FreeLibrary(LibHandle);
     end;
   end
   else
   begin
    MessageDlg('装入插件时发生错误! "' +sr.Name + '".', mtInformation, [mbOK], 0);
   end;
end;

procedure TfrmMain.PlugInClick(Sender: TObject);
var
  MyInitProc:TPluginInit;
  FName:String;
begin
  if FunPass('26',UPwd) then
  begin

    FName:=ExtractFilePath(Application.Exename)+'PlugIn'+lstPlugIn.Items[(Sender as TMenuItem).tag-1].SubItems[0];
    try
      LibHandle := LoadLibrary(PAnsiChar(FName));
      if LibHandle <> 0 then
      begin
         MyInitProc := GetProcAddress(LibHandle, cPLUGIN_INIT);
         if Assigned(InitProc) then
         begin
          //调用InitPlugin.
          MyInitProc(Application.Handle,dmMain.conn);
          //FreeLibrary(LibHandle);
         end;
      end
      else
       // FreeLibrary(LibHandle);
      begin
      end;
    except
    end;
  end;
end;

 

在窗口创建时调用:

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  LoadPlugins;
end;

 

//**********************************************************************

//下面是一个Plugin的示例:

其他新闻
  • 最近在公司写一个外壳程序,调用DLL插件把FORM嵌入到EXE中的一个PANEL中,其中遇到了不少的问题,大部分已经解决,还有几个至今没有找到解决方法,有待研究,也希望知道解决方法的富翁共享...
    2020-02-26
  •   unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,Forms, Dialogs, StdCtrls; type TForm1 = class(TForm)     Button1: TButton;     Button2: TButton;     procedure Button1Click(Sender: TO...
    2020-02-26
  • 这是DLL的代码 library MyDll; uses  SysUtils,  Dialogs,  Classes; procedure ShowInfo(info:PChar);stdcall;begin ShowMessage('您选择了【'+info+'】');end; function GetCaption:Pchar;begin  Result := '中国';end; exports ShowInfo...
    2020-02-26
友情链接

公司名称巴黎人电玩
版权所有:Copyright © 2015-2019 http://www.zhongqiangjy.com. 巴黎人电玩有限公司 版权所有

友情链接

Copyright © 2015-2019 http://www.zhongqiangjy.com. 巴黎人电玩有限公司 版权所有
公司地址http://www.zhongqiangjy.com