unit uSerialComm;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, System.SyncObjs,
  System.Win.Registry, System.Bluetooth;

type
  TParityType = (ptNone, ptOdd, ptEven, ptMark, ptSpace);
  TStopBitsType = (sbtOne, sbtOnePointFive, sbtTwo);
  TFlowControlType = (fctNone, fctRtsCts, fctXonXoff);

  TRxDataEvent = procedure(Sender: TObject; const Buffer: TBytes) of object;
  TRxStringEvent = procedure(Sender: TObject; const Text: string) of object;
  TStatusChangeEvent = procedure(Sender: TObject; Connected: Boolean; const Msg: string) of object;
  TErrorEvent = procedure(Sender: TObject; const ErrorMsg: string) of object;

  TSerialPort = class;

  { Hilo lector de datos del puerto serie }
  TSerialReadThread = class(TThread)
  private
    FOwner: TSerialPort;
    FBuffer: TBytes;
    FBytesRead: Integer;
    procedure DispatchRxData;
  protected
    procedure Execute; override;
  public
    constructor Create(AOwner: TSerialPort);
  end;

  { Componente / Clase de gestión de puerto serie }
  TSerialPort = class
  private
    FHandle: THandle;
    FPortName: string;
    FBaudRate: Integer;
    FDataBits: Byte;
    FParity: TParityType;
    FStopBits: TStopBitsType;
    FFlowControl: TFlowControlType;
    FConnected: Boolean;
    FReadThread: TSerialReadThread;
    FLock: TCriticalSection;
    
    FOnRxData: TRxDataEvent;
    FOnRxString: TRxStringEvent;
    FOnStatusChange: TStatusChangeEvent;
    FOnError: TErrorEvent;

    FTotalBytesReceived: Int64;
    FLastRxTime: TDateTime;

    procedure DoRxData(const Buffer: TBytes);
    procedure DoStatusChange(AConnected: Boolean; const AMsg: string);
    procedure DoError(const AMsg: string);
    function ConfigureDCB: Boolean;
    function ConfigureTimeouts: Boolean;
  public
    constructor Create;
    destructor Destroy; override;

    function Open: Boolean;
    procedure Close;
    function SendString(const S: string): Boolean;
    function SendBytes(const B: TBytes): Boolean;

    procedure ResetStats;
    function GetModemStatus(out ACTS, ADSR, ARing, ARLSD: Boolean): Boolean;
    procedure SetLineDTR(Active: Boolean);
    procedure SetLineRTS(Active: Boolean);

    class procedure GetAvailablePorts(AList: TStrings);
    class procedure GetPairedBluetoothDevices(AList: TStrings);

    property Connected: Boolean read FConnected;
    property PortName: string read FPortName write FPortName;
    property BaudRate: Integer read FBaudRate write FBaudRate;
    property DataBits: Byte read FDataBits write FDataBits;
    property Parity: TParityType read FParity write FParity;
    property StopBits: TStopBitsType read FStopBits write FStopBits;
    property FlowControl: TFlowControlType read FFlowControl write FFlowControl;

    property TotalBytesReceived: Int64 read FTotalBytesReceived;
    property LastRxTime: TDateTime read FLastRxTime;

    property OnRxData: TRxDataEvent read FOnRxData write FOnRxData;
    property OnRxString: TRxStringEvent read FOnRxString write FOnRxString;
    property OnStatusChange: TStatusChangeEvent read FOnStatusChange write FOnStatusChange;
    property OnError: TErrorEvent read FOnError write FOnError;
  end;

implementation

{ TSerialReadThread }

constructor TSerialReadThread.Create(AOwner: TSerialPort);
begin
  inherited Create(True);
  FOwner := AOwner;
  FreeOnTerminate := False;
  SetLength(FBuffer, 4096);
end;

procedure TSerialReadThread.DispatchRxData;
var
  DataChunk: TBytes;
begin
  if (FBytesRead > 0) and Assigned(FOwner) then
  begin
    SetLength(DataChunk, FBytesRead);
    Move(FBuffer[0], DataChunk[0], FBytesRead);
    FOwner.DoRxData(DataChunk);
  end;
end;

procedure TSerialReadThread.Execute;
var
  ReadCount: DWORD;
  Errors: DWORD;
  ComStat: TComStat;
begin
  while not Terminated do
  begin
    if (FOwner.FHandle = INVALID_HANDLE_VALUE) or (not FOwner.FConnected) then
      Break;

    ClearCommError(FOwner.FHandle, Errors, @ComStat);

    if ComStat.cbInQue > 0 then
    begin
      ReadCount := ComStat.cbInQue;
      if ReadCount > DWORD(Length(FBuffer)) then
        ReadCount := DWORD(Length(FBuffer));

      if ReadFile(FOwner.FHandle, FBuffer[0], ReadCount, ReadCount, nil) and (ReadCount > 0) then
      begin
        FBytesRead := ReadCount;
        Synchronize(DispatchRxData);
      end;
    end
    else
    begin
      // Esperar brevemente para no saturar la CPU
      Sleep(20);
    end;
  end;
end;

{ TSerialPort }

constructor TSerialPort.Create;
begin
  inherited Create;
  FHandle := INVALID_HANDLE_VALUE;
  FConnected := False;
  FPortName := 'COM1';
  FBaudRate := 9600;
  FDataBits := 8;
  FParity := ptNone;
  FStopBits := sbtOne;
  FFlowControl := fctNone;
  FLock := TCriticalSection.Create;
end;

destructor TSerialPort.Destroy;
begin
  Close;
  FLock.Free;
  inherited Destroy;
end;

function TSerialPort.ConfigureDCB: Boolean;
var
  DCB: TDCB;
begin
  Result := False;
  FillChar(DCB, SizeOf(DCB), 0);
  DCB.DCBlength := SizeOf(DCB);

  if not GetCommState(FHandle, DCB) then
    Exit;

  DCB.BaudRate := FBaudRate;
  DCB.ByteSize := FDataBits;

  case FParity of
    ptNone:  DCB.Parity := NOPARITY;
    ptOdd:   DCB.Parity := ODDPARITY;
    ptEven:  DCB.Parity := EVENPARITY;
    ptMark:  DCB.Parity := MARKPARITY;
    ptSpace: DCB.Parity := SPACEPARITY;
  end;

  case FStopBits of
    sbtOne:         DCB.StopBits := ONESTOPBIT;
    sbtOnePointFive: DCB.StopBits := ONE5STOPBITS;
    sbtTwo:         DCB.StopBits := TWOSTOPBITS;
  end;

  DCB.Flags := 1; // fBinary = 1
  if FParity <> ptNone then
    DCB.Flags := DCB.Flags or 2; // fParity = 1

  case FFlowControl of
    fctNone:
    begin
      // Sin control de flujo
    end;
    fctRtsCts:
    begin
      DCB.Flags := DCB.Flags or (1 shl 2); // fOutxCtsFlow = 1
      DCB.Flags := DCB.Flags or (2 shl 12); // fRtsControl = HANDSHAKE
    end;
    fctXonXoff:
    begin
      DCB.Flags := DCB.Flags or (1 shl 8); // fOutX = 1
      DCB.Flags := DCB.Flags or (1 shl 9); // fInX = 1
    end;
  end;

  Result := SetCommState(FHandle, DCB);
end;

function TSerialPort.ConfigureTimeouts: Boolean;
var
  Timeouts: TCommTimeouts;
begin
  Timeouts.ReadIntervalTimeout := MAXDWORD;
  Timeouts.ReadTotalTimeoutMultiplier := 0;
  Timeouts.ReadTotalTimeoutConstant := 0;
  Timeouts.WriteTotalTimeoutMultiplier := 0;
  Timeouts.WriteTotalTimeoutConstant := 1000;
  Result := SetCommTimeouts(FHandle, Timeouts);
end;

function TSerialPort.Open: Boolean;
var
  DevicePath: string;
begin
  Result := False;
  if FConnected then
    Close;

  FLock.Enter;
  try
    DevicePath := '\\.\' + FPortName;

    FHandle := CreateFile(
      PChar(DevicePath),
      GENERIC_READ or GENERIC_WRITE,
      0, // Sin compartir
      nil,
      OPEN_EXISTING,
      FILE_ATTRIBUTE_NORMAL,
      0
    );

    if FHandle = INVALID_HANDLE_VALUE then
    begin
      DoError(Format('No se pudo abrir el puerto %s (Error Windows: %d). Comprueba que el dispositivo Bluetooth esté vinculado y encendido.',
        [FPortName, GetLastError]));
      Exit;
    end;

    if not ConfigureDCB then
    begin
      DoError(Format('Error al configurar parámetros de comunicación en %s.', [FPortName]));
      CloseHandle(FHandle);
      FHandle := INVALID_HANDLE_VALUE;
      Exit;
    end;

    if not ConfigureTimeouts then
    begin
      DoError(Format('Error al configurar timeouts en %s.', [FPortName]));
      CloseHandle(FHandle);
      FHandle := INVALID_HANDLE_VALUE;
      Exit;
    end;

    // Limpiar buffers
    PurgeComm(FHandle, PURGE_TXABORT or PURGE_RXABORT or PURGE_TXCLEAR or PURGE_RXCLEAR);

    // Activar líneas DTR y RTS (fundamental para adaptadores Bluetooth RS232 y básculas)
    EscapeCommFunction(FHandle, Winapi.Windows.SETDTR);
    EscapeCommFunction(FHandle, Winapi.Windows.SETRTS);

    ResetStats;

    FConnected := True;
    
    // Iniciar hilo lector
    FReadThread := TSerialReadThread.Create(Self);
    FReadThread.Start;

    Result := True;
    DoStatusChange(True, Format('Conectado a %s a %d baudios.', [FPortName, FBaudRate]));
  finally
    FLock.Leave;
  end;
end;

procedure TSerialPort.Close;
begin
  FLock.Enter;
  try
    if not FConnected then
      Exit;

    FConnected := False;

    if Assigned(FReadThread) then
    begin
      FReadThread.Terminate;
      FReadThread.WaitFor;
      FreeAndNil(FReadThread);
    end;

    if FHandle <> INVALID_HANDLE_VALUE then
    begin
      CloseHandle(FHandle);
      FHandle := INVALID_HANDLE_VALUE;
    end;

    DoStatusChange(False, Format('Desconectado de %s.', [FPortName]));
  finally
    FLock.Leave;
  end;
end;

procedure TSerialPort.ResetStats;
begin
  FTotalBytesReceived := 0;
  FLastRxTime := 0;
end;

function TSerialPort.GetModemStatus(out ACTS, ADSR, ARing, ARLSD: Boolean): Boolean;
var
  Status: DWORD;
begin
  Result := False;
  ACTS := False;
  ADSR := False;
  ARing := False;
  ARLSD := False;
  if (FHandle <> INVALID_HANDLE_VALUE) and FConnected then
  begin
    if GetCommModemStatus(FHandle, Status) then
    begin
      ACTS := (Status and MS_CTS_ON) <> 0;
      ADSR := (Status and MS_DSR_ON) <> 0;
      ARing := (Status and MS_RING_ON) <> 0;
      ARLSD := (Status and MS_RLSD_ON) <> 0;
      Result := True;
    end;
  end;
end;

procedure TSerialPort.SetLineDTR(Active: Boolean);
begin
  if (FHandle <> INVALID_HANDLE_VALUE) and FConnected then
  begin
    if Active then
      EscapeCommFunction(FHandle, Winapi.Windows.SETDTR)
    else
      EscapeCommFunction(FHandle, Winapi.Windows.CLRDTR);
  end;
end;

procedure TSerialPort.SetLineRTS(Active: Boolean);
begin
  if (FHandle <> INVALID_HANDLE_VALUE) and FConnected then
  begin
    if Active then
      EscapeCommFunction(FHandle, Winapi.Windows.SETRTS)
    else
      EscapeCommFunction(FHandle, Winapi.Windows.CLRRTS);
  end;
end;

function TSerialPort.SendString(const S: string): Boolean;
var
  B: TBytes;
begin
  B := TEncoding.ANSI.GetBytes(S);
  Result := SendBytes(B);
end;

function TSerialPort.SendBytes(const B: TBytes): Boolean;
var
  Written: DWORD;
begin
  Result := False;
  if (not FConnected) or (FHandle = INVALID_HANDLE_VALUE) or (Length(B) = 0) then
    Exit;

  FLock.Enter;
  try
    Result := WriteFile(FHandle, B[0], Length(B), Written, nil) and (Written = DWORD(Length(B)));
  finally
    FLock.Leave;
  end;
end;

procedure TSerialPort.DoRxData(const Buffer: TBytes);
var
  S: string;
begin
  Inc(FTotalBytesReceived, Length(Buffer));
  FLastRxTime := Now;

  if Assigned(FOnRxData) then
    FOnRxData(Self, Buffer);

  if Assigned(FOnRxString) then
  begin
    S := TEncoding.ANSI.GetString(Buffer);
    FOnRxString(Self, S);
  end;
end;

procedure TSerialPort.DoStatusChange(AConnected: Boolean; const AMsg: string);
begin
  if Assigned(FOnStatusChange) then
    FOnStatusChange(Self, AConnected, AMsg);
end;

procedure TSerialPort.DoError(const AMsg: string);
begin
  if Assigned(FOnError) then
    FOnError(Self, AMsg);
end;

class procedure TSerialPort.GetAvailablePorts(AList: TStrings);
var
  Reg: TRegistry;
  PortNames: TStringList;
  I: Integer;
  PortName: string;
  DevName: string;
  Dummy: array[0..255] of Char;
begin
  AList.Clear;
  PortNames := TStringList.Create;
  try
    // 1. Obtener desde el registro de Windows
    Reg := TRegistry.Create(KEY_READ);
    try
      Reg.RootKey := HKEY_LOCAL_MACHINE;
      if Reg.OpenKeyReadOnly('HARDWARE\DEVICEMAP\SERIALCOMM') then
      begin
        Reg.GetValueNames(PortNames);
        for I := 0 to PortNames.Count - 1 do
        begin
          PortName := Reg.ReadString(PortNames[I]);
          DevName := PortNames[I];
          // Marcar si es Bluetooth o serie estándar
          if (Pos('BthModem', DevName) > 0) or (Pos('BthEnum', DevName) > 0) or (Pos('Bluetooth', DevName) > 0) then
            PortName := PortName + ' [Bluetooth SPP]'
          else
            PortName := PortName + ' [' + DevName + ']';

          if AList.IndexOf(PortName) = -1 then
            AList.Add(PortName);
        end;
        Reg.CloseKey;
      end;
    finally
      Reg.Free;
    end;

    // 2. Si el registro no tiene o faltan puertos, escanear COM1..COM64 mediante QueryDosDevice
    for I := 1 to 64 do
    begin
      PortName := Format('COM%d', [I]);
      if QueryDosDevice(PChar(PortName), Dummy, 255) > 0 then
      begin
        // Solo agregar si no está ya en la lista
        if (AList.IndexOf(PortName) = -1) and (AList.IndexOf(PortName + ' [Bluetooth SPP]') = -1) then
        begin
          // Verificar si es un puerto bluetooth por su nombre de dispositivo
          if Pos('BTHENUM', UpperCase(string(Dummy))) > 0 then
            AList.Add(PortName + ' [Bluetooth SPP]')
          else
            AList.Add(PortName);
        end;
      end;
    end;

    if AList.Count = 0 then
      AList.Add('COM1');
  finally
    PortNames.Free;
  end;
end;

class procedure TSerialPort.GetPairedBluetoothDevices(AList: TStrings);
var
  Manager: TBluetoothManager;
  DevList: TBluetoothDeviceList;
  I: Integer;
  Dev: TBluetoothDevice;
  DevInfo: string;
begin
  AList.Clear;
  try
    Manager := TBluetoothManager.Current;
    if Assigned(Manager) then
    begin
      DevList := Manager.GetPairedDevices;
      if Assigned(DevList) then
      begin
        for I := 0 to DevList.Count - 1 do
        begin
          Dev := DevList[I];
          DevInfo := Dev.DeviceName;
          if DevInfo.Trim = '' then
            DevInfo := 'Dispositivo Bluetooth (' + Dev.Address + ')'
          else
            DevInfo := DevInfo + ' (' + Dev.Address + ')';

          AList.Add(DevInfo);
        end;
      end;
    end;
  except
    on E: Exception do
      AList.Add('Aviso: Bluetooth no disponible o desactivado en este equipo (' + E.Message + ')');
  end;

  if AList.Count = 0 then
    AList.Add('(No se detectaron dispositivos Bluetooth emparejados)');
end;

end.