Delphi中的数据库插件

type
  TfrmMain = class(TForm)

……

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的示例:

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

工程文件:

library ImpUFArc;

 

uses
  SysUtils,
  Classes,
  FfrmImportUFData in 'FfrmImportUFData.pas' {frmImportUFData};

{$R *.res}

exports
        PluginInit,
        MyPlugInDescript;

begin
end.

 

unit FfrmImportUFData;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, StdCtrls, ExtCtrls, ADODB, DB, ComCtrls,registry;

type
  TfrmImportUFData = class(TForm)

……
  private
    { Private declarations }
    procedure ImportUF(sFields, dFields: TStrings;Over:Boolean);
    procedure ImportClass(Over: Boolean);
  public
    { Public declarations }
  end;

procedure PluginInit(AHandle: THandle;vConn: TADOConnection);export;  stdcall;
procedure MyPlugInDescript(var Desc: PChar);export;  stdcall;

var
  frmImportUFData: TfrmImportUFData;

const
  RegSession:String='ImpUFArc';

implementation

{$R *.dfm}

procedure MyPlugInDescript(var Desc: PChar);export;  stdcall;
begin
  Desc:='导入用友基础档案';
end;

procedure PluginInit(AHandle: THandle;vConn: TADOConnection);export;  stdcall;
begin
   Application.Handle := AHandle;
   frmImportUFData:=TfrmImportUFData.Create(Application);
   frmImportUFData.qryTemp.Connection:=vConn;
   frmImportUFData.tblDes.Connection:=vConn;
   frmImportUFData.ShowModal ;
   frmImportUFData.Free;
end;