delphi2007 教程

delphi2007 教程

首页 新随笔 联系 聚合 管理
  1013 Posts :: 0 Stories :: 28 Comments :: 0 Trackbacks
[请教] 关于把mscomm控件封装进dll的 Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiAPI/html/delphi_20061124231637174.html
不知道什么原因,封装好生成的dll用delphi调用总是报错。  
  还有mscomm接收的数据怎么给exe?  
   
  如果大家有现成的解决方案请发给我一份guangzhao@163.com  
  多谢大家  
   
  下面是找来的一点代码:  
   
  library       lib1;        
      .....        
      exports        
              OpenComm;        
              SendText;        
              CloseComm;        
      begin        
          ...        
      end.        
           
           
      unit       unit1;        
           
      interface        
          uses        
                  ActiveX,....        
           
      procedure       OpenComm(Port:Integer);stdcall;        
      procedure       SendText(Text:PChar);stdcall;        
      procedure       CloseComm;stdcall;        
           
      implementation        
           
      procedure       OpenComm(Port:Integer);        
      begin        
              MSComm1.CommPort:=1;        
              MSComm1.Open;        
      end;        
      procedure       SendText(Text:PChar);        
      begin        
              MSComm1.Output:=string(Text);        
      end;        
      procedure       CloseComm;        
      begin        
          MSComm1.Close;        
      end;        
      initialization        
              CoIntialize(nil);        
              MSComm1:=TMSComm.Create(nil);        
      finalization        
              MSComm1.Free;        
              CoUnitialize;        
      end.  
  ----------------------------------------------    
   
  上面代码中CoIntialize,CoUnitialize这俩个delphi识别不了啊,uses   ActiveX也没有用  
   
  oosmile@msn.com  
     
 

回调函数的资料,始终编译通不过  
   
  exports        
              SetCallback;        
           
           
           
      type        
                  TCallback=procedure(s:string);        
                  TABC=class(TComponent)        
                          procedure       MSCommOnComm(Sender:TObject);        
                  end;            
      var        
              FCallback:TCallback;        
              ABC:TABC;        
           
      procedure       SetCallback(ACallback:TCallback);        
      begin        
              FCallback:=@ACallback;        
      end;        
      procedure       TABC.MSCommComm(Sender:TObject);        
      var        
              s:string;        
      begin        
              while       MSComm1.InBufferCount>0       do        
              begin        
                      s:=MSComm1.Input;        
                      if       Assigned(FCallback)       then        
                                  FCallback(PChar(s));        
              end;        
      end;        
           
      initialization        
              ...        
              ABC:=TABC.Create(nil);            
              MSComm1.OnComm:=ABC.MSCommOnComm        
      finalization        
          ...        
              ABC.Free;        
      end.

大家帮帮忙,用CPort或者spcomm都好  
  如果有pcomm的delphi资料给咱一份

我没有这样做过,不过很感兴趣。在台湾大富翁查了一份封装SPCOMM的资料,不知道对你有没有帮助。  
   
  http://delphi.ktop.com.tw/board.php?cid=30&fid=70&tid=79147

感谢楼上的

不客气,因为我对工业控制一直很感兴趣,也做了好几个项目。但一直没有用串口通讯组件,都是用的自己写的WIN32底层封装。

楼上能否给一份自己封装好的api

源码都可以给。你可以根据你的需要来封装

10分感谢。先给你记分

睡觉了,明天给你揭帖

unit   Unit1;  
   
  interface  
   
  uses  
      Windows,   Messages,   SysUtils,   Variants,   Classes,   Graphics,   Controls,   Forms,  
      Dialogs,   StdCtrls;  
   
  type  
      TForm1   =   class(TForm)  
          Button1:   TButton;  
          Button2:   TButton;  
          procedure   Button1Click(Sender:   TObject);  
          procedure   Button2Click(Sender:   TObject);  
      private  
          {   Private   declarations   }  
      public  
          {   Public   declarations   }  
      end;  
   
  var  
      Form1:   TForm1;  
  function   OPEN_PORT(PORT:   SHORTSTRING;   BTL:   INTEGER):   INTEGER;   StdCall   External   'DRYPRT5.dll';  
  function   CLOSE_PORT:   INTEGER;   StdCall   External   'DRYPRT5.dll';  
  function   SEND_COMMAND(SD:   string;   var   RD:   PChar):   INTEGER;   StdCall   External   'DRYPRT5.dll';  
   
  implementation  
   
  {$R   *.dfm}  
   
  procedure   TForm1.Button1Click(Sender:   TObject);  
  begin  
      if   OPEN_PORT('1',   9600)   =   1   then   ShowMessage('正常打开');  
  end;  
   
  procedure   TForm1.Button2Click(Sender:   TObject);  
  begin  
      if   CLOSE_PORT   =   1   then   ShowMessage('正常关闭');  
  end;  
   
  end.  
   
   
   
  -----------------------------------------------------------  
   
  library   DRYPRT5;  
   
  uses  
      SysUtils,  
      Classes,  
      PRTTING   in   'PRTTING.pas';  
   
  {$R   *.RES}  
  exports  
      OPEN_PORT,  
      CLOSE_PORT,  
      SEND_COMMAND;  
  begin  
  end.  
   
   
  unit   PRTTING;  
   
  interface  
   
  uses  
      Windows,   Forms,   ExtCtrls,   SysUtils,   SPComm;  
   
  type  
      TMYOBJ   =   class  
          procedure   MYComReceiveData(Sender:   TObject;   Buffer:   Pointer;   BufferLength:   Word);  
      end;  
   
  var  
      WAIT_TIMES,   N_NUMBER:   INTEGER;  
      START_TIMES:   REAL;  
      READ_BUSY,   OPEN_BUSY,   PORT_ACTIVE,   RECEIVE_FINISH:   BOOLEAN;  
      S_DATA:   string;  
   
      MYCOM:   TCOMM;  
      MYOBJ:   TMYOBJ;  
   
  function   OPEN_PORT(PORT:   SHORTSTRING;   BTL:   INTEGER):   INTEGER;   STDCALL;  
  function   CLOSE_PORT:   INTEGER;   STDCALL;  
  function   SEND_COMMAND(SD:   string;   var   RD:   PChar):   INTEGER;   STDCALL;  
   
   
  implementation  
   
  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;  
   
  procedure   TMYOBJ.MYComReceiveData(Sender:   TObject;   Buffer:   Pointer;   BufferLength:   Word);  
  var  
      S1:   string;  
  begin  
      START_TIMES   :=   Now;  
      SetLength(S1,   BufferLength);  
      Move(Buffer^,   PChar(S1)^,   BufferLength);  
      S_DATA   :=   S_DATA   +   S1;  
   
      if   Pos(#13,   S_DATA)   >   0   then   RECEIVE_FINISH   :=   TRUE;  
  end;  
   
  //function   SEND_COMMAND(var   SD,   RD:   PChar):   INTEGER;   stdcall;  
  function   SEND_COMMAND(SD:   string;   var   RD:   PChar):   INTEGER;   stdcall;  
  var  
      N2:   REAL;  
      B:   BOOLEAN;  
  begin  
      if   READ_BUSY   then  
      begin  
          RESULT   :=   0;  
          Exit;  
      end;  
      if   not   PORT_ACTIVE   then  
      begin  
          RESULT   :=   -1;  
          Exit;  
      end;  
      READ_BUSY   :=   TRUE;  
      RECEIVE_FINISH   :=   FALSE;  
      START_TIMES   :=   Now;  
      S_DATA   :=   '';  
      MYCOM.WriteCommData(PChar(SD),   Length(SD));  
   
      B   :=   FALSE;  
      while   not   RECEIVE_FINISH   do  
      begin  
          APPLICATION.ProcessMessages;  
          N2   :=   Now   -   START_TIMES;  
          N2   :=   N2   *   100000000;  
          B   :=   N2   >   2000;  
          if   B   then   Break;  
      end;  
      if   B   then   RESULT   :=   -2   //   超时没有返回值  
      else   RESULT   :=   1;  
   
      //RD   :=   PChar(S_DATA);  
      //Move(S_DATA[1],   RD^,   length(S_DATA));  
      RD   :=   StrNew(PChar(S_DATA));  
      S_DATA   :=   '';  
      READ_BUSY   :=   FALSE;  
  end;  
   
  function   OPEN_PORT(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   CLOSE_PORT:   INTEGER;   stdcall;  
  begin  
      try  
          if   MYCOM   <>   nil   then   MYCOM.StopComm;  
          PORT_ACTIVE   :=   FALSE;  
          RESULT   :=   1;  
      except  
          RESULT   :=   -1;  
      end;  
   
      FREE_OBJ;  
  end;  
   
  end.  
   
   
   
  上面代码还有返回没有解决,这样返回不好。回调怎么实现?

while   not   RECEIVE_FINISH   do会占用100%   CPU时间的哦  
  SPCOMM是异步线程控制的,所以最好你也采用异步管理方法

同意楼上的,就是这个返回方式还没有解决

spcomm的ReceiveData触发后用什么方法把数据给exe合适呢

下面代码,exe如何调用SetCallback?  
   
  library   DRYPRT5;  
   
  uses  
      SysUtils,  
      Classes,  
      PRTTING   in   'PRTTING.pas';  
   
  {$R   *.RES}  
  exports  
      SetCallback,  
      OPEN_PORT,  
      CLOSE_PORT,  
      SEND_COMMAND;  
  begin  
  end.  
   
   
   
  unit   PRTTING;  
   
  interface  
   
  uses  
      Windows,   Forms,   ExtCtrls,   SysUtils,   SPComm;  
   
  type  
      TCallback   =   procedure(s:   string);  
      TMYOBJ   =   class  
          procedure   MYComReceiveData(Sender:   TObject;   Buffer:   Pointer;   BufferLength:   Word);  
      end;  
   
  var  
      WAIT_TIMES,   N_NUMBER:   INTEGER;  
      START_TIMES:   REAL;  
      READ_BUSY,   OPEN_BUSY,   PORT_ACTIVE,   RECEIVE_FINISH:   BOOLEAN;  
      S_DATA:   string;  
   
      MYCOM:   TCOMM;  
      MYOBJ:   TMYOBJ;  
      FCallback:   TCallback;  
   
  function   OPEN_PORT(PORT:   SHORTSTRING;   BTL:   INTEGER):   INTEGER;   STDCALL;  
  function   CLOSE_PORT:   INTEGER;   STDCALL;  
  function   SEND_COMMAND(SD:   string;   var   RD:   PChar):   INTEGER;   STDCALL;  
  procedure   SetCallback(ACallback:   TCallback);   STDCALL;  
   
   
  implementation  
   
   
   
  function   SEND_COMMAND(SD:   string;   var   RD:   PChar):   INTEGER;   stdcall;  
  var  
      N2:   REAL;  
      B:   BOOLEAN;  
  begin  
      if   READ_BUSY   then  
      begin  
          RESULT   :=   0;  
          Exit;  
      end;  
      if   not   PORT_ACTIVE   then  
      begin  
          RESULT   :=   -1;  
          Exit;  
      end;  
      READ_BUSY   :=   TRUE;  
      RECEIVE_FINISH   :=   FALSE;  
      START_TIMES   :=   Now;  
      S_DATA   :=   '';  
      MYCOM.WriteCommData(PChar(SD),   Length(SD));  
      {B   :=   FALSE;  
      while   not   RECEIVE_FINISH   do  
      begin  
          APPLICATION.ProcessMessages;  
          N2   :=   Now   -   START_TIMES;  
          N2   :=   N2   *   100000000;  
          B   :=   N2   >   2000;  
          if   B   then   Break;  
      end;  
      if   B   then   RESULT   :=   -2   //   超时没有返回值  
      else   RESULT   :=   1;  
   
      //RD   :=   PChar(S_DATA);  
      //Move(S_DATA[1],   RD^,   length(S_DATA));  
      RD   :=   StrNew(PChar(S_DATA));  
      S_DATA   :=   '';   }  
      READ_BUSY   :=   FALSE;  
  end;  
   
  function   OPEN_PORT(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;  
   
      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   CLOSE_PORT:   INTEGER;   stdcall;  
  begin  
      try  
          if   MYCOM   <>   nil   then   MYCOM.StopComm;  
          PORT_ACTIVE   :=   FALSE;  
          RESULT   :=   1;  
      except  
          RESULT   :=   -1;  
      end;  
  end;  
   
   
  procedure   TMYOBJ.MYComReceiveData(Sender:   TObject;   Buffer:   Pointer;   BufferLength:   Word);  
  var  
      S1:   string;  
  begin  
      START_TIMES   :=   Now;  
      SetLength(S1,   BufferLength);  
      Move(Buffer^,   PChar(S1)^,   BufferLength);  
      S_DATA   :=   S_DATA   +   S1;  
      if   Assigned(FCallback)   then  
          FCallback(PChar(S_DATA));  
  end;  
   
  procedure   SetCallback(ACallback:   TCallback);  
  begin  
      FCallback   :=   @ACallback;  
  end;  
   
   
  initialization  
      MYOBJ   :=   TMYOBJ.Create;  
      MYCOM   :=   TCOMM.Create(nil);  
      MYCOM.OnReceiveData   :=   MYOBJ.MYComReceiveData;  
  finalization  
      try  
          if   MYOBJ   <>   nil   then  
          begin  
              MYOBJ.FREE;  
              MYOBJ   :=   nil;  
          end;  
          if   MYCOM   <>   nil   then  
          begin  
              MYCOM.FREE;  
              MYCOM   :=   nil;  
          end;  
      except  
      end;  
   
  end.

想通过DLL给EXE,自然是要通过函数的返回值了!返回ARRAY   OF   CHAR  
  偶还用过一种方法,那就是向EXE的MAINFORM发消息,把一个字符串的地址放在消息参数里面!

jf

posted on 2008-11-27 21:12 delphi2007 阅读(424) 评论(0)  编辑 收藏 引用
只有注册用户登录后才能发表评论。