serialng.pas

RS232 Source using delphi

    try
    with FIniFile do
      begin
        fCommPort := ReadString(RegSubKey, 'CommPort', dflt_CommPort);
        fBaudRate := StrToIntDef(ReadString(RegSubKey, 'BaudRate', ''),dflt_BaudRate);
        fParityType := StrToIntDef(ReadString(RegSubKey, 'ParityType', ''), dflt_ParityType);
        ParityErrorChar := CharFromStr(ReadString(RegSubKey, 'ParityErrorChar', dflt_ParityErrorChar));
        fParityErrorReplacement := ReadBool(RegSubKey, 'ParityErrorReplacement', dflt_ParityErrorReplacement);
        fStopBits := StrToIntDef(ReadString(RegSubKey, 'StopBits', ''), dflt_StopBits);
        fDataBits := StrToIntDef(ReadString(RegSubKey, 'DataBits', ''), dflt_DataBits);
        fXONChar := CharFromStr(ReadString(RegSubKey, 'XONChar', dflt_XONChar));
        fXOFFChar := CharFromStr(ReadString(RegSubKey, 'XOFFChar', dflt_XOFFChar));
        fXONLimDiv := StrToIntDef(ReadString(RegSubKey, 'XONLimDiv',''), dflt_XONLimDiv);
        fXOFFLimDiv := StrToIntDef(ReadString(RegSubKey, 'XOFFLimDiv',''), dflt_XOFFLimDiv);
        fFlowControl := StrToIntDef(ReadString(RegSubKey, 'FlowControl',''), dflt_FlowControl);
        fStripNullChars := ReadBool(RegSubKey, 'StripNullChars', dflt_StripNullChars);
        fEventChar := CharFromStr(ReadString(RegSubKey, 'EventChar', dflt_EventChar));
        fRTOCharDelayTime := StrToIntDef(ReadString(RegSubKey, 'RTOCharDelayTime',''), dflt_RTOCharDelayTime);
        fRTOExtraDelayTime := StrToIntDef(ReadString(RegSubKey, 'RTOExtraDelayTime',''), dflt_RTOExtraDelayTime);
        fClusterSize := StrToIntDef(ReadString(RegSubKey, 'ClusterSize',''), dflt_ClusterSize);
        fRxQueueSize := StrToIntDef(ReadString(RegSubKey, 'RxQueueSize',''), dflt_RxQueueSize);
        fTxQueueSize := StrToIntDef(ReadString(RegSubKey, 'TxQueueSize',''), dflt_TxQueueSize);
        fWTOCharDelayTime := StrToIntDef(ReadString(RegSubKey, 'WTOCharDelayTime',''), dflt_WTOCharDelayTime);
        fWTOExtraDelayTime := StrToIntDef(ReadString(RegSubKey, 'WTOExtraDelayTime',''), dflt_WTOExtraDelayTime);
        fXTOAuto := ReadBool(RegSubKey, 'XTOAuto', dflt_XTOAuto);
        fRTSState := ReadBool(RegSubKey, 'RTSState', dflt_RTSState);
        fDTRState := ReadBool(RegSubKey, 'DTRState', dflt_DTRState);
        fBREAKState := ReadBool  (RegSubKey, 'BREAKState', dflt_BREAKState);
        fErrorNoise := StrToIntDef(ReadString(RegSubKey, 'ErrorNoise',''), dflt_ErrorNoise);
        Active := ReadBool(RegSubKey, 'Active', False);
        ProcessError(0401,0,'Settings readed',enMsg);
      end;
    except
      ProcessError(0402,0,'Error reading Settings',enError);
    end;
  finally
    FIniFile.Free;
  end;
end;

//
// WorkThread Definitions
// The Workthread manage all the Work in the Background
// - Checks wether the writing is done
// - Checks if Data are received
// - Checks the Status
// - Calls the Events

// Saves the process error Variables
procedure TWorkThread.SetProcessError(APlace, ACode : DWord; AMsg : String; ANoise : Byte);
begin
  Place := APlace;
  Code := ACode;
  Msg := AMsg;
  Noise := ANoise;
end;

// Calls the ProcessError Eventhandler
procedure TWorkThread.ProcessError;
begin
  Owner.ProcessError(Place,Code,Msg,Noise);
end;

// Create the Thread
constructor TWorkThread.Create(AOwner : TSerialPortNG);
begin
  Owner := AOwner;
  inherited Create(False);
end;

// Events...
procedure TWorkThread.RxClusterEvent;
begin
  Owner.RxDClusterList.Add(Cluster);
  if assigned(Owner.fOnRxClusterEvent) then
    Owner.fOnRxClusterEvent(Owner);
end;
procedure TWorkThread.CommEvent;
begin
  Owner.fOnCommEvent(Owner);
end;
procedure TWorkThread.CommStatEvent;
begin
  Owner.fOnCommStat(Owner);
end;
procedure TWorkThread.BreakEvent;
begin
  Owner.fOnBreakEvent(Owner);
end;
procedure TWorkThread.CTSEvent;
begin
  Owner.fOnCTSEvent(Owner);
end;
procedure TWorkThread.DSREvent;
begin
  Owner.fOnDSREvent(Owner);
end;
procedure TWorkThread.LineErrorEvent;
begin
  Owner.fOnLineErrorEvent(Owner);
end;
procedure TWorkThread.RingEvent;
begin
  Owner.fOnRingEvent(Owner);
end;
procedure TWorkThread.RLSDEvent;
begin
  Owner.fOnRLSDEvent(Owner);
end;
procedure TWorkThread.RxCharEvent;
begin
  Owner.fOnRxCharEvent(Owner);
end;
procedure TWorkThread.RxEventCharEvent;
begin
  Owner.fOnRxEventCharEvent(Owner);
end;
procedure TWorkThread.TxQueueEmptyEvent;
begin
  Owner.fOnTxQueueEmptyEvent(Owner);
end;
procedure TWorkThread.WriteDone;
begin
  if Assigned(Owner.fOnWriteDone) then
    Owner.fOnWriteDone(Owner);
end;

//
// Workthread Maincycle
procedure TWorkThread.Execute;
var
  WrittenBytes : DWORD;
  BytesRead : DWORD;
  CommStatus : TComStat;
  CommErrorCode : DWORD;
  CommEventFlags : DWORD;
  ModemState : DWORD;
  RetCode : DWord;
  StartTime, TickTime : DWord;
  ClusterData : Pointer;
  Buffer : Pointer;
  BufferSize : DWord;
  WaitForReadEvent : Boolean;
  WaitForCommEvent : Boolean;
  HandleEvent : array[0..1] of DWord;
  ActiveMode, TerminateMode : Boolean;
  // The local Procedure evaluates the Events generated by the CommPort
  // and calles the Events of the Mainprogram
  procedure DoCommEvent;
  begin
    if Owner.ShutdownInProgress then Exit;
    Owner.fCommEvent := CommEventFlags;
    if (CommEventFlags and EV_BREAK) <> 0 then
      if assigned(Owner.fOnBreakEvent) then
         Synchronize(BreakEvent);
    if (CommEventFlags and EV_CTS) <> 0 then
      begin
        Owner.fCTSState := (ModemState and MS_CTS_ON) <> 0;
        if assigned(Owner.fOnCTSEvent) then
          Synchronize(CTSEvent);
      end;
    if (CommEventFlags and EV_DSR) <> 0 then
      begin
        Owner.fDSRState := (ModemState and MS_DSR_ON) <> 0;
        if assigned(Owner.fOnDSREvent) then
          Synchronize(DSREvent);
      end;
    if (CommEventFlags and EV_ERR) <> 0 then
      begin
        if assigned(Owner.fOnLineErrorEvent) then
          Synchronize(LineErrorEvent);
      end;
    if (CommEventFlags and EV_RING) <> 0 then
      begin
        Owner.fRingState := (ModemState and MS_RING_ON) <> 0;
        if assigned(Owner.fOnRingEvent) then
          Synchronize(RingEvent);
      end;
    if (CommEventFlags and EV_RLSD) <> 0 then
      begin
        Owner.fRLSDState := (ModemState and MS_RLSD_ON) <> 0;
        if assigned(Owner.fOnRLSDEvent) then
          Synchronize(RLSDEvent);
      end;
    if (CommEventFlags and EV_RXCHAR) <> 0 then
      begin
        if assigned(Owner.fOnRxCharEvent) then
          Synchronize(RxCharEvent);
      end;
    if (CommEventFlags and EV_RXFLAG) <> 0 then
      begin
        if assigned(Owner.fOnRxEventCharEvent) then
          Synchronize(RxEventCharEvent);
      end;
    if (CommEventFlags and EV_TXEMPTY) <> 0 then
      begin
        if assigned(Owner.fOnTxQueueEmptyEvent) then
          Synchronize(TxQueueEmptyEvent);
      end;
    if CommEventFlags <> 0 then
      if assigned(Owner.fOnCommEvent) then
         Synchronize(CommEvent);
  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',enError);
                Synchronize(ProcessError);
              end;
            Synchronize(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);
                      Synchronize(ProcessError);
                      Synchronize(WriteDone);
                    end;
                end;
            else
              // Its an Error!!!
              Owner.fSendInProgress := False;
              Owner.ResetOverlapped(Owner.WriteOverlapped);
              SetProcessError(9702,RetCode,'Error getting Overlapped Result',enError);
              Synchronize(ProcessError);
              Synchronize(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 in the Synchronize phase
        Synchronize(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);
                    Synchronize(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
      DoCommEvent // Event Occours, fire Events
    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);
            Synchronize(ProcessError);
    {Debug}                   Owner.PortWork(False);
          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);
        Synchronize(ProcessError);
      end
    else  // Successfu