⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 新建 文本文档.txt

📁 串口通讯关于磁卡读写相关文章 资料串口控件的介绍和使用
💻 TXT
字号:
  Delphi串口通讯的监听 
 
2001-06-25· ·aizb··天极论坛

 

  串口程序我后来研究了好久,写了下面的代码,后台生成一个线程监听串口,不影响前台工作。效果很好,一直用于GPS仪器的数据接收。 

unit frmComm; 
interface 
uses 
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
StdCtrls, ComCtrls,GeoUtils,GeoGPS; 
const MAXBLOCK = 160; 

type 
TComm = record //com口记录类型
idComDev : THandle;//串口句柄 
fConnected : Boolean; 
end; 

TCommForm = class(TForm) 
ComboBox1: TComboBox; 
Button1: TButton; 
StatusBar1: TStatusBar; 
Button2: TButton; 
ComboBox2: TComboBox; 
procedure Button1Click(Sender: TObject); 
procedure Button2Click(Sender: TObject); 
procedure FormClose(Sender: TObject; var Action: TCloseAction); 
private 
{ Private declarations } 
public 
{ Public declarations } 
end; 

TCommThread = Class(TThread) 
protected 
procedure Execute;override; 
public 
constructor Create; 
end; 

var 
CommForm: TCommForm; 
CommHandle : THandle; 
Connected : Boolean; 
CommThread : TCommThread; 

implementation 
{$R *.DFM} 
uses 
frmMain,frmMdiMapView; 


procedure TCommThread.Execute; 
var 
dwErrorFlags,dwLength : DWORD; 
ComStat : PComStat; 
fReadStat : Boolean; 
InChar : Char; 
AbIn : String; 
XX,YY : double; file://经度、纬度 
VID : string; file://车号 
begin 
while Connected do begin 
GetMem(ComStat,SizeOf(TComStat)); 
ClearCommError(CommHandle, dwErrorFlags, ComStat); 
if (dwErrorFlags > 0) then begin 
PurgeComm(CommHandle,(PURGE_RXABORT and PURGE_RXCLEAR));//晴空缓存 
// return 0; 
end; 
dwLength := ComStat.cbInQue; 
if (dwLength>0) then begin 
fReadStat := ReadFile(CommHandle, InChar, 1,dwLength, nil); 
if (fReadStat) then begin 
if (InChar <> Chr(13)) and (Length(abIn) < MAXBLOCK+5 ) then AbIn := AbIn + InChar 
else begin 
... 
{接收完毕,} 
end;//if (fReadStat>0){ 
end; file://if (dwLength>0){ 
FreeMem(ComStat); 
end;{while} 
end; 

constructor TCommThread.Create; 
begin 
FreeOnTerminate := TRUE; 
inherited Create(FALSE); file://Createsuspended = false 
end; 
// 

procedure TCommForm.Button1Click(Sender: TObject); 
var 
CommTimeOut : TCOMMTIMEOUTS; 
DCB : TDCB; 
fRetVal : Boolean; 
begin 
StatusBar1.SimpleText := '连接中...'; 
CommHandle := CreateFile(PChar(ComboBox1.Text),GENERIC_READ,0,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL 
, 0); 
if CommHandle = INVALID_HANDLE_VALUE then begin 
StatusBar1.SimpleText := '连接失败'; 
Exit; 
end; 
StatusBar1.SimpleText := '已同端口 '+ ComboBox1.Text + ' 连接!'; 
CommTimeOut.ReadIntervalTimeout := MAXDWORD; 
CommTimeOut.ReadTotalTimeoutMultiplier := 0; 
CommTimeOut.ReadTotalTimeoutConstant := 0; 
SetCommTimeouts(CommHandle, CommTimeOut); 
GetCommState(CommHandle,DCB); 
DCB.BaudRate := 9600; 
DCB.ByteSize := 8; 
DCB.Parity := NOPARITY; 
DCB.StopBits := ONESTOPBIT; 
fRetVal := SetCommState(CommHandle, DCB); 
if (fRetVal) then begin 
Connected := TRUE; 
try 
CommThread := TCommThread.Create; 
except 
Connected := FALSE; 
CloseHandle(CommHandle); 
fRetVal := FALSE; 
StatusBar1.SimpleText := '线程建立失败'; 
Exit; 
end; 
end 
else begin 
Connected := FALSE; 
CloseHandle(CommHandle); 
end; 
end; 

procedure TCommForm.Button2Click(Sender: TObject); 
begin 
Connected := FALSE; 
CloseHandle(CommHandle); 
{终止线程} 
CommThread.Terminate; 
StatusBar1.SimpleText := '关闭端口'+ComboBox1.Text; 
end; 

procedure TCommForm.FormClose(Sender: TObject; var Action: TCloseAction); 
begin 
Connected := FALSE; 
CloseHandle(CommHandle); 
StatusBar1.SimpleText := '关闭端口'+ComboBox1.Text; 
end; 
end. 

 
 
 

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -