serialng.~pas

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

procedure TSerialPortNG.WorkThreadDone(Sender: TObject);
begin
  WorkThreadIsRunning := False;
end;

// Public Method to fit the TimeOut Values to the current Baudrate
// If the Property XTOAuto is true this method will be called from the SetBaud method
procedure TSerialPortNG.XTODefault;
var i : Integer;
    NewXTO : DWord;
begin
  NewXTO := 1100;
  for i := 0 to BaudRateCount-1 do
    begin
      if fBaudRate >= BaudRates[i] then
        NewXTO := XTOCharDelayDef[i];
    end;
  SetRTOCharDelayTime(NewXTO);
  SetWTOCharDelayTime(NewXTO);
end;

// Saves all Setting into the Registry
// e.g. WriteSettings('Software/DomIS','SerialNGAdvDemo')
// will save to HKEY_CURRENT_USER\Software\DomIS\SerialAdvDemo
procedure TSerialPortNG.WriteSettings(Regkey, RegSubKey : String);

var FIniFile : TRegIniFile;
begin
  FIniFile := TRegIniFile.Create(RegKey);
  try
    try
    with FIniFile do
      begin
        WriteString(RegSubKey, 'CommPort', fCommPort);
        WriteString(RegSubKey, 'BaudRate', IntToStr(fBaudRate));
        WriteString(RegSubKey, 'ParityType', IntToStr(fParityType));
        WriteString(RegSubKey, 'ParityErrorChar', fParityErrorChar);
        WriteBool  (RegSubKey, 'ParityErrorReplacement', fParityErrorReplacement);
        WriteString(RegSubKey, 'StopBits', IntToStr(fStopBits));
        WriteString(RegSubKey, 'DataBits', IntToStr(fDataBits));
        WriteString(RegSubKey, 'XONChar', fXONChar);
        WriteString(RegSubKey, 'XOFFChar', fXOFFChar);
        WriteString(RegSubKey, 'XONLimDiv', IntToStr(fXONLimDiv));
        WriteString(RegSubKey, 'XOFFLimDiv', IntToStr(fXOFFLimDiv));
        WriteString(RegSubKey, 'FlowControl', IntToStr(fFlowControl));
        WriteBool  (RegSubKey, 'StripNullChars', fStripNullChars);
        WriteString(RegSubKey, 'EventChar', fEventChar);
        WriteString(RegSubKey, 'RTOCharDelayTime', IntToStr(fRTOCharDelayTime));
        WriteString(RegSubKey, 'RTOExtraDelayTime', IntToStr(fRTOExtraDelayTime));
        WriteString(RegSubKey, 'ClusterSize', IntToStr(fClusterSize));
        WriteString(RegSubKey, 'RxQueueSize', IntToStr(fRxQueueSize));
        WriteString(RegSubKey, 'TxQueueSize', IntToStr(fTxQueueSize));
        WriteString(RegSubKey, 'WTOCharDelayTime', IntToStr(fWTOCharDelayTime));
        WriteString(RegSubKey, 'WTOExtraDelayTime', IntToStr(fWTOExtraDelayTime));
        WriteBool  (RegSubKey, 'XTOAuto', fXTOAuto);
        WriteBool  (RegSubKey, 'RTSState', fRTSState);
        WriteBool  (RegSubKey, 'DTRState', fDTRState);
        WriteBool  (RegSubKey, 'BREAKState', fBREAKState);
        WriteString(RegSubKey, 'ErrorNoise', IntToStr(fErrorNoise));
        WriteBool  (RegSubKey, 'Active', FActive);
        ProcessError(0501,0,'Settings saved',enMsg);
      end;
    except
      ProcessError(0502,0,'Error saving Settings',enError);
    end;
  finally
    FIniFile.Free;
  end;
end;

// Read all Settings from the Registry
// e.g. ReadSettings('Software/DomIS','SerialNGAdvDemo')
// will read from HKEY_CURRENT_USER\Software\DomIS\SerialAdvDemo
procedure TSerialPortNG.ReadSettings(Regkey, RegSubKey : String);
var FIniFile : TRegIniFile;
    Activate : Boolean;
    function CharFromStr(S : String):Char;
    begin
      if Length(S) > 0 then
        CharFromStr := S[1]
      else
        CharFromStr := #0;
    end;

begin
  FIniFile := TRegIniFile.Create(RegKey);
  try
    try
    with FIniFile do
      begin
        Activate := ReadBool(RegSubKey, 'Active', False); //Read the Active Flag into a save place
        if Activate then
        // The Port should be activated
        // if the Port is the same as opened, the port stays open
          CommPort := ReadString(RegSubKey, 'CommPort', dflt_CommPort)
        else
          begin
          // The Port should be deactivated
            Active := False; // Deactivate
            fCommPort := ReadString(RegSubKey, 'CommPort', dflt_CommPort) //Store new name
          end;
        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 := Activate; //After all force the new settings
        ProcessError(0401,0,'Settings readed',enMsg);
      end;
    except
      ProcessError(0402,0,'Error reading Settings',enError);
    end;
  finally
    FIniFile.Free;
  end;
end;

procedure TSerialPortNG.WaitForThreadNotRunning(Counter : Integer);
begin
  while (Counter  > 0) and
     (WorkThreadIsRunning) do
    begin
      Sleep(75);
      Dec(Counter);
    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
  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.RIEvent;
begin
  Owner.fOnRIEvent(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;

procedure TWorkThread.ThreadSynchronize(Method: TThreadMethod);
begin
  if not Owner.fThreadQuietMode then
    Synchronize(Method);
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
         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;
      ClrCommErrDone : 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