unit MainFrm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ComCtrls, ExtCtrls;
const
WM_COMMNOTIFY = WM_USER + 365; // 通讯消息
type
//接收串口数据的线程
TRecvThread = Class(TThread)
public
procedure Execute;override;
end;
TfrmMain = class(TForm)
pgcMain: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
Panel1: TPanel;
btnOpenSend: TBitBtn;
btnSendData: TBitBtn;
btnCloseSend: TBitBtn;
Label5: TLabel;
edtSendCommName: TEdit;
edtSendBaudRate: TEdit;
Label1: TLabel;
Label2: TLabel;
cmbSendByteSize: TComboBox;
cmbSendStopBits: TComboBox;
Label3: TLabel;
Label4: TLabel;
cmbSendParity: TComboBox;
Panel2: TPanel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
btnOpenRecv: TBitBtn;
btnRecvData: TBitBtn;
btnCloseRecv: TBitBtn;
edtRecvCommName: TEdit;
edtRecvBaudRate: TEdit;
cmbRecvByteSize: TComboBox;
cmbRecvStopBits: TComboBox;
cmbRecvParity: TComboBox;
mmoRecv: TMemo;
Panel3: TPanel;
Panel4: TPanel;
mmoSend: TMemo;
Label11: TLabel;
edtSend: TEdit;
stbSend: TStatusBar;
stbRecv: TStatusBar;
procedure btnOpenSendClick(Sender: TObject);
procedure btnSendDataClick(Sender: TObject);
procedure btnCloseSendClick(Sender: TObject);
procedure btnOpenRecvClick(Sender: TObject);
procedure btnRecvDataClick(Sender: TObject);
procedure btnCloseRecvClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure edtSendBaudRateExit(Sender: TObject);
procedure edtRecvBaudRateExit(Sender: TObject);
private
//数据接收消息处理函数
procedure WMCOMMNOTIFY(var Message: TMessage); message WM_COMMNOTIFY;
procedure SetSendButton ;
procedure SetRecvButton;
{ Private declarations }
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
Post_Event: THandle;//创建事件同步对象的句柄
hSend : THandle;//发送串口的句柄
hRecv : THandle;//接收串口的句柄
Read_os: Toverlapped;//重叠结构的变量
Receive: Boolean; //开关变量,代表是否接收
implementation
{$R *.dfm}
//主窗体被创建时,初始化界面显示
procedure TfrmMain.FormCreate(Sender: TObject);
begin
edtSendCommName.text := 'COM1';
edtSendBaudRate.text := '9600';
cmbSendByteSize.ItemIndex :=3;
cmbSendStopBits.ItemIndex :=0;
cmbSendParity.ItemIndex :=0;
edtRecvCommName.text := 'COM2';
edtRecvBaudRate.text := '9600';
cmbRecvByteSize.ItemIndex :=3;
cmbRecvStopBits.ItemIndex :=0;
cmbRecvParity.ItemIndex :=0;
end;
//互置发送按钮和输入框的有效性
procedure TfrmMain.SetSendButton ;
begin
edtSendCommName.Enabled := not edtSendCommName.Enabled ;
edtSendBaudRate.Enabled := not edtsendBaudRate.Enabled ;
cmbSendByteSize.Enabled := not cmbSendByteSize.Enabled ;
cmbSendStopbits.Enabled := not cmbSendStopbits.Enabled ;
cmbSendParity.Enabled := not cmbSendParity.Enabled ;
btnOpenSend.Enabled := not btnOpenSend.Enabled ;
btnSendData.Enabled := not btnSendData.Enabled ;
btnCloseSend.Enabled := not btnCloseSend.Enabled ;
end;
//互置接收按钮和输入框的有效性
procedure TfrmMain.SetRecvButton ;
begin
edtRecvCommName.Enabled := not edtRecvCommName.Enabled ;
edtRecvBaudRate.Enabled := not edtRecvBaudRate.Enabled ;
cmbRecvByteSize.Enabled := not cmbRecvByteSize.Enabled ;
cmbRecvStopbits.Enabled := not cmbRecvStopbits.Enabled ;
cmbRecvParity.Enabled := not cmbRecvParity.Enabled ;
btnOpenRecv.Enabled := not btnOpenRecv.Enabled ;
btnRecvData.Enabled := not btnRecvData.Enabled ;
btnCloseRecv.Enabled := not btnCloseRecv.Enabled ;
end;
//打开发送的串口
procedure TfrmMain.btnOpenSendClick(Sender: TObject);
var
dcb: TDCB;
Error: Boolean;
CommName : string;
begin
CommName := edtSendCommName.Text ;
// 打开发送串口
hSend := CreateFile(PChar(CommName), GENERIC_WRITE, 0,
nil, OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0);
if hSend = INVALID_HANDLE_VALUE then
raise Exception.Create('打开'+edtSendCommName.Text+'端口错误!');
// 设置输入和输出缓冲区大小
SetupComm(hSend, 1024, 1024);
//设置串口的波特率、字符位数、奇偶校验、停止位
GetCommState(hSend, dcb);
dcb.BaudRate := strToInt(edtSendBaudRate.Text);
dcb.ByteSize := strToInt(cmbSendByteSize.Text);
dcb.StopBits := cmbSendStopBits.ItemIndex ;
dcb.Parity := cmbSendParity.ItemIndex ;
Error := SetCommState(hSend, dcb);
if (not Error) then
raise Exception.Create('设置'+edtSendCommName.text+'错误');
stbSend.Panels[0].Text :=edtSendCommName.Text +'端口已打开';
stbSend.Refresh ;
SetSendButton;
end;
//向发送串口写数据
procedure TfrmMain.btnSendDataClick(Sender: TObject);
var
dwNumberOfBytesWritten, dwNumberOfBytesToWrite,
ErrorFlag, dwWhereToStartWriting: DWORD;
pDataToWrite: PChar;
write_os: Toverlapped;
begin
dwWhereToStartWriting := 0;
dwNumberOfBytesWritten := 0;
//设置将要向串口里写的数据长度
dwNumberOfBytesToWrite := edtSend.GetTextLen;
if (dwNumberOfBytesToWrite = 0) then
raise Exception.Create('发送缓冲区为空');
//将edtcomm里的文本传到pDataToWrite缓冲区
pDataToWrite := Pchar(edtSend.Text);
FillChar(Write_Os, SizeOf(write_os), 'a');
// 为重叠写创建事件对象
Write_Os.hEvent := CreateEvent(nil, True, False, nil);
//设置直到最后一个字符被发送
SetCommMask(hSend, EV_TXEMPTY);
repeat
// 发送通讯数据
if not WriteFile(hSend, pDataToWrite[dwWhereToStartWriting],
dwNumberOfBytesToWrite, dwNumberOfBytesWritten,
@write_os) then
begin
ErrorFlag := GetLastError;
if ErrorFlag <> 0 then
begin
if ErrorFlag = ERROR_IO_PENDING then
begin
WaitForSingleObject(Write_Os.hEvent, INFINITE);
//等待设置好的事件发生
GetOverlappedResult(hSend, Write_os,
dwNumberOfBytesWritten, False);
end
else
raise Exception.Create('发送数据失败');
end;
end;
//减去已发生的数据长度
Dec(dwNumberOfBytesToWrite, dwNumberOfBytesWritten);
//记录已发送的数据长度
Inc(dwWhereToStartWriting, dwNumberOfBytesWritten);
//直到全部发送完
until (dwNumberOfBytesToWrite <= 0);
mmoSend.Lines.Add('已发送:'+intToStr(dwWhereToStartWriting)+'个字节的数据');
end;
//关闭发送串口
procedure TfrmMain.btnCloseSendClick(Sender: TObject);
begin
CloseHandle(hSend);
stbSend.Panels[0].Text :=edtSendCommName.Text +'端口已关闭';
stbSend.Refresh ;
setSendButton;
end;
//打开接收串口
procedure TfrmMain.btnOpenRecvClick(Sender: TObject);
var
dcb: TDCB;
Error: Boolean;
CommName : string;
begin
CommName := edtRecvCommName.Text ;
// 打开通讯端口
hRecv := CreateFile(PChar(CommName),GENERIC_Read, 0,
nil, OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0);
if hRecv = INVALID_HANDLE_VALUE then
raise Exception.Create('打开'+edtSendCommName.Text+'端口错误!');
Error := SetCommMask(hRecv,EV_RXCHAR);
if (not Error) then
raise Exception.Create('SetCommMask错误');
// 设置缓冲区大小及主要通讯参数
SetupComm(hRecv, 1024, 1024);
//设置串口的波特率、字符位数、奇偶校验、停止位
GetCommState(hRecv, dcb);
dcb.BaudRate := strToInt(edtRecvBaudRate.Text);
dcb.ByteSize := strToInt(cmbRecvByteSize.Text);
dcb.StopBits := cmbRecvStopBits.ItemIndex ;
dcb.Parity := cmbRecvParity.ItemIndex ;
Error := SetCommState(hRecv, dcb);
if (not Error) then
raise Exception.Create('设置'+edtRecvCommName.text+'错误');
stbRecv.Panels[0].Text :=edtSendCommName.Text +'端口已打开';
stbRecv.Refresh ;
SetRecvButton;
btnRecvData.Enabled := True;
end;
//开始接收串口数据
procedure TfrmMain.btnRecvDataClick(Sender: TObject);
var
dcb: TDCB;
recvThread : TRecvThread;
begin
FillChar(Read_Os, SizeOf(Read_Os), 0);
Read_Os.Offset := 0;
Read_Os.OffsetHigh := 0;
// 创建Overlapped事件
Read_Os.hEvent := CreateEvent(nil, true, False, nil);
if Read_Os.hEvent = null then
begin
CloseHandle(hRecv);
raise Exception.Create('CreateEvent Error!')
end;
//创建Post_Event事件
Post_Event := CreateEvent(nil, True, True, nil);
if Post_Event = null then
begin
CloseHandle(hRecv);
CloseHandle(Read_Os.hEvent);
raise Exception.Create('CreateEvent Error!')
end;
// 建立通信监视线程
recvThread := TRecvThread.Create(false);
//发送DTR信号
EscapeCommFunction(hRecv, SETDTR);
btnRecvData.Enabled := False;
stbRecv.Panels[0].Text :='正在接收数据';
stbRecv.Refresh;
end;
//关闭接收串口
procedure TfrmMain.btnCloseRecvClick(Sender: TObject);
begin
Receive := False;
//关闭事件和串口
CloseHandle(Read_Os.hEvent);
CloseHandle(Post_Event);
CloseHandle(hRecv);
stbRecv.Panels[0].Text :=edtSendCommName.Text +'端口已关闭';
stbRecv.Refresh ;
SetRecvButton;
btnRecvData.Enabled := False;
end;
//接收串口数据的线程执行体
procedure TRecvThread.Execute ;
var
dwEvtMask, dwTranser: Dword;
Ok: Boolean;
Os: Toverlapped;
begin
Receive := True;
FillChar(Os, SizeOf(Os), 0);
// 创建重叠读事件对象
Os.hEvent := CreateEvent(nil, True, False, nil);
if Os.hEvent = null then
begin
MessageBox(0, 'Os.Event Create Error !', 'Notice', MB_OK);
Exit;
end;
if (not SetCommMask(hRecv, EV_RXCHAR)) then
begin
MessageBox(0, 'SetCommMask Error !', 'Notice', MB_OK);
Exit;
end;
while (Receive) do
begin
dwEvtMask := 0;
// 等待通讯事件发生
if not WaitCommEvent(hRecv, dwEvtMask, @Os) then
begin
if ERROR_IO_PENDING = GetLastError then
GetOverLappedResult(hRecv, Os, dwTranser, True)
end;
if ((dwEvtMask and EV_RXCHAR) = EV_RXCHAR) then
begin
// 等待允许传递WM_COMMNOTIFY通讯消息
WaitForSingleObject(Post_event, INFINITE);
// 处理WM_COMMNOTIFY消息时不再发送WM_COMMNOTIFY消息
ResetEvent(Post_Event);
// 传递WM_COMMNOTIFY通讯消息
Ok := PostMessage(frmMain.Handle, WM_COMMNOTIFY, hRecv, 0);
if (not Ok) then
begin
MessageBox(0, 'PostMessage Error !', 'Notice', MB_OK);
Exit;
end;
end;
end;
CloseHandle(Os.hEvent); // 关闭重叠读事件对象
end;
// 数据接收消息处理函数
procedure TfrmMain.WMCOMMNOTIFY(var Message: TMessage);
var
CommState: ComStat;
dwNumberOfBytesRead: Dword;
ErrorFlag: Dword;
InputBuffer: array[0..1024] of Char;
recvString : string;
begin
if not ClearCommError(hRecv, ErrorFlag, @CommState) then
begin
MessageBox(0, 'ClearCommError !', 'Notice', MB_OK);
PurgeComm(hRecv, Purge_Rxabort or Purge_Rxclear);
Exit;
end;
if (CommState.cbInQue > 0) then
begin
fillchar(InputBuffer, CommState.cbInQue, #0);
// 接收通讯数据
if (not ReadFile(hRecv, InputBuffer, CommState.cbInQue,
dwNumberOfBytesRead, @Read_os)) then
begin
ErrorFlag := GetLastError();
if (ErrorFlag <> 0) and (ErrorFlag <> ERROR_IO_PENDING) then
begin
Receive := False;
raise Exception.Create('读串口数据出错!');
end
else
begin
WaitForSingleObject(hRecv, INFINITE); // 等待操作完成
GetOverlappedResult(hRecv, Read_os,
dwNumberOfBytesRead, False);
end;
end;
if dwNumberOfBytesRead > 0 then
begin
Read_Os.Offset := Read_Os.Offset + dwNumberOfBytesRead;
// 处理接收的数据
InputBuffer[dwNumberOfBytesRead]:=#0;
mmoRecv.Lines.Add('接收到:'+intToStr(dwNumberOfBytesRead)+'个字节的数据');
mmoRecv.Lines.Add(strPas(inputBuffer));
end;
end;
// 允许发送下一个WM_COMMNOTIFY消息
SetEvent(Post_Event);
end;
//检查发送串口的波特率输入框输入的是否是整数
procedure TfrmMain.edtSendBaudRateExit(Sender: TObject);
var
i: integer;
begin
try
i := strToInt(edtSendBaudRate.Text)
except
edtSendBaudRate.setfocus;
raise Exception.Create('波特率设置错误');
end;
end;
//检查接收串口的波特率输入框输入的是否是整数
procedure TfrmMain.edtRecvBaudRateExit(Sender: TObject);
var
i: integer;
begin
try
i := strToInt(edtRecvBaudRate.Text)
except
edtRecvBaudRate.setfocus;
raise Exception.Create('波特率设置错误');
end;
end;
end.