DLL中使用回调函数

Question

在DLL中使用了回调函数，当一调用回调函数，回调函数执行完就报这个错误，有哪位知道是什么原因造成的吗?
    project c:\documents and settings\administrator\桌面、writecardDemo\project1.exe faulted with message:' access violation at 0X0012f705: read of address 0x0025eb52'. process stoped 
    在线等

Answer 1

///////////////////////////////////调用窗体//////////////////////////////////////////
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
type
 TFuncCallBack=procedure(str:PChar) of object;
type
  TForm1 = class(TForm)
    lbl1: TLabel;
    cbb1: TComboBox;
    btn1: TButton;
    GroupBox1: TGroupBox;
    lbl5: TLabel;
    edt5: TEdit;
    btn4: TButton;
    btn2: TButton;
    grp1: TGroupBox;
    lbl2: TLabel;
    edt2: TEdit;
    btn3: TButton;
    btn5: TButton;
    edt1: TEdit;
    procedure btn1Click(Sender: TObject);
    procedure btn4Click(Sender: TObject);
    procedure btn2Click(Sender: TObject);
    procedure btn3Click(Sender: TObject);
    procedure btn5Click(Sender: TObject);
  private
    { Private declarations }
  public
    procedure test(str:PChar);
    { Public declarations }
  end;var
  Form1: TForm1;implementationfunction StartComm(com: PChar):Boolean;stdcall;external 'WriteCard.dll';
procedure StopComm;stdcall;external 'WriteCard.dll';
procedure ReturnData(FuncCallBack: TFuncCallBack);stdcall;external 'WriteCard.dll';
//function WriteEmployeeCard(UseridUsername:PChar):Boolean;stdcall;external 'WriteCard.dll';
//function ReadCard():Boolean;stdcall;external 'WriteCard.dll';
function WriteDianZiGongPiao(writeStr:PChar):Boolean;stdcall;external 'WriteCard.dll';{$R *.dfm}procedure TForm1.btn1Click(Sender: TObject);
begin
if StartComm(PChar(cbb1.Text)) then
  ShowMessage('成功')
else
  ShowMessage('失败');
end;procedure TForm1.btn4Click(Sender: TObject);
begin
//if WriteEmployeeCard(PChar(edt5.Text)) then
//  ReturnData(test);
end;procedure TForm1.test(str: PChar);
begin
// ShowMessage(str);
edt1.Text:=str;
end;procedure TForm1.btn2Click(Sender: TObject);
begin
// if ReadCard then
//    ReturnData(test);
end;procedure TForm1.btn3Click(Sender: TObject);
begin
//  WriteDianZiGongPiao(PChar(edt2.Text));
if WriteDianZiGongPiao(PChar(edt2.Text)) then   //在这里报错了
  ReturnData(test);
end;//------------------------------------Dll------------------------------------
unit untOperatorCom;interface
 uses
   sharemem,SPComm,SysUtils,Classes,ExtCtrls,Dialogs;
  type
 TFuncCallBack=procedure(str:PChar);stdcall;
type
 TABC=class(TComponent)
   private
     procedure spcomReceiveData(Sender: TObject; Buffer: Pointer;BufferLength: Word);
     procedure Timer1Timer(Sender: TObject);
   END;
  function HexStrToStr(const S:string):string; //转化成十六制的字符串
  procedure DeleteData(machine:integer);stdcall;
  function StartComm(com: PChar): Boolean;stdcall;
  procedure StopComm;stdcall;
  function ReadData(Machine: Integer): Boolean;stdcall;
  procedure ReturnData(FuncCallBack: TFuncCallBack);stdcall;
  procedure ShowLab();stdcall;
  procedure StopTime();
  function SetOrderId(machine,OrderId:Integer):Boolean;stdcall;
  function stringtohex(str: string): string;
  function WriteCard(UseridUsername:PChar):Boolean;stdcall;
  function WriteDianZiGongPiao(writeStr:PChar):Boolean;stdcall;
implementation
var
  comm1:TComm;
  t1:TTimer;
  AFuncCallBack:TFuncCallBack;
  ABC:TABC;
  JiShi:Integer=0;
function WriteDianZiGongPiao(writeStr:PChar):Boolean;stdcall;
var
  Str:string;
begin
  Str:='#WC'+writeStr+'@';
  if comm1.WriteCommData(PChar(Str),Length(Str)) then
    Result:=True
  else
   Result:=false;
  end;function WriteCard(UseridUsername:PChar):Boolean;
var
  writeStr:string;
begin
  writeStr:='#WB'+UseridUsername+'@';
  if comm1.WriteCommData(PChar(writeStr),Length(writeStr)) then
    Result:=True
  else
   Result:=false;
  end;
function SetOrderId(machine,OrderId:Integer):Boolean;
var
  writeStr:string;
  OrderStr:string;
begin
 if OrderId<10 then
    OrderStr:=' 30 '+stringtohex(IntToStr(OrderId))
 else
    begin
      OrderStr:=stringtohex(IntToStr(OrderId));
      OrderStr:=' '+copy(OrderStr,1,2)+' '+copy(OrderStr,3,2);
      end;
 writeStr:=IntToHex(machine,2)+' 23 35'+OrderStr+' 40';
 writestr:=HexStrToStr(writestr);
if comm1.WriteCommData(PChar(writeStr),Length(writeStr)) then
  Result:=True
else
  Result:=false;
  end;
//-----------------字符串转十六进制内码-------------------------------
function stringtohex(str: string): string;
var
   i:integer;
   s:string;
begin
   s:='';
   for i:=1 to length(str) do begin
       s:=s+inttohex(Integer(str[i]),2);
   end;
   result:=s;
end;
procedure StopTime();
begin
   JiShi:=0;
   t1.Enabled:=false;
  end;procedure ShowLab();
begin
  showmessage('a');
end;function HexStrToStr(const S:string):string; //转化成十六制的字符串
var
 t:Integer;
 ts:string;
 M,Code:Integer;
begin
 t:=1;
 Result:='';
 while t<=Length(S) do
 begin
   while not (S[t] in ['0'..'9','A'..'F','a'..'f']) do
     inc(t);
   if (t+1>Length(S))or(not (S[t+1] in ['0'..'9','A'..'F','a'..'f'])) then
     ts:='$'+S[t]
   else
     ts:='$'+S[t]+S[t+1];
   Val(ts,M,Code);
   if Code=0 then
     Result:=Result+Chr(M);
   inc(t,2);
 end;
  end;procedure TABC.spcomReceiveData(Sender: TObject; Buffer: Pointer;
       BufferLength: Word);
type
  ss=array[1..500]of char ;
var
  strbuf:^ss;
  strRead,sql,StrWrite,strmemo:string;
  machine,i:integer;
  receivedataStr:string;
begin
  StopTime();
 strbuf:=Buffer;
for i:=1 to bufferlength do
  begin
    strRead:=strRead+strbuf^[i];
  end;
  receivedataStr:='';
   strRead:=copy(strRead,pos('#',strRead)+1,pos('@',strRead)-pos('#',strRead)-1);
  if Copy(strRead,1,2)='WS' then
     receivedataStr:='Y'    //写卡成功
   else
  if Length(strRead)=5 then  //找到设备，设备上没有数据
      receivedataStr:='Y'
  else
    begin
       receivedataStr:=strRead;  //返回设备上的数据
        end;
   if receivedataStr<>'' then
     if Assigned(AFuncCallBack) then
     AFuncCallBack(PChar(receivedataStr));
  end;procedure DeleteData(machine:integer);
var
  StrWrite:string;
begin
StrWrite:=inttohex(machine,2)+'23 38 30 40';
StrWrite:=HexStrToStr(StrWrite);
comm1.WriteCommData(pchar(StrWrite),Length(StrWrite))
end;function StartComm(com: PChar): Boolean;
begin
try
  comm1.CommName:=com;
  comm1.StartComm;
  Result:=true;
  except
    Result:=False;
  end;
end;procedure StopComm;
begin
comm1.StopComm();
end;function ReadData(Machine: Integer): Boolean;
var
  strWrite,M:string;
begin
  StopTime();
  strWrite:=IntToHex(Machine,2)+' 23 38 40';
  strWrite:=HexStrToStr(strWrite);
  if comm1.WriteCommData(PChar(strWrite),Length(strWrite)) then
     begin
       t1.Enabled:=true;
       Result:=True;
      end
   else
      Result:=false;
end;procedure ReturnData(FuncCallBack: TFuncCallBack);
begin
    AFuncCallBack:=FuncCallBack;      //回调函数，执行完这句以后就报错
end; procedure TABC.Timer1Timer(Sender: TObject);
begin
 inc(JiShi);
 if JiShi=10 then
  begin
      StopTime();
      if Assigned(AFuncCallBack) then
      AFuncCallBack('N');
    end;
end;initialization
      comm1:=TComm.Create(nil);
      comm1.CommName:='COM1';
      comm1.BaudRate:=38400;
      comm1.ReadIntervalTimeout:=10;
      ABC:=TABC.Create(nil);
      t1:=TTimer.Create(nil);
      t1.Enabled:=False;
      t1.Interval:=10;
      comm1.OnReceiveData:= ABC.spcomReceiveData;
      t1.OnTimer:=ABC.Timer1Timer;
  finalization
   // if Assigned(comm1) then
      comm1.StopComm;
      FreeAndNil(t1);
      FreeAndNil(comm1);
      FreeAndNil(ABC); 
  end.

Answer 2

应该是你回调函数定义的有问题。给你看个例子吧interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;type
  TForm1 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  type PFCALLBACK = function(Param1:integer;Param2:integer):integer;stdcall;
 // 定义回调函数的类型
var
  Form1: TForm1;
  gCallBack:PFCALLBACK;
  function CBFunc(Param1:integer;Param2:integer):integer;stdcall;
implementation
//回调函数需要定义为全局
{$R *.dfm}
///实现回调函数的功能
function CBFunc(Param1:integer;Param2:integer):integer;
var i:integer;
begin
//messagebox(application.Handle,'回调函数','提示信息',mb_ok);
for i:=0 to 100 do
begin
sleep(100);
self.ListBox1.Items.Add('回调函数');
end;
end;
///
function MyThreadFunc(P:pointer):Longint;stdcall;
begin
gCallBack(0,1);//简单传个参数
end;
procedure testpro ;
var i:integer;
   hThread:Thandle;//定义一个句柄
  ThreadID:DWord;
begin
for i:=0 to 4 do
begin
messagebox(application.Handle,'123','提示信息',mb_ok);
if (i=2) then
begin
hthread:=CreateThread(nil,0,@MyThreadfunc,nil,0,ThreadID);//利用这种线程怎么说呢，肯定方便啦，但是
//肯定功能上受到好多限制，所以啊，自己写，下次贴个上来
end;
end;
end;
///
function TestCallBack( Func:PFCALLBACK ):integer;
begin
gCallBack:=Func;
testpro;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
//testpro;
TestCallBack(@CBFunc);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
self.ListBox1.Clear;
end;
end.
使用回调函数需要注意的地方：
type PFCALLBACK = function(Param1:integer;Param2:integer):integer;stdcall;
 // 定义回调函数的类型
 function CBFunc(Param1:integer;Param2:integer):integer;stdcall;
//全局函数定义，指向函数的函数，指针！！！名字可以随便取，但参数之类的需要与定义
//的函数类型一致。
 function CBFunc(Param1:integer;Param2:integer):integer;
//写该函数体就没什么好说拉
function TestCallBack( Func:PFCALLBACK ):integer;
//传递回调函数的入口地址，最重要啦！