我的源程序贴出来，请高手指点迷津！

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窗体文件，该如何改写源代码！！！

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

...全文

258 18 打赏收藏转发到动态举报

写回复

用AI写文章

18 条回复

切换为时间正序

请发表友善的回复…

发表回复

knowledge_Is_Life 2008-05-01

打赏
举报

接分是王道！

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;