delphi 2010 串口的创建和使用

初始化串口

function InitialCom(Port: string; BaudRate: integer):THandle;
var
  dcb: TDCB;
  Error: Boolean;
  CommName : string;
  shSend:THandle;
begin
  CommName := Port ;
  shSend := CreateFile(PChar(CommName),GENERIC_WRITE, 0,
    nil, OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0);
  if shSend = INVALID_HANDLE_VALUE then
    raise Exception.Create('Open '+CommName+' port error!');
  Error := SetCommMask(shSend,EV_RXCHAR);
  if (not Error) then
  raise Exception.Create('SetCommMask error');
  SetupComm(shSend, 1024, 1024);
  GetCommState(shSend, dcb);
  dcb.BaudRate := BaudRate;
  dcb.ByteSize := 8;
  dcb.StopBits := ONESTOPBIT ;
  dcb.Parity := NOPARITY ;
  Error := SetCommState(shSend, dcb);
  if (not Error) then
    raise Exception.Create('Set '+CommName+' error');
  InitialCom:= shSend;
end;

发送数据

procedure SendDatatoCom(sdata: string; shSend: THandle);
var
  dwNumberOfBytesWritten, dwNumberOfBytesToWrite,
  ErrorFlag, dwWhereToStartWriting: DWORD;
  pDataToWrite: AnsiString;
  write_os: Toverlapped;
begin
  if shSend<=0 then Exit;
  dwWhereToStartWriting := 0;
  dwNumberOfBytesWritten := 0;
  dwNumberOfBytesToWrite := Length(sdata);
  if (dwNumberOfBytesToWrite = 0) then Exit;
  pDataToWrite := AnsiString(sdata);

  FillChar(Write_Os, SizeOf(write_os), 'a');
  Write_Os.hEvent := CreateEvent(nil, True, False, nil);
  SetCommMask(shSend, EV_TXEMPTY);
  repeat
    if not WriteFile(shSend, pDataToWrite[dwWhereToStartWriting+1],
      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(shSend, Write_os,
              dwNumberOfBytesWritten, False);
          end
          else
            exit;
            //raise Exception.Create('Send data failed!');
        end;
      end;
    Dec(dwNumberOfBytesToWrite, dwNumberOfBytesWritten);
    Inc(dwWhereToStartWriting, dwNumberOfBytesWritten);
  until (dwNumberOfBytesToWrite <= 0);
end;

监听端口线程
procedure Tcom_Commaction.Execute;
var
  dwEvtMask:Dword;
  Wait:Boolean;
  //OverLap:   TOverlapped;
  //lpErrors:Dword;
  //Coms1:Tcomstat;
Begin
  fillchar(lpcom_Commaction,sizeof(toverlapped),0);
  //OverLap.hEvent   :=   com_Commaction_event;

  While  true do        // (not   Terminated)
    Begin
      dwEvtMask:=0;
      try
      Wait:=WaitCommEvent(FrmCommaction.hcom_Commaction,dwevtmask,lpcom_Commaction);//@OverLap);//lpcom_Commaction);
      except
        {if Clearcommerror(FrmCommaction.hcom_Commaction,lpErrors, @Coms1) then
        begin

        end;  }
      end;
      if Wait Then
        Begin
          waitforsingleobject(com_Commaction_event,infinite);
          resetevent(com_Commaction_event);
          PostMessage(FrmCommaction.Handle,Wm_com_Commaction,0,0);
        end;
    end;

end;