急,谢谢!

解决方案 »

  1.   

    unit comm;interfaceuses  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
      Dialogs, Buttons, StdCtrls, ComCtrls;const
      WM_COMMNOTIFY = WM_USER + 1; // 通讯消息type
      TForm1 = class(TForm)
        Button1: TButton;
        Button2: TButton;
        Button3: TButton;
        Button4: TButton;
        OpenDialog1: TOpenDialog;
        Label1: TLabel;
        BitBtn1: TBitBtn;
        RichEdit1: TRichEdit;
        procedure Button1Click(Sender: TObject);
        procedure Button2Click(Sender: TObject);
        procedure Button3Click(Sender: TObject);
        procedure Button4Click(Sender: TObject);
      private
      { Private declarations }
        procedure WMCOMMNOTIFY(var Message :TMessage);message WM_COMMNOTIFY;
      public
      { Public declarations }
      end; var  Form1: TForm1;implementation{$R *.DFM}var  hNewCommFile,Post_Event: THandle;
      Read_os : Toverlapped;
      Receive :Boolean;
      ReceiveData : Dword;procedure AddToMemo(Str:PChar;Len:Dword); // 接收的数据送入显示区
    begin
      str[Len]:=#0;
      Form1.RichEdit1.Text:=Form1.RichEdit1.Text+StrPas(str);
    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(hNewCommFile,EV_RXCHAR)) then
      begin
        MessageBox(0,'SetCommMask Error !','Notice',MB_OK);
        Exit;
      end;
      while(Receive) do
      begin
        dwEvtMask:=0;
        // 等待通讯事件发生
        if not WaitCommEvent(hNewCommFile,dwEvtMask,@Os) then
        begin
          if ERROR_IO_PENDING=GetLastError then
            GetOverLappedResult(hNewCommFile,Os,dwTranser,True)
        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,hNewCommFile,0);
          if (not Ok) then
          begin
            MessageBox(0,'PostMessage Error !','Notice',MB_OK);
            Exit;
          end;
        end;
      end;
      CloseHandle(Os.hEvent); // 关闭重叠读事件对象
    end; 
      

  2.   

    procedure TForm1.WMCOMMNOTIFY(var Message :TMessage); // 消息处理函数
    var
      CommState : ComStat;
      dwNumberOfBytesRead : Dword;
      ErrorFlag : Dword;
      InputBuffer : Array [0..1024] of Char;
    begin
      if not ClearCommError(hNewCommFile,ErrorFlag,@CommState) then
      begin
        MessageBox(0,'ClearCommError !','Notice',MB_OK);
        PurgeComm(hNewCommFile,Purge_Rxabort or Purge_Rxclear);
        Exit;
      end;  if (CommState.cbInQue>0) then
      begin
      fillchar(InputBuffer,CommState.cbInQue,#0);
      // 接收通讯数据
      if (not ReadFile( hNewCommFile,InputBuffer,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(hNewCommFile);
      Exit;
      end
      else
      begin
      WaitForSingleObject(hNewCommFile,INFINITE); // 等待操作完成
      GetOverlappedResult(hNewCommFile,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.Button1Click(Sender: TObject); // 打开文件用于发送
    begin
      if OpenDialog1.Execute then
      begin
      Button3.Enabled :=False;
      Button4.Enabled :=False;
      RichEdit1.Lines.LoadFromFile(OpenDialog1.FileName);
      Form1.Caption := IntToStr(RichEdit1.GetTextLen);
      end;
      Button1.Enabled :=False;
    end; procedure TForm1.Button2Click(Sender: TObject); // 发送数据
    var
      dcb : TDCB;
      Error :Boolean;
      dwNumberOfBytesWritten,dwNumberOfBytesToWrite,
      ErrorFlag,dwWhereToStartWriting : DWORD;
      pDataToWrite : PChar;
      write_os: Toverlapped;
    begin
      Form1.Caption :='';
      // 打开通讯端口COM2
      hNewCommFile:=CreateFile( 'COM2',GENERIC_WRITE,0,
      nil, OPEN_EXISTING,FILE_FLAG_OVERLAPPED,0 );
      if hNewCommFile = INVALID_HANDLE_VALUE then
      MessageBox(0,'Error opening com port!','Notice',MB_OK);
      SetupComm(hNewCommFile,1024,1024); // 设置缓冲区大小及主要通讯参数
      GetCommState( hNewCommFile,dcb);
      dcb.BaudRate :=9600;
      dcb.ByteSize :=8;
      dcb.Parity :=NOPARITY;
      dcb.StopBits := ONESTOPBIT;
      Error := SetCommState( hNewCommFile, dcb );
      if ( not Error) then MessageBox(0,'SetCommState Error!','Notice',MB_OK);
      dwWhereToStartWriting := 0;
      dwNumberOfBytesWritten := 0;
      dwNumberOfBytesToWrite :=RichEdit1.GetTextLen;
      if (dwNumberOfBytesToWrite=0) then
      begin
      ShowMessage('Text Buffer is Empty!');
      Exit;
      end
      else
      begin
      pDataToWrite:=StrAlloc(dwNumberOfBytesToWrite+1);
      try
      RichEdit1.GetTextBuf(pDataToWrite,dwNumberOfBytesToWrite);
      Label1.Font.Color :=clRed;
      FillChar(Write_Os,SizeOf(write_os),0);
      // 为重叠写创建事件对象
      Write_Os.hEvent := CreateEvent(nil,True,False,nil);
      SetCommMask(hNewCommFile,EV_TXEMPTY);
      Label1.Caption:='正在发送数据...!';
      repeat
      Label1.Repaint;
      // 发送通讯数据
      if not WriteFile( hNewCommFile,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(hNewCommFile,Write_os,
      dwNumberOfBytesWritten,False);
      end
      else
      begin
      MessageBox(0,'WriteFile Error!','Notice',MB_OK);
      Receive :=False;
      CloseHandle(Read_Os.hEvent);
      CloseHandle(Post_Event);
      CloseHandle(hNewCommFile);
      Exit;
      end;
      end;
      end;
      Dec( dwNumberOfBytesToWrite, dwNumberOfBytesWritten );
      Inc( dwWhereToStartWriting, dwNumberOfBytesWritten );
      until (dwNumberOfBytesToWrite <= 0); // Write the whole thing!
      Form1.Caption:=IntToStr(dwWhereToStartWriting);
      finally
      StrDispose(pDataToWrite);
      end;
      CloseHandle(hNewCommFile);
      end;
      Label1.Font.Color :=clBlack;
      Label1.Caption:='发送成功!';
      Button1.Enabled :=True;
      Button3.Enabled :=True;
      Button4.Enabled :=True;
    end; procedure TForm1.Button3Click(Sender: TObject); // 接收处理
    var
      Ok : Boolean;
      dcb : TDCB;
      com_thread: Thandle;
      ThreadID:DWORD;
    begin
      ReceiveData :=0;
      Button1.Enabled :=False;
      Button2.Enabled :=False;
      RichEdit1.Clear;
      // 打开COM2
      hNewCommFile:=CreateFile( 'COM2',GENERIC_READ,0,
      nil, OPEN_EXISTING,FILE_FLAG_OVERLAPPED,0 );
      if hNewCommFile = INVALID_HANDLE_VALUE then
      begin
      MessageBox(0,'Error opening com port!','Notice',MB_OK);
      Exit;
      end;
      Ok:=SetCommMask(hNewCommFile,EV_RXCHAR);
      if ( not Ok) then
      begin
      MessageBox(0,'SetCommMask Error!','Notice',MB_OK);
      Exit;
      end;
      SetupComm(hNewCommFile,1024,1024);
      GetCommState( hNewCommFile, dcb );
      dcb.BaudRate :=9600;
      dcb.ByteSize :=8;
      dcb.Parity :=NOPARITY;
      dcb.StopBits := ONESTOPBIT;
      Ok := SetCommState( hNewCommFile, dcb );
      if ( not Ok) then MessageBox(0,'SetCommState Error!','Notice',MB_OK);
      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=null then
      begin
      CloseHandle(hNewCommFile);
      MessageBox(0,'CreateEvent Error!','Notice',MB_OK);
      Exit;
      end;
      // Create Event for PostMessage
      Post_Event:=CreateEvent(nil,True,True,nil);
      if Post_Event=null then
      begin
      CloseHandle(hNewCommFile);
      CloseHandle(Read_Os.hEvent);
      MessageBox(0,'CreateEvent Error!','Notice',MB_OK);
      Exit;
    end;
      // 建立通信监视线程
      Com_Thread:=CreateThread(nil,0,@CommWatch,nil,0,ThreadID);  if (Com_Thread=0) then
      MessageBox(Handle,'No CraeteThread!',nil,mb_OK);
      EscapeCommFunction(hNewCommFile,SETDTR);
      Label1.Font.Color :=clRed;
      Label1.Caption:='正在接收数据...!';
    end;procedure TForm1.Button4Click(Sender: TObject); // 停止通讯处理
    begin
      Label1.Font.Color :=clBlack;
      Label1.Caption:='infomation';
      Form1.Caption := IntToStr(ReceiveData);  Receive :=False;
      CloseHandle(Read_Os.hEvent);  CloseHandle(Post_Event);
      CloseHandle(hNewCommFile);  Button1.Enabled :=True;
      Button2.Enabled :=True;
    end; end.
      

  3.   

    to wyb716(小刀) :请问以上的方法适合所有的windows吗?