xcom.pas

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

procedure TXCom.SendArray(S : array of byte;L : Integer);
var
I:DWord;
begin
if L=0 then I:=Length(S) else I:=DWord(L);
  if Length(S) > 0 then
    SendData(@S[1], I);
end;

function TXCom.NextClusterSize : Integer;
begin
  EnterCriticalSection(CriticalSection);
  try
    if RxDClusterList.Count > 0 then
      if RxDClusterList.Items[0] = Nil then
          RxDClusterList.Pack;
    if RxDClusterList.Count > 0 then
      NextClusterSize := TSerialCluster(RxDClusterList.Items[0]).GetSize
    else
      NextClusterSize := -1;
  finally
    LeaveCriticalSection(CriticalSection);
  end;
end;

function TXCom.NextClusterCCError : DWord;
begin
  EnterCriticalSection(CriticalSection);
  try
    if RxDClusterList.Count > 0 then
      if RxDClusterList.Items[0] = Nil then
          RxDClusterList.Pack;
    if RxDClusterList.Count > 0 then
      NextClusterCCError := TSerialCluster(RxDClusterList.Items[0]).GetCCError
    else
      NextClusterCCError := MAXDWORD;
  finally
    LeaveCriticalSection(CriticalSection);
  end;
end;

function TXCom.ReadNextCluster(var ClusterSize : Integer; var CCError : DWord) : Pointer;
var DataBuffer : Pointer;
begin
  EnterCriticalSection(CriticalSection);
  try
    if RxDClusterList.Count > 0 then
      if RxDClusterList.Items[0] = Nil then
          RxDClusterList.Pack;
    if RxDClusterList.Count > 0 then
      begin
        CCError := TSerialCluster(RxDClusterList.Items[0]).GetCCError;
        ClusterSize := TSerialCluster(RxDClusterList.Items[0]).GetSize;
        GetMem(DataBuffer, ClusterSize);
        TSerialCluster(RxDClusterList.Items[0]).GetData(DataBuffer);
        TSerialCluster(RxDClusterList.Items[0]).Free;
        RxDClusterList.Delete(0);
        ReadNextCluster := DataBuffer;
      end
    else
      begin
        ClusterSize := -1;
        CCError := MAXDWORD;
        ReadNextCluster := Nil;
      end;
  finally
    LeaveCriticalSection(CriticalSection);
  end;
end;

function TXCom.ReadNextClusterAsString : String;
begin
  EnterCriticalSection(CriticalSection);
  try
    if RxDClusterList.Count > 0 then
      if RxDClusterList.Items[0] = Nil then
          RxDClusterList.Pack;
    if RxDClusterList.Count > 0 then
      begin
        ReadNextClusterAsString := TSerialCluster(RxDClusterList.Items[0]).GetDataAsString;
        TSerialCluster(RxDClusterList.Items[0]).Free;
        RxDClusterList.Delete(0);
      end
    else
      ReadNextClusterAsString := '';
  finally
    LeaveCriticalSection(CriticalSection);
  end;
end;

function TXCom.ReadNextClusterAsPChar(Dest : PChar) : PChar;
begin
  EnterCriticalSection(CriticalSection);
  try
    if Dest <> Nil then
      begin
        if RxDClusterList.Count > 0 then
          if RxDClusterList.Items[0] = Nil then
              RxDClusterList.Pack;
        if RxDClusterList.Count > 0 then
          begin
            ReadNextClusterAsPChar := TSerialCluster(RxDClusterList.Items[0]).GetDataAsPChar(Dest);
            TSerialCluster(RxDClusterList.Items[0]).Free;
            RxDClusterList.Delete(0);
          end
        else
          ReadNextClusterAsPChar := Nil;
      end
    else
      ReadNextClusterAsPChar := Nil;
  finally
    LeaveCriticalSection(CriticalSection);
  end;
end;

// Private Method
procedure TXCom.WorkThreadDone(Sender: TObject);
begin
  WorkThreadIsRunning := False;
end;

procedure TXCom.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;

procedure TXCom.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, 'DeviceAddress', IntToStr(fDeviceAdr));
        WriteString(RegSubKey, 'StartofText', IntToStr(fRCPStx));
        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;

procedure TXCom.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);
        fDeviceAdr:= StrToIntDef(ReadString(RegSubKey, 'DeviceAddress', ''),dflt_DeviceAdr);
        fRCPStx:= StrToIntDef(ReadString(RegSubKey, 'StartofText', ''),dflt_Stx);
        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 TXCom.WaitForThreadNotRunning(Counter : Integer);
begin
  while (Counter  > 0) and
     (WorkThreadIsRunning) do
    begin
      Sleep(75); //???
      Dec(Counter);
    end;
end;

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 : TXCom);
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);
   // 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