xcom.pas

the best serial port component for delphi application. you can send receive serial port datas as

         ThreadSynchronize(BreakEvent);
    if (CommEventFlags and EV_CTS) <> 0 then
      begin
        if assigned(Owner.fOnCTSEvent) then
          ThreadSynchronize(CTSEvent);
      end;
    if (CommEventFlags and EV_DSR) <> 0 then
      begin
        if assigned(Owner.fOnDSREvent) then
          ThreadSynchronize(DSREvent);
      end;
    if (CommEventFlags and EV_ERR) <> 0 then
      begin
        if assigned(Owner.fOnLineErrorEvent) then
          ThreadSynchronize(LineErrorEvent);
      end;
    if (CommEventFlags and EV_RING) <> 0 then
      begin
        if assigned(Owner.fOnRingEvent) then
          ThreadSynchronize(RingEvent);
      end;
    if (CommEventFlags and EV_RLSD) <> 0 then
      begin
        if assigned(Owner.fOnRLSDEvent) then
          ThreadSynchronize(RLSDEvent);
      end;
    if (CommEventFlags and EV_RXCHAR) <> 0 then
      begin
        if assigned(Owner.fOnRxCharEvent) then
          ThreadSynchronize(RxCharEvent);
      end;
    if (CommEventFlags and EV_RXFLAG) <> 0 then
      begin
        if assigned(Owner.fOnRxEventCharEvent) then
          ThreadSynchronize(RxEventCharEvent);
      end;
    if (CommEventFlags and EV_TXEMPTY) <> 0 then
      begin
        if assigned(Owner.fOnTxQueueEmptyEvent) then
          ThreadSynchronize(TxQueueEmptyEvent);
      end;
    if CommEventFlags <> 0 then
      if assigned(Owner.fOnCommEvent) then
         ThreadSynchronize(CommEvent);
  end;

  // Fetch the ModemStatus and CommErrorCode and CommStatus and generate
  // a CommStatEvent if something changed
  procedure GetStatus;
  var ExecDoCommEvent : Boolean;
      ExecRIEvent : Boolean;
  begin
    ExecDoCommEvent := False;
    ExecRIEvent := False;
    if GetCommModemStatus(Owner.hCommPort,ModemState) then
      begin
       // There is a Bug in Win9x on signalizing the RING Event
       // We catch this manually here
       // The RingEvent is singnalize only on the falling edge of the RI!
        if Owner.Platform = VER_PLATFORM_WIN32_WINDOWS then
          begin
            if ((ModemState and MS_RING_ON) = 0) and
               ((Owner.fModemState and MS_RING_ON) <> 0) then
              // The RingIndicator Line has changed and is now False
              // generate Event
              begin
                CommEventFlags := EV_RING;
                Owner.fRingState := (ModemState and MS_RING_ON) <> 0;
                ExecDoCommEvent := True;
              end;
          end;
        if ((ModemState xor Owner.fModemState) and MS_RING_ON) <> 0 then
          ExecRIEvent := True;
        Owner.fModemState := ModemState;
// Krystian from Poland suggest to add these 3 lines and got correct states
// even if no Event is assigned.
        Owner.fCTSState := (ModemState and MS_CTS_ON) <> 0;
        Owner.fDSRState := (ModemState and MS_DSR_ON) <> 0;
        Owner.fRLSDState := (ModemState and MS_RLSD_ON) <> 0;
        Owner.fRingState := (ModemState and MS_RING_ON) <> 0;
        if ExecRIEvent and assigned(Owner.fOnRIEvent) then
          ThreadSynchronize(RIEvent);
        if ExecDoCommEvent then
          DoCommEvent;
       end
    else
      begin
        SetProcessError(9905,GetLastError,'Error getting ModemStatus',enError);
        ThreadSynchronize(ProcessError);
      end;
    if ClearCommError(owner.hCommPort, CommErrorCode, @CommStatus) then
      begin
        if (Owner.fCommError <> CommErrorCode) or
           (Owner.fCommStateFlags <> CommStatus.Flags) or
           (Owner.fCommStateInQueue <> CommStatus.cbInQue) or
           (Owner.fCommStateOutQueue <> CommStatus.cbOutQue) then
          begin
            Owner.fCommError := CommErrorCode;
            Owner.fCommStateFlags := CommStatus.Flags;
            Owner.fCommStateInQueue := CommStatus.cbInQue;
            Owner.fCommStateOutQueue := CommStatus.cbOutQue;
            if Assigned(Owner.fOnCommStat) then
              ThreadSynchronize(CommStatEvent);
          end
      end
    else
      begin
        SetProcessError(9803,GetLastError,'Error ClearCommError',enError);
        ThreadSynchronize(ProcessError);
      end
  end;

  // This local procedure checks if the Writing is done
  procedure CheckWriter;
  begin
    if Owner.fSendInProgress then
      begin
        if GetOverlappedResult(Owner.hCommPort,Owner.WriteOverlapped,WrittenBytes, FALSE) then
          begin
            Owner.fWrittenBytes := WrittenBytes;
            Owner.fSendInProgress := False;
            if WrittenBytes <> Owner.BytesToWrite then
              begin
                SetProcessError(9701,RetCode,'Error write TimeOut (WB<>BtW)'+IntToStr(WrittenBytes)+'/'+IntToStr(Owner.BytesToWrite),enError);
                ThreadSynchronize(ProcessError);
              end;
            ThreadSynchronize(WriteDone);
          end
        else
          begin
            RetCode := GetLastError;
            case RetCode of
              ERROR_IO_INCOMPLETE :;
              ERROR_IO_PENDING :
                begin
                  TickTime := GetTickCount;
                  if ((WrittenBytes*Owner.fWTOCharDelayTime)/1000+Owner.fWTOExtraDelayTime) < (Owner.WriteStartTime - TickTime) then
                    begin
                      Owner.fWrittenBytes := WrittenBytes;
                      Owner.fSendInProgress := False;
                      Owner.ResetOverlapped(Owner.WriteOverlapped);
                      SetProcessError(9701,RetCode,'Error write TimeOut',enError);
                      ThreadSynchronize(ProcessError);
                      ThreadSynchronize(WriteDone);
                    end;
                end;
            else
              // Its an Error!!!
              Owner.fSendInProgress := False;
              Owner.ResetOverlapped(Owner.WriteOverlapped);
              SetProcessError(9702,RetCode,'Error getting Overlapped Result',enError);
              ThreadSynchronize(ProcessError);
              ThreadSynchronize(WriteDone);
            end;
          end;
      end;
  end;

  //This procedure stores the received Cluster into the List
  procedure DoRxClusterStore;
  begin
    if not Owner.ShutdownInProgress then
      begin
        if BytesRead > 0 then
          begin
            GetMem(ClusterData,BytesRead);
            Move(Buffer^,ClusterData^,BytesRead);
            Cluster := TSerialCluster.Create(ClusterData,BytesRead,CommErrorCode);
          end
        else
           Cluster := TSerialCluster.Create(Nil,0,CommErrorCode);
        // The Storing of the Cluster into the Queue is done a CriticalSection
        EnterCriticalSection(Owner.CriticalSection);
        try
          Owner.RxDClusterList.Add(Cluster);
        finally
          //End of safe block
          LeaveCriticalSection(Owner.CriticalSection);
        end;
        ThreadSynchronize(RxClusterEvent);
      end;
  end;

  //Checks if Data is wainting in the RxDQueue and reads if Conditions are met
  //is called only if no Overlapp is running
  procedure ReadNoWait;
  begin
    if CommStatus.cbInQue = 0 then // No Char received
      StartTime := GetTickCount // Remember this Time as a Startpoint
    else // at least one Char was received
      begin
      // A Cluster is completed if one of the followoing conditions fit
      // - Owner request reading now
      // - cbInQue is greater than ClusterSize
      // - (cbInQue *  fRTOCharDelayTime)/1000 + fRTOExtraDelayTime is greater than the elapsed Time
      // - a (Line-) Error occoured
        TickTime := GetTickCount;
        if (Owner.fReadRequest) or
           (CommStatus.cbInQue >= Owner.ClusterSize) or
           (((CommStatus.cbInQue *  Owner.fRTOCharDelayTime)/1000 + Owner.fRTOExtraDelayTime) < (TickTime - StartTime)) or
           ((CommErrorCode and (CE_RXOVER or CE_OVERRUN or CE_RXPARITY or CE_FRAME or CE_BREAK)) <> 0) then
          begin
            BufferSize := CommStatus.cbInQue;
            GetMem(Buffer,BufferSize);
            if ReadFile(owner.hCommPort,
                               PChar(Buffer)^,
                               BufferSize,
                               BytesRead,
                               @Owner.ReadOverlapped) then
              begin //We have received something
                Owner.fReadRequest := False; // Reset the Requestflag
                DoRxClusterStore; // Store Data and fire Event...
                FreeMem(Buffer,BufferSize); // Free Buffer
                Buffer := Nil;
                StartTime := GetTickCount // Remember this Time as a Startpoint
              end
            else  // ReadFile was not successful, this may caused by the Overlapped function
              begin
                RetCode := GetLastError;
                if RetCode = ERROR_IO_PENDING then // Yes, Reading is in Progress
                  WaitForReadEvent := True
                else
                  begin // Error while reading
                    Owner.fReadRequest := False;
                    FreeMem(Buffer,BufferSize);
                    Buffer := Nil;
                    SetProcessError(9804,RetCode,'Error reading Data',enError);
                    ThreadSynchronize(ProcessError);
                  end;
              end;
          end;
      end;
  end;

  // Checks for new events
  //is called only if no Overlapp is running
  procedure CommEventNoWait;
  begin
    if WaitCommEvent(Owner.hCommPort,CommEventFlags,@Owner.StatusOverlapped) then
      begin
        GetStatus;  // Update Statusflags 25.3.2003
        DoCommEvent; // Event Occours, fire Events
      end
    else
      begin
        RetCode := GetLastError;
        if RetCode = ERROR_IO_PENDING then
          WaitForCommEvent := True //Check the Overlapped.hEvent
        else
          begin
            SetProcessError(9907,RetCode,'Error calling WaitCommEvent',enError);
            ThreadSynchronize(ProcessError);
          end;
      end;
  end;

  // Checks for received Data while an Overlapp is running
  procedure ProcessWaitForRead;
  begin
    if GetOverlappedResult(Owner.hCommPort,Owner.ReadOverlapped,BytesRead, False) then
      begin
        RetCode := GetLastError;
        if RetCode = ERROR_OPERATION_ABORTED then
          SetProcessError(9907,RetCode,'Error read aborted',enError)
        else
          SetProcessError(9908,RetCode,'Error getting Overlappedresult',enError);
        ThreadSynchronize(ProcessError);
      end
    else  // Successfull Overlapped read
      begin
        DoRxClusterStore; // Store Data and fire Event...
        FreeMem(Buffer,BufferSize); // Free Buffer
        Buffer := Nil;
        StartTime := GetTickCount // Remember this Time as a Startpoint
      end;
    WaitForReadEvent := False;
  end;

  // Checks for new Events while an Overlapp is running
  procedure ProcessWaitForComm;
  begin
    if (Owner.fActive) then
      begin
        GetStatus;
        DoCommEvent;
      end;
    WaitForCommEvent := False;
  end;


// Main Cycle of the Thread
begin
  StartTime := 0;
  WaitForCommEvent := False;
  WaitForReadEvent := False;
  ActiveMode := Owner.fActive;
  TerminateMode := Terminated;
  while not TerminateMode do
    begin
      if ActiveMode then
        begin
          Owner.WorkThreadIsRunning := True;
          if (Owner.fActive) then
            GetStatus; // Picup several Information about the actual State of Com
          CheckWriter; // Checks for pending Writeprocess
          if (not WaitForReadEvent) and (Owner.fActive) then // Start new Action only if not deactivating
            ReadNoWait; // Reads if avail, no waiting here
          if not WaitForCommEvent and (Owner.fActive) then   // Start new Action only if not deactivating
            CommEventNoWait; // Check for Events, no waiting here
          // WaitForMultiple Events
          if (WaitForReadEvent and WaitForCommEvent) then
            begin
              HandleEvent[0] := Owner.ReadOverlapped.hEvent;
              HandleEvent[1] := Owner.StatusOverlapped.hEvent;
              RetCode := WaitForMultipleObjects(2,@HandleEvent,False,75);
              if (Owner.fActive) then
                GetStatus; // Picup several Information about the actual State of Com
              case RetCode of
              WAIT_OBJECT_0 :
                begin
                  ProcessWaitForRead;
                end;
              WAIT_OBJECT_0 + 1 :
                begin
                  ProcessWaitForComm;
                end;
              WAIT_TIMEOUT :
                begin
                end;
              else
                SetProcessError(9911,RetCode,'Error getting Overlappedresult',enError);
                ThreadSynchronize(ProcessError);
                WaitForReadEvent := False;
                WaitForCommEvent := False;
              end;
            end
          else if WaitForReadEvent then
            begin
              RetCode := WaitForSingleObject(Owner.ReadOverlapped.hEvent,75);
              if (Owner.fActive) then
                GetStatus; // Picup several Information about the actual State of Com
              case RetCode of
              WAIT_OBJECT_0 :
                begin
                  if (Owner.fActive) then
                    ProcessWaitForRead;
                end;
              WAIT_TIMEOUT :
                begin
                end;
              else
                SetProcessError(9912,RetCode,'Error getting Overlappedresult',enError);
                ThreadSynchronize(ProcessError);
                WaitForReadEvent := False;
              end;
            end
          else if WaitForCommEvent then// WaitForCommEvent
            begin
              RetCode := WaitForSingleObject(Owner.StatusOverlapped.hEvent,75);
              if (Owner.fActive) then
                GetStatus; // Picup several Information about the actual State of Com
              case RetCode of
              WAIT_OBJECT_0 :
                begin
                  ProcessWaitForComm;
                end;
              WAIT_TIMEOUT :
                begin
                end;
              else
                SetProcessError(9913,RetCode,'Error getting Overlappedresult',enError);
                ThreadSynchronize(ProcessError);