qiushuifuye 2015-08-04 03:41 采纳率: 100%
浏览 3608
已采纳

delphi DLL数据及窗体调用

DLL工程文件代码:

library DLLUSERS;
uses
  Windows,
  ADODB,
  Dialogs,
  Forms,
  SysUtils,
  Classes,
  U_DataModule in 'U_DataModule.pas' {DataModule1: TDataModule},
  U_Users in 'U_Users.pas' {Frm_Users},
  U_Initialize in 'U_Initialize.pas';
{$R *.res}
function GetForm(ClassName: PChar; DM: TDataModule1): TFormClass; stdcall;
begin
  DataModule1 := DM;
  Result:=TFormClass(FindClass(ClassName));
end;

procedure InitDLL(DM: TDataModule1); stdcall;
begin
  DataModule1:=DM;
end;

exports
  GetForm,InitDLL,SetUseName;
begin
end. 

DLL公共单元代码:

unit U_Initialize;
{DLL公共单元UNIT}
interface

  function GetUseName: PChar; stdcall;
  procedure SetUseName(SName: PChar); stdcall;

var
  StrName: PChar;

implementation

uses
  U_DataModule, ActiveX;

function GetUseName: PChar; stdcall;
begin
  Result:=StrName;
end;

procedure SetUseName(SName: PChar); stdcall;
begin
  StrName:=SName;
end;

initialization
  CoInitialize(nil);
  DataModule1 := TDataModule1.Create(nil);
finalization
  DataModule1.Free;
  CoUninitialize;

end. 

DLL数据模块代码:

 unit U_DataModule;
{数据模块}
interface

uses
  SysUtils, Classes, DB, ADODB;

type
  TDataModule1 = class(TDataModule)
    ADOCNT: TADOConnection;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  DataModule1: TDataModule1;

implementation

{$R *.dfm}

end.

DLL内部窗体代码:

 unit U_Users;
{DLL内部窗体}
interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DBGridEhGrouping, ComCtrls, GridsEh, DBGridEh, ExtCtrls,
  RzPanel, Menus, ADODB, DB, EhlibCDS, EhlibADO, Comobj, DBGridEhImpExp,
  U_DataModule;

type
  TFrm_Users = class(TForm)
    MainMenu1: TMainMenu;
    mmAdd: TMenuItem;
    mmEdit: TMenuItem;
    mmDelete: TMenuItem;
    mmRight: TMenuItem;
    mmFind: TMenuItem;
    mmDataOut: TMenuItem;
    mmClose: TMenuItem;
    RzGroupBox1: TRzGroupBox;
    DBGridEhUsers: TDBGridEh;
    StatusBar1: TStatusBar;
    SaveDialog1: TSaveDialog;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    ADOUsers,ADODelete:TADOQuery;
    DSUsers: TDataSource;
    { Public declarations }
  end;

var
  Frm_Users: TFrm_Users;

implementation

uses
  U_Initialize;

{$R *.dfm}

procedure TFrm_Users.FormCreate(Sender: TObject);
begin
  Font.Name:='Arial';
  ADOUsers:=TADOQuery.Create(nil);
  ADODelete:=TADOQuery.Create(nil);
  DSUsers:=TDataSource.Create(nil);
  ADOUsers.Connection:=DataModule1.ADOCNT;
  ADODelete.Connection:=DataModule1.ADOCNT;
  //设置文件类型列表和默认文件类型
  SaveDialog1.Filter:='Text files (*.txt)|*.TXT|Comma separated values (*.csv)|*.CSV|HTML file (*.htm)|*.HTM|Rich Text Format (*.rtf)|*.RTF|Microsoft Excel Workbook (*.xls)|*.XLS';
  SaveDialog1.FilterIndex:=0;
end;

procedure TFrm_Users.FormShow(Sender: TObject);
begin
  StrName:=GetUseName;
  with  ADOUsers  do
  begin
    Close;
    SQL.Clear;
    if String(StrName)='alsaby' then
    SQL.Add('select a.*,b.Person_Name,c.Partment_Name from t_User a '+
            'left join t_Person b on a.User_PersonId=b.Person_Id '+
            'left join t_Partment c on a.User_PartmentId=c.Partment_Id '+
            'order by a.User_Name') else
    if String(StrName)='admin' then
    SQL.Add('select a.*,b.Person_Name,c.Partment_Name from t_User a '+
            'left join t_Person b on a.User_PersonId=b.Person_Id '+
            'left join t_Partment c on a.User_PartmentId=c.Partment_Id '+
            'where a.User_Name<>''alsaby'' order by a.User_Name') else   
    SQL.Add('select a.*,b.Person_Name,c.Partment_Name from t_User a '+
            'left join t_Person b on a.User_PersonId=b.Person_Id '+
            'left join t_Partment c on a.User_PartmentId=c.Partment_Id '+
            'where a.User_Name<>''alsaby'' and a.User_Name<>''admin'' order by a.User_Name');
    Open;
  end;
  DSUsers.DataSet:=ADOUsers;
  DBGridEhUsers.DataSource:=DSUsers;
  StatusBar1.Panels[1].Text:=IntToStr(ADOUsers.RecordCount) +' 条数据。';
end;

procedure TFrm_Users.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  ADOUsers.Close;
  ADOUsers.Destroy;
  ADODelete.Close;
  ADODelete.Destroy;
  DSUsers.Destroy;
  Action:=caFree;
end;

initialization
  RegisterClass(TFrm_Users);
finalization
  UnRegisterClass(TFrm_Users);
end.

主程序调用代码:

 unit U_Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ImgList, ComCtrls, ADODB, DB, jpeg, ExtCtrls, RzPanel,
  RzSplit, RzTreeVw, U_DataModule;

type
  TInitDLL = procedure(DM: TFrm_DataModule); stdcall;
  TSetUseName = procedure(SName: PChar); stdcall;
  TGetForm = function(ClassName: PChar; DM: TFrm_DataModule): TFormClass; stdcall;
  TFrm_Main = class(TForm)
    MainMenu1: TMainMenu;
    mmSysFlies: TMenuItem;
    mmUserChange: TMenuItem;
    N2: TMenuItem;
    mmExit: TMenuItem;
    N1: TMenuItem;
    mmBakRecover: TMenuItem;
    mmSysUser: TMenuItem;
    N5: TMenuItem;
    StatusBar1: TStatusBar;
    OpenDialog1: TOpenDialog;
    ImageList1: TImageList;
    procedure FormCreate(Sender: TObject);
    procedure mmSysUserClick(Sender: TObject);
  private
    { Private declarations }
  public
    UName: String;
    { Public declarations }
  end;

var
  Frm_Main: TFrm_Main;
implementation

uses
  U_Public;

{$R *.dfm}

procedure TFrm_Main.FormCreate(Sender: TObject);
begin
  Font.Name:='Arial';
  UName:=Frm_DataModule.ADO_User.FieldByName('User_Name').AsString;
end;

procedure TFrm_Main.mmSysUserClick(Sender: TObject);
var
  DLLName: String;
  DLLHandle: THandle;
  FarProc: TFarProc;
  Form: TForm;
  SetUseName: TSetUseName;
  GetForm: TGetForm;
  InitDLL: TInitDLL;
begin
  GetDir(0,DLLName);
  DLLName := DLLName + '\DLLUSERS.dll';
  DLLHandle:= SafeLoadLibrary(DLLName);
  if DLLHandle > 0 then
    Try
      FarProc := GetProcAddress(DLLHandle, 'InitDLL');
      if FarProc<>nil then
      begin
        InitDLL := TInitDLL(FarProc);
        InitDLL(Frm_DataModule);
      end;

      FarProc := GetProcAddress(DLLHandle, 'SetUseName');
      if FarProc<>nil then
      begin
        SetUseName := TSetUseName(FarProc);
        SetUseName(PChar(Trim(UName)));
      end;

      FarProc := GetProcAddress(DLLHandle, 'GetForm');
      if FarProc<>nil then
      begin
        GetForm := TGetForm(FarProc);
        Form := GetForm('TFrm_Users', Frm_DataModule).Create(nil);
        Form.ShowModal;
        FreeAndNil(Form);
      end;
    Finally
      FreeLibrary(DLLHandle);
    End
  else
  ShowMessage(DLLName+'文件不存在!');  
end;

end.

以上在运行程序时没有错误,数据也正常显示,但是关闭调用的DLL内部窗体后,再次通过主程序调用就出现了Read of Address 00000008错误,请高手指点这是咋回事?

  • 写回答

5条回答 默认 最新

  • lyhoo163 2015-08-07 01:47
    关注

    function GetForm(ClassName: PChar; DM: TDataModule1): TFormClass; stdcall;
    begin
    DataModule1 := DM;
    Result:=TFormClass(FindClass(ClassName));
    end;

    procedure InitDLL(DM: TDataModule1); stdcall;
    begin
    DataModule1:=DM;
    end;

    传递了对象,是不可取的。必成传递TADOConnection的连接字符,就可以了。

    本回答被题主选为最佳回答 , 对您是否有帮助呢?
    评论
查看更多回答(4条)

报告相同问题?

悬赏问题

  • ¥15 如何构建全国统一的物流管理平台?
  • ¥100 ijkplayer使用AndroidStudio/CMake编译,如何支持 rtsp 直播流?
  • ¥20 和学习数据的传参方式,选择正确的传参方式有关
  • ¥15 这是网络安全里面的poem code
  • ¥15 用js遍历数据并对非空元素添加css样式
  • ¥15 使用autodl云训练,希望有直接运行的代码(关键词-数据集)
  • ¥50 python写segy数据出错
  • ¥20 关于线性结构的问题:希望能从头到尾完整地帮我改一下,困扰我很久了
  • ¥30 3D多模态医疗数据集-视觉问答
  • ¥20 设计一个二极管稳压值检测电路