X
xx0239
Unregistered / Unconfirmed
GUEST, unregistred user!
要通过计算机的串口与外部的设备进行通讯,要怎么编程,要怎么控制外部的设备啊,
或者有没有关于这方面的资料啊..谢谢帮忙!~
或者有没有关于这方面的资料啊..谢谢帮忙!~
P
pipi158
Unregistered / Unconfirmed
GUEST, unregistred user!
你需要有外部设备的通讯协议，根据协议进行相应的操作
B
biyesheng
Unregistered / Unconfirmed
GUEST, unregistred user!
帮你贴篇文章不知有没有用
用DELPHI进行 Win32环境下串行通讯的程序设计
张秀德 姜新通 张冬生
摘要 由于在Delphi环境中没有提供通讯控件，本文介绍了用Delphi4.0实现的Win32
环境下基于线程的串行通讯程序设计，能适当降低数据丢失率以及提高系统可靠性，并
给出了一个通讯程序实例。
关键词 串行通讯 多线程 程序设计
在自动化工业控制应用中，经常需要计算机与外围设备进行数据通讯。而异步串行通讯
是一种常用的通讯手段。在单任务操作系统中，不能同时处理两件以上不同的任务。
Win32是基于线程的多任务操作系统，使得应用程序能同时执行多个任务，即在一个进程
中可同时运行多个线程。利用Win32的这个特点，在通讯过程中可以适当降低数据丢失率，
提高系统可靠性。
随着Win95系统的逐步普及，程序员们更愿意在Win95下编程。而Delphi也越来越为广大程
序员所喜爱。然而，令人遗憾的是在Delphi环境中没有象其它的一些编程语言一样提供标
准通讯控件。因此，利用Delphi进行通讯程序设计时，不但要掌握多线程编程技术，还要
了解一些与通讯相关的API函数的使用。
一 多线程基本概念
首先介绍进程概念。一个进程通常定义为程序的一个实例。在Win32中，进程占据4GB地
址空间。实际上，一个进程可以包含几个线程，它们可以同时执行进程的地址空间中的
代码。为了运行所有这些线程，操作系统以轮转方式为每个独立线程分配一些CPU时间片
。这给人一种假象，好像这些线程是在同时运行。创建一个Win32进程时，它的第一个线
程称为主线程，由系统自动生成。然后可由主线程生成其它的线程，这些线程又可生成
更多的线程。
线程描述了进程内的执行，是组成进程的基本单位。每次初始化一个进程时，系统创建
一个主线程。通常对于许多应用程序，主线程是应用程序的唯一线程。但是，进程也可
以创建额外的线程，目的在于尽可能充分合理的利用CPU时间。线程可以使用
CreateThread()函数来创建。
在有若干线程并行运行的环境里，同步各不同线程活动的能力是非常重要的，这样可以避
免对共享资源的访问冲突。事件对象是同步线程的最基本形式，它用以向其它线程发信
号以表示某一操作已经完成。例如，一个进程可能运行了两个线程。第一个线程从文件
读数据到内存缓冲区中。每当数据已被读入，第一个线程就发信号给第二个线程它可以
处理数据了。当第二个线程完成了对数据的处理时，它可能需要再次给第一个线程发信
号以让第一个线程能够从文件中读入下一块数据。事件可以使用CreateEvent()函数来
创建。线程和事件在任何时候都处于两种状态之一：有信号和无信号。当线程被创建和
正在运行时，它是无信号的。一旦线程终止，它就变成有信号的。线程可以通过使用
SetEvent()和ResetEvent()函数来将事件置成有信号和无信号。
除了以上介绍的概念和函数，在通讯程序中还要用到等待函数WaitForSingleObject()
和重叠I/O操作。等待函数能使线程阻塞自身执行，而重叠I/O操作能使费时的操作在后
台中运行。
二 通讯程序设计
在Windows环境下，对于串行通讯的控制是通过中断机制驱动的，由系统自行处理。
Windows禁止应用程序直接和硬件打交道，程序员只能使用Windows提供的标准函数通
过通讯驱动程序与硬件接口。首先，用CreateFile()函数打开通讯端口，然后通过
SetupComm() 函数给通讯的输入输出队列分配一定大小的内存缓冲区，接着通过
BuildCommDCB()函数 和SetCommState()等函数对主要通讯参数进行设置。初始化完成
后就可以利用ReadFile()函数和 WriteFile() 函数对通讯端口进行读写操作了。程序
界面如图所示。
本文提供的实例程序使用简单方便。利用一条串行数据线连接在两台计算机Com2之间
就可以进行文本文件传输。对于Delphi的具体编程方法这里不再赘述。实例中有详细
注释。
unit comunate;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, Buttons, StdCtrls, ComCtrls;
const
WM_COMMNOTIFY = WM_USER + 1;
// 通讯消息
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
OpenDialog1: TOpenDialog;
Label1: TLabel;
BitBtn1: TBitBtn;
RichEdit1: TRichEdit;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Private declarations }
procedure WMCOMMNOTIFY(var Message :TMessage);message WM_COMMNOTIFY;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
var
hNewCommFile,Post_Event: THandle;
Read_os : Toverlapped;
Receive :Boolean;
ReceiveData : Dword;
procedure AddToMemo(Str
Char;Len
word);
// 接收的数据送入显示区
begin
str[Len]:=#0;
Form1.RichEdit1.Text:=Form1.RichEdit1.Text+StrPas(str);
end;
procedure CommWatch(Ptrointer);stdcall;
// 通讯监视线程
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(hNewCommFile,EV_RXCHAR)) then
begin
MessageBox(0,'SetCommMask Error !','Notice',MB_OK);
Exit;
end;
while(Receive)do
begin
dwEvtMask:=0;
// 等待通讯事件发生
if not WaitCommEvent(hNewCommFile,dwEvtMask,@Os) then
begin
if ERROR_IO_PENDING=GetLastError then
GetOverLappedResult(hNewCommFile,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(Form1.Handle,WM_COMMNOTIFY,hNewCommFile,0);
if (not Ok) then
begin
MessageBox(0,'PostMessage Error !','Notice',MB_OK);
Exit;
end;
end;
end;
CloseHandle(Os.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(hNewCommFile,ErrorFlag,@CommState) then
begin
MessageBox(0,'ClearCommError !','Notice',MB_OK);
PurgeComm(hNewCommFile,Purge_Rxabort or Purge_Rxclear);
Exit;
end;
if (CommState.cbInQue>0) then
begin
fillchar(InputBuffer,CommState.cbInQue,#0);
// 接收通讯数据
if (not ReadFile( hNewCommFile,InputBuffer,CommState.cbInQue,
dwNumberOfBytesRead,@Read_os )) then
begin
ErrorFlag := GetLastError();
if (ErrorFlag <> 0) and (ErrorFlag <> ERROR_IO_PENDING) then
begin
MessageBox(0,'ReadFile Error!','Notice',MB_OK);
Receive :=False;
CloseHandle(Read_Os.hEvent);
CloseHandle(Post_Event);
CloseHandle(hNewCommFile);
Exit;
end
else
begin
WaitForSingleObject(hNewCommFile,INFINITE);
// 等待操作完成
GetOverlappedResult(hNewCommFile,Read_os,
dwNumberOfBytesRead,False);
end;
end;
if dwNumberOfBytesRead>0 then
begin
Read_Os.Offset :=Read_Os.Offset+dwNumberOfBytesRead;
ReceiveData := Read_Os.Offset;
// 处理接收的数据
AddToMemo(InputBuffer,dwNumberOfBytesRead);
end;
end;
// 允许发送下一个WM_COMMNOTIFY消息
SetEvent(Post_Event);
end;
procedure TForm1.Button1Click(Sender: TObject);
// 打开文件用于发送
begin
if OpenDialog1.Execute then
begin
Button3.Enabled :=False;
Button4.Enabled :=False;
RichEdit1.Lines.LoadFromFile(OpenDialog1.FileName);
Form1.Caption := IntToStr(RichEdit1.GetTextLen);
end;
Button1.Enabled :=False;
end;
procedure TForm1.Button2Click(Sender: TObject);
// 发送数据
var
dcb : TDCB;
Error :Boolean;
dwNumberOfBytesWritten,dwNumberOfBytesToWrite,
ErrorFlag,dwWhereToStartWriting : DWORD;
pDataToWrite : PChar;
write_os: Toverlapped;
begin
Form1.Caption :='';
// 打开通讯端口COM2
hNewCommFile:=CreateFile( 'COM2',GENERIC_WRITE,0,
nil, OPEN_EXISTING,FILE_FLAG_OVERLAPPED,0 );
if hNewCommFile = INVALID_HANDLE_VALUE then
MessageBox(0,'Error opening com port!','Notice',MB_OK);
SetupComm(hNewCommFile,1024,1024);
// 设置缓冲区大小及主要通讯参数
GetCommState( hNewCommFile,dcb);
dcb.BaudRate :=9600;
dcb.ByteSize :=8;
dcb.Parity :=NOPARITY;
dcb.StopBits := ONESTOPBIT;
Error := SetCommState( hNewCommFile, dcb );
if ( not Error) then
MessageBox(0,'SetCommState Error!','Notice',MB_OK);
dwWhereToStartWriting := 0;
dwNumberOfBytesWritten := 0;
dwNumberOfBytesToWrite :=RichEdit1.GetTextLen;
if (dwNumberOfBytesToWrite=0) then
begin
ShowMessage('Text Buffer is Empty!');
Exit;
end
else
begin
pDataToWrite:=StrAlloc(dwNumberOfBytesToWrite+1);
try
RichEdit1.GetTextBuf(pDataToWrite,dwNumberOfBytesToWrite);
Label1.Font.Color :=clRed;
FillChar(Write_Os,SizeOf(write_os),0);
// 为重叠写创建事件对象
Write_Os.hEvent := CreateEvent(nil,True,False,nil);
SetCommMask(hNewCommFile,EV_TXEMPTY);
Label1.Caption:='正在发送数据...!';
repeat
Label1.Repaint;
// 发送通讯数据
if not WriteFile( hNewCommFile,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(hNewCommFile,Write_os,
dwNumberOfBytesWritten,False);
end
else
begin
MessageBox(0,'WriteFile Error!','Notice',MB_OK);
Receive :=False;
CloseHandle(Read_Os.hEvent);
CloseHandle(Post_Event);
CloseHandle(hNewCommFile);
Exit;
end;
end;
end;
Dec( dwNumberOfBytesToWrite, dwNumberOfBytesWritten );
Inc( dwWhereToStartWriting, dwNumberOfBytesWritten );
until (dwNumberOfBytesToWrite <= 0);
// Write the whole thing!
Form1.Caption:=IntToStr(dwWhereToStartWriting);
finally
StrDispose(pDataToWrite);
end;
CloseHandle(hNewCommFile);
end;
Label1.Font.Color :=clBlack;
Label1.Caption:='发送成功!';
Button1.Enabled :=True;
Button3.Enabled :=True;
Button4.Enabled :=True;
end;
procedure TForm1.Button3Click(Sender: TObject);
// 接收处理
var
Ok : Boolean;
dcb : TDCB;
com_thread: Thandle;
ThreadIDWORD;
begin
ReceiveData :=0;
Button1.Enabled :=False;
Button2.Enabled :=False;
RichEdit1.Clear;
// 打开COM2
hNewCommFile:=CreateFile( 'COM2'，GENERIC_READ,0,
nil, OPEN_EXISTING,FILE_FLAG_OVERLAPPED,0 );
if hNewCommFile = INVALID_HANDLE_VALUE then
begin
MessageBox(0,'Error opening com port!','Notice',MB_OK);
Exit;
end;
Ok:=SetCommMask(hNewCommFile,EV_RXCHAR);
if ( not Ok) then
begin
MessageBox(0,'SetCommMask Error!','Notice',MB_OK);
Exit;
end;
SetupComm(hNewCommFile,1024,1024);
GetCommState( hNewCommFile, dcb );
dcb.BaudRate :=9600;
dcb.ByteSize :=8;
dcb.Parity :=NOPARITY;
dcb.StopBits := ONESTOPBIT;
Ok := SetCommState( hNewCommFile, dcb );
if ( not Ok) then
MessageBox(0,'SetCommState Error!','Notice',MB_OK);
FillChar(Read_Os,SizeOf(Read_Os),0);
Read_Os.Offset := 0;
Read_Os.OffsetHigh := 0;
// Create Event for Overlapped Read
Read_Os.hEvent :=CreateEvent(nil,true,False,nil);
if Read_Os.hEvent=null then
begin
CloseHandle(hNewCommFile);
MessageBox(0,'CreateEvent Error!','Notice',MB_OK);
Exit;
end;
// Create Event for PostMessage
Post_Event:=CreateEvent(nil,True,True,nil);
if Post_Event=null then
begin
CloseHandle(hNewCommFile);
CloseHandle(Read_Os.hEvent);
MessageBox(0,'CreateEvent Error!','Notice',MB_OK);
Exit;
end;
// 建立通信监视线程
Com_Thread:=CreateThread(nil,0,@CommWatch,nil,0,ThreadID);
if (Com_Thread=0) then
MessageBox(Handle,'No CraeteThread!',nil,mb_OK);
EscapeCommFunction(hNewCommFile,SETDTR);
Label1.Font.Color :=clRed;
Label1.Caption:='正在接收数据...!';
end;
procedure TForm1.Button4Click(Sender: TObject);
// 停止通讯处理
begin
Label1.Font.Color :=clBlack;
Label1.Caption:='infomation';
Form1.Caption := IntToStr(ReceiveData);
Receive :=False;
CloseHandle(Read_Os.hEvent);
CloseHandle(Post_Event);
CloseHandle(hNewCommFile);
Button1.Enabled :=True;
Button2.Enabled :=True;
end;
end.
参考文献
1．Windows95 Windows NT3.5高级编程技术 Jeffrey Richter著
2．基于Windows 95&NT的串行通信编程 李柯 <<微电脑世界>> 1997。5
3．Windows 95中的串行通信 王齐 <<微电脑世界>> 1997。3
用DELPHI进行 Win32环境下串行通讯的程序设计
张秀德 姜新通 张冬生
摘要 由于在Delphi环境中没有提供通讯控件，本文介绍了用Delphi4.0实现的Win32
环境下基于线程的串行通讯程序设计，能适当降低数据丢失率以及提高系统可靠性，并
给出了一个通讯程序实例。
关键词 串行通讯 多线程 程序设计
在自动化工业控制应用中，经常需要计算机与外围设备进行数据通讯。而异步串行通讯
是一种常用的通讯手段。在单任务操作系统中，不能同时处理两件以上不同的任务。
Win32是基于线程的多任务操作系统，使得应用程序能同时执行多个任务，即在一个进程
中可同时运行多个线程。利用Win32的这个特点，在通讯过程中可以适当降低数据丢失率，
提高系统可靠性。
随着Win95系统的逐步普及，程序员们更愿意在Win95下编程。而Delphi也越来越为广大程
序员所喜爱。然而，令人遗憾的是在Delphi环境中没有象其它的一些编程语言一样提供标
准通讯控件。因此，利用Delphi进行通讯程序设计时，不但要掌握多线程编程技术，还要
了解一些与通讯相关的API函数的使用。
一 多线程基本概念
首先介绍进程概念。一个进程通常定义为程序的一个实例。在Win32中，进程占据4GB地
址空间。实际上，一个进程可以包含几个线程，它们可以同时执行进程的地址空间中的
代码。为了运行所有这些线程，操作系统以轮转方式为每个独立线程分配一些CPU时间片
。这给人一种假象，好像这些线程是在同时运行。创建一个Win32进程时，它的第一个线
程称为主线程，由系统自动生成。然后可由主线程生成其它的线程，这些线程又可生成
更多的线程。
线程描述了进程内的执行，是组成进程的基本单位。每次初始化一个进程时，系统创建
一个主线程。通常对于许多应用程序，主线程是应用程序的唯一线程。但是，进程也可
以创建额外的线程，目的在于尽可能充分合理的利用CPU时间。线程可以使用
CreateThread()函数来创建。
在有若干线程并行运行的环境里，同步各不同线程活动的能力是非常重要的，这样可以避
免对共享资源的访问冲突。事件对象是同步线程的最基本形式，它用以向其它线程发信
号以表示某一操作已经完成。例如，一个进程可能运行了两个线程。第一个线程从文件
读数据到内存缓冲区中。每当数据已被读入，第一个线程就发信号给第二个线程它可以
处理数据了。当第二个线程完成了对数据的处理时，它可能需要再次给第一个线程发信
号以让第一个线程能够从文件中读入下一块数据。事件可以使用CreateEvent()函数来
创建。线程和事件在任何时候都处于两种状态之一：有信号和无信号。当线程被创建和
正在运行时，它是无信号的。一旦线程终止，它就变成有信号的。线程可以通过使用
SetEvent()和ResetEvent()函数来将事件置成有信号和无信号。
除了以上介绍的概念和函数，在通讯程序中还要用到等待函数WaitForSingleObject()
和重叠I/O操作。等待函数能使线程阻塞自身执行，而重叠I/O操作能使费时的操作在后
台中运行。
二 通讯程序设计
在Windows环境下，对于串行通讯的控制是通过中断机制驱动的，由系统自行处理。
Windows禁止应用程序直接和硬件打交道，程序员只能使用Windows提供的标准函数通
过通讯驱动程序与硬件接口。首先，用CreateFile()函数打开通讯端口，然后通过
SetupComm() 函数给通讯的输入输出队列分配一定大小的内存缓冲区，接着通过
BuildCommDCB()函数 和SetCommState()等函数对主要通讯参数进行设置。初始化完成
后就可以利用ReadFile()函数和 WriteFile() 函数对通讯端口进行读写操作了。程序
界面如图所示。
本文提供的实例程序使用简单方便。利用一条串行数据线连接在两台计算机Com2之间
就可以进行文本文件传输。对于Delphi的具体编程方法这里不再赘述。实例中有详细
注释。
unit comunate;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, Buttons, StdCtrls, ComCtrls;
const
WM_COMMNOTIFY = WM_USER + 1;
// 通讯消息
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
OpenDialog1: TOpenDialog;
Label1: TLabel;
BitBtn1: TBitBtn;
RichEdit1: TRichEdit;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Private declarations }
procedure WMCOMMNOTIFY(var Message :TMessage);message WM_COMMNOTIFY;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
var
hNewCommFile,Post_Event: THandle;
Read_os : Toverlapped;
Receive :Boolean;
ReceiveData : Dword;
procedure AddToMemo(Str
Char;Lenword);// 接收的数据送入显示区
begin
str[Len]:=#0;
Form1.RichEdit1.Text:=Form1.RichEdit1.Text+StrPas(str);
end;
procedure CommWatch(Ptr
ointer);stdcall;// 通讯监视线程
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(hNewCommFile,EV_RXCHAR)) then
begin
MessageBox(0,'SetCommMask Error !','Notice',MB_OK);
Exit;
end;
while(Receive)do
begin
dwEvtMask:=0;
// 等待通讯事件发生
if not WaitCommEvent(hNewCommFile,dwEvtMask,@Os) then
begin
if ERROR_IO_PENDING=GetLastError then
GetOverLappedResult(hNewCommFile,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(Form1.Handle,WM_COMMNOTIFY,hNewCommFile,0);
if (not Ok) then
begin
MessageBox(0,'PostMessage Error !','Notice',MB_OK);
Exit;
end;
end;
end;
CloseHandle(Os.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(hNewCommFile,ErrorFlag,@CommState) then
begin
MessageBox(0,'ClearCommError !','Notice',MB_OK);
PurgeComm(hNewCommFile,Purge_Rxabort or Purge_Rxclear);
Exit;
end;
if (CommState.cbInQue>0) then
begin
fillchar(InputBuffer,CommState.cbInQue,#0);
// 接收通讯数据
if (not ReadFile( hNewCommFile,InputBuffer,CommState.cbInQue,
dwNumberOfBytesRead,@Read_os )) then
begin
ErrorFlag := GetLastError();
if (ErrorFlag <> 0) and (ErrorFlag <> ERROR_IO_PENDING) then
begin
MessageBox(0,'ReadFile Error!','Notice',MB_OK);
Receive :=False;
CloseHandle(Read_Os.hEvent);
CloseHandle(Post_Event);
CloseHandle(hNewCommFile);
Exit;
end
else
begin
WaitForSingleObject(hNewCommFile,INFINITE);
// 等待操作完成
GetOverlappedResult(hNewCommFile,Read_os,
dwNumberOfBytesRead,False);
end;
end;
if dwNumberOfBytesRead>0 then
begin
Read_Os.Offset :=Read_Os.Offset+dwNumberOfBytesRead;
ReceiveData := Read_Os.Offset;
// 处理接收的数据
AddToMemo(InputBuffer,dwNumberOfBytesRead);
end;
end;
// 允许发送下一个WM_COMMNOTIFY消息
SetEvent(Post_Event);
end;
procedure TForm1.Button1Click(Sender: TObject);
// 打开文件用于发送
begin
if OpenDialog1.Execute then
begin
Button3.Enabled :=False;
Button4.Enabled :=False;
RichEdit1.Lines.LoadFromFile(OpenDialog1.FileName);
Form1.Caption := IntToStr(RichEdit1.GetTextLen);
end;
Button1.Enabled :=False;
end;
procedure TForm1.Button2Click(Sender: TObject);
// 发送数据
var
dcb : TDCB;
Error :Boolean;
dwNumberOfBytesWritten,dwNumberOfBytesToWrite,
ErrorFlag,dwWhereToStartWriting : DWORD;
pDataToWrite : PChar;
write_os: Toverlapped;
begin
Form1.Caption :='';
// 打开通讯端口COM2
hNewCommFile:=CreateFile( 'COM2',GENERIC_WRITE,0,
nil, OPEN_EXISTING,FILE_FLAG_OVERLAPPED,0 );
if hNewCommFile = INVALID_HANDLE_VALUE then
MessageBox(0,'Error opening com port!','Notice',MB_OK);
SetupComm(hNewCommFile,1024,1024);
// 设置缓冲区大小及主要通讯参数
GetCommState( hNewCommFile,dcb);
dcb.BaudRate :=9600;
dcb.ByteSize :=8;
dcb.Parity :=NOPARITY;
dcb.StopBits := ONESTOPBIT;
Error := SetCommState( hNewCommFile, dcb );
if ( not Error) then
MessageBox(0,'SetCommState Error!','Notice',MB_OK);
dwWhereToStartWriting := 0;
dwNumberOfBytesWritten := 0;
dwNumberOfBytesToWrite :=RichEdit1.GetTextLen;
if (dwNumberOfBytesToWrite=0) then
begin
ShowMessage('Text Buffer is Empty!');
Exit;
end
else
begin
pDataToWrite:=StrAlloc(dwNumberOfBytesToWrite+1);
try
RichEdit1.GetTextBuf(pDataToWrite,dwNumberOfBytesToWrite);
Label1.Font.Color :=clRed;
FillChar(Write_Os,SizeOf(write_os),0);
// 为重叠写创建事件对象
Write_Os.hEvent := CreateEvent(nil,True,False,nil);
SetCommMask(hNewCommFile,EV_TXEMPTY);
Label1.Caption:='正在发送数据...!';
repeat
Label1.Repaint;
// 发送通讯数据
if not WriteFile( hNewCommFile,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(hNewCommFile,Write_os,
dwNumberOfBytesWritten,False);
end
else
begin
MessageBox(0,'WriteFile Error!','Notice',MB_OK);
Receive :=False;
CloseHandle(Read_Os.hEvent);
CloseHandle(Post_Event);
CloseHandle(hNewCommFile);
Exit;
end;
end;
end;
Dec( dwNumberOfBytesToWrite, dwNumberOfBytesWritten );
Inc( dwWhereToStartWriting, dwNumberOfBytesWritten );
until (dwNumberOfBytesToWrite <= 0);
// Write the whole thing!
Form1.Caption:=IntToStr(dwWhereToStartWriting);
finally
StrDispose(pDataToWrite);
end;
CloseHandle(hNewCommFile);
end;
Label1.Font.Color :=clBlack;
Label1.Caption:='发送成功!';
Button1.Enabled :=True;
Button3.Enabled :=True;
Button4.Enabled :=True;
end;
procedure TForm1.Button3Click(Sender: TObject);
// 接收处理
var
Ok : Boolean;
dcb : TDCB;
com_thread: Thandle;
ThreadID
WORD;begin
ReceiveData :=0;
Button1.Enabled :=False;
Button2.Enabled :=False;
RichEdit1.Clear;
// 打开COM2
hNewCommFile:=CreateFile( 'COM2'，GENERIC_READ,0,
nil, OPEN_EXISTING,FILE_FLAG_OVERLAPPED,0 );
if hNewCommFile = INVALID_HANDLE_VALUE then
begin
MessageBox(0,'Error opening com port!','Notice',MB_OK);
Exit;
end;
Ok:=SetCommMask(hNewCommFile,EV_RXCHAR);
if ( not Ok) then
begin
MessageBox(0,'SetCommMask Error!','Notice',MB_OK);
Exit;
end;
SetupComm(hNewCommFile,1024,1024);
GetCommState( hNewCommFile, dcb );
dcb.BaudRate :=9600;
dcb.ByteSize :=8;
dcb.Parity :=NOPARITY;
dcb.StopBits := ONESTOPBIT;
Ok := SetCommState( hNewCommFile, dcb );
if ( not Ok) then
MessageBox(0,'SetCommState Error!','Notice',MB_OK);
FillChar(Read_Os,SizeOf(Read_Os),0);
Read_Os.Offset := 0;
Read_Os.OffsetHigh := 0;
// Create Event for Overlapped Read
Read_Os.hEvent :=CreateEvent(nil,true,False,nil);
if Read_Os.hEvent=null then
begin
CloseHandle(hNewCommFile);
MessageBox(0,'CreateEvent Error!','Notice',MB_OK);
Exit;
end;
// Create Event for PostMessage
Post_Event:=CreateEvent(nil,True,True,nil);
if Post_Event=null then
begin
CloseHandle(hNewCommFile);
CloseHandle(Read_Os.hEvent);
MessageBox(0,'CreateEvent Error!','Notice',MB_OK);
Exit;
end;
// 建立通信监视线程
Com_Thread:=CreateThread(nil,0,@CommWatch,nil,0,ThreadID);
if (Com_Thread=0) then
MessageBox(Handle,'No CraeteThread!',nil,mb_OK);
EscapeCommFunction(hNewCommFile,SETDTR);
Label1.Font.Color :=clRed;
Label1.Caption:='正在接收数据...!';
end;
procedure TForm1.Button4Click(Sender: TObject);
// 停止通讯处理
begin
Label1.Font.Color :=clBlack;
Label1.Caption:='infomation';
Form1.Caption := IntToStr(ReceiveData);
Receive :=False;
CloseHandle(Read_Os.hEvent);
CloseHandle(Post_Event);
CloseHandle(hNewCommFile);
Button1.Enabled :=True;
Button2.Enabled :=True;
end;
end.
参考文献
1．Windows95 Windows NT3.5高级编程技术 Jeffrey Richter著
2．基于Windows 95&NT的串行通信编程 李柯 <<微电脑世界>> 1997。5
3．Windows 95中的串行通信 王齐 <<微电脑世界>> 1997。3
Z
ZRWeng
Unregistered / Unconfirmed
GUEST, unregistred user!
一般是用spcomm or mscomm 或则自己用API写
根据外设提供的通讯指令格式，发送数据就可以了
根据外设提供的通讯指令格式，发送数据就可以了
小
小翁
Unregistered / Unconfirmed
GUEST, unregistred user!
使用此控件，非常简单：
unit mscom;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
extctrls,syncobjs;
type
//类型定义
TBaudRate = ( br110, br300, br600, br1200, br2400, br4800,
br9600, br14400, br19200, br38400, br56000,
br57600, br115200 );
TComPortNumber = ( pnCOM1, pnCOM2, pnCOM3, pnCOM4, pnCOM5, pnCOM6, pnCOM7,
pnCOM8, pnCOM9, pnCOM10, pnCOM11, pnCOM12, pnCOM13,
pnCOM14, pnCOM15, pnCOM16 );
TParity = ( None, Odd, Even, Mark, Space );
TStopBits = ( SB1, SB1_5, SB2 );
TDataBits = ( DB5, DB6, DB7, DB8 );
THWHandShaking=(hhNone,hhNoneRTSON,hhRTSCTS);
TSWHandShaking=(shNone,shXonXoff);
//例外声明
ECommError = class( Exception );
//事件函数定位器声明
TReceiveDataEvent = procedure(Sender: TObject) of object;
TReceiveErrorEvent = procedure(Sender: TObject;
EventMask : DWORD) of object;
TModemStateChangeEvent = procedure(Sender: TObject;
ModemEvent : DWORD) of object;
const
// 输入缓冲区的默认大小
INPUTBUFFERSIZE = 4096;
// Line Status位定义
ME_CTS = 1;
ME_DSR = 2;
ME_RING = 4;
ME_RLSD = 8;
//DCB 位定义
dcb_Binary = $00000001;
dcb_ParityCheck = $00000002;
dcb_OutxCtsFlow = $00000004;
dcb_OutxDsrFlow = $00000008;
dcb_DtrControlMask = $00000030;
dcb_DtrControlDisable = $00000000;
dcb_DtrControlEnable = $00000010;
dcb_DtrControlHandshake = $00000020;
dcb_DsrSensivity = $00000040;
dcb_TXContinueOnXoff = $00000080;
dcb_OutX = $00000100;
dcb_InX = $00000200;
dcb_ErrorChar = $00000400;
dcb_NullStrip = $00000800;
dcb_RtsControlMask = $00003000;
dcb_RtsControlDisable = $00000000;
dcb_RtsControlEnable = $00001000;
dcb_RtsControlHandshake = $00002000;
dcb_RtsControlToggle = $00003000;
dcb_AbortOnError = $00004000;
dcb_Reserveds = $FFFF8000;
type
Tmscom = class(TComponent)
private
{ Private declarations }
CommTimer: TTimer;
//组件用的定时器
szInputBuffer: array[0..INPUTBUFFERSIZE-1] of Char;
hComm: THandle;
FCommPort: TComPortNumber;
FPortOpen: Boolean;
FBaudRate: TBaudRate;
FParityCheck: Boolean;
FHwHandShaking: THwHandShaking;
FSwHandShaking: TSwHandShaking;
FDataBits: TDataBits;
FParity: TParity;
FStopBits: TStopBits;
FInputLen: DWORD;
//每次执行Input时所读取的字符串长度
FRThreshold: DWORD;//设置引发接收事件的阀值
FDTR: Boolean;
FRTS: Boolean;
FInputData: String;
// FByteNo: DWORD;
//已读取的字节数
FInputByteData: array of Byte;
FCommEvent: DWORD;
FCommError: DWORD;
FCDHolding: Boolean;
FCTSHolding: Boolean;
FDSRHolding: Boolean;
FRIHolding: Boolean;
//事件
FOnReceiveData: TReceiveDataEvent;
FOnReceiveError: TReceiveErrorEvent;
FOnModemStateChange:TModemStateChangeEvent;
//设置函数
procedure SetBaudRate( Rate : TBaudRate );
//设置速率
procedure SetHwHandShaking( c : THwHandShaking);//硬件交握
procedure SetSwHandShaking( c : TSwHandShaking);//软件交握
procedure SetDataBits( Size : TDataBits );//数据位数
procedure SetParity( p : TParity );//极性检查
procedure SetStopBits( Bits : TStopBits );//停止位
procedure SetInDataCount(StrNoWORD);//设成0表示清除FInputData
procedure SetRThreshold(RTNoWORD);
//接收阀值
procedure SetPortOpen(b:Boolean);//打开通信端口
procedure _SetCommState;//设置通信参数
procedure SetDTRStatus(b:Boolean);//DTR 状态
procedure SetRTSStatus(b:Boolean);//RTS状态
Procedure ReadProcess;//读取数据函数
Procedure GetModemState;//线路状态检测函数
procedure OpenComm;//打开通信端口函数
procedure CloseComm;//开关通信端口函数
function ReadCommEvent()WORD;
//硬件线路状态值读取
function ReadCommError()WORD;
//错误状态值的读取
function ReadInputData():String;//返回收到的数据
function ReadInDataCount()WORD;//读取有多少数据
function ReadCDHolding:Boolean;
//取得CD线路状态
function ReadDSRHolding:Boolean;//取得DSR线路状态
function ReadRIHolding:Boolean;//取得RI线路状态
function ReadCTSHolding:Boolean;//取得CTS线路状态
protected
{ Protected declarations }
//给子类继承用
procedure ProcTimer(Sender:TObject);
procedure ReceiveData();
procedure ReceiveError( EvtMask : DWORD );
procedure ModemStateChange( ModemEvent : DWORD );
public
{ Public declarations }
//给应用程序调用用
property Handle: THandle read hComm;
constructor Create( AOwner: TComponent );
override;
destructor Destroy;
override;
function OutputString(DataToWrite: String): Boolean;
function OutputByte(const ByteData:array of Byte):Boolean;
function ReadInputByte(var APByte)WORD;
published
{ Published declarations }
//属性列表用
property CommPort: TComPortNumber read FCommPort write FCommPort;
property PortOpen:Boolean read FPortOpen write SetPortOpen;
property BaudRate: TBaudRate read FBaudRate write SetBaudRate;
property HwHandShaking: THwHandShaking read FHwHandShaking write SetHwHandShaking;
property SwHandShaking: TSwHandShaking read FSwHandShaking write SetSwHandShaking;
property DataBits: TDataBits read FDataBits write SetDataBits;
property Parity: TParity read FParity write SetParity;
property StopBits: TStopBits read FStopBits write SetStopBits;
property CommEventWORD read ReadCommEvent;
property CommErrorWORD read ReadCommError;
property Input:string read ReadInputData;
property InputLenWORD read FInputLen write FInputLen;
property RThresholdWORD read FRThreshold write SetRThreshold;
property CDHolding:Boolean read ReadCDHolding;
property DSRHolding:Boolean read ReadDSRHolding;
property RIHolding:Boolean read ReadRIHolding;
property CTSHolding:Boolean read ReadCTSHolding;
property DTREnabled:Boolean read FDTR write SetDTRStatus;
property RTSEnabled:Boolean read FRTS write SetRTSStatus;
property DataCountWORD read ReadInDataCount write SetInDataCount;
property OnReceiveData: TReceiveDataEvent
read FOnReceiveData write FOnReceiveData;
property OnReceiveError: TReceiveErrorEvent
read FOnReceiveError write FOnReceiveError;
property OnModemStateChange: TModemStateChangeEvent
read FOnModemStateChange write FOnModemStateChange;
end;
procedure Register;
implementation
(******************************************************************************)
// TComm PUBLIC METHODS
(******************************************************************************)
constructor Tmscom.Create( AOwner: TComponent );
begin
inherited Create( AOwner );
CommTimer:=TTimer.Create(Self);
CommTimer.Interval:=100;
CommTimer.OnTimer:=ProcTimer;
hComm := 0;
//通信端口Handle先清空
FPortOpen:=False;
FCommPort := pnCOM2;
//默认COM2
FBaudRate := br9600;
//9600bps
FHwHandShaking := hhNone;
//不激活硬件流量控制
FSwHandShaking := shNone;
//不激活软件流量控制
FDataBits := DB8;
//数据位数=8
FParity := None;
//不作同位检查
FStopBits := SB1;
//停止位数=1
FInputLen:=0;
//默认是一次执行全部读取
CommTimer.Enabled:=True;
end;
destructor Tmscom.Destroy;
begin
CommTimer.Interval:=0;
CommTimer.Enabled:=False;
inherited Destroy;
end;
//打开通信端口
procedure Tmscom.OpenComm;
var
hNewCommFile: THandle;
ComStr:String;
begin
ComStr:='COM' + IntToStr(1+ord(FCommPort));
hNewCommFile := CreateFile( PChar(ComStr),
GENERIC_READ or GENERIC_WRITE,
0, {not shared}
nil, {no security ??}
OPEN_EXISTING,
0,{No Overlapped}
0 {template} );
if hNewCommFile = INVALID_HANDLE_VALUE then
raise ECommError.Create( 'Error opening serial port' );
if not SetupComm( hNewCommFile, INPUTBUFFERSIZE, INPUTBUFFERSIZE ) then
begin
CloseHandle( hComm );
raise ECommError.Create( 'Cannot setup comm buffer' );
end;
// It is ok to continue.
hComm := hNewCommFile;
// 清除湲冲区
PurgeComm( hComm, PURGE_TXABORT or PURGE_RXABORT or
PURGE_TXCLEAR or PURGE_RXCLEAR ) ;
// 通信端口组态
_SetCommState;
{ // 设置事件屏蔽
if not SetCommMask(hComm, EV_CTS or EV_DSR or EV_RLSD or EV_RING ) then
begin
MessageDlg('Set Comm Mask Error!', mtError, [mbOK], 0);
exit ;
end;
}
FPortOpen:=True;
end;
{TComm.OpenComm}
//关闭通信端口
procedure Tmscom.CloseComm;
begin
// No need to continue if we're not communicating.
if hComm = 0 then
Exit;
// 实际关闭通信端口
CloseHandle( hComm );
FPortOpen:=False;
hComm := 0
end;
//由通信端口送出字符串数据
function Tmscom.OutputString(DataToWrite: String ): Boolean;
var
lrc: LongWord;
tmpChar: PChar;
begin
if hComm=0 then
begin
MessageDlg('COM Port is not opened yet!', mtError, [mbOK], 0);
Result := False;
exit;
end;
// 送出数据
tmpChar:=PChar(DataToWrite);
if WriteFile(hComm,tmpChar^,Length(DataToWrite), lrc, nil) then
begin
Result:=True;
exit;
end;
Result:=False;
end;
{TComm.OutputString}
//传送二进制的数据
function Tmscom.OutputByte(const ByteData: array of Byte ): Boolean;
var
lrc: LongWord;
i: Integer;
begin
if hComm=0 then
begin
MessageDlg('COM Port is not opened yet!', mtError, [mbOK], 0);
Result := False;
exit;
end;
// 送出数据
for i:=Low(ByteData) to High(ByteData)do
WriteFile(hComm,ByteData,1,lrc, nil);
Result := True;
end;
{TComm.OutputByte}
//数据到达时的事件触发
procedure Tmscom.ReceiveData();
begin
if Assigned(FOnReceiveData) then
FOnReceiveData(self)
end;
//接收错误时的事件触发
procedure Tmscom.ReceiveError( EvtMask : DWORD );
begin
if Assigned(FOnReceiveError) then
FOnReceiveError( self, EvtMask )
end;
//线路状态改变时的事件触发
procedure Tmscom.ModemStateChange( ModemEvent : DWORD );
begin
if Assigned(FOnModemStateChange) then
FOnModemStateChange( self, ModemEvent )
end;
(******************************************************************************)
// TComm PRIVATE 方法
(******************************************************************************)
//以下是通信参数的设置
procedure Tmscom._SetCommState;
var
dcb: Tdcb;
tmpValue: DWORD;
begin
//取得串行端口设置
GetCommState( hComm, dcb );
//变更传输速率
case FBaudRate of
br110 : tmpValue := 110;
br300 : tmpValue := 300;
br600 : tmpValue := 600;
br1200 : tmpValue := 1200;
br2400 : tmpValue := 2400;
br4800 : tmpValue := 4800;
br9600 : tmpValue := 9600;
br14400 : tmpValue := 14400;
br19200 : tmpValue := 19200;
br38400 : tmpValue := 38400;
br56000 : tmpValue := 56000;
br57600 : tmpValue := 57600;
else
{br115200 :} tmpValue := 115200;
end;
//指定新值
dcb.BaudRate := tmpValue;
dcb.Flags := 1;
//必须指定为1
dcb.Parity := Ord( FParity );//Parity的指定
FParityCheck:=False;
if Ord(FParity)<>0 then
FParityCheck:=True;
if FParityCheck then
dcb.Flags := dcb.Flags or dcb_ParityCheck;
// Enable parity check
// 设置硬件流量控制
Case FHwHandShaking of
hhNone:;
hhNoneRTSON:
dcb.Flags := dcb.Flags or dcb_RTSControlEnable;
hhRTSCTS:
dcb.Flags := dcb.Flags or dcb_RTSControlHandShake or dcb_OutxCtsFlow;
end;
//设置软件流量控制
Case FSwHandShaking of
shNone:;
shXonXoff:
dcb.Flags := dcb.Flags or dcb_OutX or dcb_InX;
end;
//设置数据位数
dcb.ByteSize := Ord( FDataBits ) + 5;
//设置停止位数
dcb.StopBits := Ord( FStopBits );
//将设置写入
SetCommState( hComm, dcb )
end;
procedure Tmscom.SetPortOpen(b:Boolean);
begin
if b then
//若指定打开通信端口，则…
begin
if FPortOpen then
begin
MessageDlg('COM Port has been opened!', mtError, [mbOK], 0);
exit;
end;
//FportOpen loop
OpenComm;
//打开通信端口
exit;
end;
//b loop
CloseComm;
end;
//指定传输速度
procedure Tmscom.SetBaudRate( Rate : TBaudRate );
begin
if Rate = FBaudRate then
Exit;
FBaudRate := Rate;
if hComm <> 0 then
_SetCommState
end;
//硬件流量控制
procedure Tmscom.SetHwHandShaking( c: THwHandShaking);
begin
if c = FHwHandShaking then
Exit;
FHwHandShaking := c;
if hComm <> 0 then
_SetCommState
end;
//软件交握指定
procedure Tmscom.SetSwHandShaking( c : TSwHandShaking );
begin
if c = FSwHandShaking then
Exit;
FSwHandShaking := c;
if hComm <> 0 then
_SetCommState
end;
//设置数据位数
procedure Tmscom.SetDataBits( Size : TDataBits );
begin
if Size = FDataBits then
Exit;
FDataBits := Size;
if hComm <> 0 then
_SetCommState
end;
//设置极性检查方式
procedure Tmscom.SetParity( p : TParity );
begin
if p = FParity then
Exit;
FParity := p;
if hComm <> 0 then
_SetCommState
end;
//设置停止位
procedure Tmscom.SetStopBits( Bits : TStopBits );
begin
if Bits = FStopBits then
Exit;
FStopBits := Bits;
if hComm <> 0 then
_SetCommState
end;
//读取CD状态
function Tmscom.ReadCDHolding():Boolean;
begin
Result:=FCDHolding;
end;
//读取DSR状态
function Tmscom.ReadDSRHolding():Boolean;
begin
Result:=FDSRHolding;
end;
//读取RI状态
function Tmscom.ReadRIHolding():Boolean;
begin
Result:=FRIHolding;
end;
//读取CTS状态
function Tmscom.ReadCTSHolding():Boolean;
begin
Result:=FCTSHolding;
end;
//设置DTR状态
procedure Tmscom.SetDTRStatus(b:Boolean);
begin
if hComm=0 then
exit ;
FDTR:=b;
if b then
EscapeCommFunction(hComm,SETDTR) //将DTR升至高电压
else
EscapeCommFunction(hComm,CLRDTR);//将DTR降至低电压
end;
//设置RTS状态
procedure Tmscom.SetRTSStatus(b:Boolean);
begin
if hComm=0 then
begin
ECommError.Create('COM Port is not opened yet!');
exit ;
end;
FRTS:=b;
if b then
EscapeCommFunction(hComm,SETRTS) //将RTS升至高电压
else
EscapeCommFunction(hComm,CLRRTS);
//将RTS降至低电压
end;
//返回数据
function Tmscom.ReadInputData():String;
begin
if hComm=0 then
begin
ECommError.Create('COM Port is not opened yet!');
end;
//决定每一次的指令要返回多少的字符(以Byte为单位)
ReadProcess;
Result:=FInputData;
end;
//返回数据
function Tmscom.ReadInputByte(var APByte)WORD;
begin
if hComm=0 then
begin
ECommError.Create('COM Port is not opened yet!');
end;
ReadProcess;//执行读取函数
AP:= @FInputByteData[0];//取得数据地址
Result:=High(FInputByteData);//取得数据数组的最高索引值
end;
//读取数据的字节数
function Tmscom.ReadInDataCount()WORD;
var
CS: TCOMSTAT;
dwCommErrorWORD;
begin
ClearCommError(hComm,dwCommError,@CS);
//取得状态
Result:=CS.cbInQue;
end;
//清空数据缓冲区
procedure Tmscom.SetInDataCount(StrNOWORD);
begin
if StrNo<>0 then
exit ;
PurgeComm(hComm, PURGE_RXCLEAR) // 清除COM 数据
end;
//线路状态的数值
function Tmscom.ReadCommEvent()WORD;
begin
Result:=FCommEvent;
end;
//错误状态值的读取
function Tmscom.ReadCommError()WORD;
begin
Result:=FCommError;
end;
//设置引发接收事件的阀值
procedure Tmscom.SetRThreshold(RTNoWORD);
begin
FRThreshold:=RTNo;
end;
//以下是实际的读取动作
Procedure Tmscom.ReadProcess;
var
nBytesRead: DWORD;
dwCommError: DWORD;
CS: TCOMSTAT;
i,ReadLen: DWORD;
begin
//使用ClearCommError得知有多少的数据在缓冲区中
//并得知错误种类
ClearCommError(hComm,dwCommError,@CS);
//取得状态
FCommError:=dwCommError;
//错误数值
if cs.cbInQue <>0 then
//若缓冲区有数据，则读取
begin
if InputLen=0 then
//指定读取的数据数
ReadLen:=cs.cbInQue
else
ReadLen:=InputLen;
if cs.cbInQue > sizeof(szInputBuffer) then
PurgeComm(hComm, PURGE_RXCLEAR) // 清除COM 数据
else
begin
//读取数据
if ReadFile(hComm, szInputBuffer,ReadLen,nBytesRead,nil) then
// 接收COM 的数据
begin
//取出数据
FInputData:=Copy(szInputBuffer,1,ReadLen);
//设置字节数组长度
SetLength(FInputByteData,ReadLen);
//将数据搬到数组中
for i:=0 to ReadLen-1do
FInputByteData:=ord(szInputBuffer);
end;
//ReadFile Loop
end;
//else
Loop
end;
//cs.binQue Loop
end;
//取得线路的状态
procedure Tmscom.GetModemState;
var
dwModemState : DWORD;
begin
if hComm=0 then
begin
raise ECommError.Create('COM Port is not opened yet!');
end;
//取得线路状态
FCommEvent:=0;
if GetCommModemStatus( hComm, dwModemState ) then
begin
//判断CD状态
if (dwModemState and MS_RLSD_ON)=MS_RLSD_ON then
begin
if not FCDHolding then
FCommEvent:= EV_RLSD;
FCDHolding:=True;
end
else
begin
if FCDHolding then
FCommEvent:= EV_RLSD;
FCDHolding:=False;
end;
//判断DSR状态
if (dwModemState and MS_DSR_ON)=MS_DSR_ON then
begin
if not FDSRHolding then
FCommEvent:=FCommEvent + EV_DSR;
FDSRHolding:=True;
end
else
begin
if FDSRHolding then
FCommEvent:=FCommEvent + EV_DSR;
FDSRHolding:=False;
end;
//判断RI状态
if (dwModemState and MS_RING_ON)=MS_RING_ON then
begin
if not FRIHolding then
FCommEvent:=FCommEvent + EV_RING;
FRIHolding:=True;
end
else
begin
if FRIHolding then
FCommEvent:=FCommEvent + EV_RING;
FRIHolding:=False;
end;
//判断CTS状态
if (dwModemState and MS_CTS_ON)=MS_CTS_ON then
begin
if not FCTSHolding then
FCommEvent:=FCommEvent + EV_CTS;
FCTSHolding:=True;
end
else
begin
if FCTSHolding then
FCommEvent:=FCommEvent + EV_CTS;
FCTSHolding:=False;
end;
end;
end;
procedure Register;
begin
RegisterComponents('System', [Tmscom]);
end;
//组件的定时器程序，在此会决定事件是否被触发
procedure Tmscom.ProcTimer(Sender: TObject);
var
tmpValue: DWORD;
dwCommErrorWORD;
CS: TCOMSTAT;
begin
if hComm=0 then
exit;
//若设置读取的字符数，检查并触发事件
ClearCommError(hComm,dwCommError,@CS);
//取得状态
FCommError:=dwCommError;
//错误数值
if FRThreshold>0 then
begin
if cs.cbInQue >=FRthreshold then
ReceiveData();
end;
GetModemState;
Application.ProcessMessages;
//看有无其它的指令需执行，以免锁住
//检查线路状态是否发生改变，若改变则触发事件
tmpValue:=ReadCommEvent;
if tmpValue<>0 then
ModemStateChange(tmpValue);
Application.ProcessMessages;
//看有无其它的指令需执行，以免锁住
//若发生错误，则引发错误
tmpValue:=ReadCommError;
if tmpValue<>0 then
ReceiveError(tmpValue);
Application.ProcessMessages;
//看有无其它的指令需执行，以免锁住
end;
end.
unit mscom;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
extctrls,syncobjs;
type
//类型定义
TBaudRate = ( br110, br300, br600, br1200, br2400, br4800,
br9600, br14400, br19200, br38400, br56000,
br57600, br115200 );
TComPortNumber = ( pnCOM1, pnCOM2, pnCOM3, pnCOM4, pnCOM5, pnCOM6, pnCOM7,
pnCOM8, pnCOM9, pnCOM10, pnCOM11, pnCOM12, pnCOM13,
pnCOM14, pnCOM15, pnCOM16 );
TParity = ( None, Odd, Even, Mark, Space );
TStopBits = ( SB1, SB1_5, SB2 );
TDataBits = ( DB5, DB6, DB7, DB8 );
THWHandShaking=(hhNone,hhNoneRTSON,hhRTSCTS);
TSWHandShaking=(shNone,shXonXoff);
//例外声明
ECommError = class( Exception );
//事件函数定位器声明
TReceiveDataEvent = procedure(Sender: TObject) of object;
TReceiveErrorEvent = procedure(Sender: TObject;
EventMask : DWORD) of object;
TModemStateChangeEvent = procedure(Sender: TObject;
ModemEvent : DWORD) of object;
const
// 输入缓冲区的默认大小
INPUTBUFFERSIZE = 4096;
// Line Status位定义
ME_CTS = 1;
ME_DSR = 2;
ME_RING = 4;
ME_RLSD = 8;
//DCB 位定义
dcb_Binary = $00000001;
dcb_ParityCheck = $00000002;
dcb_OutxCtsFlow = $00000004;
dcb_OutxDsrFlow = $00000008;
dcb_DtrControlMask = $00000030;
dcb_DtrControlDisable = $00000000;
dcb_DtrControlEnable = $00000010;
dcb_DtrControlHandshake = $00000020;
dcb_DsrSensivity = $00000040;
dcb_TXContinueOnXoff = $00000080;
dcb_OutX = $00000100;
dcb_InX = $00000200;
dcb_ErrorChar = $00000400;
dcb_NullStrip = $00000800;
dcb_RtsControlMask = $00003000;
dcb_RtsControlDisable = $00000000;
dcb_RtsControlEnable = $00001000;
dcb_RtsControlHandshake = $00002000;
dcb_RtsControlToggle = $00003000;
dcb_AbortOnError = $00004000;
dcb_Reserveds = $FFFF8000;
type
Tmscom = class(TComponent)
private
{ Private declarations }
CommTimer: TTimer;
//组件用的定时器
szInputBuffer: array[0..INPUTBUFFERSIZE-1] of Char;
hComm: THandle;
FCommPort: TComPortNumber;
FPortOpen: Boolean;
FBaudRate: TBaudRate;
FParityCheck: Boolean;
FHwHandShaking: THwHandShaking;
FSwHandShaking: TSwHandShaking;
FDataBits: TDataBits;
FParity: TParity;
FStopBits: TStopBits;
FInputLen: DWORD;
//每次执行Input时所读取的字符串长度
FRThreshold: DWORD;//设置引发接收事件的阀值
FDTR: Boolean;
FRTS: Boolean;
FInputData: String;
// FByteNo: DWORD;
//已读取的字节数
FInputByteData: array of Byte;
FCommEvent: DWORD;
FCommError: DWORD;
FCDHolding: Boolean;
FCTSHolding: Boolean;
FDSRHolding: Boolean;
FRIHolding: Boolean;
//事件
FOnReceiveData: TReceiveDataEvent;
FOnReceiveError: TReceiveErrorEvent;
FOnModemStateChange:TModemStateChangeEvent;
//设置函数
procedure SetBaudRate( Rate : TBaudRate );
//设置速率
procedure SetHwHandShaking( c : THwHandShaking);//硬件交握
procedure SetSwHandShaking( c : TSwHandShaking);//软件交握
procedure SetDataBits( Size : TDataBits );//数据位数
procedure SetParity( p : TParity );//极性检查
procedure SetStopBits( Bits : TStopBits );//停止位
procedure SetInDataCount(StrNo
WORD);//设成0表示清除FInputDataprocedure SetRThreshold(RTNo
WORD);//接收阀值
procedure SetPortOpen(b:Boolean);//打开通信端口
procedure _SetCommState;//设置通信参数
procedure SetDTRStatus(b:Boolean);//DTR 状态
procedure SetRTSStatus(b:Boolean);//RTS状态
Procedure ReadProcess;//读取数据函数
Procedure GetModemState;//线路状态检测函数
procedure OpenComm;//打开通信端口函数
procedure CloseComm;//开关通信端口函数
function ReadCommEvent()
WORD;//硬件线路状态值读取
function ReadCommError()
WORD;//错误状态值的读取
function ReadInputData():String;//返回收到的数据
function ReadInDataCount()
WORD;//读取有多少数据function ReadCDHolding:Boolean;
//取得CD线路状态
function ReadDSRHolding:Boolean;//取得DSR线路状态
function ReadRIHolding:Boolean;//取得RI线路状态
function ReadCTSHolding:Boolean;//取得CTS线路状态
protected
{ Protected declarations }
//给子类继承用
procedure ProcTimer(Sender:TObject);
procedure ReceiveData();
procedure ReceiveError( EvtMask : DWORD );
procedure ModemStateChange( ModemEvent : DWORD );
public
{ Public declarations }
//给应用程序调用用
property Handle: THandle read hComm;
constructor Create( AOwner: TComponent );
override;
destructor Destroy;
override;
function OutputString(DataToWrite: String): Boolean;
function OutputByte(const ByteData:array of Byte):Boolean;
function ReadInputByte(var AP
Byte)WORD;published
{ Published declarations }
//属性列表用
property CommPort: TComPortNumber read FCommPort write FCommPort;
property PortOpen:Boolean read FPortOpen write SetPortOpen;
property BaudRate: TBaudRate read FBaudRate write SetBaudRate;
property HwHandShaking: THwHandShaking read FHwHandShaking write SetHwHandShaking;
property SwHandShaking: TSwHandShaking read FSwHandShaking write SetSwHandShaking;
property DataBits: TDataBits read FDataBits write SetDataBits;
property Parity: TParity read FParity write SetParity;
property StopBits: TStopBits read FStopBits write SetStopBits;
property CommEvent
WORD read ReadCommEvent;property CommError
WORD read ReadCommError;property Input:string read ReadInputData;
property InputLen
WORD read FInputLen write FInputLen;property RThreshold
WORD read FRThreshold write SetRThreshold;property CDHolding:Boolean read ReadCDHolding;
property DSRHolding:Boolean read ReadDSRHolding;
property RIHolding:Boolean read ReadRIHolding;
property CTSHolding:Boolean read ReadCTSHolding;
property DTREnabled:Boolean read FDTR write SetDTRStatus;
property RTSEnabled:Boolean read FRTS write SetRTSStatus;
property DataCount
WORD read ReadInDataCount write SetInDataCount;property OnReceiveData: TReceiveDataEvent
read FOnReceiveData write FOnReceiveData;
property OnReceiveError: TReceiveErrorEvent
read FOnReceiveError write FOnReceiveError;
property OnModemStateChange: TModemStateChangeEvent
read FOnModemStateChange write FOnModemStateChange;
end;
procedure Register;
implementation
(******************************************************************************)
// TComm PUBLIC METHODS
(******************************************************************************)
constructor Tmscom.Create( AOwner: TComponent );
begin
inherited Create( AOwner );
CommTimer:=TTimer.Create(Self);
CommTimer.Interval:=100;
CommTimer.OnTimer:=ProcTimer;
hComm := 0;
//通信端口Handle先清空
FPortOpen:=False;
FCommPort := pnCOM2;
//默认COM2
FBaudRate := br9600;
//9600bps
FHwHandShaking := hhNone;
//不激活硬件流量控制
FSwHandShaking := shNone;
//不激活软件流量控制
FDataBits := DB8;
//数据位数=8
FParity := None;
//不作同位检查
FStopBits := SB1;
//停止位数=1
FInputLen:=0;
//默认是一次执行全部读取
CommTimer.Enabled:=True;
end;
destructor Tmscom.Destroy;
begin
CommTimer.Interval:=0;
CommTimer.Enabled:=False;
inherited Destroy;
end;
//打开通信端口
procedure Tmscom.OpenComm;
var
hNewCommFile: THandle;
ComStr:String;
begin
ComStr:='COM' + IntToStr(1+ord(FCommPort));
hNewCommFile := CreateFile( PChar(ComStr),
GENERIC_READ or GENERIC_WRITE,
0, {not shared}
nil, {no security ??}
OPEN_EXISTING,
0,{No Overlapped}
0 {template} );
if hNewCommFile = INVALID_HANDLE_VALUE then
raise ECommError.Create( 'Error opening serial port' );
if not SetupComm( hNewCommFile, INPUTBUFFERSIZE, INPUTBUFFERSIZE ) then
begin
CloseHandle( hComm );
raise ECommError.Create( 'Cannot setup comm buffer' );
end;
// It is ok to continue.
hComm := hNewCommFile;
// 清除湲冲区
PurgeComm( hComm, PURGE_TXABORT or PURGE_RXABORT or
PURGE_TXCLEAR or PURGE_RXCLEAR ) ;
// 通信端口组态
_SetCommState;
{ // 设置事件屏蔽
if not SetCommMask(hComm, EV_CTS or EV_DSR or EV_RLSD or EV_RING ) then
begin
MessageDlg('Set Comm Mask Error!', mtError, [mbOK], 0);
exit ;
end;
}
FPortOpen:=True;
end;
{TComm.OpenComm}
//关闭通信端口
procedure Tmscom.CloseComm;
begin
// No need to continue if we're not communicating.
if hComm = 0 then
Exit;
// 实际关闭通信端口
CloseHandle( hComm );
FPortOpen:=False;
hComm := 0
end;
//由通信端口送出字符串数据
function Tmscom.OutputString(DataToWrite: String ): Boolean;
var
lrc: LongWord;
tmpChar: PChar;
begin
if hComm=0 then
begin
MessageDlg('COM Port is not opened yet!', mtError, [mbOK], 0);
Result := False;
exit;
end;
// 送出数据
tmpChar:=PChar(DataToWrite);
if WriteFile(hComm,tmpChar^,Length(DataToWrite), lrc, nil) then
begin
Result:=True;
exit;
end;
Result:=False;
end;
{TComm.OutputString}
//传送二进制的数据
function Tmscom.OutputByte(const ByteData: array of Byte ): Boolean;
var
lrc: LongWord;
i: Integer;
begin
if hComm=0 then
begin
MessageDlg('COM Port is not opened yet!', mtError, [mbOK], 0);
Result := False;
exit;
end;
// 送出数据
for i:=Low(ByteData) to High(ByteData)do
WriteFile(hComm,ByteData,1,lrc, nil);
Result := True;
end;
{TComm.OutputByte}
//数据到达时的事件触发
procedure Tmscom.ReceiveData();
begin
if Assigned(FOnReceiveData) then
FOnReceiveData(self)
end;
//接收错误时的事件触发
procedure Tmscom.ReceiveError( EvtMask : DWORD );
begin
if Assigned(FOnReceiveError) then
FOnReceiveError( self, EvtMask )
end;
//线路状态改变时的事件触发
procedure Tmscom.ModemStateChange( ModemEvent : DWORD );
begin
if Assigned(FOnModemStateChange) then
FOnModemStateChange( self, ModemEvent )
end;
(******************************************************************************)
// TComm PRIVATE 方法
(******************************************************************************)
//以下是通信参数的设置
procedure Tmscom._SetCommState;
var
dcb: Tdcb;
tmpValue: DWORD;
begin
//取得串行端口设置
GetCommState( hComm, dcb );
//变更传输速率
case FBaudRate of
br110 : tmpValue := 110;
br300 : tmpValue := 300;
br600 : tmpValue := 600;
br1200 : tmpValue := 1200;
br2400 : tmpValue := 2400;
br4800 : tmpValue := 4800;
br9600 : tmpValue := 9600;
br14400 : tmpValue := 14400;
br19200 : tmpValue := 19200;
br38400 : tmpValue := 38400;
br56000 : tmpValue := 56000;
br57600 : tmpValue := 57600;
else
{br115200 :} tmpValue := 115200;
end;
//指定新值
dcb.BaudRate := tmpValue;
dcb.Flags := 1;
//必须指定为1
dcb.Parity := Ord( FParity );//Parity的指定
FParityCheck:=False;
if Ord(FParity)<>0 then
FParityCheck:=True;
if FParityCheck then
dcb.Flags := dcb.Flags or dcb_ParityCheck;
// Enable parity check
// 设置硬件流量控制
Case FHwHandShaking of
hhNone:;
hhNoneRTSON:
dcb.Flags := dcb.Flags or dcb_RTSControlEnable;
hhRTSCTS:
dcb.Flags := dcb.Flags or dcb_RTSControlHandShake or dcb_OutxCtsFlow;
end;
//设置软件流量控制
Case FSwHandShaking of
shNone:;
shXonXoff:
dcb.Flags := dcb.Flags or dcb_OutX or dcb_InX;
end;
//设置数据位数
dcb.ByteSize := Ord( FDataBits ) + 5;
//设置停止位数
dcb.StopBits := Ord( FStopBits );
//将设置写入
SetCommState( hComm, dcb )
end;
procedure Tmscom.SetPortOpen(b:Boolean);
begin
if b then
//若指定打开通信端口，则…
begin
if FPortOpen then
begin
MessageDlg('COM Port has been opened!', mtError, [mbOK], 0);
exit;
end;
//FportOpen loop
OpenComm;
//打开通信端口
exit;
end;
//b loop
CloseComm;
end;
//指定传输速度
procedure Tmscom.SetBaudRate( Rate : TBaudRate );
begin
if Rate = FBaudRate then
Exit;
FBaudRate := Rate;
if hComm <> 0 then
_SetCommState
end;
//硬件流量控制
procedure Tmscom.SetHwHandShaking( c: THwHandShaking);
begin
if c = FHwHandShaking then
Exit;
FHwHandShaking := c;
if hComm <> 0 then
_SetCommState
end;
//软件交握指定
procedure Tmscom.SetSwHandShaking( c : TSwHandShaking );
begin
if c = FSwHandShaking then
Exit;
FSwHandShaking := c;
if hComm <> 0 then
_SetCommState
end;
//设置数据位数
procedure Tmscom.SetDataBits( Size : TDataBits );
begin
if Size = FDataBits then
Exit;
FDataBits := Size;
if hComm <> 0 then
_SetCommState
end;
//设置极性检查方式
procedure Tmscom.SetParity( p : TParity );
begin
if p = FParity then
Exit;
FParity := p;
if hComm <> 0 then
_SetCommState
end;
//设置停止位
procedure Tmscom.SetStopBits( Bits : TStopBits );
begin
if Bits = FStopBits then
Exit;
FStopBits := Bits;
if hComm <> 0 then
_SetCommState
end;
//读取CD状态
function Tmscom.ReadCDHolding():Boolean;
begin
Result:=FCDHolding;
end;
//读取DSR状态
function Tmscom.ReadDSRHolding():Boolean;
begin
Result:=FDSRHolding;
end;
//读取RI状态
function Tmscom.ReadRIHolding():Boolean;
begin
Result:=FRIHolding;
end;
//读取CTS状态
function Tmscom.ReadCTSHolding():Boolean;
begin
Result:=FCTSHolding;
end;
//设置DTR状态
procedure Tmscom.SetDTRStatus(b:Boolean);
begin
if hComm=0 then
exit ;
FDTR:=b;
if b then
EscapeCommFunction(hComm,SETDTR) //将DTR升至高电压
else
EscapeCommFunction(hComm,CLRDTR);//将DTR降至低电压
end;
//设置RTS状态
procedure Tmscom.SetRTSStatus(b:Boolean);
begin
if hComm=0 then
begin
ECommError.Create('COM Port is not opened yet!');
exit ;
end;
FRTS:=b;
if b then
EscapeCommFunction(hComm,SETRTS) //将RTS升至高电压
else
EscapeCommFunction(hComm,CLRRTS);
//将RTS降至低电压
end;
//返回数据
function Tmscom.ReadInputData():String;
begin
if hComm=0 then
begin
ECommError.Create('COM Port is not opened yet!');
end;
//决定每一次的指令要返回多少的字符(以Byte为单位)
ReadProcess;
Result:=FInputData;
end;
//返回数据
function Tmscom.ReadInputByte(var AP
Byte)WORD;begin
if hComm=0 then
begin
ECommError.Create('COM Port is not opened yet!');
end;
ReadProcess;//执行读取函数
AP:= @FInputByteData[0];//取得数据地址
Result:=High(FInputByteData);//取得数据数组的最高索引值
end;
//读取数据的字节数
function Tmscom.ReadInDataCount()
WORD;var
CS: TCOMSTAT;
dwCommError
WORD;begin
ClearCommError(hComm,dwCommError,@CS);
//取得状态
Result:=CS.cbInQue;
end;
//清空数据缓冲区
procedure Tmscom.SetInDataCount(StrNO
WORD);begin
if StrNo<>0 then
exit ;
PurgeComm(hComm, PURGE_RXCLEAR) // 清除COM 数据
end;
//线路状态的数值
function Tmscom.ReadCommEvent()
WORD;begin
Result:=FCommEvent;
end;
//错误状态值的读取
function Tmscom.ReadCommError()
WORD;begin
Result:=FCommError;
end;
//设置引发接收事件的阀值
procedure Tmscom.SetRThreshold(RTNo
WORD);begin
FRThreshold:=RTNo;
end;
//以下是实际的读取动作
Procedure Tmscom.ReadProcess;
var
nBytesRead: DWORD;
dwCommError: DWORD;
CS: TCOMSTAT;
i,ReadLen: DWORD;
begin
//使用ClearCommError得知有多少的数据在缓冲区中
//并得知错误种类
ClearCommError(hComm,dwCommError,@CS);
//取得状态
FCommError:=dwCommError;
//错误数值
if cs.cbInQue <>0 then
//若缓冲区有数据，则读取
begin
if InputLen=0 then
//指定读取的数据数
ReadLen:=cs.cbInQue
else
ReadLen:=InputLen;
if cs.cbInQue > sizeof(szInputBuffer) then
PurgeComm(hComm, PURGE_RXCLEAR) // 清除COM 数据
else
begin
//读取数据
if ReadFile(hComm, szInputBuffer,ReadLen,nBytesRead,nil) then
// 接收COM 的数据
begin
//取出数据
FInputData:=Copy(szInputBuffer,1,ReadLen);
//设置字节数组长度
SetLength(FInputByteData,ReadLen);
//将数据搬到数组中
for i:=0 to ReadLen-1do
FInputByteData:=ord(szInputBuffer);
end;
//ReadFile Loop
end;
//else
Loop
end;
//cs.binQue Loop
end;
//取得线路的状态
procedure Tmscom.GetModemState;
var
dwModemState : DWORD;
begin
if hComm=0 then
begin
raise ECommError.Create('COM Port is not opened yet!');
end;
//取得线路状态
FCommEvent:=0;
if GetCommModemStatus( hComm, dwModemState ) then
begin
//判断CD状态
if (dwModemState and MS_RLSD_ON)=MS_RLSD_ON then
begin
if not FCDHolding then
FCommEvent:= EV_RLSD;
FCDHolding:=True;
end
else
begin
if FCDHolding then
FCommEvent:= EV_RLSD;
FCDHolding:=False;
end;
//判断DSR状态
if (dwModemState and MS_DSR_ON)=MS_DSR_ON then
begin
if not FDSRHolding then
FCommEvent:=FCommEvent + EV_DSR;
FDSRHolding:=True;
end
else
begin
if FDSRHolding then
FCommEvent:=FCommEvent + EV_DSR;
FDSRHolding:=False;
end;
//判断RI状态
if (dwModemState and MS_RING_ON)=MS_RING_ON then
begin
if not FRIHolding then
FCommEvent:=FCommEvent + EV_RING;
FRIHolding:=True;
end
else
begin
if FRIHolding then
FCommEvent:=FCommEvent + EV_RING;
FRIHolding:=False;
end;
//判断CTS状态
if (dwModemState and MS_CTS_ON)=MS_CTS_ON then
begin
if not FCTSHolding then
FCommEvent:=FCommEvent + EV_CTS;
FCTSHolding:=True;
end
else
begin
if FCTSHolding then
FCommEvent:=FCommEvent + EV_CTS;
FCTSHolding:=False;
end;
end;
end;
procedure Register;
begin
RegisterComponents('System', [Tmscom]);
end;
//组件的定时器程序，在此会决定事件是否被触发
procedure Tmscom.ProcTimer(Sender: TObject);
var
tmpValue: DWORD;
dwCommError
WORD;CS: TCOMSTAT;
begin
if hComm=0 then
exit;
//若设置读取的字符数，检查并触发事件
ClearCommError(hComm,dwCommError,@CS);
//取得状态
FCommError:=dwCommError;
//错误数值
if FRThreshold>0 then
begin
if cs.cbInQue >=FRthreshold then
ReceiveData();
end;
GetModemState;
Application.ProcessMessages;
//看有无其它的指令需执行，以免锁住
//检查线路状态是否发生改变，若改变则触发事件
tmpValue:=ReadCommEvent;
if tmpValue<>0 then
ModemStateChange(tmpValue);
Application.ProcessMessages;
//看有无其它的指令需执行，以免锁住
//若发生错误，则引发错误
tmpValue:=ReadCommError;
if tmpValue<>0 then
ReceiveError(tmpValue);
Application.ProcessMessages;
//看有无其它的指令需执行，以免锁住
end;
end.
R
resun
Unregistered / Unconfirmed
GUEST, unregistred user!
楼上写的太多了，没耐心看啊
没这么复杂吧？找个控件或动态库用，很简单啊
给个信箱，给你发个moxa公司的串口通讯动态库，很好用
没这么复杂吧？找个控件或动态库用，很简单啊
给个信箱，给你发个moxa公司的串口通讯动态库，很好用
卡
卡色
Unregistered / Unconfirmed
GUEST, unregistred user!
我也贴一篇！
Delphi中串口通信的实现
河南省计算中心 张海航
--------------------------------------------------------------------------------
Delphi是一种具有功能强大、简便易用和代码执行速度快等优点的可视化快速应用开发工具
，它在构架企业信息系统方面发挥着越来越重要的作用，许多程序员愿意选择 Delphi作为
开发工具编制各种应用程序。但是，美中不足之处是 Delphi没有自带的串口通信控件，在
它的帮助文档里也没有提及串口通信，这就给编制通信程序的开发人员带来许多不便。
目前，利用 Delphi实现串口通信的常用的方法有 3种：一是利用控件，如 MSCOMM控件和
SPCOMM控件；二是使用 API函数；三是调用其他串口通信程序。其中利用 API编写串口通
信程序较为复杂，需要掌握大量的通信知识。相比较而言，利用 SPCOMM控件则相对较简
单，并且该控件具有丰富的与串口通信密切相关的属性及事件，提供了对串口的各种操
作，而且还支持多线程。下面本文结合实例详细介绍 SPCOMM控件的使用。
SPCOMM的安装
1．选择下拉菜单 Component中的 Install Component选项，弹出如图 1所示的窗口。
图 1
在 Unit file name处填写 SPCOMM控件所在的路径，其他各项可用默认值，点击 OK按钮。
2．安装后，在 System控件面板中将出现一个红色控件 COM。现在就可以像 Delphi自带控
件一样使用 COM控件了。
SPCOMM的属性、方法和事件
1.属性
●CommName：表示 COM1、 COM2等串口的名字；
●BaudRate:根据实际需要设定的波特率，在串口打开后也可更改此值，实际波特率随之更
改；
●ParityCheck：表示是否需要奇偶校验；
●ByteSize：根据实际情况设定的字节长度；
●Parity：奇偶校验位；
●StopBits：停止位；
●SendDataEmpty：这是一个布尔型属性，为 true时表示发送缓存为空，或者发送队列里没
有信息；为 false时表示发送缓存不为空，或者发送队列里有信息。
2．方法
●Startcomm方法用于打开串口，当打开失败时通常会报错。错误主要有 7种：⑴串口已经
打开；⑵打开串口错误；⑶文件句柄不是通信句柄；⑷不能够安装通信缓存；⑸不能产生
事件；⑹不能产生读进程；⑺不能产生写进程；
●StopComm方法用于关闭串口，没有返回值；
●WriteCommData(pDataToWrite: PChar;dwSizeofDataToWrite:Word )方法是个带有布尔型
返回值的函数，用于将一个字符串发送到写进程，发送成功返回 true，发送失败返回 false。
执行此函数将立即得到返回值，发送操作随后执行。该函数有两个参数，其中 pDataToWrite
是要发送的字符串， dwSizeofDataToWrite是发送字符串的长度。
3．事件
●OnReceiveDatarocedure (Sender: TObject;Buffer: Pointer;BufferLength: Word)
of object
当有数据输入缓存时将触发该事件，在这里可以对从串口收到的数据进行处理。 Buffer中
是收到的数据， BufferLength是收到的数据长度。
●OnReceiveError : procedure(Sender: TObject;
EventMask : DWORD)
当接收数据出现错误时将触发该事件。
SPCOMM的使用
下面是一个利用 SPCOMM控件的串口通信的例子。
以实现 PC机与单片机 8051之间的通信为例，首先要调通它们之间的握手信号。假定它们
之间的通信协议是： PC到 8051一帧数据 6个字节， 8051到 PC一帧数据也为 6个字节。
当 PC发出（ F0,01,FF,FF,01,F0）后 8051能收到一帧（ F0,01,FF,FF,01,F0），表示数
据通信握手成功，两者之间就可以按照协议相互传输数据。
创建一个新的工程 COMM.DPR，把窗体的 NAME属性定为 FCOMM，把窗体的标题定义为测试
通信，按照图 2添加控件 (图 2中黑色矩形围住的控件即为 COMM1)。
图 2
1.设定 COMM1属性：
●波特率： 4800；
●奇偶校验位：无；
●字节长度： 8；
●停止位： 1；
●串口： COM1。
Memo1中将显示发送和接收的数据。将新的窗体存储为 Comm.pas。
2.编写源代码
//变量说明
var
fcomm: TFCOMM;
viewstring:string;
i:integer;
rbuf,sbuf:array[16] of byte;
//打开串口
procedure TFCOMM.FormShow(Sender: TObject);
begin
comm1.StartComm;
end;
//关闭串口
procedure TFCOMM.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
comm1.StopComm;
end;
//自定义发送数据过程
procedure senddata;
var
i:integer;
commflg:boolean;
begin
viewstring:=‘’ ;
commflg:=true;
for i:=1 to 6do
begin
if not fcomm.comm1.writecommdata(@sbuf,1) then
begin
commflg:=false;
break;
end;
//发送时字节间的延时
sleep(2);
viewstring:=viewstring＋ inttohex(sbuf,2)＋‘’ ;
end;
viewstring:=‘发送’＋ viewstring;
fcomm.memo1.lines.add(viewstring);
fcomm.memo1.lines.add(‘’ );
if not commflg then
messagedlg(‘发送失败 !’ ,mterror,[mbyes],0);
end;
//发送按钮的点击事件
procedure TFCOMM.Btn_sendClick(Sender: TObject);
begin
sbuf[1]:=byte(＄ f0);
//帧头
sbuf[2]:=byte(＄ 01);
//命令号
sbuf[3]:=byte(＄ ff);
sbuf[4]:=byte(＄ ff);
sbuf[5]:=byte(＄ 01);
sbuf[6]:=byte(＄ f0);
//帧尾
senddata;//调用发送函数
end;
//接收过程
procedure TFCOMM.Comm1ReceiveData(Sender: TObject;
Buffer: Pointer;BufferLength: Word);
var
i:integer;
begin
viewstring:=‘’ ;
move(buffer^,pchar(@rbuf^),bufferlength);
for i:=1 to bufferlengthdo
viewstring:=viewstring＋ inttohex(rbuf,2)＋‘’ ;
viewstring:=‘接收’＋ viewstring;
memo1.lines.add(viewstring);
memo1.lines.add(‘’ );
end;
如果 memo1上显示发送 F0 01 FF FF 01 F0和接收到 F0 01 FF FF 01 F0，这表示串口已正
确地发送出数据并正确地接收到数据，则串口通信成功。
（网页编辑：徐向阳）
Delphi中串口通信的实现
河南省计算中心 张海航
--------------------------------------------------------------------------------
Delphi是一种具有功能强大、简便易用和代码执行速度快等优点的可视化快速应用开发工具
，它在构架企业信息系统方面发挥着越来越重要的作用，许多程序员愿意选择 Delphi作为
开发工具编制各种应用程序。但是，美中不足之处是 Delphi没有自带的串口通信控件，在
它的帮助文档里也没有提及串口通信，这就给编制通信程序的开发人员带来许多不便。
目前，利用 Delphi实现串口通信的常用的方法有 3种：一是利用控件，如 MSCOMM控件和
SPCOMM控件；二是使用 API函数；三是调用其他串口通信程序。其中利用 API编写串口通
信程序较为复杂，需要掌握大量的通信知识。相比较而言，利用 SPCOMM控件则相对较简
单，并且该控件具有丰富的与串口通信密切相关的属性及事件，提供了对串口的各种操
作，而且还支持多线程。下面本文结合实例详细介绍 SPCOMM控件的使用。
SPCOMM的安装
1．选择下拉菜单 Component中的 Install Component选项，弹出如图 1所示的窗口。
图 1
在 Unit file name处填写 SPCOMM控件所在的路径，其他各项可用默认值，点击 OK按钮。
2．安装后，在 System控件面板中将出现一个红色控件 COM。现在就可以像 Delphi自带控
件一样使用 COM控件了。
SPCOMM的属性、方法和事件
1.属性
●CommName：表示 COM1、 COM2等串口的名字；
●BaudRate:根据实际需要设定的波特率，在串口打开后也可更改此值，实际波特率随之更
改；
●ParityCheck：表示是否需要奇偶校验；
●ByteSize：根据实际情况设定的字节长度；
●Parity：奇偶校验位；
●StopBits：停止位；
●SendDataEmpty：这是一个布尔型属性，为 true时表示发送缓存为空，或者发送队列里没
有信息；为 false时表示发送缓存不为空，或者发送队列里有信息。
2．方法
●Startcomm方法用于打开串口，当打开失败时通常会报错。错误主要有 7种：⑴串口已经
打开；⑵打开串口错误；⑶文件句柄不是通信句柄；⑷不能够安装通信缓存；⑸不能产生
事件；⑹不能产生读进程；⑺不能产生写进程；
●StopComm方法用于关闭串口，没有返回值；
●WriteCommData(pDataToWrite: PChar;dwSizeofDataToWrite:Word )方法是个带有布尔型
返回值的函数，用于将一个字符串发送到写进程，发送成功返回 true，发送失败返回 false。
执行此函数将立即得到返回值，发送操作随后执行。该函数有两个参数，其中 pDataToWrite
是要发送的字符串， dwSizeofDataToWrite是发送字符串的长度。
3．事件
●OnReceiveData
rocedure (Sender: TObject;Buffer: Pointer;BufferLength: Word) of object
当有数据输入缓存时将触发该事件，在这里可以对从串口收到的数据进行处理。 Buffer中
是收到的数据， BufferLength是收到的数据长度。
●OnReceiveError : procedure(Sender: TObject;
EventMask : DWORD)
当接收数据出现错误时将触发该事件。
SPCOMM的使用
下面是一个利用 SPCOMM控件的串口通信的例子。
以实现 PC机与单片机 8051之间的通信为例，首先要调通它们之间的握手信号。假定它们
之间的通信协议是： PC到 8051一帧数据 6个字节， 8051到 PC一帧数据也为 6个字节。
当 PC发出（ F0,01,FF,FF,01,F0）后 8051能收到一帧（ F0,01,FF,FF,01,F0），表示数
据通信握手成功，两者之间就可以按照协议相互传输数据。
创建一个新的工程 COMM.DPR，把窗体的 NAME属性定为 FCOMM，把窗体的标题定义为测试
通信，按照图 2添加控件 (图 2中黑色矩形围住的控件即为 COMM1)。
图 2
1.设定 COMM1属性：
●波特率： 4800；
●奇偶校验位：无；
●字节长度： 8；
●停止位： 1；
●串口： COM1。
Memo1中将显示发送和接收的数据。将新的窗体存储为 Comm.pas。
2.编写源代码
//变量说明
var
fcomm: TFCOMM;
viewstring:string;
i:integer;
rbuf,sbuf:array[16] of byte;
//打开串口
procedure TFCOMM.FormShow(Sender: TObject);
begin
comm1.StartComm;
end;
//关闭串口
procedure TFCOMM.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
comm1.StopComm;
end;
//自定义发送数据过程
procedure senddata;
var
i:integer;
commflg:boolean;
begin
viewstring:=‘’ ;
commflg:=true;
for i:=1 to 6do
begin
if not fcomm.comm1.writecommdata(@sbuf,1) then
begin
commflg:=false;
break;
end;
//发送时字节间的延时
sleep(2);
viewstring:=viewstring＋ inttohex(sbuf,2)＋‘’ ;
end;
viewstring:=‘发送’＋ viewstring;
fcomm.memo1.lines.add(viewstring);
fcomm.memo1.lines.add(‘’ );
if not commflg then
messagedlg(‘发送失败 !’ ,mterror,[mbyes],0);
end;
//发送按钮的点击事件
procedure TFCOMM.Btn_sendClick(Sender: TObject);
begin
sbuf[1]:=byte(＄ f0);
//帧头
sbuf[2]:=byte(＄ 01);
//命令号
sbuf[3]:=byte(＄ ff);
sbuf[4]:=byte(＄ ff);
sbuf[5]:=byte(＄ 01);
sbuf[6]:=byte(＄ f0);
//帧尾
senddata;//调用发送函数
end;
//接收过程
procedure TFCOMM.Comm1ReceiveData(Sender: TObject;
Buffer: Pointer;BufferLength: Word);
var
i:integer;
begin
viewstring:=‘’ ;
move(buffer^,pchar(@rbuf^),bufferlength);
for i:=1 to bufferlengthdo
viewstring:=viewstring＋ inttohex(rbuf,2)＋‘’ ;
viewstring:=‘接收’＋ viewstring;
memo1.lines.add(viewstring);
memo1.lines.add(‘’ );
end;
如果 memo1上显示发送 F0 01 FF FF 01 F0和接收到 F0 01 FF FF 01 F0，这表示串口已正
确地发送出数据并正确地接收到数据，则串口通信成功。
（网页编辑：徐向阳）
W
wwolf
Unregistered / Unconfirmed
GUEST, unregistred user!
用SPCOMM吧，很好的一个串口控件，有原码。我试试便知。
至于通讯吧，要注意外部设备的编码格式，也就是通信协议。
至于通讯吧，要注意外部设备的编码格式，也就是通信协议。
计
计算机1
Unregistered / Unconfirmed
GUEST, unregistred user!
用Spcomm比较好一点!
J
journer
Unregistered / Unconfirmed
GUEST, unregistred user!
用SPCOMM吧