我自己开发过一个 串口通讯控件如下：
基本解决了延时的问题；
我是这样处理的，通过 ClearCommError(hCommHandle,dwError,@CS); 取得状态
然后看看缓冲区数据长度 ：cs.cbInQue
然后在用ClearCommError(hCommHandle,dwError,@CS); 取得状态
比较这次和上次缓冲取数据的长度，看看是否一样长。如果一样长，说明已经收完了。
如果不一样长，重复上边的操作。
-------------------------------------------------------
下面是控件代码：
unit CommDai;
interface
uses
Windows, Messages, SysUtils, Classes,Forms ;
type
TParity = ( None, Odd, Even );
TStopBits = ( _1, _1_5, _2 );
TDataBits = ( DB5, DB6, DB7, DB8 );
TCommDai = class(TComponent)
private
FBaudRate: DWORD;
FreadComCount:integer;
FCommName: String;
FParity: TParity;
FStopBits: TStopBits;
FRecieveDelay: Word;
hCommHandle:Thandle;
FFtuAddress:word;
FDataBits: TDataBits;
procedure SetBaudRate(const Value: DWORD);
procedure SetParity(const Value: TParity);
procedure SetStopBits(const Value: TStopBits);
procedure SetRecieveDelay(const Value: Word);
procedure SetDataBits(const Value: TDataBits);
{ Private declarations }
protected
{ Protected declarations }
public
property Handle: THandle read hCommHandle write hCommHandle;
property readComCount:integer read FreadComCount;
function SendString(str:string): string;
// constructor Create( AOwner: TComponent ); override;
// destructor Destroy; override;
function stringtohex(str:string): string;
Procedure TimeDelay(DT
WORD);
function StartComm:boolean;
procedure StopComm;
procedure SendByteArray(SendStr:String) ; overload;
procedure SendByteArray(ByteArray:Array of Byte; SendCount:word);overload;
procedure RecieveByteArray(var ByteArray:Array of Byte;var RecieveCount:word);overload;
function BytesToString(Bytes:Array of Byte;Count:word):String;
function RecieveByteArray:string; overload;
{ Public declarations }
published
property CommName: string read FCommName write FCommName; // String read FCommName write
property BaudRate: DWORD read FBaudRate write SetBaudRate; //read FBaudRate write
property Parity: TParity read FParity write SetParity; //read FParity write FParity
property StopBits: TStopBits read FStopBits write SetStopBits; //read FStopBits write SetStopBits
property RecieveDelay :Word read FRecieveDelay write SetRecieveDelay;
property FtuAddress: word read FFtuAddress write FFtuAddress;
property DataBits: TDataBits read FDataBits write SetDataBits;
{ Published declarations }
end;
procedure Register;
{$R CommDai.dcr}
implementation
procedure Register;
begin
RegisterComponents('dai', [TCommDai]);
end;
{ TCommDai }
procedure TCommDai.SetBaudRate(const Value: DWORD);
begin
FBaudRate := Value;
end;
procedure TCommDai.SetParity(const Value: TParity);
begin
FParity := Value;
end;
procedure TCommDai.SetRecieveDelay(const Value: Word);
begin
FRecieveDelay := Value;
end;
procedure TCommDai.SetStopBits(const Value: TStopBits);
begin
FStopBits := Value;
end;
function TCommDai.stringtohex(str:string): string;
var temp:string;
begin
str:=trim(str);
while length(str)>1 do
begin
temp:=temp+'$'+copy(str,1,2);
str:=copy(str,3,length(str)-2);
str:=trim(str);
end;
result:=temp;
end;
function TCommDai.SendString(str:string): string;
var temp:string;
begin
str:=trim(str);
while length(str)>1 do
begin
temp:=temp+' '+copy(str,1,2);
str:=copy(str,3,length(str)-2);
str:=trim(str);
end;
result:=temp;
end;
{ public function or procedure}
// constructor Create( AOwner: TComponent ); override;
// destructor Destroy; override;
Procedure TCommDai.TimeDelay(DT
WORD);
var
TT
WORD;
begin
//取得现在的Tick值
//TT:=GetTickCount();
//计算Tick差值是否超过设置值
// while GetTickCount()-TT<DT do
// begin
sleep(DT);
// Application.ProcessMessages; //释放控制权
// end;
end;
//以下是打开通信端口的程序
function TCommDai.StartComm:boolean;
var
cc:TCOMMCONFIG;
Temp:string;
begin
hCommHandle:=CreateFile(PChar(FCommName),//文件名指针,如com1,com2
GENERIC_READ or GENERIC_WRITE, //存取属性
2, //共享模式 0-不共享， 1-共相书
nil, OPEN_EXISTING, 0, 0); // 打开COM
if (hCommHandle = INVALID_HANDLE_VALUE) then begin // 如果COM 未打开
result:=false;
exit;
end;
GetCommState(hCommHandle,cc.dcb); // 得知目前COM 的状态
cc.dcb.BaudRate:= BaudRate;//CBR_9600; // 设置波特率为9600
cc.dcb.ByteSize:=ord(FDataBits)+5; // 字节为 8 bit
cc.dcb.Parity:=ord(FParity); //NOPARITY; // Parity 为 None
cc.dcb.StopBits:=ord(StopBits); //ONESTOPBIT; // 1 个Stop bit
if not SetCommState(hCommHandle, cc.dcb) then
begin// 设置COM 的状态
MessageBox (0, '通信端口设置错误!!!','',MB_OK);
CloseHandle(hCommHandle);
result:=false;
exit;
end;
result:=true;
end;
procedure TcommDai.StopComm;
begin
SetCommMask( hCommHandle,$0);
CloseHandle(hCommHandle);
end;
procedure TcommDai.SendByteArray(SendStr:string) ;
var StrTemp :string;
SendByteCount :integer;
SendBuff :Array[0..2047] of Byte;
nBytesRead, dwEvent, dwError:LongWORD ;
cs:TCOMSTAT;
pt
byte;
lrc:dword;
i:integer;
begin
StrTemp:=self.stringtohex(SendStr);
SendByteCount:=Length(StrTemp) div 3;
//SetLength(SendBuff,SendByteCount);
for i:=0 to SendByteCount-1 do
SendBuff
:=StrToInt(copy(StrTemp,i*3+1,3));
//实际的传送动作
try
WriteFile(hCommHandle,SendBuff, SendByteCount ,lrc, nil); // 送出
except
application.MessageBox('发送失败！','系统提示！',mb_ok+mb_iconinformation);
end;
end;
PROCEDURE TcommDai.SendByteArray(ByteArray:Array of Byte; SendCount:word);
var
lrc:dword;
begin
try
WriteFile(hCommHandle,ByteArray, SendCount ,lrc, nil); // 送出
except
application.MessageBox('发送失败！','系统提示！',mb_ok+mb_iconinformation);
end;
end;
procedure TcommDai.RecieveByteArray(var ByteArray:Array of Byte;var RecieveCount:word);
var
StrTemp :String;
RecieveBuff :Array[0..2047] of Byte;
cs:TCOMSTAT;
ptbyte;
lrc:dword;
nBytesRead, dwEvent, dwError:LongWORD ;
i:integer;
comp:integer;
begin
timedelay(20);
ClearCommError(hCommHandle,dwError,@CS); //取得状态
comp:=cs.cbInQue;
// timedelay(1);
for i:=1 to 50 do
begin
timedelay(20);
ClearCommError(hCommHandle,dwError,@CS); //取得状态
if (comp=cs.cbInQue) and (cs.cbInQue>1) then break;
if (i>15) and (cs.cbInQue=0) then break;
comp:=cs.cbInQue;
end;
FreadComCount:=i;
// application.MessageBox(pchar(inttostr(i)),'系统提示！',mb_ok+mb_iconinformation);
RecieveCount:=cs.cbInQue;
if cs.cbInQue >2048 then
begin
PurgeComm(hCommHandle, PURGE_RXCLEAR);
RecieveCount:=0;
// 清除COM 数据
exit;
end;
try
ReadFile(hCommHandle, ByteArray,cs.cbInQue,nBytesRead,nil); // 接收COM 的数据
except
end;
end;
function TcommDai.RecieveByteArray:string; //用不到了
var
StrTemp :String;
RecieveBuff :Array[0..2047] of Byte;
cs:TCOMSTAT;
ptbyte;
lrc:dword;
nBytesRead, dwEvent, dwError:LongWORD ;
i:integer;
comp:integer;
begin
timedelay(10 );
ClearCommError(hCommHandle,dwError,@CS); //取得状态
comp:=cs.cbInQue;
timedelay(0);
i:=1;
while i<100 do
begin
timedelay(10 );
ClearCommError(hCommHandle,dwError,@CS); //取得状态
if (comp=cs.cbInQue) and (cs.cbInQue>1) then break;
comp:=cs.cbInQue;
inc(i);
end;
// 数据是否大于我们所准备的Buffer
if cs.cbInQue=0 then
begin
result:='';
exit;
end;
if cs.cbInQue >2048 then
begin
PurgeComm(hCommHandle, PURGE_RXCLEAR);
result:='';
application.MessageBox('接受溢出，可能是未打开端口！','系统提示！',mb_ok+mb_iconinformation);
// 清除COM 数据
exit;
end;
try
ReadFile(hCommHandle, RecieveBuff,cs.cbInQue,nBytesRead,nil); // 接收COM 的数据
except
application.MessageBox('接受失败！','系统提示！',mb_ok+mb_iconinformation);
end;
StrTemp:='';
for i:=0 to cs.cbInQue -1 do
StrTemp:=StrTemp+inttohex(RecieveBuff,2)+' ';
Result:=StrTemp;
end;
function TcommDai.BytesToString(Bytes:Array of Byte;Count:word):String;
var i :integer;
StrTemp :String;
begin
strTemp:='';
for i:=0 to Count-1 do
strTemp:=strTemp+ inttohex(Bytes,2)+' ';
Result:=strTemp;
end;
procedure TCommDai.SetDataBits(const Value: TDataBits);
begin
FDataBits := Value;
end;
end.
