xcom.pas

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

    CheckOS := VersionInfo.dwPlatformId
  else
    CheckOS := -1;
end;

// Help function to collect CommPortNames
procedure GetPortList(Strings : TStrings);
var Reg : TRegistry;

  procedure ScanRegHardware;
  var
    i : integer;
    PortName : string;
    LName : TStringList;
  begin
    if Reg.OpenKeyReadOnly('\hardware\devicemap\serialcomm') then
      begin
        LName := TStringList.Create;
        Reg.GetValueNames(LName);
        for i := 0 to LName.Count - 1 do
          begin
            if Reg.GetDataType(LName.Strings[i]) = rdString then
              begin
                PortName := Reg.ReadString(LName.Strings[i]);
                if Strings.IndexOf(PortName) < 0 then
                  Strings.Add(PortName);
              end
          end;
        LName.Free;
      end
  end;

  procedure ScanRegEnum(Key : String);
  // This Subprocedure recurses thru all keys below key
  var
    LKey : TStringList;
    LName : TStringList;
    i : Integer;
    Driver, PortName : String;
    PortSubClass : Byte;
  begin
    if not Reg.OpenKeyReadOnly(Key) then // Danke Andreas Schmidt!
      Exit;
    LName := TStringList.Create;
    Reg.GetValueNames(LName);
    i := LName.IndexOf('class');
    if i >= 0 then
      begin
        if (Reg.GetDataType('class') = rdString) and
           ((LowerCase(Reg.ReadString('class')) = 'ports') or    //normal Serialports like COMx
            (LowerCase(Reg.ReadString('class')) = 'modem')) and  //some abnormal onboard Modems
           (Reg.GetDataType('driver') = rdString) and
           (Reg.GetDataType('portname') = rdString) then
          begin
            Driver := Reg.ReadString('driver');
            PortName := Reg.ReadString('portname');
            if Reg.OpenKeyReadOnly('\System\CurrentControlSet\Services\Class\'+ Driver) and
               (Reg.ReadBinaryData('PortSubClass',PortSubClass,1) = 1) and
               ((PortSubClass = 1) or    //Ports
                (PortSubClass = 2)) and  //Modems
               (Strings.IndexOf(PortName) < 0) then
                 Strings.Add(PortName);
          end
      end;
    LName.Free;
    Reg.OpenKeyReadOnly(Key);
    if Reg.HasSubKeys then
      begin
        LKey := TStringList.Create;
        Reg.GetKeyNames(LKey);
        for i := 0 to LKey.Count - 1 do
          begin
            ScanRegEnum(Key + '\' + LKey[i]);
          end;
        LKey.Free;
      end;
  end;

var
  VersionInfo : TOSVersionInfo;
begin
  if CheckOS(VersionInfo) > 0 then
    if VersionInfo.dwMajorVersion >= 4 then
      begin
        Reg := TRegistry.Create;
        Reg.RootKey := HKEY_LOCAL_MACHINE;
        if VersionInfo.dwMajorVersion > 4 then
          ScanRegHardware //Win 2k, XP
        else if VersionInfo.dwMinorVersion > 0 then
          ScanRegEnum('\enum') //Win9x, mE
        else
          ScanRegHardware; //WinNT
        Reg.Free;
      end;
end;

constructor TSerialCluster.Create(Data : Pointer; Size : Integer; CCError : DWord);
begin
  inherited Create;
  ClusterData := Data; // Take the Pointer
  ClusterSize := Size; // Size of Data
  ClusterCCError := CCError;
end;

function TSerialCluster.GetCCError : DWord;
begin
  GetCCError := ClusterCCError;
end;

function TSerialCluster.GetSize : Integer;
begin
  GetSize := ClusterSize;
end;

procedure TSerialCluster.GetData(Dest : Pointer);
begin
  if Dest <> Nil then
    Move(ClusterData^, Dest^, ClusterSize);
end;

function TSerialCluster.GetDataAsString : String;
var S : String;
begin
  SetLength(S,ClusterSize);
  Move(ClusterData^, S[1], ClusterSize);
  GetDataAsString := S;
end;

function TSerialCluster.GetDataAsPChar(Dest : PChar) : PChar;
type TMaxSize = array[0..MaxLongInt-1] of Char;
     PMaxSize = ^TMaxSize;
begin
  if Dest <> Nil then
    begin
      Move(ClusterData^, Dest^, ClusterSize);
      PMaxSize(Dest)^[ClusterSize] := #0;
    end;
  GetDataAsPChar := Dest;
end;

destructor TSerialCluster.Destroy;
begin
  Dispose(ClusterData);
  inherited Destroy;
end;

procedure TXCom.SetCommPort(value : ShortString);
begin
  if value <> fCommPort then
    begin
      fCommPort := value;
      PortWork(fActive);
    end;
end;

procedure TXCom.SetBaudRate(value : DWord);
begin
  if value <> fBaudRate then
    begin
      fBaudRate := value;
      if fXTOAuto then
        XTODefault; // Adjust the CharDelay Timeouts
      if fActive then
        SetupDCB;
    end;
end;

procedure TXCom.SetStx(value : Byte);
begin
  if value <> fRCPStx then
    begin
      fRCPStx:= value;
    end;
end;

procedure TXCom.SetDeviceAdr(value : Byte);
begin
  if value <> fDeviceAdr then
    begin
      fDeviceAdr := value;
    end;
end;

procedure TXCom.SetParityType(value : Byte);
begin
  if value <> fParityType then
    begin
      fParityType := value;
      if fActive then
        SetupDCB;
    end;
end;

procedure TXCom.SetParityErrorChar(value : Char);
begin
  if value <> fParityErrorChar then
    begin
      fParityErrorChar := value;
      if fActive then
        SetupDCB;
    end;
end;

procedure TXCom.SetParityErrorReplacement(value : Boolean);
begin
  if value <> fParityErrorReplacement then
    begin
      fParityErrorReplacement := value;
      if fActive then
        SetupDCB;
    end;
end;

procedure TXCom.SetStopBits(value : Byte);
begin
  if value <> fStopBits then
    begin
      fStopBits := value;
      if fActive then
        SetupDCB;
    end;
end;

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

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

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

procedure TXCom.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 TXCom.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 TXCom.SetFlowControl(value : LongInt);
begin
  if value <> fFlowControl then
    begin
      fFlowControl := value;
      if fActive then
        SetupDCB;
    end;
end;

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

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

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

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

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

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

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

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

procedure TXCom.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 TXCom.SetTxQueueSize(value : Word);
begin
  if value <> fTxQueueSize then
    begin