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;

Delphi数据库应用程序中常见错误

01-11

Delphi数据库应用程序中常见错误、原因/解决方法: rnrn  数据感知控件DataSource属性未设置或者设置错误(链接为其他的DataSource) rnrn  原因:在设计时不小心改动,拷贝粘贴过程中未全部更改 rnrn  测试时标准代码中没有数据,无法进行测试 rnrn  解决:确定需要输入数据的表格的先后顺序,在依次输入测试数据,再进行测试 rnrn  wwFilterDialog中进行数据过滤时,应该显示字段列表的字段没有显示,不方便输入 rnrn  解决:判断字段,查找标码填充字段列表 rnrn  运行程序时出现字段未找到的错误 rnrn  原因:数据库进行了更改,而DataSet的字段列表没有更新 rnrn  用DBGrid显示数据时,为方便阅读,单数行与奇数行用不同颜色显示,在数据量时,浏览数据时明显感觉到DBGrid数据刷新不够,单数行与奇数行的颜色不能正确显示 rnrn  原因:DBGrid的 DataSource的DataSet中有较多的查找字段 rnrn  解决:将部分查找字段去除 rnrn  窗体标题为英文 rnrn  原因:设计后未仔细检查 rnrn  解决:更改为中文 rnrn  DBNavigator中“刷新”按钮点击后出错 rnrn  原因未知 rnrn  解决:去除该按钮 rnrn  与dxDBGrid配套使用的DBNavigator,在dxDBGrid的模式为LoadAll时,导航按钮与期望的方式不同 rnrn  原因:dxDBGrid在LoadAll模式时,与DataSet中的数据不一致 rnrn  解决:去除导航中的部分按钮 rnrn  由存储过程得到的数据集对应的DBNavigator的“刷新”出错 rnrn  原因:不清 rnrn  解决:去除该按钮 rnrn  窗体Show后,进入数据编辑后,部分查找字段编辑时出现数据集未打开 rnrn  原因:数据集打开顺序有问题 rnrn  解决:调整数据集的打开顺序,让标码数据集先打开 rnrn  出现未找到存储过程的错误 rnrn  原因:数据库的存储过程进行的重命名 rnrn  解决:更改DataSource中的存储程序名称 rnrn  wwFilterDialog的标题空白 rnrn  解决:改为与数据集相关的标题,如“筛选计划” rnrn  窗体在1024*768下设计时,即使窗体为800*600,在屏幕分辨率为800*600的时候出现窗体中的内容不能全部显示的现象 rnrn  解决:1024*768下设计800*600时预留一定的空间 rnrn  出现“Couldno’t perform the edit because another user changed the record”错误 rnrn  原因:未知 rnrn  dxDBGrid在将字段拖曳到分组栏时,不能进行编辑:dxDBGrid中的当前记录与数据感知控件的当前记录不一致 rnrn  解决:将二者在不同部分实现,不在同一窗体实现 rnrn  出现“General SQL Error”错误 rnrn  原因:未知。但发现在FormShow中打开表很多,尝试将其中部分表不打开时,错误消失,且不打开的表不同时,错误都消失 rnrn  (系统休眠后)第一次连接数据库时(用户、口令均正确),出现错误,但第二次则正常 rnrn  原因:未知 rnrn  打开/保存对话框未设置过滤条件 rnrn  解决:设置合理的Filter、DefaultExt rnrn  防差错措施不完善。(如输入数据(数字)出错时不报警) rnrn  解决:保存前验证正确性判断,设置Mask rnrn  数据感知控件DBComboBox应可进行选择和输入的输入框,不能进行输入 rnrn  解决:更改Style属性为csDropDown rnrn  其他更一般的问题: rnrn  模态对话框,Escape键不起作用 rnrn  解决:合理设置Button的Canceled属性 rnrn  模态对话框,回车键不起默认作用 rnrn  解决:合理设置Button的Defaulted属性 rnrn  使用Tab键后焦点跳转顺序无规律 rnrn  解决:设置控件的TabOrder属性 rnrn 转http://develop.csai.cn/delphi/200609131611001875.htm 论坛

没有更多推荐了,返回首页