C
cloud_sky
Unregistered / Unconfirmed
GUEST, unregistred user!
[?]我在联机生化仪时接收数据不是每次都能收到全部数据,有时可以,有时不可以,对串口采集
的数据保存成文件也不完整。我用超级终端却可接收全部数据。程序代码:
const
IO_COMMNOTIFY = WM_USER+11;
IO_HIDEWINDOW = WM_USER+12;
IO_WAITING = WM_USER+13;
IO_TRANSMITTING = WM_USER+14;
IO_REINITCOMM = WM_USER+15;
IO_READFILE = WM_USER+20;
IO_READCOM = WM_USER + 21;
WINDOWTITLE = '端口';
TODBWINTITLE = 'ToDB';
ReadBufferSize = 400;
WriteBufferSize = 100;
type
TWWriteFile = class(TForm)
Database1: TDatabase;
SPAddSysmex: TStoredProc;
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
private
// ToDBWindow:THandle;
FileName,OffSetChar;
BaudRate,StopBit,DataBit,ParityChar;
CommDevChar;
SoftwareKey,SwapFileKey,CommKey:HKey;
AcceptStr:String;
function FileInitialize:Boolean;
function Comminitialize:Boolean;
function GetFileNameChar;
procedure MsgCommProcess(var Message:TMessage);
Message IO_COMMNOTIFY;
procedure HideWindow(var Msg:TMessage);Message IO_HIDEWINDOW;
{ Private declarations }
public
{ Public declarations }
end;
TComm = class(TThread)
protected
procedure Execute;override;
end;
var
WWriteFile: TWWriteFile;
hcom,Post_Event:THandle;
lpoloverlapped;
Read_Buffer:array[1..300]of char;
wmHide:Integer=0;
hFile:THandle;
implementation
{$R *.DFM}
procedure TComm.Execute;
var dwEvtMaskWord;
Wait:Boolean;
begin
new(lpol);
lpol^.hEvent:=Post_Event;
while WWriteFile.Tag=0do
begin
Application.ProcessMessages;
dwEvtMask:=0;
SendMessage(WWriteFile.Handle,IO_HIDEWINDOW,0,0);
Wait:=WaitCommEvent(hcom,dwevtmask,lpol);
if Wait then
begin
WaitForSingleObject(Post_Event,Infinite);
ResetEvent(Post_Event);
PostMessage(WWriteFile.Handle,IO_COMMNOTIFY,0,0);
end;
end;
WWriteFile.Tag:=0;
end;
function TWWriteFile.GetFileNameChar;
begin
result:=PChar('AsysOutP.txt');
end;
function TWWriteFile.FileInitialize:Boolean;
begin
hFile:=CreateFile(GetFileName,GENERIC_WRITE,FILE_SHARE_READ or
FILE_SHARE_WRITE,nil,CREATE_NEW,FILE_ATTRIBUTE_NORMAL ,0);
if hFile=INVALID_HANDLE_VALUE then
begin
DeleteFile(GetFileName);
hFile:=CreateFile(GetFileName,GENERIC_WRITE,FILE_SHARE_READ or
FILE_SHARE_WRITE,nil,CREATE_NEW,FILE_ATTRIBUTE_NORMAL ,0);
end;
if hFile=INVALID_HANDLE_VALUE then
result:=false
else
result:=True;
end;
function TWWriteFile.CommInitialize;
var i:Integer;
lpdcb:Tdcb;
begin
for i:=1 to ReadBufferSizedo
Read_Buffer:='~';
// if hcom<>INVALID_HANDLE_VALUE then
// CloseHandle(hCom);
hcom:=CreateFile(PChar('COM1'),GENERIC_READ or GENERIC_WRITE,
0,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
if hcom=INVALID_HANDLE_VALUE then
begin
ShowMessage('failed to create a handle of communication device !');
result:=false;
end
else
begin
SetupComm(hcom,300,300);
GetCommState(hcom,lpdcb);
{ lpdcb.BaudRate:=StrToInt(String(BaudRate));
lpdcb.ByteSize:=StrToInt(String(DataBit));
lpdcb.StopBits:=StrToInt(String(StopBit));
lpdcb.Parity:=StrToInt(String(Parity));
}
lpdcb.BaudRate:=9600;
lpdcb.ByteSize:=8;
// lpdcb.StopBits:= ONESTOPBIT;
// lpdcb.Parity:= NOPARITY;
lpdcb.StopBits:=ONESTOPBIT;
lpdcb.Parity:=EvenParity;//偶校验
//lpdcb.Parity:=0;
if not SetCommState(hcom,lpdcb) then
result:=false
else
begin
SetCommMask(hcom,ev_rxchar);
result:=true;
end;
end;
end;
procedure TWWriteFile.MsgCommProcess(var Message:TMessage);
var
Clear:Boolean;
Coms:TComStat;
cbNum,I,StartPos:Integer;
ReadNumber:Cardinal;
lpErrors:Cardinal;
begin
Clear:=ClearCommError(hcom,lpErrors,@coms);
StartPos:=0;
for I:=1 to 300do
Read_Buffer:='~' ;
if Clear then
begin
cbNum:=Coms.cbInQue;
ReadFile(hcom,Read_Buffer,cbNum,ReadNumber,lpol);
for I:=1 to ReadNumberdo
if Read_Buffer<>char(13) then
AcceptStr:=AcceptStr+Read_Buffer ;
StartPos:=pos(char(2),AcceptStr);
if (StartPos>0) and (length(AcceptStr)>=236) then
begin
SPAddSysmex.ParamByName('@text').AsString:=
// Copy(trim(AcceptStr),2,234);
copy(AcceptStr,StartPos+1,234);
SPAddSysmex.ExecProc;
SPAddSysmex.Close;
AcceptStr:=Copy(AcceptStr,235,Length(AcceptStr));
// AcceptStr:=Copy(AcceptStr,237,Length(AcceptStr));
end;
if ReadNumber>0 then
begin
cbNum:=ReadNumber;
WriteFile(hFile,Read_Buffer,cbNum,ReadNumber,nil);
end;
SetEvent(Post_Event);
end;
end;
的数据保存成文件也不完整。我用超级终端却可接收全部数据。程序代码:
const
IO_COMMNOTIFY = WM_USER+11;
IO_HIDEWINDOW = WM_USER+12;
IO_WAITING = WM_USER+13;
IO_TRANSMITTING = WM_USER+14;
IO_REINITCOMM = WM_USER+15;
IO_READFILE = WM_USER+20;
IO_READCOM = WM_USER + 21;
WINDOWTITLE = '端口';
TODBWINTITLE = 'ToDB';
ReadBufferSize = 400;
WriteBufferSize = 100;
type
TWWriteFile = class(TForm)
Database1: TDatabase;
SPAddSysmex: TStoredProc;
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
private
// ToDBWindow:THandle;
FileName,OffSetChar;
BaudRate,StopBit,DataBit,ParityChar;
CommDevChar;
SoftwareKey,SwapFileKey,CommKey:HKey;
AcceptStr:String;
function FileInitialize:Boolean;
function Comminitialize:Boolean;
function GetFileNameChar;
procedure MsgCommProcess(var Message:TMessage);
Message IO_COMMNOTIFY;
procedure HideWindow(var Msg:TMessage);Message IO_HIDEWINDOW;
{ Private declarations }
public
{ Public declarations }
end;
TComm = class(TThread)
protected
procedure Execute;override;
end;
var
WWriteFile: TWWriteFile;
hcom,Post_Event:THandle;
lpoloverlapped;
Read_Buffer:array[1..300]of char;
wmHide:Integer=0;
hFile:THandle;
implementation
{$R *.DFM}
procedure TComm.Execute;
var dwEvtMaskWord;
Wait:Boolean;
begin
new(lpol);
lpol^.hEvent:=Post_Event;
while WWriteFile.Tag=0do
begin
Application.ProcessMessages;
dwEvtMask:=0;
SendMessage(WWriteFile.Handle,IO_HIDEWINDOW,0,0);
Wait:=WaitCommEvent(hcom,dwevtmask,lpol);
if Wait then
begin
WaitForSingleObject(Post_Event,Infinite);
ResetEvent(Post_Event);
PostMessage(WWriteFile.Handle,IO_COMMNOTIFY,0,0);
end;
end;
WWriteFile.Tag:=0;
end;
function TWWriteFile.GetFileNameChar;
begin
result:=PChar('AsysOutP.txt');
end;
function TWWriteFile.FileInitialize:Boolean;
begin
hFile:=CreateFile(GetFileName,GENERIC_WRITE,FILE_SHARE_READ or
FILE_SHARE_WRITE,nil,CREATE_NEW,FILE_ATTRIBUTE_NORMAL ,0);
if hFile=INVALID_HANDLE_VALUE then
begin
DeleteFile(GetFileName);
hFile:=CreateFile(GetFileName,GENERIC_WRITE,FILE_SHARE_READ or
FILE_SHARE_WRITE,nil,CREATE_NEW,FILE_ATTRIBUTE_NORMAL ,0);
end;
if hFile=INVALID_HANDLE_VALUE then
result:=false
else
result:=True;
end;
function TWWriteFile.CommInitialize;
var i:Integer;
lpdcb:Tdcb;
begin
for i:=1 to ReadBufferSizedo
Read_Buffer:='~';
// if hcom<>INVALID_HANDLE_VALUE then
// CloseHandle(hCom);
hcom:=CreateFile(PChar('COM1'),GENERIC_READ or GENERIC_WRITE,
0,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
if hcom=INVALID_HANDLE_VALUE then
begin
ShowMessage('failed to create a handle of communication device !');
result:=false;
end
else
begin
SetupComm(hcom,300,300);
GetCommState(hcom,lpdcb);
{ lpdcb.BaudRate:=StrToInt(String(BaudRate));
lpdcb.ByteSize:=StrToInt(String(DataBit));
lpdcb.StopBits:=StrToInt(String(StopBit));
lpdcb.Parity:=StrToInt(String(Parity));
}
lpdcb.BaudRate:=9600;
lpdcb.ByteSize:=8;
// lpdcb.StopBits:= ONESTOPBIT;
// lpdcb.Parity:= NOPARITY;
lpdcb.StopBits:=ONESTOPBIT;
lpdcb.Parity:=EvenParity;//偶校验
//lpdcb.Parity:=0;
if not SetCommState(hcom,lpdcb) then
result:=false
else
begin
SetCommMask(hcom,ev_rxchar);
result:=true;
end;
end;
end;
procedure TWWriteFile.MsgCommProcess(var Message:TMessage);
var
Clear:Boolean;
Coms:TComStat;
cbNum,I,StartPos:Integer;
ReadNumber:Cardinal;
lpErrors:Cardinal;
begin
Clear:=ClearCommError(hcom,lpErrors,@coms);
StartPos:=0;
for I:=1 to 300do
Read_Buffer:='~' ;
if Clear then
begin
cbNum:=Coms.cbInQue;
ReadFile(hcom,Read_Buffer,cbNum,ReadNumber,lpol);
for I:=1 to ReadNumberdo
if Read_Buffer<>char(13) then
AcceptStr:=AcceptStr+Read_Buffer ;
StartPos:=pos(char(2),AcceptStr);
if (StartPos>0) and (length(AcceptStr)>=236) then
begin
SPAddSysmex.ParamByName('@text').AsString:=
// Copy(trim(AcceptStr),2,234);
copy(AcceptStr,StartPos+1,234);
SPAddSysmex.ExecProc;
SPAddSysmex.Close;
AcceptStr:=Copy(AcceptStr,235,Length(AcceptStr));
// AcceptStr:=Copy(AcceptStr,237,Length(AcceptStr));
end;
if ReadNumber>0 then
begin
cbNum:=ReadNumber;
WriteFile(hFile,Read_Buffer,cbNum,ReadNumber,nil);
end;
SetEvent(Post_Event);
end;
end;