关于串口通讯的问题,在线等 ( 积分: 50 )

  • 主题发起人 主题发起人 【清风】
  • 开始时间 开始时间

【清风】

Unregistered / Unconfirmed
GUEST, unregistred user!
那位兄弟有关于用D写的串口通讯的代码,给发一点,最好是API的,我现在在写一个串口通讯的东西,代码也写了,但总觉得从串口读取数据特别慢,一次要 100 多毫秒,不知道那位兄弟有这方面的经验,怎么能优化串口的通讯,谢谢.
 
那位兄弟有关于用D写的串口通讯的代码,给发一点,最好是API的,我现在在写一个串口通讯的东西,代码也写了,但总觉得从串口读取数据特别慢,一次要 100 多毫秒,不知道那位兄弟有这方面的经验,怎么能优化串口的通讯,谢谢.
 
一个利用API实现的串口读,写的例子:
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:PChar;Len:Dword); // 接收的数据送入显示区Memo2
begin
//接收厚的字符串为NULL终止
str[Len]:=#0;
Form1.Memo2.Text:=Form1.Memo2.Text+StrPas(str);
end;


procedure CommWatch(Ptr:Pointer);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:DWORD;
ErrorCode,ErrorFlag:DWORD;
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);
end;

procedure TForm1.btnReceiveDataClick(Sender: TObject);
var
com_thread: Thandle;
ThreadID:DWORD;

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.
 
用控件,一般也不需要那么长时间。
可能是你使用的控件的属性设置问题。
比如我曾经用过 SPCOMM ,开始时间也是很长,
ReadInternalTimeOut 的默认值 100
后来改1就变快了。
我想,你检查一下控件的属性,应该就可以了。
 
to : eigo
能把你的例子的窗体文件(.dfm)的单元文件(.pas)一块发给我吗,我测试一下速度
我的邮箱 bj_haiqing@163.com
 
to 清风:
请查收。
 
谢谢 eigo
 
后退
顶部