一个利用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
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);
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.