serialng.pas

用SerialNG组件写的一个串口通信程序,在delphi7下测试通过

procedure TSerialPortNG.SetDataBits(value : Byte);
begin
  if value <> fDataBits then
    begin
      fDataBits := value;
      if fActive then
        SetupDCB;
    end;
end;

procedure TSerialPortNG.SetXONChar(value : Char);
begin
  if value <> fXONChar then
    begin
      fXONChar := value;
      if fActive then
        SetupDCB;
    end;
end;

procedure TSerialPortNG.SetXOFFChar(value : Char);
begin
  if value <> fXOFFChar then
    begin
      fXOFFChar := value;
      if fActive then
        SetupDCB;
    end;
end;

procedure TSerialPortNG.SetXONLimDiv(value : Byte);
begin
  if value <> fXONLimDiv then
    begin
      if value > 100 then
        begin
          ProcessError(0100,value,'Warning XOnLimDef set to 100',enWarning);
          value := 100;
        end;
      fXONLimDiv := value;
      if fActive then
        SetupDCB;
    end;
end;

procedure TSerialPortNG.SetXOFFLimDiv(value : Byte);
begin
  if value <> fXOFFLimDiv then
    begin
      if value > 100 then
        begin
          ProcessError(0100,value,'Warning XOffLimDef set to 100',enWarning);
          value := 100;
        end;
      fXOFFLimDiv := value;
      if fActive then
        SetupDCB;
    end;
end;

procedure TSerialPortNG.SetFlowControl(value : LongInt);
begin
  if value <> fFlowControl then
    begin
      fFlowControl := value;
      if fActive then
        SetupDCB;
    end;
end;

procedure TSerialPortNG.SetStripNullChars(value : Boolean);
begin
  if value <> fStripNullChars then
    begin
      fStripNullChars := value;
      if fActive then
        SetupDCB;
    end;
end;

procedure TSerialPortNG.SetEventChar(value : Char);
begin
  if value <> fEventChar then
    begin
      fEventChar := value;
      if fActive then
        SetupDCB;
    end;
end;

procedure TSerialPortNG.SetRTOCharDelayTime(value : DWord);
begin
  if value <> fRTOCharDelayTime then
    fRTOCharDelayTime := value;
end;

procedure TSerialPortNG.SetRTOExtraDelayTime(value : Word);
begin
  if value <> fRTOExtraDelayTime then
    fRTOExtraDelayTime := value;
end;

procedure TSerialPortNG.SetWTOCharDelayTime(value : DWord);
begin
  if value <> fWTOCharDelayTime then
    begin
      fWTOCharDelayTime := value;
      if fActive then
        SetupDCB;
    end;
end;

procedure TSerialPortNG.SetWTOExtraDelayTime(value : Word);
begin
  if value <> fWTOExtraDelayTime then
    begin
      fWTOExtraDelayTime := value;
      if fActive then
        SetupDCB;
    end;
end;

procedure TSerialPortNG.SetXTOAuto(value : Boolean);
begin
  if value <> fXTOAuto then
    begin
      fXTOAuto := value;
      if fXTOAuto then
        XTODefault;
    end;
end;

procedure TSerialPortNG.SetClusterSize(value : Word);
begin
  fClusterSize := value;
end;

procedure TSerialPortNG.SetRxQueueSize(value : Word);
begin
  if value <> fRxQueueSize then
    begin
      fRxQueueSize := value;
      if not SetupComm(hCommPort,fRxQueueSize,fTxQueueSize) then
        ProcessError(0101,GetLastError,'Error can not set Quesize',enError);
    end;
end;

procedure TSerialPortNG.SetTxQueueSize(value : Word);
begin
  if value <> fTxQueueSize then
    begin
      fTxQueueSize := value;
      if not SetupComm(hCommPort,fRxQueueSize,fTxQueueSize) then
        ProcessError(0102,GetLastError,'Error can not set Quesize',enError);
    end;
end;

procedure TSerialPortNG.SetErrorNoise(value : Byte);
begin
  fErrorNoise := value;
end;

procedure TSerialPortNG.SetReadRequest(value : Boolean);
begin
  fReadRequest := value;
end;

procedure TSerialPortNG.SetActive(NewState : Boolean);
begin
  // You may expect that this function set only the fActive Value
  // This is done by the PortWork procedure, depending from the successful
  // opened Port
  if NewState <> fActive then
    PortWork(NewState);
end;

//
// Several Methods

procedure TSerialPortNG.ProcessError(Place, Code : DWord; Msg : String; Noise : Byte);
begin
  if ShutdownInProgress then Exit; // No Messages now the Component is in Destroystate
  if Noise <= fErrorNoise then
    if assigned(fOnProcessError) then
      fOnProcessError(Self,Place,Code,Msg,Noise); //Owner replaced by Self
end;

procedure TSerialPortNG.InitOverlapped(var Overlapped : TOverlapped);
begin
  Overlapped.Offset := 0;
  Overlapped.OffsetHigh := 0;
  Overlapped.Internal := 0;
  Overlapped.InternalHigh := 0;
  Overlapped.hEvent := CreateEvent(nil,True,False,'');
  if Overlapped.hEvent = 0 then
    ProcessError(1001,GetLastError,'Error Creating Overlapped Event',enError)
  else if GetLastError = ERROR_ALREADY_EXISTS then
    ProcessError(1002,ERROR_ALREADY_EXISTS,'Error Overlapped Event Exists',enError)
end;

procedure TSerialPortNG.ResetOverlapped(var Overlapped : TOverlapped);
begin
  if not ResetEvent(Overlapped.hEvent) then
    ProcessError(1101,GetLastError,'Error resetting Overlapped Event',enError);
end;

procedure TSerialPortNG.SetOverlapped(var Overlapped : TOverlapped);
begin
  if not SetEvent(Overlapped.hEvent) then
// EVENT_MODIFY_STATE
    ProcessError(1101,GetLastError,'Error resetting Overlapped Event',enError);
end;


//
// Create method.
constructor TSerialPortNG.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  InitializeCriticalSection(CriticalSection); 
  ShutdownInProgress := False;
  hCommPort := INVALID_HANDLE_VALUE;

  // Set initial settings.  Even though
  // the default parameter was specified
  // in the property, if you were to
  // create a component at runtime, the
  // defaults would not get set.  So it
  // is important to call them again in
  // the create of the component.
  fCommPort := dflt_CommPort;
  fBaudRate := dflt_BaudRate;
  fParityType := dflt_ParityType;
  fStopBits := dflt_StopBits;
  fDataBits := dflt_DataBits;
  fXONChar := dflt_XONChar;
  fXOFFChar := dflt_XOFFChar;
  fXONLimDiv := dflt_XONLimDiv;
  fXOFFLimDiv := dflt_XOFFLimDiv;
  fFlowControl := dflt_FlowControl;
  fRTOCharDelayTime := dflt_RTOCharDelayTime;
  fRTOExtraDelayTime := dflt_RTOExtraDelayTime;
  fWTOCharDelayTime := dflt_WTOCharDelayTime;
  fWTOExtraDelayTime := dflt_WTOExtraDelayTime;
  fXTOAuto := dflt_XTOAuto;
  fClusterSize := dflt_ClusterSize;
  fRxQueueSize := dflt_RxQueueSize;
  fTxQueueSize := dflt_TxQueueSize;
  fErrorNoise := enAll;
  fReadRequest := False;
  fRTSState := dflt_RTSState;
  fDTRState := dflt_DTRState;
  fBREAKState := dflt_BREAKState;
  fOnTxQueueEmptyEvent := Nil;
  fOnBreakEvent := Nil;
  fOnCTSEvent := Nil;
  fOnDSREvent := Nil;
  fOnLineErrorEvent := Nil;
  fOnRingEvent := Nil;
  fOnRLSDEvent := Nil;
  fOnRxCharEvent := Nil;
  fOnRxEventCharEvent := Nil;
  fOnRxClusterEvent := Nil;
  fOnProcessError := Nil;
  fThreadQuietMode := dflt_ThreadQuietMode;
  fAutoReadRequest := dflt_AutoReadRequest;
  LastErr := 0;
  RxDClusterList := TList.Create; // Create the List to store the received Clusters
  InitOverlapped(WriteOverlapped);
  InitOverlapped(ReadOverlapped);
  InitOverlapped(StatusOverlapped);
  WorkThread := TWorkThread.Create(Self);
  WorkThread.OnTerminate := WorkThreadDone;
end;

// Destroy method.
destructor TSerialPortNG.Destroy;
var i : Integer;
begin
  ShutdownInProgress := True;
  PortWork(False);
  WorkThread.Terminate;
  WaitForThreadNotRunning(10);
  CloseHandle(WriteOverlapped.hEvent);
  CloseHandle(StatusOverlapped.hEvent);
  CloseHandle(ReadOverlapped.hEvent);
  for i := 0 to RxDClusterList.Count-1 do
    begin
      if RxDClusterList.Items[i] <> Nil then
        begin
          TSerialCluster(RxDClusterList.Items[i]).Free;
          RxDClusterList.Items[i] := Nil;
        end;
    end;
  RxDClusterList.Free;
  WorkThread.Free;
  DeleteCriticalSection(CriticalSection);
  inherited Destroy;
end;

// PortWork Closes or Opens the Port depending of the Parm
// It sets the fActive Variable depending of result of Opening the Port
procedure TSerialPortNG.PortWork(ReOpen : Boolean);
var
  CommPortName : array [0..127] of Char;
begin
  if fActive then // The Port is Open, Close first
    begin
      ProcessError(0100,0,'Msg start deactivating Port',enMsg);
      if not SetCommMask(hCommPort,0) then
        ProcessError(0101,GetLastError,'Error disabling CommEvents',enError);
      fActive := False; // The WorkThread check this Flag
      if not PurgeComm(hCommPort, PURGE_RXABORT or PURGE_RXCLEAR or PURGE_TXABORT or PURGE_TXCLEAR) then
        ProcessError(0102,GetLastError,'Error clearing Queues',enError);
      WaitForThreadNotRunning(15);
      if WorkThreadIsRunning then
        ProcessError(0104,0,'Warning ThreadIsRunning',enWarning);
      SetSignalDTR(False);
      SetSignalRTS(False);
      if not CloseHandle(hCommPort) then
        ProcessError(0103,GetLastError,'Error closing Port',enError);
      hCommPort := INVALID_HANDLE_VALUE;
    end;
// The Port is Closed, the Thread is Idle
  if  ReOpen then
    begin // Reopen the Port with (new) Parms
      ProcessError(0110,0,'Msg start reactivating Port',enMsg);
      hCommPort := CreateFile(StrPCopy(CommPortName,'\\.\'+Copy(fCommPort,1,79)),
            GENERIC_READ OR GENERIC_WRITE,
            0,
            nil,
            OPEN_EXISTING,
            FILE_FLAG_OVERLAPPED,0);
      fActive := (hCommPort <> INVALID_HANDLE_VALUE);
      if fActive then