串口程序我后来研究了好久，写了下面的代码，后台生成一个线程监听串口，不影响前台工作。效果很好，一直用于GPS仪器的数据接收。
unit frmComm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls,GeoUtils,GeoGPS;
const MAXBLOCK = 160;
type
TComm = record
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.
