您的位置：程序门 -> delphi -> 网络通信/分布式开发



请问我在dll中使用了spcomm控件，现在是如何在dll中spcomm的writecommdata方法里写代码，以及如何在onreceivedata事件中写代码？


[收藏此页] [打印本页]选择字色：背景色：字体：[大][中][小]


请问我在dll中使用了spcomm控件，现在是如何在dll中spcomm的writecommdata方法里写代码，以及如何在onreceivedata事件中写代码？[已结贴,结贴人:yikeshu_888]
发表于：2007-03-01 17:13:09 楼主
关于发送指令，我现在在dll中是这样写的：
function   sendcommdata（scomm:pchar):longbool;stdcall;
var
      sinit6:string;
begin
          try
                comm1.commname:=scomm;
                sinit6:=hextostr（ '6899999999999968050161cd16 ');
                comm1.writecommdata（pchar（sinit6),length（sinit6));
                result:=true;
          except
                result:=false;
          end;
end;

在调用程序的按扭上是这样写的：
procedure   tfcomm.btnrestoreclick（sender:   tobject);
begin
if   sendcommdata（slt_com.text)   then
          //showmessage（ '复位卡的初始化指令发送成功);
else
      messagedlg（ '复位卡的初始化指令发送失败! ',mterror,[mbyes],0);
end;
现在的问题是:
1.上述的发送指令的方法和思路是否正确，各位是如何将发送指令的代码放在dll中的？
2.发送指令后，如何在dll中写代码来触发onreceivedata事件？
    我之前在窗体上放个spcomm控件，然后再在onreceivedata事件知道如何写代码，但现在不知道在dll中如何写触发onreceivedata事件的代码。

请各位高手指点，非常感谢。    
发表于：2007-03-01 17:32:551楼 得分:0
1.思路是对的，在dll中封装函数，外部参数调用
2.要得到onreceivedata返回事件的内容，是通过时间等待，判断是否符合你想要得到的数据包格式。
发表于：2007-03-01 19:15:482楼 得分:0
谢谢anime_jin朋友，
对于2，我的意思是如何在dll中写onreceivedata返回事件?
事件内容的代码我会写，之前把spcomm控件放到窗体上时我是这样写的，如：
procedure   tfcomm.comm1receivedata（sender:   tobject;   buffer:   pointer;
    bufferlength:   word);
var     s,sinit2;
begin
            //接收rs232的数据并显示memo1上。
            setlength（s,bufferlength);
            move（buffer^,pchar（s)^,bufferlength);
            memo1.lines.add（strtohex（s));
            memo1.invalidate;

            //如果”初始化1“成功，则进入下一步初始化2。
            if   （strtohex（s)= '68   ff   ff   ff   ff   ff   ff   68   c5   01   62   f2   16 ')   and   （jstimes=1)   then
                  begin
                          sinit2:=hextostr（ '68999999999999680301016b16 ');
                          comm1.writecommdata（pchar（sinit2),length（sinit2));
                  end;
end;

但现在是将spcomm放到dll中，我就不知道如何在dll中来编写这个触发事件（不是指编写事件的内容）。

请问有没有相关的代码例子，谢谢。
发表于：2007-03-02 09:21:403楼 得分:0
type
    tmycomm=class（tcomm)
      public
        procedure   myrecedataproc（sender:   tobject;   buffer:   pointer;
    bufferlength:   word);
      end;

var
    mycomm:tmycomm;

imp.....
        procedure   tmycomm.myrecedataproc（sender:   tobject;   buffer:   pointer;
    bufferlength:   word);
begin
//enter   the   code   here...   for   recevice   the   data....

end;


-----------------------------------------------------------------
//create   a   dynimac   comm   object   to   send   data   and   recevice   data....  

mycomm:=tmycomm.create（nil);
mycomm.commname:= 'com1 ';
//---set   up   the   params...

mycomm.onrecevicedata:=mycomm.myrecedataproc;
-----------------------------------------------------------------

//send   data...
var
  psendpoint:pchar;
  senddata:string;
  sendlen:integer;

 
senddata:= 'send   data   to   device. ';
psendpoint:=@senddata[1];
sendlen:=length（senddata);
mycomm.writecommdata（psendpoint,sendlen);
....


发表于：2007-03-02 10:43:334楼 得分:0
谢谢楼上朋友，我是想将数据的发送，以及接收返回数据的处理等都放在dll中，调用程序仅传递几个必要的参数给dll进行处理。

我的dll文件大致是这样的：
library   project1;
uses
    sysutils,
    classes,
    dialogs,
    spcomm;
var
      comm1:tcomm;
{$r   *.res}


function   opencomm（scomm:pchar):longbool;stdcall;
begin
    comm1:=tcomm.create（nil);
    try
          try
                comm1.commname:=scomm;
                comm1.startcomm;
                result:=true;
          except
                result:=false;
          end;
  finally
      //comm1.free;
  end;

end;

function   closecomm（scomm:pchar):longbool;stdcall;
begin
          try
                comm1.commname:=scomm;
                comm1.stopcomm;
                result:=true;
          except
                result:=false;
          end;
end;

procedure   mycomm1receivedata（sender:   tobject;   buffer:   pointer;
    bufferlength:   word);
begin
      showmessage（ '测试看能不能执行到这里。 ');
end;

function   sendcommdata（scomm:pchar):longbool;stdcall;
var
      sinit6:string;
begin
          try
                comm1.commname:=scomm;
                sinit6:=hextostr（ '6899999999999968050161cd16 ');
                comm1.writecommdata（pchar（sinit6),length（sinit6));
                result:=true;
          except
                result:=false;
          end;

    comm1.onreceivedata:=mycomm1receivedata;
    //此行编译时通不过，提示：[error]   project1.dpr（202):   incompatible   types:   'method   pointer   and   regular   procedure '     我现在不知道如何调用这个过程，给这个过程传参。
end;

exports
opencomm,closecomm,sendcommdata;
begin
end.

请指点，非常感谢。
发表于：2007-03-02 10:59:125楼 得分:0
我写的dll中   触发     主窗体的事件的例子
直接   传事件

//////////////////dll   部分

library   project1;

uses
    sysutils,
    classes,
    forms,
    unit1   in   'unit1.pas '   {form1};

{$r   *.res}
procedure   setevent（i:tmyp);stdcall;
begin
form1:=tform1.create（application);
form1.myevent:=i;
//form1.show;
end;
exports
    setevent   index   1;   //    
begin
end.


unit   unit1;

interface

uses
      windows,   messages,   sysutils,   variants,   classes,   graphics,   controls,   forms,
      dialogs,   extctrls,   stdctrls;

type
      tmyp   =   procedure（buf:   pchar;   len:   integer)   of   object;
      tform1   =   class（tform)
            timer1:   ttimer;
            procedure   timer1timer（sender:   tobject);
      private
        {   private   declarations   }
      public
            myevent:   tmyp;
      end;

var
      form1:   tform1;

implementation

{$r   *.dfm}

procedure   tform1.timer1timer（sender:   tobject);
var
      str:   string;

begin
      str   :=   formatdatetime（ 'yyyy-mm-dd   hh:nn:ss   zzz ',   now)   +   '   爱吃猪脚 ';
      if   assigned（myevent)   then
            myevent（pchar（str),   length（str));
end;

end.


主程序

unit   unit2;

interface

uses
      windows,   messages,   sysutils,   variants,   classes,   graphics,   controls,   forms,
      dialogs,   stdctrls;

type
      tmyp   =   procedure（buf:   pchar;   len:   integer)   of   object;
      tset   =   procedure（i:   tmyp);   stdcall;

      tform1   =   class（tform)
            button1:   tbutton;
            memo1:   tmemo;

            procedure   button1click（sender:   tobject);
      private
        {   private   declarations   }
      public
            myevent:   tmyp;
            procedure   myp（buf:   pchar;   len:   integer);  
      end;

var
      form1:   tform1;
      temp:   tset;

implementation

{$r   *.dfm}

procedure   tform1.button1click（sender:   tobject);
var
      dllhandle:   thandle;
begin
      dllhandle   :=   loadlibrary（pchar（ 'project1.dll '));
      if   dllhandle   =   0   then
            begin
                  showmessage（ '找不到指定的连接库 ');
                  exit;
            end;
      @temp   :=   getprocaddress（dllhandle,   pchar（ 'setevent '));
      myevent   :=   myp;
      temp（myevent);
end;

procedure   tform1.myp（buf:   pchar;   len:   integer);

var
      str:   string;
begin
      setlength（str,   len);
      move（buf[0],   str[1],   len);
      memo1.lines.add（str);
      str   :=   ' ';
end;

end.


发表于：2007-03-02 13:06:306楼 得分:0
楼上朋友，我把你的例子作了测试，点击button1没有任何反应呀。
发表于：2007-03-02 16:31:107楼 得分:0
ms       dll不支持事件的吧，可以封装成com组件
发表于：2007-03-02 16:52:318楼 得分:0
我自己写的   可以   运行的
你可以   +我qq   253377572
发表于：2007-03-02 19:52:429楼 得分:0
这个东西我经常做！我先说说我的做法，一般情况我是写一个类，如
type
    tmydllclass   =   class
    private
        mycomm   :   tcomm;
        procedure   recvdata（sender   :   tobject;buffer   :   pointer;   bufferlength   :   word);
    public
        constructor   create;
        destructor   destroy;   override;
        function   opencomm（comname   :   pchar;   baud   :   word)   :   boolean;
        function   sendbuffer（buffer   :   pchar;   bufferlength   :   integer)   :   integer;
    end;
现在我只简单介绍构造函数和就可以了
    constructor   tmydllclass.create;
    begin
        mycomm   :=   tcomm.create（nil);
        mycomm.onrecevicedata   :=   recvdata;
    end;
这样串口只要收到数据就直接调用recvdata处理数据了

如果你想在dll外面处理，你可以将这个作为一个回调函数，让外面的类过程来处理。
发表于：2007-03-03 10:54:0310楼 得分:0
mark
发表于：2007-03-03 11:37:3511楼 得分:0
楼主的函数指针错误我也遇到,我摸索了很久最后只是觉得对象里面的procedure   跟面向过程的procedure   不太一样,对了很长时间还是初现你遇到的错误提示,最后就用笨办法,就是像（红辣椒)和（博克)那样写得那样,将一个类的procedure   recvdata（sender   :   tobject;buffer   :   pointer;   bufferlength   :   word)方法付给那个过程.当然那个类不一定继承于tcomm继承别的类也行
发表于：2007-03-05 11:15:4812楼 得分:0
plax0850,你好，
能不能按你的方法帮把我的dll改一下呀。

我的dll:
library   project1;
uses
    sysutils,
    classes,
    dialogs,
    spcomm;
var
      comm1:tcomm;
{$r   *.res}


function   opencomm（scomm:pchar):longbool;stdcall;
begin
    comm1:=tcomm.create（nil);
    try
          try
                comm1.commname:=scomm;
                comm1.startcomm;
                result:=true;
          except
                result:=false;
          end;
  finally
      //comm1.free;
  end;

end;

function   closecomm（scomm:pchar):longbool;stdcall;
begin
          try
                comm1.commname:=scomm;
                comm1.stopcomm;
                result:=true;
          except
                result:=false;
          end;
end;

procedure   mycomm1receivedata（sender:   tobject;   buffer:   pointer;
    bufferlength:   word);
begin
      showmessage（ '测试看能不能执行到这里。 ');
end;

function   sendcommdata（scomm:pchar):longbool;stdcall;
var
      sinit6:string;
begin
          try
                comm1.commname:=scomm;
                sinit6:=hextostr（ '6899999999999968050161cd16 ');
                comm1.writecommdata（pchar（sinit6),length（sinit6));
                result:=true;
          except
                result:=false;
          end;

    comm1.onreceivedata:=mycomm1receivedata;
    //此行编译时通不过，提示：[error]   project1.dpr（202):   incompatible   types:   'method   pointer   and   regular   procedure '     我现在不知道如何调用这个过程，给这个过程传参。
end;

exports
opencomm,closecomm,sendcommdata;
begin
end.


我现在是要将发送和处理返回数据都放到dll中进行处理，调用程序只传一个串口号这个参数。

请帮忙给我这个dll改一下。

谢，谢。
发表于：2007-03-05 16:00:5913楼 得分:0
unit   unitcomm;
uses
    classes,   spcomm;
interface

type
    tmydllclass   =   class
    private
        mycomm   :   tcomm;
        commopen   :   boolean;
        procedure   recvdata（sender   :   tobject;buffer   :   pointer;   bufferlength   :   word);
    public
        constructor   create;
        destructor   destroy;   override;
        function   opencomm（comname   :   pchar;   baud   :   word)   :   boolean;
        function   sendbuffer（buffer   :   pchar;   bufferlength   :   integer)   :   integer;
        function   closecomm   :   boolean;
        function   isopen   :   boolean;
    end;

implemention
constructor   tmydllclass.create;
begin
    mycomm   :=   tcomm.create（nil);
    mycomm.onrecevicedata   :=   recvdata;
end;

destructor   tmydllclass.destroy;
begin
    if   commopen   then
        mycomm.stopcomm;
end;

function   tmydllclass.opencom（comname   :   pchar;   baud   :   word)   :   boolean;
begin    
    try
        mycomm.commname   :=   comname;
        mycomm.baudrate   :=   baud;
        mycomm.startcomm;
        commopen   :=   true;
    except
        commopen   :=   false;
    end;    
    result   :=   commopen;
end;

function   tmydllclass.sendbuffer（buffer   :   pchar;   bufferlength   :   integer)   :   integer;
begin
    result   :=   0;
    if   commopen   then
    begin
        try
            mycomm.writecommdata（buffer,   bufferlength);
            result   :=   bufferlength;
        except
            result   :=   0;
        end;
    end;
end;

function   tmydllclass.closecomm   :   boolean;
begin
    result   :=   false;
    if   commopen   then
    begin
        mycomm.stopcomm;
        commopen   :=   false;
        result   :=   true;
    end
end;

procedure   tmydllclass.recvdata（sender   :   tobject;buffer   :   pointer;   bufferlength   :   word);
begin
    showmessage（ '测试看能不能执行到这里。 ');
end;

function   tmydllclass.isopen   :   boolean;
begin
    result   :=   comopen;
end;

end.

上面是类的实现，是随意写的，不一定正确，你自己琢磨一下，调试一下，下面是dll部分
library   project1;
uses
    sysutils,
    classes;
var
    comclass   :   tmydllclass;

function   opencomm（scomm:pchar;   baud   :   word):longbool;stdcall;
begin
    result   :=   false;
    if   comclass   =   nil   then
    begin
        comclass   :=   tmydllclass.create;
    end;    
    if   comclass.isopen   then

end;


发表于：2007-03-05 16:07:2214楼 得分:0
按错了键，重新写dll部分
library   project1;
uses
    sysutils,
    classes;
var
    comclass   :   tmydllclass;

function   opencomm（scomm:pchar;   baud   :   word):longbool;stdcall;
begin
    if   comclass   =   nil   then
    begin
        comclass   :=   tmydllclass.create;
    end;    
    if   comclass.isopen   then
        comclass.closecomm;
    result   :=   comclass.opencom（scomm,   baud);
end;

function   closecomm（scomm:pchar):longbool;stdcall;
begin
    result   :=   true;
    if   comclass   <>   nil   then
    begin
        comclass.closecomm;
    end;
end;

function   sendcommdata（scomm:pchar):longbool;stdcall;
var
      sinit6:string;
begin
    result   :=   false;
    sinit6:=hextostr（ '6899999999999968050161cd16 ');
    if   （comclass   <>   nil)   and   （comclass.isopen)   then
    begin
        result   :=   （comclass.sendbuffer（pchar（sinit6),   length（sinit6))   >   0);
       
    end;
end;

发表于：2007-03-05 16:53:3115楼 得分:0
多谢博克兄，我现在正在试。
发表于：2007-03-06 16:26:0616楼 得分:0
博克,你好，按你写的类，我调试了一下，现在基本上搞定了。

但现在还有2个问题：
我先将我调试后的dll代码贴出：
以下是dll主文件:
library   project1;
uses
    sysutils,
    classes,
    dialogs,
    unit1   in   'unit1.pas ';
type
    //定义函数类型
    p_formfun   =   function   （log   :   string)   :   integer;

var
    comclass   :   tmydllclass;


function   opencomm（scomm:pchar):boolean;stdcall;
begin
    if   comclass   =   nil   then
    begin
        comclass   :=   tmydllclass.create;
    end;
    if   comclass.isopen   then
    comclass.closecomm（scomm);
    result   :=   comclass.opencomm（scomm);
end;

function   closecomm（scomm:pchar):boolean;stdcall;
begin
    result   :=   true;
    if   comclass   <>   nil   then
    begin
        comclass.closecomm（scomm);
    end;
end;

function   hextostr（   //十六进制字符串处理成字符串
    mhex:   string   //十六进制字符串
):   string;//返回处理后的字符串
var
    i:   integer;
begin
    result   :=   ' ';
    mhex   :=   stringreplace（mhex,   #32,   ' ',   [rfreplaceall]);
    for   i   :=   1   to   length（mhex)   div   2   do
        result   :=   result   +   chr（strtointdef（ '$ '   +   copy（mhex,   i   *   2   -   1,   2),   0));
end;   {   hextostr   }

function   strtohex（   //字符串处理成十六进制字符串
    mstr:   string;   //字符串
    //mspace:   boolean   =   false   //是否用空格分开
    mspace:   boolean   =   true   //是否用空格分开
):   string;   //返回处理后的十六进制字符串
const
    cspacestr:   array[boolean]   of   string   =   （ ' ',   #32);
var
    i:   integer;
begin
    result   :=   ' ';
    for   i   :=   1   to   length（mstr)   do
        result   :=   format（ '%s%s%.2x ',   [result,   cspacestr[mspace],   ord（mstr[i])]);
    if   mspace   then   delete（result,   1,   1);
end;   {   strtohex   }

function   sendrestoredata（scomm:string;sedtold:string;sedtnew1:string):boolean;stdcall;
var
      srestore_init11:string;     //复位卡的第一步：初始化指令。
begin
    result   :=   false;
    srestore_init11:=hextostr（ '6899999999999968050161cd16 ');
    if   （comclass   <>   nil)   and   （comclass.isopen)   then
    begin
        result   :=   （comclass.sendbuffer（pchar（srestore_init11),   length（srestore_init11))   >   0);
        jstimes:=11;

        myedtold:=sedtold;
        myedtnew1:=sedtnew1;
    end;
end;

function   fun_test   （   pfun:p_formfun)   :   integer   ;   stdcall   ;
begin
    pfun（strtohex（s_recv));
    result   :=   0;
end   ;

exports
opencomm,closecomm,sendrestoredata,fun_test;

begin
end.

以下是dll中的单元：
unit   unit1;

interface

uses
    sysutils,classes,spcomm,dialogs;

type
    tmydllclass   =   class
    private
        mycomm   :   tcomm;
        commopen   :   boolean;
        procedure   recvdata（sender   :   tobject;buffer   :   pointer;   bufferlength   :   word);
    public
        constructor   create;
        destructor   destroy;   override;
        function   opencomm（comname   :   pchar)   :   boolean;
        function   sendbuffer（buffer   :   pchar;   bufferlength   :   integer)   :   integer;
        function   closecomm（comname   :   pchar)   :   boolean;
        function   isopen   :   boolean;
    end;
var
    s_recv:string;
    jstimes:integer;
    myedtold,myedtnew1:string;
implementation
constructor   tmydllclass.create;
begin
    mycomm   :=   tcomm.create（nil);
    mycomm.onreceivedata   :=   recvdata;
end;

destructor   tmydllclass.destroy;
begin
    if   commopen   then
        mycomm.stopcomm;
end;

function   tmydllclass.sendbuffer（buffer   :   pchar;   bufferlength   :   integer)   :   integer;
begin
    result   :=   0;
    if   commopen   then
    begin
        try
            mycomm.writecommdata（buffer,   bufferlength);
            result   :=   bufferlength;
        except
            result   :=   0;
        end;
    end;
end;

function   tmydllclass.opencomm（comname   :   pchar)   :   boolean;
begin
    try
        mycomm.commname   :=   comname;
        mycomm.baudrate:=2400;
        mycomm.startcomm;
        commopen   :=   true;
    except
        commopen   :=   false;
    end;
    result   :=   commopen;
end;

function   tmydllclass.closecomm（comname   :   pchar)   :   boolean;
begin
    result   :=   false;
    if   commopen   then
    begin
        mycomm.commname   :=   comname;
        mycomm.stopcomm;
        commopen   :=   false;
        result   :=   true;
    end
end;

function   hextostr（   //十六进制字符串处理成字符串
    mhex:   string   //十六进制字符串
):   string;   //返回处理后的字符串
var
    i:   integer;
begin
    result   :=   ' ';
    mhex   :=   stringreplace（mhex,   #32,   ' ',   [rfreplaceall]);
    for   i   :=   1   to   length（mhex)   div   2   do
        result   :=   result   +   chr（strtointdef（ '$ '   +   copy（mhex,   i   *   2   -   1,   2),   0));
end;   {   hextostr   }


function   strtohex（   //字符串处理成十六进制字符串
    mstr:   string;   //字符串
    //mspace:   boolean   =   false   //是否用空格分开
    mspace:   boolean   =   true   //是否用空格分开
):   string;   //返回处理后的十六进制字符串
const
    cspacestr:   array[boolean]   of   string   =   （ ' ',   #32);
var
    i:   integer;
begin
    result   :=   ' ';
    for   i   :=   1   to   length（mstr)   do
        result   :=   format（ '%s%s%.2x ',   [result,   cspacestr[mspace],   ord（mstr[i])]);
    if   mspace   then   delete（result,   1,   1);
end;   {   strtohex   }

procedure   tmydllclass.recvdata（sender   :   tobject;buffer   :   pointer;   bufferlength   :   word);
var     srestore_writeinit12,srestore_writebackinit13,srestore14:string;
          soldps,sd1,sd2,sd3,sd4,snewps,sn1,sn2,sn3,sn4:   string;
          srestore:string;
begin

            //----计算出原密码，新密码的字符串------
            sd1:=copy（myedtold,7,2);
            sd2:=copy（myedtold,5,2);
            sd3:=copy（myedtold,3,2);
            sd4:=copy（myedtold,1,2);
            soldps:=inttohex（（strtoint（ '$ '+sd1)+51),2)+inttohex（（strtoint（ '$ '+sd2)+51),2)+inttohex（（strtoint（ '$ '+sd3)+51),2)+inttohex（（strtoint（ '$ '+sd4)+51),2);

            sn1:=copy（myedtnew1,7,2);
            sn2:=copy（myedtnew1,5,2);
            sn3:=copy（myedtnew1,3,2);
            sn4:=copy（myedtnew1,1,2);
            snewps:=inttohex（（strtoint（ '$ '+sn1)+51),2)+inttohex（（strtoint（ '$ '+sn2)+51),2)+inttohex（（strtoint（ '$ '+sn3)+51),2)+inttohex（（strtoint（ '$ '+sn4)+51),2);
            {
            //接收rs232的数据并显示memo1上。
            setlength（s,bufferlength);
            move（buffer^,pchar（s)^,bufferlength);
            memo1.lines.add（strtohex（s));
            memo1.invalidate;
            }
            setlength（s_recv,bufferlength);
            move（buffer^,pchar（s_recv)^,bufferlength);

                        //**********点击了复位卡按纽。**********************************
            //如果第一步 "初始化 "成功，则进入第二步:写数据初始化。
            if   （strtohex（s_recv)= '68   ff   ff   ff   ff   ff   ff   68   c5   01   62   f2   16 ')   and   （jstimes=11)   then
                  begin
                          srestore_writeinit12:=hextostr（ '68999999999999680301016b16 ');
                          mycomm.writecommdata（pchar（srestore_writeinit12),length（srestore_writeinit12));
                          jstimes:=12;
                  end;

            //如果第二步 "写数据初始化 "成功，则进入第三步:写返写区初始化。
            if   （strtohex（s_recv)= '68   ff   ff   ff   ff   ff   ff   68   83   00   4d   16 ')   and   （jstimes=12)   then
                  begin
                          srestore_writebackinit13:=hextostr（ '68999999999999680301026c16 ');
                          mycomm.writecommdata（pchar（srestore_writebackinit13),length（srestore_writebackinit13));
                          jstimes:=13;
                  end;

            //如果第三步 "写返写区初始化 "成功，则进入最后一步第四步:复位卡。
            if   （strtohex（s_recv)= '68   ff   ff   ff   ff   ff   ff   68   83   00   4d   16 ')   and   （jstimes=13)   then
                  begin
                          srestore:= '6899999999999968041534339b4341cccccccccccc '+soldps+snewps+ 'f349ad16 ';
                          srestore14:=hextostr（srestore);
                          //srestore14:=hextostr（ '6899999999999968041534339b4341cccccccccccc3334353633343536f349ad16 ');
                          mycomm.writecommdata（pchar（srestore14),length（srestore14));
                          jstimes:=14;
                  end;

            //如果第四步：复位卡成功，则提示复位卡制作成功。
            if   （strtohex（s_recv)= '68   ff   ff   ff   ff   ff   ff   68   83   00   4d   16 ')   and     （jstimes=14)   then
                    begin
                        showmessage（ '复位卡的制作成功! ');
                        jstimes:=15;
                    end;
            //复位卡的异常处理,第一步发送指令后的返回结果不正确。
            if   （strtohex（s_recv)= '68   ff   ff   ff   ff   ff   ff   68   c5   01   32   c2   16 ')   and   （jstimes=11)then
                    messagedlg（ '复位卡的操作失败，请将卡拿开，再放上去! ',mterror,[mbyes],0)   ;
end;

function   tmydllclass.isopen   :   boolean;
begin
    result   :=   commopen;
end;

end.
发表于：2007-03-06 16:34:1917楼 得分:0
以下是调用程序exe的相关代码：
procedure   tuseprog.btnrestoreclick（sender:   tobject);
var   pfun   :p_formfun;
begin
if   sendrestoredata（slt_com.text,edtold.text,edtnew1.text)   then
else
      messagedlg（ '复位卡的初始化指令发送失败! ',mterror,[mbyes],0);


pfun   :=   @fun_addlog;
    //将这个函数的指针传递给dll,就可以在dll中调用外面的函数
fun_test（pfun);
end;

相关代码：
function   opencomm（scomm:string):boolean;stdcall;external   'project1.dll ';
function   closecomm（scomm:string):boolean;stdcall;external   'project1.dll ';
function   sendrestoredata（scomm:string;sedtold:string;sedtnew1:string):boolean;stdcall;external   'project1.dll ';

//定义dll输出的函数类型
function   fun_test   （   pfun:p_formfun)   :   integer   ;   stdcall   ;external   'project1.dll ';

implementation

function   fun_addlog（log:   string):   integer;
begin
    useprog.memo1.lines.add（log);
    useprog.memo1.invalidate;
end;

现有两个问题：
1.如何才能将返回指令及时显示在exe上memo1上面？我现在的程序不能正常显示在memo1上。
2.showmessage（ '复位卡的制作成功! ');   这条提示信息会出现两个。是什么原因？

请博克兄和各位大虾指点一下，非常感谢。
分不够再加。
发表于：2007-03-07 20:29:1218楼 得分:20
客气了，定义一个回调函数就可以了，就可以了，就相当于写控件的事件一样。
回调函数也是函数指针。只不过你没有经常使用而已。

回调函数类型的定义，delphi已经定义了很多。如大部分事件类型，其实就是回调函数类型。
在这儿我要指出的是你在dll中写function   fun_test   （   pfun:p_formfun)   :   integer   ;   stdcall;函数的时候，为何不在dll中定义p_formfun的一个全局变量，专门来存储这个pfun回调函数啦。然后在mydllclass类中的串口接收事件中调用这个函数指针，那么这时候只要接收到数据就会调用你写的fun_addlog函数了。这个fun_addlog函数就是传说中的回调函数。能够及时响应串口事件哟！

相关文章
其他资讯

快速检索
分类导航标签a

最新资讯
热门点击