关于Windows API的一个串口通信测试程序的问题(50分)

ccdd_liu · 2006-01-09

我用《Delphi串口通信技术与工程实践》（人民邮电出版社赵兰涛苏彦华编著）附带光盘中的程序——Windows API串口编程实例进行串口调试，字符能够被发送出去，但却接收不到东西（用其他程序进行调试都可以接受到的）。请教高手！如须原码，请告诉我邮箱。谢谢！

nicai_wgl · 2006-01-09

代码贴出来，大家帮你分析

ccdd_liu · 2006-01-09

有点长哦~~

ccdd_liu · 2006-01-09

unit Unit1; interface uses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs, StdCtrls, ComCtrls; const  WM_COMMNOTIFY = WM_USER + 100; // 通讯消息 type  TForm1 = class(TForm)    StatusBar1: TStatusBar;    Memo1: TMemo;    Memo2: TMemo;    Label1: TLabel;    Label2: TLabel;    GroupBox1: TGroupBox;    Label3: TLabel;    Label4: TLabel;    Label5: TLabel;    Label6: TLabel;    ComboBox4: TComboBox;    ComboBox3: TComboBox;    ComboBox2: TComboBox;    ComboBox1: TComboBox;    Label7: TLabel;    ComboBox5: TComboBox;    btnOpenCom: TButton;    btnSendData: TButton;    btnReceiveData: TButton;    btnCloseCom: TButton;    procedure btnOpenComClick(Sender: TObject);    procedure FormCreate(Sender: TObject);    procedure btnCloseComClick(Sender: TObject);    procedure btnSendDataClick(Sender: TObject);    procedure btnReceiveDataClick(Sender: TObject);  private    { Private declarations }    procedure WMCOMMNOTIFY(var Message :TMessage);message WM_COMMNOTIFY;  public    { Public declarations }  end; var  Form1: TForm1; implementation {$R *.dfm} var  CommHandle:THandle;  PostEvent:THandle;  ReadOs : Toverlapped;  Connected:Boolean;  Receive :Boolean;  ReceiveData : Dword; procedure AddToMemo(Str

Char;Len

word); // 接收的数据送入显示区Memo2 begin  //接收厚的字符串为NULL终止  str[Len]:=#0;  Form1.Memo2.Text:=Form1.Memo2.Text+StrPas(str); end; procedure CommWatch(Ptr

ointer);stdcall; // 通讯监视线程 var  dwEvtMask,dwTranser : Dword;  PostMsgFlag: Boolean;  overlapped : Toverlapped; begin  Receive :=True;  FillChar(overlapped,SizeOf(overlapped),0);  overlapped.hEvent :=CreateEvent(nil,True,False,nil); // 创建重叠读事件对象  if overlapped.hEvent=null then  begin    MessageBox(0,'overlapped.Event Create Error !','Notice',MB_OK);    Exit;  end;  //进入串口监视状态，直到全局变量Receive置为False停止  while(Receive) do  begin    dwEvtMask:=0;    // 等待串口事件发生    if not WaitCommEvent(CommHandle,dwEvtMask,@overlapped) then    begin      if ERROR_IO_PENDING=GetLastError then        GetOverLappedResult(CommHandle,overlapped,dwTranser,True)      end;      //串口读事件发布消息      if ((dwEvtMask and EV_RXCHAR)=EV_RXCHAR) then      begin        // 等待允许传递WM_COMMNOTIFY通讯消息        WaitForSingleObject(Postevent,INFINITE);        // 处理WM_COMMNOTIFY消息时不再发送WM_COMMNOTIFY消息        ResetEvent(PostEvent);        // 传递WM_COMMNOTIFY通讯消息，告知主线程调用读串口的过程        PostMsgFlag:=PostMessage(Form1.Handle,WM_COMMNOTIFY,CommHandle,0);        if (not PostMsgFlag) then        begin          MessageBox(0,'PostMessage Error !','Notice',MB_OK);          Exit;        end;      end;    end;    CloseHandle(overlapped.hEvent); // 关闭重叠读事件对象 end; procedure TForm1.WMCOMMNOTIFY(var Message :TMessage); // 消息处理函数 var  CommState : ComStat;  dwNumberOfBytesRead : Dword;  ErrorFlag : Dword;  InputBuffer : Array [0..1024] of Char; begin  if not ClearCommError(CommHandle,ErrorFlag,@CommState) then  begin    MessageBox(0,'ClearCommError !','Notice',MB_OK);    PurgeComm(CommHandle,Purge_Rxabort or Purge_Rxclear);    Exit;  end;  if CommState.cbInQue>0 then  begin    fillchar(InputBuffer,CommState.cbInQue,#0);    // 接收通讯数据    if (not ReadFile( CommHandle,InputBuffer,CommState.cbInQue,                 dwNumberOfBytesRead,@ReadOs )) then    begin      ErrorFlag := GetLastError();      if (ErrorFlag <> 0) and (ErrorFlag <> ERROR_IO_PENDING) then      begin        MessageBox(0,'ReadFile Error!','Notice',MB_OK);        Receive :=False;        CloseHandle(ReadOs.hEvent);        CloseHandle(PostEvent);        CloseHandle(CommHandle);        Exit;      end      else begin        WaitForSingleObject(CommHandle,INFINITE); // 等待操作完成        GetOverlappedResult(CommHandle,ReadOs,dwNumberOfBytesRead,False);      end;    end;    if dwNumberOfBytesRead>0 then    begin      ReadOs.Offset :=ReadOs.Offset+dwNumberOfBytesRead;      ReceiveData := ReadOs.Offset;      // 处理接收的数据      AddToMemo(InputBuffer,dwNumberOfBytesRead);    end;  end;  // 允许发送下一个WM_COMMNOTIFY消息  SetEvent(PostEvent); end; procedure TForm1.btnOpenComClick(Sender: TObject); var    CommTimeOut : TCOMMTIMEOUTS;    DCB : TDCB; begin    StatusBar1.SimpleText := '连接中...';    //发送消息的句柄    PostEvent:=CreateEvent(nil,True,True,nil);    if PostEvent=null then    begin        MessageBox(0,'CreateEvent Error!','Notice',MB_OK);        StatusBar1.SimpleText := '串口打开失败';        Exit;    end;    //Overlapped Read建立句柄    ReadOs.hEvent :=CreateEvent(nil,true,False,nil);    if ReadOs.hEvent=null then    begin        MessageBox(0,'CreateEvent Error!','Notice',MB_OK);        CloseHandle(PostEvent);        StatusBar1.SimpleText := '串口打开失败';        Exit;    end;    //建立串口句柄    CommHandle := CreateFile(PChar(ComboBox1.Text),GENERIC_WRITE or GENERIC_READ,             0,nil,OPEN_EXISTING,FILE_FLAG_OVERLAPPED or FILE_ATTRIBUTE_NORMAL,0);    if CommHandle = INVALID_HANDLE_VALUE then    begin        CloseHandle(PostEvent);        CloseHandle(ReadOs.hEvent);        MessageBox(0,'串口打开失败!','Notice',MB_OK);        StatusBar1.SimpleText := '串口打开失败';        Exit;    end;    StatusBar1.SimpleText := '已同端口 '+ ComboBox1.Text + ' 连接！';    //设置超时    CommTimeOut.ReadIntervalTimeout := MAXDWORD;    CommTimeOut.ReadTotalTimeoutMultiplier := 0;    CommTimeOut.ReadTotalTimeoutConstant := 0;    SetCommTimeouts(CommHandle, CommTimeOut);    //设置读写缓存    SetupComm(CommHandle,4096,1024);    //对串口进行指定配置    GetCommState(CommHandle,DCB);    DCB.BaudRate := StrToInt(ComboBox2.Text);    DCB.ByteSize := StrToInt(ComboBox3.Text);    DCB.Parity := ComboBox4.ItemIndex;;    DCB.StopBits := ComboBox5.ItemIndex;    Connected := SetCommState(CommHandle, DCB);    //关系串口的读事件    if (not SetCommMask(CommHandle,EV_RXCHAR)) then    begin      MessageBox(0,'SetCommMask Error !','Notice',MB_OK);      Exit;    end;    if (Connected) then    begin        btnOpenCom.Enabled :=False;    end    else begin        CloseHandle(CommHandle);        StatusBar1.SimpleText := '设置串口失败';    end; end; procedure TForm1.FormCreate(Sender: TObject); begin    Connected:=False;    ComboBox1.ItemIndex:=0;    ComboBox2.ItemIndex:=0;    ComboBox3.ItemIndex:=4;    ComboBox4.ItemIndex:=0;    ComboBox5.ItemIndex:=0;       end; procedure TForm1.btnCloseComClick(Sender: TObject); begin    if not Connected then    begin        StatusBar1.SimpleText := '未打开串口';        Exit;    end;    Receive :=False;    //取消事件监视，此时监视线程中的WaitCommEvent将返回    SetCommMask(CommHandle,0);    //等待监视线程结束    WaitForSingleObject(PostEvent,INFINITE);     //关闭事件句柄    CloseHandle(PostEvent);    //停止发送和接收数据，并清除发送和接收缓冲区    PurgeComm(CommHandle,PURGE_TXABORT or PURGE_RXABORT or PURGE_TXCLEAR or PURGE_RXCLEAR);     //关闭其他的句柄    CloseHandle(ReadOs.hEvent);    CloseHandle(CommHandle);        btnOpenCom.Enabled :=True;    Connected:=False;    StatusBar1.SimpleText := '串口已经关闭'; end; procedure TForm1.btnSendDataClick(Sender: TObject); var    Str:String;    i:Integer;    writeoverlapped:TOverlapped;    ByteToWrite,BytesWritten,AllBytesWritten

WORD;    ErrorCode,ErrorFlag

WORD;    CommStat:COMSTAT; begin    if not Connected then    begin        StatusBar1.SimpleText := '未打开串口';        Exit;    end;    if (Memo1.GetTextLen=0) then    begin        StatusBar1.SimpleText := '缓冲区为空';        Exit;    end;    AllBytesWritten:=0;    for i:=0 to memo1.Lines.Count-1 do    begin        Str:=memo1.Lines;        ByteToWrite:=length(Str);        if  ByteToWrite=0 then continue;        try            StatusBar1.SimpleText := '正在发送数据';            //初始化一步读写结构            FillChar(writeoverlapped,Sizeof(writeoverlapped),0);             //避免贡献资源冲突            writeoverlapped.hEvent:=CreateEvent(nil,True,False,nil);            //发送数据            if not WriteFile(Commhandle,Str[1],ByteToWrite,BytesWritten,@writeoverlapped) then            begin                ErrorCode:=GetLastError;                if ErrorCode<>0 then                begin                    if ErrorCode=ERROR_IO_PENDING then                    begin                        StatusBar1.SimpleText := '端口忙，正在等待...';                        while not GetOverlappedResult(Commhandle,writeoverlapped,BytesWritten,True) do                        begin                            ErrorCode:=GetLastError;                            if ErrorCode=ERROR_IO_PENDING then                                continue                            else begin                                ClearCommError(Commhandle,ErrorFlag,@CommStat);                                showmessage('发送数据出错');                                CloseHandle(WriteOverlapped.hEvent);                                CloseHandle(Commhandle);                                btnOpenCom.Enabled :=True;                                Exit;                            end;                         end;                         AllBytesWritten:=AllBytesWritten+BytesWritten;                    end                    else begin                        ClearCommError(Commhandle,ErrorFlag,@CommStat);                        showmessage('发送数据出错');                        CloseHandle(WriteOverlapped.hEvent);                        Receive :=False;                        CloseHandle(Commhandle);                        CloseHandle(PostEvent);                        btnOpenCom.Enabled :=True;                        Exit;                    end;                end;            end;        finally            CloseHandle(writeoverlapped.hEvent);        end;    end;    StatusBar1.SimpleText:='已经发送了Byte个数：'+IntToStr(ALLBytesWritten);    btnReceiveData.OnClick(btnReceiveData); end; procedure TForm1.btnReceiveDataClick(Sender: TObject); var    com_thread: Thandle;    ThreadIDWORD; begin    if not connected then    begin        StatusBar1.SimpleText := '未打开串口';        Exit;    end;    ReceiveData :=0;    Memo2.Clear;    FillChar(ReadOs,SizeOf(ReadOs),0);    ReadOs.Offset := 0;    ReadOs.OffsetHigh := 0;    // 建立通信监视线程    Com_Thread:=CreateThread(nil,0,@CommWatch,nil,0,ThreadID);    if (Com_Thread=0) then        MessageBox(Handle,'No CreateThread!',nil,mb_OK);            //设置DTR信号线    EscapeCommFunction(Commhandle,SETDTR);    StatusBar1.SimpleText := '正在接收数据...'; end; end.

ccdd_liu · 2006-01-09

辛苦大家了~！

nicai_wgl · 2006-01-10

你创建了接收线程，但线程里什么都没做，也没有接收数据的代码，当然是接收不到数据的，我的串口接收数据函数，你参考一下。 function TCustomCom.Read(pData: PChar; DataLen: DWord): Boolean; var  Overlapped: TOverlapped;  FEvent: TSimpleEvent;  iReceive, dwErrorFlags: DWord; begin  Result := True;  Lock;  FEvent := TSimpleEvent.Create;  try    iReceive := 0;    FillChar(Overlapped, Sizeof(Overlapped), 0);    Overlapped.hEvent := FEvent.Handle;    ClearCommError(Fm_handle, dwErrorFlags, nil); //清除错误标志    try      if not ReadFile(Fm_handle, pData[0], DataLen, DWord(iReceive), @Overlapped) and        (GetLastError <> ERROR_IO_PENDING) then        abort;      if FEvent.WaitFor(Fm_ReadTimeout) = wrSignaled then      begin        GetOverlappedResult(Fm_handle, Overlapped, dWord(iReceive), False);        FEvent.ResetEvent;      end      else abort;    except      Result := False;    end;  finally    FEvent.Free;    Unlock;    Result := Result and (iReceive = DataLen);  end; end;

ccdd_liu · 2006-01-12

这种通信方式是同步还是异步（重叠）的呢？

nicai_wgl · 2006-01-12

ReadFile(Fm_handle, pData[0], DataLen, DWord(iReceive), @Overlapped) 是异步的

ccdd_liu · 2006-01-12

呵呵，好像是异步的哈：） 如果要改成同步的，是不是把所有函数中的lpOverlapped参数删除就可以了呢？

ccdd_liu · 2006-01-12

To:nicai_wgl 你说线程里什么都没做，也没有接收数据的代码,那程序中 procedure TForm1.WMCOMMNOTIFY(var Message :TMessage); // 消息处理函数  是做什么用的呢?

nicai_wgl · 2006-01-13

Sorry，没有仔细看代码，你是怎么调试的， procedure TForm1.WMCOMMNOTIFY(var Message :TMessage); 设置断点试试。

ccdd_liu · 2006-01-16

到现在我也没弄明白怎么回事,大家帮帮我啊~~~~

Pinaster01 · 2006-01-22

转别人的 在Windows 95/NT中，WM_COMMNOTIFY消息已经取消，在串行口产生一个通信事件时，程序并不会收到通知消息。线程需要调用WaitCommEvent函数来监视发生在串行口中的各种事件，该函数的第二个参数返回一个事件屏蔽变量，用来指示事件的类型。线程可以用SetCommMask建立事件屏蔽以指定要监视的事件，表12.4列出了可以监视的事件。调用GetCommMask可以查询串行口当前的事件屏蔽。

dongejkle · 2006-01-28

帮顶! http://www.source520.com 站长开发推广同盟站长朋友的终极驿站 同时拥有海量源码电子经典书籍下载 http://www.source520.com/search/search.asp "编程.站长"论坛搜索引擎-----为中国站长注入动力!

ejoyway · 2006-06-21

我也用《Delphi串口通信技术与工程实践》（人民邮电出版社赵兰涛苏彦华编著）附带光盘中的程序——电话语音查询系统(11章),程序运行时出现"tapi设备不支持语音扩展"的错误提示框.光标停在apdtapidevice1.voiceenable=false上!哪位高手知道请赐教!谢谢了

关于Windows API的一个串口通信测试程序的问题(50分)

ccdd_liu

Unregistered / Unconfirmed

nicai_wgl

Unregistered / Unconfirmed

ccdd_liu

Unregistered / Unconfirmed

ccdd_liu

Unregistered / Unconfirmed

ccdd_liu

Unregistered / Unconfirmed

nicai_wgl

Unregistered / Unconfirmed

ccdd_liu

Unregistered / Unconfirmed

nicai_wgl

Unregistered / Unconfirmed

ccdd_liu

Unregistered / Unconfirmed

ccdd_liu

Unregistered / Unconfirmed

nicai_wgl

Unregistered / Unconfirmed

ccdd_liu

Unregistered / Unconfirmed

Pinaster01

Unregistered / Unconfirmed

dongejkle

Unregistered / Unconfirmed

ejoyway

Unregistered / Unconfirmed

Similar threads