api串口通信实例

最新推荐文章于 2024-07-18 09:15:54 发布

裸奔的蜗牛

最新推荐文章于 2024-07-18 09:15:54 发布

阅读量3.5k

点赞数

文章标签： api thread 通讯 null integer forms

delphi相关同时被 2 个专栏收录

32 篇文章 0 订阅

订阅专栏

api

29 篇文章 0 订阅

订阅专栏

我这里有一个示例程序，功能不是很强，但是学习串口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[i];
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.