我的源程序贴出来,请高手指点迷津!

wosyjy 2008-04-25 05:49:17

主程序:如下:
unit UCRM_MAIN;

interface

uses
................
type
TFZX_MAIN = class(TForm)
MainMenu1: TMainMenu;
G1: TMenuItem;
........
var
FZX_MAIN: TFZX_MAIN;
//
procedure FCrm_BAAGLAPP(App:THandle);stdcall;external '.\HBDLL\DllCrm_BAAGL.dll';
procedure FCrm_BAAGLSFM(frmAy:array of string;frmStrL:TStringList);stdcall;external'.\HBDLL\DllCrm_BAAGL.dll';

procedure FCrm_BMAGLAPP(App:THandle);stdcall;external '.\HBDLL\DllCrm_BMAGL.dll';
procedure FCrm_BMAGLSFM(frmAy:array of string;frmStrL:TStringList);stdcall;external '.\HBDLL\DllCrm_BMAGL.dll';
..........
//

procedure TFZX_MAIN.SM01M02Click(Sender: TObject);
var mainAy : array of string ;
begin
SetLength(mainAy,2);
mainAy[0] := userno ; mainAy[1] := dllcurdir;
FCrm_BAAGLAPP(Application.Handle);
FCrm_BAAGLLSFM(mainAy,UserpowerStr);
mainAy := nil ;
end;

procedure TFZX_MAIN.SM01M02Click(Sender: TObject);
var mainAy : array of string ;
begin
SetLength(mainAy,2);
mainAy[0] := userno ; mainAy[1] := dllcurdir;
FCrm_BMAGLAPP(Application.Handle);
FCrm_BMAGLLSFM(mainAy,UserpowerStr);
mainAy := nil ;
end;

//以上是静态用两个功能 封装好的作业
第一个封装的窗体源码如下:
///////////////////
library DllCrm_BAAGL;


uses
ShareMem,
SysUtils,
Classes,
UCrm_BAAGL in 'UCrm_BAAGL.pas' {FCrm_BAAGL};

{$R *.res}
function GetDllChildFormBAAGL(Parent:TComponent):TFCrm_BAAGL;stdcall;
begin
Result := TFCrm_BAAGL.Create(Parent);
end;

exports
FCrm_BAAGLAPP,FCrm_BAAGLSFM;

begin
end.
////////////////////////
unit UCrm_BAAGL;

interface
uses
.............
type
TFCrm_BAAGL = class(TForm)
.............................
var
FCrm_BAAGL: TFCrm_BAAGL;

procedure FCrm_BAAGLAPP(App:THandle);stdcall;
procedure FCrm_BAAGLSFM(frmAy:array of string;frmStrL:TStringList);stdcall;

implementation

{$R *.dfm}
//***** 窗体初始调用 *****
procedure FCrm_BAAGLAPP(App:THandle );stdcall;
begin
Application.Handle := App;
end;
//***** 窗体初始调用 *****
procedure FCrm_BAAGLSFM(frmAy:array of string;frmStrL:TStringList);stdcall;
begin
try
if not Assigned(FCrm_BAAGL) then
FCrm_BAAGL := TFCrm_BAAGL.Create(Application);
try
userno := frmAy[0] ;
dllcurdir := frmAy[1] ;
UserpowerStr := TStringList.Create;
UserpowerStr.CommaText := frmStrL.CommaText ;
FCrm_BAAGL.ShowModal;
finally
FCrm_BAAGL.Free;
end;
except
on E: Exception do
MessageDlg ('Error in CRMBAAFm: ' +
E.Message, mtError, [mbOK], 0);
end;
end;
第二个窗体同第一个相似。
////////////////////

请教高手,我想在主程序中,动态调用这两个DLL窗体文件,该如何改写源代码!!!

先谢谢了!!! 能否将具体改写的代码给出,有老了!! 多谢!!!




...全文
196 点赞 收藏 18
写回复
18 条回复
切换为时间正序
当前发帖距今超过3年,不再开放新的回复
发表回复
接分是王道!
回复
wxsan 2008-04-26
顶!
回复
GDTOPONE 2008-04-26
其实blazingfire 已经写得好明白了,我又用了一个从头到尾的简单例子给你看,你还是不明白就真的没办法了.
回复
GDTOPONE 2008-04-26
又加了一个动态调用的例子,应该明白了吧?
回复
GDTOPONE 2008-04-26
动态调用:

unit UFcall;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TFcall = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Fcall: TFcall;

implementation

{$R *.dfm}
{------------------请注意------------------------------}
//procedure FCrm_BAAGLAPP(App:THandle);stdcall;external 'mydll.dll';

procedure TFcall.Button1Click(Sender: TObject);
type
TShowNls = procedure(App:THandle);stdcall;
var
Th:Thandle;
ShowNls:TShowNls;
Tp:TFarProc;
begin
Th:=LoadLibrary('mydll.dll'); {装载DLL}
if Th>0 then
try
Tp:=GetProcAddress(Th,PChar('FCrm_BAAGLAPP'));
if Tp<>nil then begin
ShowNls:=TShowNls(Tp);
ShowNls(Application.Handle);
end
else
ShowMessage('FCrm_BAAGLAPP过程没有找到');
finally
FreeLibrary(Th); {释放DLL}
end
else
ShowMessage('mydll.dll没有找到');
end;

end.
回复
wosyjy 2008-04-26
楼上说的很清楚,这里先谢谢!
你改过的程序,是可以正常运行的。(我原来的程序正常运行没问题,但都是在静态调用)。
我的程序和你改过的程序,在动态调用时,就出错了。
我现在希望知道如何成功的动态调用,也就是将我原来的静态调用改成动态调用,(我会普通的函数或过程的动态调用),
但窗体的动态调用就不行了。请指点!!
回复
GDTOPONE 2008-04-26
其实答案一早出来了,也话是楼主没有用心去看,将我再举个例子吧

1.DLL的主体:

library MYDLL;

{ Important note about DLL memory management: ShareMem must be the
first unit in your library's USES clause AND your project's (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }

uses
SysUtils,
Classes,
Umain in 'Umain.pas' {Fmain};

{$R *.res}
exports
FCrm_BAAGLAPP;

begin
end.


2.DLL里内的窗体:

unit Umain;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TFmain = class(TForm)
Button1: TButton;
Edit1: TEdit;
ListBox1: TListBox;
procedure Button1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

{---看看这里与你的对比---}

procedure FCrm_BAAGLAPP(App: THandle); stdcall;

implementation

{$R *.dfm}
procedure FCrm_BAAGLAPP(App: THandle); stdcall;
var
Fmain: TFmain;
begin
Application.Handle := App;
Fmain:=TFmain.Create(Application);
try
Fmain.ShowModal;
finally
Fmain.Free;
end;
end;
procedure TFmain.Button1Click(Sender: TObject);
begin
{--窗体的按钮单激事件--}
close;
end;

procedure TFmain.FormShow(Sender: TObject);
begin
{--窗体的show事件--}
edit1.Text:='abc';
end;

procedure TFmain.FormCreate(Sender: TObject);
var
i:integer;
begin
{窗体的FormCreate}
for i := 0 to 20 do
ListBox1.Items.Add(inttostr(i));
end;

end.


3.调用:

unit UFcall;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TFcall = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Fcall: TFcall;

implementation

{$R *.dfm}
procedure FCrm_BAAGLAPP(App:THandle);stdcall;external 'mydll.dll';

procedure TFcall.Button1Click(Sender: TObject);
begin
FCrm_BAAGLAPP(Application.Handle);
end;

end.


以上是一个简单的例子,同样的如楼主所说的:我的窗体中,有FormShow(Sender: TObject);事件.
回复
wosyjy 2008-04-25
unit UCrm_BAAGL;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DB, ADODB, Grids, DBGrids, StdCtrls, Mask, DBCtrls, Buttons,
ExtCtrls, AppEvnts;

type
TFCrm_BAAGL = class(TForm)
PanMenu: TPanel;
Madd: TSpeedButton;
Mmod: TSpeedButton;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure MaddClick(Sender: TObject);

....




回复
wosyjy 2008-04-25
还是不行,提示要增加USEs unit UCrm_BAAGL 单元,因为我的UCrm_BAAGL 单元中有很多过程,包括FORMSHOW;
回复
blazingfire 2008-04-25
作如下修改,修改部分用////标出:

unit UCrm_BAAGL;

interface
uses
.............
type
TFCrm_BAAGL = class(TForm)
.............................
////var
////FCrm_BAAGL: TFCrm_BAAGL;

procedure FCrm_BAAGLAPP(App: THandle); stdcall;
procedure FCrm_BAAGLSFM(frmAy: array of string; frmStrL: TStringList); stdcall;

implementation

{$R *.dfm}
//***** 窗体初始调用 *****

procedure FCrm_BAAGLAPP(App: THandle); stdcall;
begin
Application.Handle := App;
end;
//***** 窗体初始调用 *****

procedure FCrm_BAAGLSFM(frmAy: array of string; frmStrL: TStringList); stdcall;
var
FCrm_BAAGL: TFCrm_BAAGL;
begin
try
if not Assigned(FCrm_BAAGL) then
////FCrm_BAAGL := TFCrm_BAAGL.Create(Application);
FCrm_BAAGL := TFCrm_BAAGL.Create(nil);//TFCrm_BAAGL创建以nil作为Owner试试
try
userno := frmAy[0];
dllcurdir := frmAy[1];
UserpowerStr := TStringList.Create;
UserpowerStr.CommaText := frmStrL.CommaText;
FCrm_BAAGL.ShowModal;
finally
FCrm_BAAGL.Free;
end;
except
on E: Exception do
MessageDlg('Error in CRMBAAFm: ' +
E.Message, mtError, [mbOK], 0);
end;
end;


另外,主程序和DLL程序dpr单元的Uses部分引用的第一个单元一定要是ShareMem
回复
wosyjy 2008-04-25
我的窗体中,有FormShow(Sender: TObject);事件

procedure TFCrm_BAAGL.FormShow(Sender: TObject);
begin
oldwhere := ' ';
fm_caption:= ';
enlist := 'MaddMmodMdelMsavMyfqPanEditPanList';
proc_no:='HBCBAA0100';

BAAGLShowForm();
BAAGLShow();
end;
回复
wosyjy 2008-04-25
静态调用,没问题,动态调用不行。(我没有注销 //FCrm_BAAGL: TFCrm_BAAGL )因注销后执行不了。
回复
wosyjy 2008-04-25
动态调用时,还是报错,同上面信息一样,
{var
//FCrm_BAAGL: TFCrm_BAAGL;---------------------这里注掉 }
这里注掉的话,编译时提示要加 uses Fcrm_baagl
回复
GDTOPONE 2008-04-25
//FCrm_BAAGL: TFCrm_BAAGL;---------------------这里注掉

procedure FCrm_BAAGLAPP(App:THandle);stdcall;

更改为:

//FCrm_BAAGL: TFCrm_BAAGL;---------------------这里注掉
procedure FCrm_BAAGLAPP(App:THandle,frmAy:array of string;frmStrL:TStringList);stdcall;

回复
GDTOPONE 2008-04-25

unit UCRM_MAIN;

interface

uses
................
type
TFZX_MAIN = class(TForm)
MainMenu1: TMainMenu;
G1: TMenuItem;
........
var
FZX_MAIN: TFZX_MAIN;

procedure FCrm_BAAGLAPP(App:THandle,frmAy:array of string;frmStrL:TStringList);stdcall;external '.\HBDLL\DllCrm_BAAGL.dll';


procedure TFZX_MAIN.SM01M02Click(Sender: TObject);
var mainAy : array of string ;
begin
SetLength(mainAy,2);
mainAy[0] := userno ; mainAy[1] := dllcurdir;
FCrm_BAAGLAPP(Application.Handle,mainAy,UserpowerStr);
mainAy := nil ;
end;



第一个封装的窗体源码如下:
///////////////////
library DllCrm_BAAGL;


uses
ShareMem,
SysUtils,
Classes,
UCrm_BAAGL in 'UCrm_BAAGL.pas' {FCrm_BAAGL};

{$R *.res}
function GetDllChildFormBAAGL(Parent:TComponent):TFCrm_BAAGL;stdcall;
begin
Result := TFCrm_BAAGL.Create(Parent);
end;

exports
FCrm_BAAGLAPP;

begin
end.
////////////////////////
unit UCrm_BAAGL;

interface
uses
.............
type
TFCrm_BAAGL = class(TForm)
.............................
var
//FCrm_BAAGL: TFCrm_BAAGL;---------------------这里注掉

procedure FCrm_BAAGLAPP(App:THandle);stdcall;


implementation

{$R *.dfm}
//***** 窗体初始调用 *****
procedure FCrm_BAAGLAPP(App:THandle,frmAy:array of string;frmStrL:TStringList);stdcall;
var
FCrm_BAAGL: TFCrm_BAAGL;//------------这里加回先前注掉的
begin
Application.Handle := App;
try
if not Assigned(FCrm_BAAGL) then
FCrm_BAAGL := TFCrm_BAAGL.Create(Application);
try
userno := frmAy[0] ;
dllcurdir := frmAy[1] ;
UserpowerStr := TStringList.Create;
UserpowerStr.CommaText := frmStrL.CommaText ;
FCrm_BAAGL.ShowModal;
finally
FCrm_BAAGL.Free;
end;
except
on E: Exception do
MessageDlg ('Error in CRMBAAFm: ' +
E.Message, mtError, [mbOK], 0);
end;

end;

回复
wosyjy 2008-04-25
哪位大侠能帮助解决了,就马上给分,结贴。
我动态调用其它的函数和过程,都没问题,碰到窗体,就不行了,就是不知道原因是什么,窗体封装的原理又是什么???
回复
wosyjy 2008-04-25
不行,出现错误,access violation at address 083c95Bc.read of address 083c95Bc.信息。
如果是函数或过程,这样调用是没有问题的,但是封装窗体,动态调用,就不行。我搞不懂,错在哪里了!!
回复
mantti 2008-04-25

unit UCRM_MAIN;

interface

uses
................
type
TFCrm_BAAGLAPP = procedure(App:THandle);stdcall; //申明
TFCrm_BAAGLSFM = procedure FCrm_BAAGLSFM(frmAy:array of string;frmStrL:TStringList);stdcall; //申明
TFZX_MAIN = class(TForm)
MainMenu1: TMainMenu;
G1: TMenuItem;
........
var
FZX_MAIN: TFZX_MAIN;

procedure TFZX_MAIN.SM01M02Click(Sender: TObject);
var mainAy : array of string ;
var
MyFuncA: TFCrm_BAAGLAPP;
MyFuncB: TFCrm_BAAGLSFM;
FPointer: TFarProc;
handle: THandle;
begin
SetLength(mainAy,2);
mainAy[0] := userno ; mainAy[1] := dllcurdir;

hanlde := LoadLibrary(PChar('.\HBDLL\DllCrm_BAAGL.dll')); //装载Library
if handle <> 0 then
begin
FPointer := GetProcAddress(handle, 'FCrm_BAAGLAPP');
if not (FPointer = nil) then
begin
MyFuncA := TFCrm_BAAGLAPP(FPointer);
MyFuncA(Application.Handle);
FreeLibrary(handle);
end;
end;

hanlde := LoadLibrary(PChar('.\HBDLL\DllCrm_BAAGL.dll'));
if handle <> 0 then
begin
FPointer := GetProcAddress(handle, 'FCrm_BAAGLSFM');
if not (FPointer = nil) then
begin
MyFuncB := TFCrm_BAAGLSFM(FPointer);
MyFuncB(mainAy, UserpowerStr);
FreeLibrary(handle);
end;
end;

mainAy := nil ;
end;
回复
相关推荐
发帖
Delphi
创建于2007-08-02

4925

社区成员

Delphi 开发及应用
申请成为版主
帖子事件
创建了帖子
2008-04-25 05:49
社区公告
暂无公告