(串口编程)以前我发的代码中有点问题,这是最新改进版,98/2000完全兼容(0分)

  • 主题发起人 主题发起人 吕雪松
  • 开始时间 开始时间

吕雪松

Unregistered / Unconfirmed
GUEST, unregistred user!
以前的在9x下没有问题,但在2000下不能读取串口数据,研究了一下发现缺几行代码。
这是最新改进版,多线程,98/2000下均运行通过,并表示报歉。

procedure TCommThread.Execute;
var
dwErrorFlags,dwLength : DWORD;
ComStat : PComStat;
fReadStat : Boolean;
InChar : Char;
AbIn : String;
XX,YY : double; //经度、纬度
VID : string; //车号
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
{接收完毕,开始截取经纬度信息}
CommForm.DealInPackage(Trim(AbIn));
AbIn := '';
end;
end;//if (fReadStat>0){
end; //if (dwLength>0){
FreeMem(ComStat);
end;{while}
end;

constructor TCommThread.Create;
begin
FreeOnTerminate := TRUE;

inherited Create(FALSE); //Createsuspended = false
end;

....

procedure TCommForm.InitializeComPort;
var
CommTimeOut : TCOMMTIMEOUTS;
DCB : TDCB;
fRetVal : Boolean;
begin
ShowStatus('同端口' + ComboBox2.Text + '连接中...');
// CommHandle := CreateFile(PChar(ComboBox2.Text),(GENERIC_READ and GENERIC_WRITE),0,nil,OPEN_EXISTING,FILE_FLAG_OVERLAPPED ,0);
CommHandle := CreateFile(PChar(ComboBox2.Text),(GENERIC_READ),0,nil,OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL and FILE_FLAG_OVERLAPPED,0);

if CommHandle = INVALID_HANDLE_VALUE then begin
ShowStatus('连接端口' + ComboBox2.Text + '失败');
Exit;
end;

SetCommMask(CommHandle, EV_RXCHAR ) ;

SetupComm(CommHandle, 4096, 4096) ;

PurgeComm(CommHandle, PURGE_TXABORT and PURGE_RXABORT and PURGE_TXCLEAR and PURGE_RXCLEAR ) ;

ShowStatus('已同端口 '+ ComboBox2.Text + ' 连接!');

// set up for overlapped I/O
CommTimeOut.ReadIntervalTimeout := MAXDWORD;
CommTimeOut.ReadTotalTimeoutMultiplier := 0;
CommTimeOut.ReadTotalTimeoutConstant := 1000;
CommTimeOut.WriteTotalTimeoutMultiplier := Trunc(2*CBR_9600/StrToInt(ComboBox3.Text));
CommTimeOut.WriteTotalTimeoutConstant := 0 ;

SetCommTimeouts(CommHandle, CommTimeOut);
//Set port
GetCommState(CommHandle,DCB);
DCB.DCBlength := SizeOf(TDCB);
//波特率
DCB.BaudRate := StrToInt(ComboBox3.Text);

//字节位长度
if RadioButton4.Checked then
DCB.ByteSize := 7
else
DCB.ByteSize := 8;

{校验, EVENPARITY Even
MARKPARITY Mark
NOPARITY No parity
ODDPARITY Odd
}
if RadioButton1.Checked then
DCB.Parity := NOPARITY //无
else if RadioButton1.Checked then
DCB.Parity := ODDPARITY //奇
else
DCB.Parity := EVENPARITY;//偶

{ //停止位
ONESTOPBIT 1 stop bit
ONE5STOPBITS 1.5 stop bits
TWOSTOPBITS 2 stop bits
}
if RadioButton6.Checked then
DCB.StopBits := ONESTOPBIT
else if RadioButton7.Checked then
DCB.StopBits := ONE5STOPBITS
else
DCB.StopBits := TWOSTOPBITS;

fRetVal := SetCommState(CommHandle, DCB);

if (fRetVal) then begin
Connected := TRUE;
//显示端口已经连接
MainForm.ToolButton3.ImageIndex := 14;
try
CommThread := TCommThread.Create;
except
Connected := FALSE;
CloseHandle(CommHandle);
fRetVal := FALSE;
ShowStatus('线程建立失败');
Exit;
end;
//连接串口后模拟失效
SetConnectType(0);
CommThread.Priority := tpNormal;
end
else begin
Connected := FALSE;
CloseHandle(CommHandle);
end;
end;
 
是作GPS的吗?能不能给我一个完整的源码?SKYMAN@CHINA.COM
 
吕雪松:你好!
我的程序初始化正常后,为什么送数据时,总是包错,程序如下!


procedure TMainForm.Button1Click(Sender: TObject);
var
dwBytesWritten:DWORD;
ComStat : PComStat;
fWriteState:boolean;
stemp:string;
Sending:pchar;
begin
PurgeComm(CommHandle,(PURGE_RXABORT and PURGE_RXCLEAR));

strcopy(Sending,pchar(MainForm.DataStrings.Strings[0]+#13));//将数据的后面加上一个回车
//showmessage(inttostr(strlen(Sending)));

fWriteState:=WriteFile(MainForm.CommHandle,Sending,strlen(Sending),dwBytesWritten,nil);

if not fWriteState then
MessageDlg('没有发送成功!',mtError,[mbYes],0);
end;


 
接受答案了.
 
To:吕雪松
你好,我有一个有关串口的问题要求教于你:
能不能写一个程序,将已经打开的串口(这个串口是别的程序打开的)关闭。
如果可能,你能不能指点一下怎么实现?
谢谢你啦!
 
后退
顶部