问题描述
- 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错误,请高手指点这是咋回事?
解决方案
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的连接字符,就可以了。
解决方案二:
改成传递TADOConnection的连接字符 ConnectionString,就可以了。
解决方案三:
delphi 调用dll窗体
delphi动态调用dll窗体
调用DLL窗体-Delphi实例
解决方案四:
回复 Robot-D
我看了你的实例,如果ADOCONNECTION创建在数据模块又怎么处理呢?
解决方案五:
通过构造函数或者变量把adoconnection传过来。
解决方案六:
首先你写的DLL,导出函数中居然传递了Delphi对象,如果传递对象,请带包编译,否则会出现问题,如果不想带包,可以使用接口代替对象传递
时间: 2024-08-03 08:03:58