45289382.txt

是用该语言编写的关于串口通信的源代码。欢迎各位下载

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;
  const
  WM_COMMNOTIFY=WM_USER+1;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Button2: TButton;
    Button3: TButton;
    Edit7: TEdit;
    Label3: TLabel;
    Timer1: TTimer;
    Timer2: TTimer;
    Timer3: TTimer;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label2: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Button1: TButton;
    procedure Button2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure Timer3Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
   
  private
    { Private declarations }
    procedure StopRData(Sender:TObject);
    procedure SendTo232(var ss:byte);
    procedure ShowReadData(var RVData:array of byte);
    PROCEDURE WMCOMMNOTIFY(var Message:TMessage);
    Message WM_COMMNOTIFY;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
var
 hReadCommFile,Post_Event:Thandle;
 Read_Os:Toverlapped;
 Receive:Boolean;
 ReceiveData:DWORD;
 ss:byte;


procedure TForm1.StopRData(Sender:TObject);
begin
Receive:=False;
CloseHandle(Read_Os.hEvent);
CloseHandle(Post_Event);
CloseHandle(hReadCommFile);

end;

procedure TForm1.ShowReadData(var RVData:array of byte);
var
 CK:byte;
 i:integer;
 II:real;
begin
ck:=(255-(RVData[0]+RVData[1]+RVData[2]))+1;
if ck=RVData[3] then
begin
label3.Caption:='数据正确';
ss:=20;
i:=RVData[0];
ii:=(RVData[1]+RVData[2]*256)/10;
if i=1 then
begin
Label5.Caption:=IntToStr(RVData[0]);
label7.Caption:=FloatToStr(ii)+'度';

end
else
begin
Label9.Caption:=IntToStr(RVData[0]);
label11.Caption:=FloatToStr(ii)+'度';

end;
end
else
begin
Label3.Caption:='数据错误！';
ss:=200;
end;
timer1.Enabled:=true;
end;

procedure CommWatch(Ptr:Pointer);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=null then
   begin
       MessageBox(0,'Os.Event Create Error!','Notice',MB_OK);
       exit;
   end;
 if(not SetCommMask(hReadCommFile,EV_RXCHAR))then
   begin
       MessageBox(0,'SetCommMask Error!','Notice',MB_OK);
       exit;
   end;
 while(Receive) do
   begin
       dwEvtMask:=0;
       if not WaitCommEvent(hReadCommFile,dwEvtMask,@Os) then
          begin
              if ERROR_IO_PENDING=GetLastError then
                GetOverLappedResult(hReadCommFile,Os,dwTranser,True)
          end;
       if((dwEvtMask and EV_RXCHAR)=eV_RXCHAR)then
          begin
              WaitForSingleObject(Post_event,INFINITE);
              ResetEvent(Post_Event);
              OK:=PostMessage(Form1.Handle,WM_COMMNOTIFY,hReadCommFile,0);
              if(not OK)then
                begin
                    MessageBox(0,'PostMessage Error!','Notice',MB_OK);
                    exit;
                end;
          end;
       end;
   CloseHandle(Os.hEvent);

end;

procedure TForm1.WMCOMMNOTIFY(var Message:TMessage);
var
 CommState:ComStat;
 dwNumberOfBytesRead:DWORD;
 ErrorFlag:DWORD;
 RData:Array[0..3]of Byte;
begin
 if Not ClearCommError(hReadCommFile,ErrorFlag,@CommState) then
   begin
    MessageBox(0,'ClearCommError!','Notice',MB_OK);
    PurgeComm(hReadCommFile,Purge_Rxabort or Purge_Rxclear);
    exit;
   end;
 if(CommState.cbInQue>0)then
  begin
     Fillchar(RData,CommState.cbInQue,#0);
     if (not ReadFile(hReadCommFile,RData,CommState.cbInQue,dwNumberOfBytesRead,@Read_Os)) then
       begin
         ErrorFlag:=GetLastError();
         if (ErrorFlag<>0)and(ErrorFlag<>ERROR_IO_PENDING) then
           begin
             MessageBox(0,'ReadFile Error!','Notice',MB_OK);
             Receive:=False;
             CloseHandle(Read_Os.hEvent);
             CloseHandle(Post_Event);
             CloseHandle(hReadCommFile);
             exit;
           end
           else
           begin
             WaitForSingleObject(hReadCommFile,INFINITE);
             GetOverlappedResult(hReadCommFile,Read_Os,dwNumberOfBytesRead,False);

           end;

       end;
      if dwNumberOfBytesRead>0 then
        begin
            Read_Os.Offset:=Read_Os.Offset+dwNumberOfBytesRead;
            ReceiveData:=Read_Os.Offset;
            ShowReadData(RData);
        end;

  end;
  SetEvent(Post_Event);
end;

procedure TForm1.SendTo232(var ss:byte);
Var
hWriteCommFile:Thandle;
Write_Os:ToverLapped;
dcb:TDCB;
Error,ok:Boolean;
ErrorFlag,dwNumberOfBytesToWrite,dwNumberOfBytesWritten:DWORD;
begin
hWriteCommFile:=CreateFile('COM1',GENERIC_WRITE,FILE_SHARE_DELETE,NIL,OPEN_EXISTING,FILE_FLAG_OVERLAPPED,0);
if hWriteCommFile=INVALID_HANDLE_VALUE then
MessageBox(0,'hWriteCommFile Error!','Error Notice',MB_OK);
SetupComm(hWriteCommFile,1024,1024);
GetCommState(hWriteCommFile,dcb);
dcb.BaudRate:=1200;
dcb.ByteSize:=8;
dcb.Parity:=NOPARITY;
dcb.StopBits:=ONESTOPBIT;
Error:=SetCommState(hWriteCommFile,dcb);
 dwNumberOfBytesWritten:=1;
 dwNumberOfBytesToWrite:=1;

if (not Error) then
  MessageBox(0,'SetCommState Error','Notice',MB_OK);

  try
   FillChar(Write_Os,SizeOf(Write_Os),0);
   Write_Os.hEvent:=CreateEvent(nil,True,False,nil);
   SetCommMask(hWriteCommFile,EV_TXEMPTY);

   ok:=WriteFile(hWriteCommFile,ss,dwNumberOfBytesToWrite,
                            dwNumberOfBytesWritten,@Write_Os);
     if not ok then
      begin
          ErrorFlag:=GetLastError;
          if ErrorFlag<>0 then
            begin
              if ErrorFlag=ERROR_IO_PENDING then
                begin
                    WaitForSingleObject(Write_Os.hEvent,INFINITE);
                    GetOverlappedResult(hWriteCommFile,Write_Os,dwNumberOfBytesWritten,False);
                end
              else
                begin
                     MessageBox(0,'发送错误！','失败',MB_OK);
                     CloseHandle(Write_Os.hEvent);
                     Closehandle(hWriteCommFile);
                     exit;
                end;

           end;
      end;
      edit7.Text:=IntToStr(ss);
   finally
   ;
   end;
   Closehandle(hWriteCommFile);
   timer3.Enabled:=true;

end;










procedure TForm1.Button2Click(Sender: TObject);
var
 OK:Boolean;
 dcb:Tdcb;
 com_thread:Thandle;
 ThreadID:Dword;
begin
timer3.Enabled:=false;
ReceiveData:=0;
hReadCommFile:=CreateFile('COM1',GENERIC_READ,FILE_SHARE_DELETE,nil,OPEN_EXISTING,FILE_FLAG_OVERLAPPED,0);
if hReadCommFile=INVALID_HANDLE_VALUE then
  begin
      MessageBox(0,'打开COM1端口错误！','失败',MB_OK);
      exit;
  end;
OK:=SetCommMask(hReadCommFile,EV_RXCHAR);
if(not OK)then
  begin
      Messagebox(0,'SetCommMask Error!','Notice',MB_OK);
      exit;
  end;
SetupComm(hReadCommFile,1024,1024);
GetCommState(hReadCommFile,dcb);
dcb.BaudRate:=1200;
dcb.ByteSize:=8;
dcb.Parity:=NOPARITY;
dcb.StopBits:=ONESTOPBIT;
OK:=SetCommState(hReadCommFile,dcb);
if (not OK)then
  begin
      MessageBox(0,'SetCommState Error!','Notice',MB_OK);
      exit;
  end;
FillChar(Read_Os,SizeOf(Read_Os),0);
Read_Os.Offset:=0;
Read_Os.OffsetHigh:=0;
Read_Os.hEvent:=CreateEvent(nil,true,false,nil);
if Read_Os.hEvent=null then
   begin
       CloseHandle(hReadCommFile);
       MessageBox(0,'CreateEvent 1 Error!','Notice',MB_OK);
       exit;
   end;
Post_Event:=CreateEvent(nil,True,True,nil);
if Post_Event=null then
   begin
        CloseHandle(hReadCommFile);
        CloseHandle(Read_Os.hEvent);
        MessageBox(0,'CreateEvent 2 Error!','Notice',MB_OK);
        exit;
   end;
Com_Thread:=CreateThread(nil,0,@CommWatch,nil,0,ThreadID);
if (Com_Thread=0) then
  MessageBox(Handle,'CreateThread Error!',nil,MB_OK);
  EscapeCommFunction(hReadCommFile,SETDTR);
  Label1.Font.Color:=clRed;
  Label1.Caption:='正在接收数据。。。!';


end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin
timer1.Enabled:=false;
Receive:=False;
CloseHandle(Read_Os.hEvent);
CloseHandle(Post_Event);
CloseHandle(hReadCommFile);
label1.Caption:='停止接收数据。。。';
timer2.Enabled:=true;
end;

procedure TForm1.Timer2Timer(Sender: TObject);

begin
timer2.Enabled:=false;
SendTo232(ss);
end;



procedure TForm1.Timer3Timer(Sender: TObject);
begin
timer3.Enabled:=False;
form1.Button2Click(Sender);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
label1.Caption:='';
label5.Caption:='';
label7.Caption:='';
label9.Caption:='';
label11.Caption:='';
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
StopRData(Sender);
label1.Caption:='停止接收数据。。。';
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if button1.Caption='接收'then
begin
button1.Caption:='停止';
button2click(sender);
end
else
begin
button1.Caption:='接收';
Receive:=False;
CloseHandle(Read_Os.hEvent);
CloseHandle(Post_Event);
CloseHandle(hReadCommFile);
label1.Caption:='停止通讯！';
end;
end;

end.