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;