delphi2007 教程

求人看看这个代码，有关DLL中使用回调函数的问题：回调不能返回正确值 Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiAPI/html/delphi_20061125234815170.html
用回调函数总是不能正确返回，我发送消息SendMessage是可以的。  
   
   
  unit   Unit1;  
  .........  
   
  type  
      TCallback   =   procedure(s:   pchar);   stdcall;  
   
  var  
      Form1:   TForm1;  
  function   OpenPort(PORT:   shortstring;   BTL:   integer):   integer;   stdcall   External   'DRYPRT5.dll';  
  function   ClosePort:   integer;   stdcall   External   'DRYPRT5.dll';  
  function   OutDate(SD:   string):   integer;   stdcall   External   'DRYPRT5.dll';  
  procedure   SetCallback(ACallback:   TCallback);   stdcall   External   'DRYPRT5.dll';  
  procedure   CallbackExample(s:   pchar);   stdcall;  
   
  implementation  
   
  {$R   *.dfm}  
   
  procedure   CallbackExample(s:   pchar);   stdcall;  
  begin  
      Form1.Label1.Caption   :=   (s);  
  end;  
   
  procedure   TForm1.Button1Click(Sender:   TObject);  
  begin  
      if   OpenPort('1',   9600)   =   1   then   Shape1.Brush.Color   :=   clred;  
  end;  
   
  procedure   TForm1.Button2Click(Sender:   TObject);  
  begin  
      if   ClosePort   =   1   then   Shape1.Brush.Color   :=   clblack;  
  end;  
   
  procedure   TForm1.Button4Click(Sender:   TObject);  
  begin  
      SetCallback(@CallbackExample);//此处传给DLL地址  
  end;  
   
  end.  
   
  /////////////////////////////////////////////////////////////////////////////////  
   
  library   DRYPRT5;  
   
  uses  
      SysUtils,  
      Classes,  
      PRTTING   in   'PRTTING.pas';  
   
  {$R   *.RES}  
  exports  
      SetCallback,  
      OpenPort,  
      ClosePort,  
      OutDate,  
      IniComm;  
  begin  
  end.  
   
  /////////////  
  unit   PRTTING;  
  .......  
  type  
      TMYOBJ   =   class  
          procedure   MYComReceiveData(Sender:   TObject;   Buffer:   Pointer;   BufferLength:   Word);  
      end;  
  type  
      TCallback   =   procedure(s:   pchar);  
   
  var  
      Read_busy,   Open_busy,   Port_active,   Receive_finish:   BOOLEAN;  
   
      S_DATA:   string;  
   
      MYCOM:   TCOMM;  
      MYOBJ:   TMYOBJ;  
      FCallback:   TCallback;  
   
      hd:   THandle;  
   
  function   OpenPort(Port:   shortstring;   BTL:   INTEGER):   INTEGER;   STDCALL;  
  function   ClosePort:   INTEGER;   STDCALL;  
  function   OutDate(SD:   string):   INTEGER;   STDCALL;  
  procedure   SetCallback(ACallback:   TCallback);   STDCALL;  
  procedure   SendData(SData:   string);   STDCALL;  
  procedure   IniComm(formhd:   THandle);   STDCALL;  
   
  implementation  
   
  procedure   TMYOBJ.MYComReceiveData(Sender:   TObject;   Buffer:   Pointer;   BufferLength:   Word);  
  var  
      S1:   string;  
      RD:   pchar;  
  begin  
      SetLength(S1,   BufferLength);  
      Move(Buffer^,   pchar(S1)^,   BufferLength);  
      S_DATA   :=   S1;  
      if   Assigned(FCallback)   then  
          FCallback(pchar(S_DATA   ));//回调  
  end;  
   
  procedure   SetCallback(ACallback:   TCallback);   stdcall;  
  begin  
      FCallback   :=   ACallback;//得到  
  end;  
   
   
  下面是另外的函数有这个问题没有关系  
   
  procedure   INI_OBJ;  
  begin  
      MYOBJ   :=   TMYOBJ.Create;  
      MYCOM   :=   TCOMM.Create(nil);  
      MYCOM.OnReceiveData   :=   MYOBJ.MYComReceiveData;  
  end;  
   
  procedure   FREE_OBJ;  
  begin  
      try  
          if   MYOBJ   <>   nil   then  
          begin  
              MYOBJ.FREE;  
              MYOBJ   :=   nil;  
          end;  
          if   MYCOM   <>   nil   then  
          begin  
              MYCOM.FREE;  
              MYCOM   :=   nil;  
          end;  
      except  
      end;  
  end;  
   
  function   OutDate(SD:   string):   INTEGER;   stdcall;  
  begin  
      if   Read_busy   then   //正在发送  
      begin  
          RESULT   :=   0;  
          Exit;  
      end;  
      if   not   Port_active   then   //没有打开串口  
      begin  
          RESULT   :=   -1;  
          Exit;  
      end;  
      Read_busy   :=   TRUE;   //发送开始  
      MYCOM.WriteCommData(pchar(SD),   Length(SD));  
      Read_busy   :=   FALSE;   //发送结束  
      RESULT   :=   1;  
  end;  
   
  function   OpenPort(Port:   shortstring;   BTL:   INTEGER):   INTEGER;   stdcall;  
  begin  
      if   Open_busy   or   Read_busy   then  
      begin  
          RESULT   :=   0;  
          Exit;  
      end;  
      if   Port_active   then  
      begin  
          RESULT   :=   -1;  
          Exit;  
      end;  
      Open_busy   :=   TRUE;  
      INI_OBJ;  
   
      MYCOM.BaudRate   :=   BTL;  
      MYCOM.CommName   :=   'com'   +   Port;  
      try  
          MYCOM.StartComm;  
          Port_active   :=   TRUE;  
          RESULT   :=   1;  
      except  
          Port_active   :=   FALSE;  
          RESULT   :=   -2;  
      end;  
      Open_busy   :=   FALSE;  
  end;  
   
  function   ClosePort:   INTEGER;   stdcall;  
  begin  
      try  
          if   MYCOM   <>   nil   then   MYCOM.StopComm;  
          Port_active   :=   FALSE;  
          RESULT   :=   1;  
      except  
          RESULT   :=   -1;  
      end;  
      FREE_OBJ;  
  end;  
   
   
   
  end.

type  
      TCallback   =   procedure(s:   pchar);   stdcall;  
                                                                        ~~~~~~~~加上，dll和app两边声明要一致  
   
 

谢谢.看得可真仔细了,哈哈