unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls, Buttons, ExtCtrls;
const
WM_COMMNOTIFY = WM_USER + 1;
// 通讯消息
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
OpenDialog1: TOpenDialog;
RichEdit1: TRichEdit;
RichEdit2: TRichEdit;
SaveDialog1: TSaveDialog;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
fsdk: TRadioGroup;
RadioGroup2: TRadioGroup;
RadioGroup3: TRadioGroup;
RadioGroup4: TRadioGroup;
RadioGroup5: TRadioGroup;
StatusBar1: TStatusBar;
RadioGroup6: TRadioGroup;
BitBtn3: TBitBtn;
Label1: TLabel;
Label2: TLabel;
Button3: TButton;
Button5: TButton;
Label3: TLabel;
ComboBox1: TComboBox;
Timer1: TTimer;
CheckBox1: TCheckBox;
procedure FormCreate(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure fsdkClick(Sender: TObject);
procedure RadioGroup2Click(Sender: TObject);
procedure RadioGroup3Click(Sender: TObject);
procedure RadioGroup4Click(Sender: TObject);
procedure RadioGroup6Click(Sender: TObject);
procedure RadioGroup5Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
private
procedure WMCOMMNOTIFY(var Message :TMessage);message WM_COMMNOTIFY;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
var
hNewCommFile2,Post_Event: THandle;
hNewCommFile1 : THandle;
Read_os : Toverlapped;
Receive :Boolean;
ReceiveData : Dword;
ComBaudRate : Dword=9600;
ComParity : byte=0;
ComStopBits : byte=0;
ComByteSize : byte=8;
ComFile1
char='Com1' ;
ComFile2
char='Com2' ;
reLen :dword =0;
DWBuffer
word =1024 ;//发送、接收缓冲区的大小
ReadString1 :String='' ;
ReadString2 :String='' ;
AutoWriteComm :Boolean = False;
procedure SetStatusBar ;
//Set状态栏
var sText :string ;
begin
sText :=inttostr(ComBaudRate)+';';
case ComParity of
0 : sText:=sText+'N;';
1 : sText:=sText+'O;';
2 : sText:=sText+'E;';
end;
sText:=sText+inttostr(ComByteSize)+';';
case ComStopBits of
0 : sText:=sText+'1';
1 : sText:=sText+'1.5';
2 : sText:=sText+'2';
end;
form1.StatusBar1.Panels[4].Text := '通信参数:'+sText;
end ;
procedure SetControlEnabed( ComPortID:integer;ControlState:Boolean ) ;
//Set通信参数控件的Enabled状态
begin
if ComPortID = 1 then
begin
Form1.fsdk.Enabled :=ControlState ;
Form1.Button2.Enabled :=ControlState ;
end
else
Form1.RadioGroup2.Enabled:=ControlState ;
//如果正在发送或接收,通信参数控件的Enabled状态取消恢复True
if ControlState then
if (Form1.BitBtn3.Caption='终止接收数据')
or (Form1.Button2.Enabled = False) then
exit ;
Form1.RadioGroup5.Enabled:=ControlState ;
Form1.RadioGroup6.Enabled:=ControlState ;
Form1.RadioGroup4.Enabled:=ControlState ;
Form1.RadioGroup3.Enabled:=ControlState ;
Form1.ComboBox1.Enabled:=ControlState ;
end;
procedure AddToMemo(Str
Char;Len
word);
// 接收的数据送入显示区
begin
str[Len]:=#0;
Form1.RichEdit2.Text:=Form1.RichEdit2.Text+StrPas(str);
Readstring1 :=StrPas(str);
reLen:= reLen+ Len ;
Form1.Timer1.Enabled := true ;
Form1.StatusBar1.Panels[3].Text :=inttostr(Len)+ '已收数据:'+inttostr(ReLen);
Application.ProcessMessages;
end;
procedure CommWatch(Ptr
ointer);stdcall;
// 通讯监视线程
var
dwEvtMask,dwTranser : Dword;
Ok : Boolean;
Os : Toverlapped;
begin
Receive :=True;
FillChar(Os,SizeOf(Os),0);
Os.hEvent :=CreateEvent(nil,True,False,nil);
// 创建重叠读事件对象
if Os.hEvent=0 then
begin
MessageBox(0,'创建重叠读事件对象发生错误 !','提示信息',MB_OK);
Exit;
end;
if (not SetCommMask(hNewCommFile2,EV_RXCHAR)) then
begin
//MessageBox(0,'SetCommMask Error !','Notice',MB_OK);
MessageBox(0,'设置串口发生错误!','提示信息',MB_OK);
Exit;
end;
while(Receive)do
begin
dwEvtMask:=0;
// 等待通讯事件发生
if not WaitCommEvent(hNewCommFile2,dwEvtMask,@Os) then
begin
if ERROR_IO_PENDING=GetLastError then
GetOverLappedResult(hNewCommFile2,Os,dwTranser,True);
{Form1.StatusBar1.Panels[3].Text := '无数据接收';
Application.ProcessMessages;
//Zxy Add}
end;
if ((dwEvtMask and EV_RXCHAR)=EV_RXCHAR) then
begin
// 等待允许传递WM_COMMNOTIFY通讯消息
WaitForSingleObject(Post_event,INFINITE);
// 处理WM_COMMNOTIFY消息时不再发送WM_COMMNOTIFY消息
ResetEvent(Post_Event);
// 传递WM_COMMNOTIFY通讯消息
Ok:=PostMessage(Form1.Handle,WM_COMMNOTIFY,hNewCommFile2,0);
if (not Ok) then
begin
//MessageBox(0,'PostMessage Error !','Notice',MB_OK);
MessageBox(0,'发送消息时产生错误 !','提示信息',MB_OK);
Exit;
end;
end;
end;
CloseHandle(Os.hEvent);
// 关闭重叠读事件对象
end;
procedure TForm1.WMCOMMNOTIFY(var Message :TMessage);
// 消息处理函数
var
CommState : ComStat;
dwNumberOfBytesRead : Dword;
ErrorFlag : Dword;
InputBuffer : Array[0..4096] of Char ;//应用动态数组,我不会呀...
begin
if not ClearCommError(hNewCommFile2,ErrorFlag,@CommState) then
begin
//MessageBox(0,'ClearCommError !','Notice',MB_OK);
MessageBox(0,'无法清除串口错误 !','提示信息',MB_OK);
PurgeComm(hNewCommFile2,Purge_Rxabort or Purge_Rxclear);
Exit;
end;
if (CommState.cbInQue>0) then
begin
fillchar(InputBuffer,CommState.cbInQue,#0);
// 接收通讯数据
if (not ReadFile(hNewCommFile2,InputBuffer,CommState.cbInQue,dwNumberOfBytesRead,@Read_os)) then
begin
ErrorFlag := GetLastError();
if (ErrorFlag =0) or (ErrorFlag = ERROR_IO_PENDING) then
begin
Form1.StatusBar1.Panels[3].Text := '无数据接收';
Application.ProcessMessages;
//Zxy Add
end ;
if (ErrorFlag <> 0) and (ErrorFlag <> ERROR_IO_PENDING) then
begin
//MessageBox(0,'ReadFile Error!','Notice',MB_OK);
MessageBox(0,'接收数据发生错误!','提示信息',MB_OK);
Receive :=False;
CloseHandle(Read_Os.hEvent);
CloseHandle(Post_Event);
CloseHandle(hNewCommFile2);
Exit;
end
else
begin
WaitForSingleObject(hNewCommFile2,INFINITE);
// 等待操作完成
GetOverlappedResult(hNewCommFile2,Read_os,dwNumberOfBytesRead,False);
end;
end;
if dwNumberOfBytesRead>0 then
begin
Read_Os.Offset :=Read_Os.Offset+dwNumberOfBytesRead;
ReceiveData := Read_Os.Offset;
// 处理接收的数据
AddToMemo(InputBuffer,dwNumberOfBytesRead);
end;
end;
// 允许发送下一个WM_COMMNOTIFY消息
SetEvent(Post_Event);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
RichEdit1.clear;
RichEdit2.clear;
StatusBar1.Panels[4].Text := '通信参数:9600:N:8:1';
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
CheckBox1.Checked:=False ;
close;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
dcb : TDCB;
Error :Boolean;
dwNumberOfBytesWritten,dwNumberOfBytesToWrite,
ErrorFlag,dwWhereToStartWriting : DWORD;
pDataToWrite : PChar;
write_os: Toverlapped;
begin
// 打开通讯端口COM1
SetControlEnabed(1,False);
StatusBar1.Panels[2].Text :='打开发送端口...!';
hNewCommFile1:=CreateFile( COMFile2,GENERIC_WRITE,0,nil, OPEN_EXISTING,FILE_FLAG_OVERLAPPED,0 );
if hNewCommFile1 = INVALID_HANDLE_VALUE then
begin
//MessageBox(0,'Error opening com port!','Notice',MB_OK);
MessageBox(0,'发送端口不存在或已占用!','提示信息',MB_OK);
CloseHandle(hNewCommFile1);
SetControlEnabed(1,True);
exit;
end ;
SetupComm(hNewCommFile1,DWBuffer,DWBuffer);
// 设置缓冲区大小及主要通讯参数
GetCommState( hNewCommFile1,dcb);
dcb.BaudRate :=ComBaudRate ;
dcb.ByteSize :=ComByteSize;
dcb.Parity :=ComParity;
dcb.StopBits := ComStopBits;
Error := SetCommState( hNewCommFile1, dcb );
if (not Error) then
begin
//MessageBox(0,'SetCommState Error!','Notice',MB_OK);
MessageBox(0,'设置串口参数错误!','提示信息',MB_OK);
CloseHandle(hNewCommFile1);
SetControlEnabed(1,True);
exit ;
end;
dwWhereToStartWriting := 0;
dwNumberOfBytesWritten := 0;
dwNumberOfBytesToWrite :=RichEdit1.GetTextLen+1;
//不知为什么要+1,否则最后一个字符就没有传出去,当然就收不到了
if (dwNumberOfBytesToWrite - 1 =0) then
begin
ShowMessage('无发送数据!');
Button2.Enabled :=true;
CloseHandle(hNewCommFile1);
SetControlEnabed(1,True);
Exit;
end
else
begin
pDataToWrite:=StrAlloc(dwNumberOfBytesToWrite+1);
try
RichEdit1.GetTextBuf(pDataToWrite,dwNumberOfBytesToWrite);
FillChar(Write_Os,SizeOf(write_os),0);
// 为重叠写创建事件对象
Write_Os.hEvent := CreateEvent(nil,True,False,nil);
SetCommMask(hNewCommFile1,EV_TXEMPTY);
StatusBar1.Panels[2].Text :='正在发送...!';
repeat
// 发送通讯数据
if not WriteFile( hNewCommFile1,pDataToWrite[dwWhereToStartWriting],
dwNumberOfBytesToWrite,dwNumberOfBytesWritten,@write_os ) then
begin
ErrorFlag :=GetLastError;
if ErrorFlag<>0 then
begin
if ErrorFlag=ERROR_IO_PENDING then
begin
WaitForSingleObject(Write_Os.hEvent,INFINITE);
GetOverlappedResult(hNewCommFile1,Write_os,dwNumberOfBytesWritten,False);
end
else
begin
MessageBox(0,'发送数据时产生错误!','提示信息',MB_OK);
Receive :=False;
CloseHandle(Read_Os.hEvent);
CloseHandle(Post_Event);
CloseHandle(hNewCommFile1);
SetControlEnabed(1,True);
Exit;
end;
end;
end;
Dec(dwNumberOfBytesToWrite, dwNumberOfBytesWritten );
Inc( dwWhereToStartWriting, dwNumberOfBytesWritten );
StatusBar1.Panels[2].Text :='发送中..'+IntToStr(dwWhereToStartWriting);
Application.ProcessMessages;
until (dwNumberOfBytesToWrite <= 0);
// Write the whole thing!
// Form1.Caption:=IntToStr(dwWhereToStartWriting);
finally
StrDispose(pDataToWrite);
end;
CloseHandle(hNewCommFile1);
end;
StatusBar1.Panels[2].Text :='发送:'+IntToStr(dwWhereToStartWriting);
SetControlEnabed(1,True);
if CheckBox1.Checked then
begin
Sleep(1000);
Button2Click(Button2);
Application.ProcessMessages;
end;
end;
procedure TForm1.fsdkClick(Sender: TObject);
begin
case fsdk.ItemIndex of
0: ComFile1 := 'Com1' ;
1: ComFile1 := 'Com2' ;
2: ComFile1 := 'Com3' ;
3: ComFile1 := 'Com4' ;
end;
end;
procedure TForm1.RadioGroup2Click(Sender: TObject);
begin
case RadioGroup2.ItemIndex of
0: ComFile2 := 'Com1' ;
1: ComFile2 := 'Com2' ;
2: ComFile2 := 'Com3' ;
3: ComFile2 := 'Com4' ;
end;
end;
procedure TForm1.RadioGroup3Click(Sender: TObject);
begin
case RadioGroup3.ItemIndex of
0: ComBaudRate := 110 ;
1: ComBaudRate := 300 ;
2: ComBaudRate := 600 ;
3: ComBaudRate := 1200 ;
4: ComBaudRate := 2400 ;
5: ComBaudRate := 4800 ;
6: ComBaudRate := 9600 ;
7: ComBaudRate := 14400 ;
8: ComBaudRate := 19200 ;
9: ComBaudRate := 38400 ;
10: ComBaudRate := 56000 ;
11: ComBaudRate := 57600 ;
12: ComBaudRate := 115200 ;
end;
SetStatusBar ;
end;
procedure TForm1.RadioGroup4Click(Sender: TObject);
begin
ComParity := RadioGroup4.ItemIndex;
//ComParity := RadioGroup4.ItemIndex ;
//ComParity := RadioGroup4.Items.Strings[RadioGroup4.ItemIndex] ;
SetStatusBar;
end;
procedure TForm1.RadioGroup6Click(Sender: TObject);
begin
ComByteSize := RadioGroup6.ItemIndex+1 ;
//ComByteSize := StrToInt(RadioGroup6.Items.Strings[RadioGroup6.ItemIndex]) ;
SetStatusBar;
end;
procedure TForm1.RadioGroup5Click(Sender: TObject);
begin
ComStopBits:= RadioGroup5.ItemIndex ;
// ComStopBits:= StrToInt(RadioGroup5.Items.Strings[RadioGroup5.ItemIndex]);
SetStatusBar;
end;
procedure TForm1.BitBtn3Click(Sender: TObject);
var
Ok : Boolean;
dcb : TDCB;
com_thread: Thandle;
ThreadID
WORD;
begin
if BitBtn3.Caption='开始接收数据' then
begin
SetControlEnabed(2,False);
ReceiveData :=0;
// 打开接收端口
hNewCommFile2:=CreateFile( ComFile2,GENERIC_READ,0, nil, OPEN_EXISTING,FILE_FLAG_OVERLAPPED,0 );
if hNewCommFile2 = INVALID_HANDLE_VALUE then
begin
MessageBox(0,'接收端口不存在或已占用!','提示',MB_OK);
SetControlEnabed(2,True);
Exit;
end;
Ok:=SetCommMask(hNewCommFile2,EV_RXCHAR);
if (not Ok) then
begin
MessageBox(0,'设置通信串口错误!','提示信息',MB_OK);
CloseHandle(Read_Os.hEvent);
CloseHandle(Post_Event);
CloseHandle(hNewCommFile2);
SetControlEnabed(2,True);
Exit;
end;
SetupComm(hNewCommFile2,DWBuffer,DWBuffer);
GetCommState( hNewCommFile2, dcb );
dcb.BaudRate :=ComBaudRate ;
dcb.ByteSize :=ComByteSize;
dcb.Parity :=ComParity;
dcb.StopBits := ComStopBits;
Ok := SetCommState( hNewCommFile2, dcb );
if (not Ok) then
begin
MessageBox(0,'设置通信参数错误!','提示',MB_OK);
CloseHandle(Read_Os.hEvent);
CloseHandle(Post_Event);
CloseHandle(hNewCommFile2);
SetControlEnabed(2,True);
Exit ;
end ;
FillChar(Read_Os,SizeOf(Read_Os),0);
Read_Os.Offset := 0;
Read_Os.OffsetHigh := 0;
// Create Event for Overlapped Read
Read_Os.hEvent :=CreateEvent(nil,true,False,nil);
if Read_Os.hEvent=0 then
begin
CloseHandle(hNewCommFile2);
MessageBox(0,'建立接收进程错误!','提示',MB_OK);
CloseHandle(Read_Os.hEvent);
CloseHandle(Post_Event);
CloseHandle(hNewCommFile2);
SetControlEnabed(2,True);
Exit;
end;
// Create Event for PostMessage
Post_Event:=CreateEvent(nil,True,True,nil);
if Post_Event=0 then
begin
CloseHandle(hNewCommFile2);
CloseHandle(Read_Os.hEvent);
MessageBox(0,'建立接收事件发生错误!','提示',MB_OK);
SetControlEnabed(2,True);
Exit;
end;
// 建立通信监视线程
Com_Thread:=CreateThread(nil,0,@CommWatch,nil,0,ThreadID);
if (Com_Thread=0) then
begin
MessageBox(Handle,'No CraeteThread!',nil,mb_OK);
CloseHandle(hNewCommFile2);
CloseHandle(Read_Os.hEvent);
SetControlEnabed(2,True);
exit ;
end ;
EscapeCommFunction(hNewCommFile2,SETDTR);
BitBtn3.Caption:='终止接收数据' ;
StatusBar1.Panels[3].Text :='正在等待数据...!';
StatusBar1.Panels[1].Text :='接收端口已开○';
//Label1.Caption:='正在接收数据...!';
end
else
begin
StatusBar1.Panels[3].Text :='接收数据已终止!';
StatusBar1.Panels[1].Text:='接收端口未开●';
BitBtn3.Caption:='开始接收数据';
CloseHandle(Read_Os.hEvent);
CloseHandle(Post_Event);
CloseHandle(hNewCommFile2);
SetControlEnabed(2,True);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
RichEdit1.Lines.LoadFromFile(OpenDialog1.FileName);
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
RichEdit1.clear;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
RichEdit2.clear;
reLen :=0;
end;
procedure TForm1.ComboBox1Change(Sender: TObject);
//var aa :string;
begin
DWBuffer := strtoint(ComboBox1.text);
//ShowMessage(inttostr(DwBuffer));
end;
procedure TForm1.BitBtn2Click(Sender: TObject);
var
EditSize
word ;
MySavefile : TextFile;
begin
EditSize :=RichEdit2.GetTextLen;
if EditSize <= 0 then
showmessage('没有需要数据保存的数据')
else
begin
if SaveDialog1.Execute then
begin
if FileExists(SaveDialog1.FileName) then
if MessageDlg('文件:'+SaveDialog1.FileName+'已存在,是否覆盖?',
mtConfirmation, mbYesNoCancel, 0) <> idYes then
Exit;
AssignFile(MySaveFile,SaveDialog1.FileName);
Rewrite(MySaveFile);
Write(MySaveFile,RichEdit2.Lines.text);
CloseFile(MySaveFile);
//RichEdit2.Lines.SaveToFile(SaveDialog1.FileName);
end ;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
if Readstring1 = Readstring2 then
begin
StatusBar1.Panels[3].Text :='接收完成:'+inttostr(ReLen);
Application.ProcessMessages;
reLen :=0 ;
Timer1.Enabled := False ;
end
else
begin
Readstring2:= Readstring1 ;
end;
end;
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
if CheckBox1.Checked = True then
begin
repeat
Application.ProcessMessages;
Sleep(500) ;
until Button2.Enabled ;
//sleep(10000);
Button2Click(Button2);
end ;
end;
end.