关于Windows API的一个串口通信测试程序的问题 找超市进销存管理
2楼: 代码贴出来，大家帮你分析 如设备维修管理软件
3楼: 有点长哦~~
4楼: 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);
btnReceiveData.OnClick(btnReceiveData);
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.
5楼: 辛苦大家了~！
6楼: 你创建了接收线程，但线程里什么都没做，也没有接收数据的代码，当然是接收不到数据的，我的串口接收数据函数，你参考一下。
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;
库存管理软件版7楼: 这种通信方式是同步还是异步（重叠）的呢？
8楼: ReadFile(Fm_handle, pData[0], DataLen, DWord(iReceive), @Overlapped)
是异步的
9楼: 呵呵，好像是异步的哈：）
如果要改成同步的，是不是把所有函数中的lpOverlapped参数删除就可以了呢？
10楼: To:nicai_wgl
你说线程里什么都没做，也没有接收数据的代码,那程序中 procedure TForm1.WMCOMMNOTIFY(var Message :TMessage); // 消息处理函数 是做什么用的呢？
11楼: Sorry，没有仔细看代码，你是怎么调试的，
procedure TForm1.WMCOMMNOTIFY(var Message :TMessage); 设置断点试试。
12楼: 到现在我也没弄明白怎么回事,大家帮帮我啊~~~~ 如超市进销存管理
13楼: 转别人的
在Windows 95/NT中，WM_COMMNOTIFY消息已经取消，在串行口产生一个通信事件时，程序并不会收到通知消息。线程需要调用WaitCommEvent函数来监视发生在串行口中的各种事件，该函数的第二个参数返回一个事件屏蔽变量，用来指示事件的类型。线程可以用SetCommMask建立事件屏蔽以指定要监视的事件，表12.4列出了可以监视的事件。调用GetCommMask可以查询串行口当前的事件屏蔽。
库存管理软件版14楼: 帮顶!
http://www.source520.com
站长开发推广同盟 站长朋友的终极驿站
同时拥有海量源码电子经典书籍下载
http://www.source520.com/search/search.asp
＂编程.站长＂论坛搜索引擎-----为中国站长注入动力!
15楼: 我也用《Delphi串口通信技术与工程实践》（人民邮电出版社 赵兰涛 苏彦华 编著）附带光盘中的程序——电话语音查询系统(11章),程序运行时出现＂tapi设备不支持语音扩展＂的错误提示框.光标停在apdtapidevice1.voiceenable=false上!哪位高手知道请赐教!谢谢了
联系我们
