ewsdr/HPSDRNetwork.pas

unit HPSDRNetwork;

{
  UDP network layer for openHPSDR Ethernet Protocol V4.3.
  Pure FPC RTL - uses only the standard 'Sockets' unit.
  No anonymous procedures, no inline var - compatible with FPC 3.2 / Lazarus 2.x
}

{$IFDEF FPC}
  {$MODE Delphi}
{$ENDIF}

interface

uses
  Classes, SysUtils, Math,
{$IFDEF WINDOWS}
  WinSock2, MMSystem,
{$ELSE}
  Sockets, BaseUnix,
{$ENDIF}
  HPSDRProtocol, SyncObjs;

{$IFDEF WINDOWS}
// ---------------------------------------------------------------------------
// WinSock2 — type aliases и forward declarations
// ---------------------------------------------------------------------------
const
  SOCK_INVALID          = TSocket(INVALID_SOCKET);
  INADDR_ANY            = 0;
  IPPROTO_UDP           = 17;
  SO_EXCLUSIVEADDRUSE   = LongInt(not 5);  // = $FFFFFFFB — исключительное владение портом

type
  TInetSockAddr = WinSock2.TSockAddrIn;
  TSockLen      = Integer;
  TFDSet        = WinSock2.TFDSet;
  TTimeVal      = WinSock2.TTimeVal;

function fpSocket(Domain, SType, Proto: Integer): TSocket;
function fpBind(S: TSocket; Addr: PSockAddr; AddrLen: Integer): Integer;
function fpSetSockOpt(S: TSocket; Level, OptName: Integer;
                      OptVal: Pointer; OptLen: Integer): Integer;
function fpGetSockName(S: TSocket; Addr: PSockAddr;
                       AddrLen: PInteger): Integer;
function fpSendTo(S: TSocket; Buf: Pointer; BufLen, Flags: Integer;
                  ToAddr: PSockAddr; AddrLen: Integer): Integer;
function fpRecvFrom(S: TSocket; Buf: Pointer; BufLen, Flags: Integer;
                    FromAddr: PSockAddr; FromLen: PInteger): Integer;
procedure fpFD_ZERO(var FDS: TFDSet);
procedure fpFD_SET(S: TSocket; var FDS: TFDSet);
function fpSelect(Nfds: Integer; ReadFDS, WriteFDS, ExceptFDS: PFDSet;
                  Timeout: PTimeVal): Integer;
procedure CloseSocket(S: TSocket);
function htons(Host: Word): Word;
function ntohs(Net: Word): Word;
function StrToNetAddr(const IP: string): WinSock2.TInAddr;
function NetAddrToStr(const Addr: WinSock2.TInAddr): string;

{$ELSE}
// ---------------------------------------------------------------------------
// Unix — типы уже определены в Sockets/BaseUnix
// ---------------------------------------------------------------------------
const
  SOCK_INVALID = TSocket(-1);
{$ENDIF}


type
  THPSDRDevice = record
    IPAddress:       string;
    Port:            Word;
    MAC:             array[0..5] of Byte;
    BoardType:       Byte;
    ProtocolVersion: Byte;
    FirmwareVersion: Byte;
    NumDDCs:         Byte;
    FreqOrPhase:     Byte;
    EndianModes:     Byte;
    InUse:           Boolean;
    Valid:           Boolean;
  end;
  PHPSDRDevice      = ^THPSDRDevice;
  THPSDRDeviceArray = array of THPSDRDevice;

  TOnDeviceFound = procedure(const Dev: THPSDRDevice) of object;
  TOnDDCIQPacket = procedure(DDCIndex: Integer;
                              const Data: TDDCIQPacket) of object;
  TOnMicPacket   = procedure(const Data: TMicDataPacket) of object;
  TOnHPStatus    = procedure(const Status: THighPriorityStatus) of object;

  { THPSDRNetwork }
  THPSDRNetwork = class
  private
    FSocket:          TSocket;
    FLocalPort:       Word;
    FDevice:          THPSDRDevice;
    FConnected:       Boolean;
    FRunning:         Boolean;

    FSeqGeneral:  LongWord;
    FLastError:   string;   // последняя ошибка сокета (для диагностики)
    FSeqDDCSpec:  LongWord;
    FSeqDUCSpec:  LongWord;
    FSeqHP:       LongWord;
    FSeqAudio:    LongWord;
    FSeqDUCIQ:    LongWord;

    FReceiveThread:   TThread;
    FKeepaliveThread: TThread;

    FOnDeviceFound: TOnDeviceFound;
    FOnDDCIQ:       TOnDDCIQPacket;
    FOnMic:         TOnMicPacket;
    FOnHPStatus:    TOnHPStatus;

    FPortDDCSpec:  Word;
    FPortDUCSpec:  Word;
    FPortHPFromPC: Word;
    FPortDDCAudio: Word;
    FPortDUCIQ:    Word;
    FDirectIP:     string;   // для unicast discovery

    // Кэш DDC Specific — keepalive повторно шлёт первые 5 сек после старта
    FCachedDDCSpec:  TDDCSpecificPacket;
    FCachedDDCValid: Boolean;
    FResendCount:    Integer;

    // Текущее состояние для построения HP пакетов
    FCurrentRXFreq:  Double;
    FCurrentTXFreq:  Double;
    FCurrentDrive:   Byte;
    FIsTransmitting: Boolean;
    FPAEnabled:      Boolean;
    FAlexEnabled:    Boolean;

    FSendLock: TCriticalSection;  // защита concurrent UDP sends

    function  DoCreateSocket: TSocket;
    procedure DoCloseSocket(var S: TSocket);
    function  DoSendTo(S: TSocket; const Buf; BufLen: Integer;
                       const DestIP: string; DestPort: Word): Boolean;
    function  DoRecvFrom(S: TSocket; var Buf; BufLen: Integer;
                         var SrcIP: string; var SrcPort: Word;
                         TimeoutMs: Integer): Integer;

    procedure HandleHPStatus(const Buf: array of Byte; Len: Integer);
    procedure HandleDDCIQ(const Buf: array of Byte; Len: Integer; DDCIdx: Integer);
    procedure HandleMicData(const Buf: array of Byte; Len: Integer);
    procedure StartThreads;
    procedure StopThreads;
    function  NextSeq(var S: LongWord): LongWord;
    procedure PackSeqBytes(var B: array of Byte; Seq: LongWord);

  public
    constructor Create;
    destructor  Destroy; override;

    function  Discover(TimeoutMs: Integer = 3000): THPSDRDeviceArray;
    function  Connect(const Dev: THPSDRDevice): Boolean;
    procedure Disconnect;

    procedure SendGeneralPacket(const Pkt: TGeneralPacket);
    procedure SendDDCSpecific(const Pkt: TDDCSpecificPacket);
    procedure ConfigureDDCs(NumDDCs: Byte; SampleRate: Word; ADCSource: Byte = 0);
    procedure SendDUCSpecific(const Pkt: TDUCSpecificPacket);
    procedure SendHighPriority(const Pkt: THighPriorityPacket);
    procedure SetRunAndFreq(Run: Boolean; DDC0FreqHz, DUCFreqHz: Double;
                            DriveLevel: Byte = 100);
    procedure UpdateState(RXFreqHz, TXFreqHz: Double; DriveLevel: Byte;
                          Transmitting, PAEnabled, AlexEnabled: Boolean);
    procedure SendFullHP;
    procedure SendDDCAudio(const LeftRight: array of SmallInt);
    procedure SendDUCIQ(const IData, QData: array of Integer);

    property Connected:     Boolean        read FConnected;
    property Running:       Boolean        read FRunning;
    property Device:        THPSDRDevice   read FDevice;
    property LocalPort:     Word           read FLocalPort;
    property LastError:     string         read FLastError;
    property OnDeviceFound: TOnDeviceFound read FOnDeviceFound write FOnDeviceFound;
    property OnDDCIQ:       TOnDDCIQPacket read FOnDDCIQ       write FOnDDCIQ;
    property OnMicPacket:   TOnMicPacket   read FOnMic         write FOnMic;
    property OnHPStatus:    TOnHPStatus    read FOnHPStatus     write FOnHPStatus;
    property DirectIP: string read FDirectIP write FDirectIP;  // unicast discovery
  end;

implementation

{$IFDEF WINDOWS}
var
  WSAData_: WinSock2.TWSAData;
{$ENDIF}

{$IFDEF WINDOWS}
// ---------------------------------------------------------------------------
// WinSock2 wrapper implementations
// ---------------------------------------------------------------------------
function fpSocket(Domain, SType, Proto: Integer): TSocket;
begin
  Result := WinSock2.socket(Domain, SType, Proto);
end;

function fpBind(S: TSocket; Addr: PSockAddr; AddrLen: Integer): Integer;
begin
  Result := WinSock2.bind(S, Addr^, AddrLen);
end;

function fpSetSockOpt(S: TSocket; Level, OptName: Integer;
                      OptVal: Pointer; OptLen: Integer): Integer;
begin
  Result := WinSock2.setsockopt(S, Level, OptName, OptVal, OptLen);
end;

function fpGetSockName(S: TSocket; Addr: PSockAddr; AddrLen: PInteger): Integer;
begin
  Result := WinSock2.getsockname(S, Addr^, AddrLen^);
end;

function fpSendTo(S: TSocket; Buf: Pointer; BufLen, Flags: Integer;
                  ToAddr: PSockAddr; AddrLen: Integer): Integer;
begin
  Result := WinSock2.sendto(S, Buf^, BufLen, Flags, ToAddr^, AddrLen);
end;

function fpRecvFrom(S: TSocket; Buf: Pointer; BufLen, Flags: Integer;
                    FromAddr: PSockAddr; FromLen: PInteger): Integer;
begin
  Result := WinSock2.recvfrom(S, Buf^, BufLen, Flags, FromAddr^, FromLen^);
end;

procedure fpFD_ZERO(var FDS: TFDSet);
begin
  WinSock2.FD_ZERO(FDS);
end;

procedure fpFD_SET(S: TSocket; var FDS: TFDSet);
begin
  WinSock2.FD_SET(S, FDS);
end;

function fpSelect(Nfds: Integer; ReadFDS, WriteFDS, ExceptFDS: PFDSet;
                  Timeout: PTimeVal): Integer;
begin
  Result := WinSock2.select(Nfds, ReadFDS, WriteFDS, ExceptFDS, Timeout);
end;

procedure CloseSocket(S: TSocket);
begin
  WinSock2.closesocket(S);
end;

function htons(Host: Word): Word;
begin
  Result := WinSock2.htons(Host);
end;

function ntohs(Net: Word): Word;
begin
  Result := WinSock2.ntohs(Net);
end;

function StrToNetAddr(const IP: string): WinSock2.TInAddr;
begin
  Result.S_addr := WinSock2.inet_addr(PAnsiChar(AnsiString(IP)));
end;

function NetAddrToStr(const Addr: WinSock2.TInAddr): string;
begin
  Result := string(WinSock2.inet_ntoa(Addr));
end;
{$ENDIF}

// ===========================================================================
// Синхронизация через отдельные классы-посредники (без анонимных процедур)
// ===========================================================================

type
  { TStatusSync - передаёт HP Status в главный поток }
  TStatusSync = class
  private
    FCallback: TOnHPStatus;
    FStatus:   THighPriorityStatus;
  public
    constructor Create(CB: TOnHPStatus; const St: THighPriorityStatus);
    procedure Execute;
  end;

  { TMicSync - передаёт Mic данные в главный поток }
  TMicSync = class
  private
    FCallback: TOnMicPacket;
    FPkt:      TMicDataPacket;
  public
    constructor Create(CB: TOnMicPacket; const P: TMicDataPacket);
    procedure Execute;
  end;

constructor TStatusSync.Create(CB: TOnHPStatus; const St: THighPriorityStatus);
begin
  inherited Create;
  FCallback := CB;
  FStatus   := St;
end;

procedure TStatusSync.Execute;
begin
  if Assigned(FCallback) then FCallback(FStatus);
end;

constructor TMicSync.Create(CB: TOnMicPacket; const P: TMicDataPacket);
begin
  inherited Create;
  FCallback := CB;
  FPkt      := P;
end;

procedure TMicSync.Execute;
begin
  if Assigned(FCallback) then FCallback(FPkt);
end;

// ===========================================================================
// Receive thread
// ===========================================================================
type
  TReceiveThread = class(TThread)
  private
    FNet: THPSDRNetwork;
  protected
    procedure Execute; override;
  public
    constructor Create(ANet: THPSDRNetwork);
  end;

constructor TReceiveThread.Create(ANet: THPSDRNetwork);
begin
  FNet := ANet;
  FreeOnTerminate := False;
  inherited Create(False);
end;

procedure TReceiveThread.Execute;
var
  Buf:     array[0..1500] of Byte;
  Len:     Integer;
  SrcIP:   string;
  SrcPort: Word;
begin
  FillChar(Buf, SizeOf(Buf), 0);
  SrcIP   := '';
  SrcPort := 0;
  while not Terminated do
  begin
    if FNet.FSocket = SOCK_INVALID then
    begin
      Sleep(50);
      Continue;
    end;
    Len := FNet.DoRecvFrom(FNet.FSocket, Buf, SizeOf(Buf), SrcIP, SrcPort, 50);
    if Terminated then Break;
    if Len < 4 then Continue;

    case SrcPort of
      PORT_HP_TO_PC:
        if Len >= SizeOf(THighPriorityStatus) then
          FNet.HandleHPStatus(Buf, Len);
      PORT_MIC_DATA:
        if Len >= 132 then
          FNet.HandleMicData(Buf, Len);
      PORT_DDC0_IQ .. PORT_DDC0_IQ + MAX_DDCS - 1:
        FNet.HandleDDCIQ(Buf, Len, SrcPort - PORT_DDC0_IQ);
    end;
  end;
end;

// ===========================================================================
// Keepalive thread
// ===========================================================================
type
  TKeepaliveThread = class(TThread)
  private
    FNet: THPSDRNetwork;
  protected
    procedure Execute; override;
  public
    constructor Create(ANet: THPSDRNetwork);
  end;

constructor TKeepaliveThread.Create(ANet: THPSDRNetwork);
begin
  FNet := ANet;
  FreeOnTerminate := False;
  inherited Create(False);
end;

procedure TKeepaliveThread.Execute;
begin
  while not Terminated do
  begin
    Sleep(50);
    if Terminated then Break;
    if not FNet.FConnected then Continue;
    // Отправляем полный HP с частотами и ALEX — как piHPSDR
    FNet.SendFullHP;
    // Повторно отправляем DDC Specific первые 5 сек после Run=1 (каждые 500 мс).
    // ddc_specific_thread на эмуляторе/железе стартует ПОСЛЕ получения Run=1,
    // поэтому первый ConfigureDDCs может прийти раньше чем порт 1025 откроется.
    if FNet.FRunning and FNet.FCachedDDCValid then
    begin
      Inc(FNet.FResendCount);
      if (FNet.FResendCount <= 100) and (FNet.FResendCount mod 10 = 2) then
        FNet.SendDDCSpecific(FNet.FCachedDDCSpec);
    end;
  end;
end;

// ===========================================================================
// THPSDRNetwork
// ===========================================================================

constructor THPSDRNetwork.Create;
begin
  inherited;
  FSocket          := SOCK_INVALID;
  FConnected       := False;
  FRunning         := False;
  FLocalPort       := 0;
  FReceiveThread   := nil;
  FKeepaliveThread := nil;
  FPortDDCSpec     := PORT_DDC_SPECIFIC;
  FPortDUCSpec     := PORT_DUC_SPECIFIC;
  FPortHPFromPC    := PORT_HP_FROM_PC;
  FPortDDCAudio    := PORT_DDC_AUDIO;
  FPortDUCIQ       := PORT_DUC_IQ;
  FCurrentRXFreq   := 7100000;
  FCurrentTXFreq   := 7100000;
  FCurrentDrive    := 0;
  FIsTransmitting  := False;
  FPAEnabled       := True;
  FAlexEnabled     := True;
  FSendLock        := TCriticalSection.Create;
end;

destructor THPSDRNetwork.Destroy;
begin
  Disconnect;
  FSendLock.Free;
  inherited;
end;

function THPSDRNetwork.NextSeq(var S: LongWord): LongWord;
begin
  Result := S;
  Inc(S);
end;

procedure THPSDRNetwork.PackSeqBytes(var B: array of Byte; Seq: LongWord);
begin
  B[0] := (Seq shr 24) and $FF;
  B[1] := (Seq shr 16) and $FF;
  B[2] := (Seq shr  8) and $FF;
  B[3] :=  Seq         and $FF;
end;

// ---------------------------------------------------------------------------
// Сокеты (только FPC RTL Sockets unit)
// ---------------------------------------------------------------------------

function THPSDRNetwork.DoCreateSocket: TSocket;
var
  Addr: TInetSockAddr;
  Opt:  LongInt;
  ALen: TSockLen;
begin
  FillChar(Addr, SizeOf(Addr), 0);
  Result := fpSocket(AF_INET, SOCK_DGRAM, IPPROTO_UDP);
  if Result = SOCK_INVALID then
  begin
    FLastError := 'fpSocket failed';
    Exit;
  end;

  // Broadcast
  Opt := 1;
  fpSetSockOpt(Result, SOL_SOCKET, SO_BROADCAST, @Opt, SizeOf(Opt));

{$IFDEF WINDOWS}
  // На Windows SO_REUSEADDR позволяет перехватить порт другому процессу.
  // Используем SO_EXCLUSIVEADDRUSE вместо SO_REUSEADDR.
  Opt := 1;
  fpSetSockOpt(Result, SOL_SOCKET, SO_EXCLUSIVEADDRUSE, @Opt, SizeOf(Opt));
{$ELSE}
  Opt := 1;
  fpSetSockOpt(Result, SOL_SOCKET, SO_REUSEADDR, @Opt, SizeOf(Opt));
{$ENDIF}

  // Большой приёмный буфер
  Opt := 4 * 1024 * 1024;
  fpSetSockOpt(Result, SOL_SOCKET, SO_RCVBUF, @Opt, SizeOf(Opt));

  FillChar(Addr, SizeOf(Addr), 0);
  Addr.sin_family := AF_INET;
  Addr.sin_port   := htons(0);  // случайный свободный порт
{$IFDEF WINDOWS}
  Addr.sin_addr.S_addr := INADDR_ANY;
{$ELSE}
  Addr.sin_addr.s_addr := INADDR_ANY;
{$ENDIF}

  if fpBind(Result, @Addr, SizeOf(Addr)) <> 0 then
  begin
{$IFDEF WINDOWS}
    FLastError := 'fpBind failed, WSAError=' + IntToStr(WinSock2.WSAGetLastError);
{$ELSE}
    FLastError := 'fpBind failed';
{$ENDIF}
    CloseSocket(Result);
    Result := SOCK_INVALID;
    Exit;
  end;

  ALen := SizeOf(Addr);
  if fpGetSockName(Result, @Addr, @ALen) = 0 then
    FLocalPort := ntohs(Addr.sin_port);

  FLastError := '';
end;

procedure THPSDRNetwork.DoCloseSocket(var S: TSocket);
begin
  if S <> SOCK_INVALID then
  begin
    CloseSocket(S);
    S := SOCK_INVALID;
  end;
end;

function THPSDRNetwork.DoSendTo(S: TSocket; const Buf; BufLen: Integer;
                                const DestIP: string; DestPort: Word): Boolean;
var
  Addr: TInetSockAddr;
begin
  Result := False;
  if S = SOCK_INVALID then Exit;
  FillChar(Addr, SizeOf(Addr), 0);
  Addr.sin_family      := AF_INET;
  Addr.sin_port        := htons(DestPort);
  Addr.sin_addr        := StrToNetAddr(DestIP);
  FSendLock.Enter;
  try
    Result := fpSendTo(S, @Buf, BufLen, 0, @Addr, SizeOf(Addr)) = BufLen;
  finally
    FSendLock.Leave;
  end;
end;

function THPSDRNetwork.DoRecvFrom(S: TSocket; var Buf; BufLen: Integer;
                                  var SrcIP: string; var SrcPort: Word;
                                  TimeoutMs: Integer): Integer;
var
  FDS:  TFDSet;
  TV:   TTimeVal;
  Addr: TInetSockAddr;
  ALen: TSockLen;
  N:    LongInt;
begin
  Result := 0;
  if S = SOCK_INVALID then Exit;

  fpFD_ZERO(FDS);
  fpFD_SET(S, FDS);
  TV.tv_sec  := TimeoutMs div 1000;
  TV.tv_usec := (TimeoutMs mod 1000) * 1000;

  N := fpSelect(S + 1, @FDS, nil, nil, @TV);
  if N <= 0 then Exit;

  ALen   := SizeOf(Addr);
  Result := fpRecvFrom(S, @Buf, BufLen, 0, @Addr, @ALen);
  if Result > 0 then
  begin
    SrcIP   := NetAddrToStr(Addr.sin_addr);
    SrcPort := ntohs(Addr.sin_port);
  end
  else
    Result := 0;
end;

// ---------------------------------------------------------------------------
// Discovery
// ---------------------------------------------------------------------------

function THPSDRNetwork.Discover(TimeoutMs: Integer): THPSDRDeviceArray;
var
  S:       TSocket;
  Pkt:     TDiscoveryPacket;
  Buf:     array[0..511] of Byte;
  Len:     Integer;
  SrcIP:   string;
  SrcPort: Word;
  Found:   THPSDRDeviceArray;
  Start:     QWord;
  LastSend:  QWord;
  Elapsed:   QWord;
  Remaining: Integer;
  k:         Integer;
  Dup:       Boolean;
begin
  FillChar(Buf, SizeOf(Buf), 0);
  SrcIP   := '';
  SrcPort := 0;
  SetLength(Found, 0);
  Result := Found;

  S := DoCreateSocket;
  if S = SOCK_INVALID then Exit;
  try
    FillChar(Pkt, SizeOf(Pkt), 0);
    Pkt.Command := CMD_DISCOVERY;

    // Отправляем broadcast (и unicast если задан FDirectIP)
    DoSendTo(S, Pkt, SizeOf(Pkt), '255.255.255.255', PORT_COMMAND);
    if FDirectIP <> '' then
      DoSendTo(S, Pkt, SizeOf(Pkt), FDirectIP, PORT_COMMAND);

    Start    := GetTickCount64;
    LastSend := Start;
    repeat
      Elapsed := GetTickCount64 - Start;
      if Elapsed >= QWord(TimeoutMs) then Break;

      // Повторяем broadcast каждые 500 мс
      if GetTickCount64 - LastSend >= 500 then
      begin
        DoSendTo(S, Pkt, SizeOf(Pkt), '255.255.255.255', PORT_COMMAND);
        if FDirectIP <> '' then
          DoSendTo(S, Pkt, SizeOf(Pkt), FDirectIP, PORT_COMMAND);
        LastSend := GetTickCount64;
      end;

      // Ждём ответ не дольше 100 мс за раз — чтобы успеть повторить отправку
      Remaining := TimeoutMs - Integer(Elapsed);
      if Remaining <= 0 then Break;
      if Remaining > 100 then Remaining := 100;

      Len := DoRecvFrom(S, Buf, SizeOf(Buf), SrcIP, SrcPort, Remaining);
      if Len < 60 then Continue;
      if not (Buf[4] in [$02, $03]) then Continue;

      Dup := False;
      for k := 0 to High(Found) do
        if Found[k].IPAddress = SrcIP then
        begin
          Dup := True;
          Break;
        end;
      if Dup then Continue;

      SetLength(Found, Length(Found) + 1);
      FillChar(Found[High(Found)], SizeOf(THPSDRDevice), 0);
      with Found[High(Found)] do
      begin
        IPAddress       := SrcIP;
        Port            := SrcPort;
        Move(Buf[5], MAC[0], 6);
        BoardType       := Buf[11];
        ProtocolVersion := Buf[12];
        FirmwareVersion := Buf[13];
        NumDDCs         := Buf[20];
        FreqOrPhase     := Buf[21];
        EndianModes     := Buf[22];
        InUse           := Buf[4] = $03;
        Valid           := True;
      end;

      if Assigned(FOnDeviceFound) then
        FOnDeviceFound(Found[High(Found)]);
    until False;

    Result := Found;
  finally
    DoCloseSocket(S);
  end;
end;

function THPSDRNetwork.Connect(const Dev: THPSDRDevice): Boolean;
begin
  Result := False;
  if FConnected then Disconnect;

  FDevice := Dev;
  FSocket := DoCreateSocket;
  if FSocket = SOCK_INVALID then Exit;

  FConnected  := True;
  FSeqGeneral := 0;
  FSeqDDCSpec := 0;
  FSeqDUCSpec := 0;
  FSeqHP      := 0;
  FSeqAudio   := 0;
  FSeqDUCIQ   := 0;

  StartThreads;
  Result := True;
end;

procedure THPSDRNetwork.Disconnect;
begin
  if not FConnected then Exit;

  if FRunning then
    SetRunAndFreq(False, 7100000, 7100000, 0);

  FRunning := False;
  StopThreads;
  DoCloseSocket(FSocket);
  FConnected    := False;
  FDevice.Valid := False;
end;

procedure THPSDRNetwork.StartThreads;
begin
{$IFDEF WINDOWS}
  // Повышаем точность системного таймера — по умолчанию 15.6ms, делаем 1ms
  // Это критично для Sleep() в потоках и PortAudio
  timeBeginPeriod(1);
{$ENDIF}
  FReceiveThread := TReceiveThread.Create(Self);
  FReceiveThread.Priority := tpHighest;     // Сетевой поток — критический
  FKeepaliveThread := TKeepaliveThread.Create(Self);
  FKeepaliveThread.Priority := tpNormal;
end;

procedure THPSDRNetwork.StopThreads;
begin
{$IFDEF WINDOWS}
  timeEndPeriod(1);
{$ENDIF}
  if Assigned(FReceiveThread) then
  begin
    FReceiveThread.Terminate;
    if FSocket <> SOCK_INVALID then
    begin
      CloseSocket(FSocket);
      FSocket := SOCK_INVALID;
    end;
    FReceiveThread.WaitFor;
    FreeAndNil(FReceiveThread);
  end;
  if Assigned(FKeepaliveThread) then
  begin
    FKeepaliveThread.Terminate;
    FKeepaliveThread.WaitFor;
    FreeAndNil(FKeepaliveThread);
  end;
end;

// ---------------------------------------------------------------------------
// Обработчики пакетов — синхронизация через объекты, без анонимных proc
// ---------------------------------------------------------------------------

procedure THPSDRNetwork.HandleHPStatus(const Buf: array of Byte; Len: Integer);
var
  St:   THighPriorityStatus;
  Sync: TStatusSync;
  M:    TThreadMethod;
begin
  if not Assigned(FOnHPStatus) then Exit;
  Move(Buf[0], St, SizeOf(St));
  Sync := TStatusSync.Create(FOnHPStatus, St);
  try
    M := Sync.Execute;
    TThread.Synchronize(nil, M);
  finally
    Sync.Free;
  end;
end;

procedure THPSDRNetwork.HandleDDCIQ(const Buf: array of Byte; Len: Integer;
                                    DDCIdx: Integer);
var
  Pkt: TDDCIQPacket;
begin
  if not Assigned(FOnDDCIQ) then Exit;
  FillChar(Pkt, SizeOf(Pkt), 0);
  Move(Buf[0], Pkt, Min(Len, SizeOf(Pkt)));
  FOnDDCIQ(DDCIdx, Pkt);  // прямой вызов из потока — UI не трогает
end;

procedure THPSDRNetwork.HandleMicData(const Buf: array of Byte; Len: Integer);
var
  Pkt: TMicDataPacket;
begin
  if not Assigned(FOnMic) then Exit;
  Move(Buf[0], Pkt, SizeOf(Pkt));
  FOnMic(Pkt);  // прямой вызов из receive thread — TX обработка не касается UI
end;

// ---------------------------------------------------------------------------
// Отправка пакетов
// ---------------------------------------------------------------------------

procedure THPSDRNetwork.SendGeneralPacket(const Pkt: TGeneralPacket);
var
  B: TGeneralPacket;
begin
  B := Pkt;
  PackSeqBytes(B.Seq, NextSeq(FSeqGeneral));
  DoSendTo(FSocket, B, SizeOf(B), FDevice.IPAddress, PORT_COMMAND);
end;

procedure THPSDRNetwork.SendDDCSpecific(const Pkt: TDDCSpecificPacket);
var
  B: TDDCSpecificPacket;
begin
  B := Pkt;
  PackSeqBytes(B.Seq, NextSeq(FSeqDDCSpec));
  DoSendTo(FSocket, B, SizeOf(B), FDevice.IPAddress, FPortDDCSpec);
end;

// ---------------------------------------------------------------------------
// ALEX фильтры — логика из piHPSDR new_protocol.c
// Возвращает 32-bit ALEX0 register value
// RXFreqHz — частота приёма ADC0
// TXFreqHz — частота передачи (или = RXFreqHz при RX)
// Transmitting — режим передачи
// IsOrion2 — ANAN-7000/8000 (другие BPF)
// ---------------------------------------------------------------------------
function CalcAlex0(RXFreqHz, TXFreqHz: Double;
                   Transmitting, IsOrion2: Boolean): LongWord;
var
  txf: Double;
begin
  Result := 0;

  // TX relay при передаче
  // Bit 27 ($08000000) = T/R relay для всех плат
  // Bit 18 ($00040000) = TxRx Status для Orion MkII / Saturn / G2
  if Transmitting then
  begin
    Result := Result or $08000000;  // ALEX_TX_RELAY bit27
    if IsOrion2 then
      Result := Result or $00040000; // TxRx Status bit18 (ANAN-7/8000, Saturn)
  end;

  // RX HPF (для ANAN-100/200) или BPF (для ANAN-7000)
  if IsOrion2 then
  begin
    // Band-pass filters ANAN-7000/8000
    if    RXFreqHz < 1500000  then Result := Result or $00001000   // BYPASS_BPF
    else if RXFreqHz < 2100000  then Result := Result or $00000040 // 160 BPF
    else if RXFreqHz < 5500000  then Result := Result or $00000020 // 80/60 BPF
    else if RXFreqHz < 11000000 then Result := Result or $00000010 // 40/30 BPF
    else if RXFreqHz < 22000000 then Result := Result or $00000002 // 20/15 BPF
    else if RXFreqHz < 35600000 then Result := Result or $00000004 // 12/10 BPF
    else                             Result := Result or $00000008; // 6m+preamp
  end
  else
  begin
    // High-pass filters ANAN-100/200
    if    RXFreqHz < 1800000  then Result := Result or $00001000   // BYPASS_HPF
    else if RXFreqHz < 6500000  then Result := Result or $00000040 // 1.5 MHz HPF
    else if RXFreqHz < 9500000  then Result := Result or $00000020 // 6.5 MHz HPF
    else if RXFreqHz < 13000000 then Result := Result or $00000010 // 9.5 MHz HPF
    else if RXFreqHz < 20000000 then Result := Result or $00000002 // 13 MHz HPF
    else if RXFreqHz < 50000000 then Result := Result or $00000004 // 20 MHz HPF
    else                             Result := Result or $00000008; // 6m preamp
  end;

  // TX LPF — при RX через Ant1/2/3 сигнал идёт через TX LPF тоже
  // (для pre-Orion2 без внешней антенны)
  if not Transmitting and not IsOrion2 then
    txf := RXFreqHz   // RX через Ant1: используем RX частоту для LPF
  else
    txf := TXFreqHz;

  if    txf > 35600000 then Result := Result or $20000000  // 6m bypass LPF
  else if txf > 24000000 then Result := Result or $40000000 // 12/10m LPF
  else if txf > 16500000 then Result := Result or $80000000 // 17/15m LPF
  else if txf > 8000000  then Result := Result or $00100000 // 30/20m LPF
  else if txf > 5000000  then Result := Result or $00200000 // 60/40m LPF
  else if txf > 2500000  then Result := Result or $00400000 // 80m LPF
  else                        Result := Result or $00800000; // 160m LPF

  // TX antenna — ANT1 по умолчанию
  if not Transmitting then
    Result := Result or $01000000;  // ALEX_TX_ANTENNA_1
end;

procedure THPSDRNetwork.ConfigureDDCs(NumDDCs: Byte; SampleRate: Word;
                                      ADCSource: Byte);
var
  Pkt:     TDDCSpecificPacket;
  i, ddc:  Integer;
  DDCBase: Integer;
begin
  FillChar(Pkt, SizeOf(Pkt), 0);

  // ANAN-7000/8000/Saturn имеют 2 ADC
  if FDevice.BoardType in [4, 5, 10] then  // ORION=4, ORION2=5, SATURN=10
    Pkt.NumADCs := 2
  else
    Pkt.NumADCs := 1;

  // Для ANGELIA/ORION/ORION2/SATURN DDC начинается с индекса 2 (DDC0/1 — PureSignal)
  // Для HERMES/HL2 — с 0
  if FDevice.BoardType in [3, 4, 5, 10] then  // ANGELIA=3, ORION=4, ORION2=5, SATURN=10
    DDCBase := 2
  else
    DDCBase := 0;

  for i := 0 to NumDDCs - 1 do
  begin
    ddc := DDCBase + i;
    // Enable bit для DDC ddc
    Pkt.DDCEnable[ddc div 8] := Pkt.DDCEnable[ddc div 8] or Byte(1 shl (ddc mod 8));
    // Config: 6 байт на DDC начиная с offset 17 в пакете → в массиве DDCConfig
    // DDCConfig[ddc*6 + 0] = ADC source
    // DDCConfig[ddc*6 + 1..2] = sample rate / 1000 (ksps)
    // DDCConfig[ddc*6 + 5] = bits per sample
    Pkt.DDCConfig[ddc * 6]     := ADCSource;
    Pkt.DDCConfig[ddc * 6 + 1] := (SampleRate shr 8) and $FF;
    Pkt.DDCConfig[ddc * 6 + 2] :=  SampleRate        and $FF;
    Pkt.DDCConfig[ddc * 6 + 3] := 0;
    Pkt.DDCConfig[ddc * 6 + 4] := 0;
    Pkt.DDCConfig[ddc * 6 + 5] := 24;  // 24 bits per sample
  end;

  SendDDCSpecific(Pkt);
  FCachedDDCSpec  := Pkt;
  FCachedDDCValid := True;
  FResendCount    := 0;
end;

procedure THPSDRNetwork.SendDUCSpecific(const Pkt: TDUCSpecificPacket);
var
  B: TDUCSpecificPacket;
begin
  B := Pkt;
  PackSeqBytes(B.Seq, NextSeq(FSeqDUCSpec));
  DoSendTo(FSocket, B, SizeOf(B), FDevice.IPAddress, FPortDUCSpec);
end;

procedure THPSDRNetwork.SendHighPriority(const Pkt: THighPriorityPacket);
var
  B: THighPriorityPacket;
begin
  B := Pkt;
  PackSeqBytes(B.Seq, NextSeq(FSeqHP));
  DoSendTo(FSocket, B, SizeOf(B), FDevice.IPAddress, FPortHPFromPC);
end;

procedure THPSDRNetwork.UpdateState(RXFreqHz, TXFreqHz: Double;
                                    DriveLevel: Byte;
                                    Transmitting, PAEnabled, AlexEnabled: Boolean);
begin
  FCurrentRXFreq  := RXFreqHz;
  FCurrentTXFreq  := TXFreqHz;
  FCurrentDrive   := DriveLevel;
  FIsTransmitting := Transmitting;
  FPAEnabled      := PAEnabled;
  FAlexEnabled    := AlexEnabled;
end;

procedure THPSDRNetwork.SendFullHP;
var
  Buf:      array[0..1443] of Byte;
  Ph:       LongWord;
  Alex0:    LongWord;
  IsOrion2: Boolean;
  DDCBase:  Integer;   // 0 для HERMES, 2 для ORION/ORION2/ANGELIA
begin
  if not FConnected then Exit;

  FillChar(Buf, SizeOf(Buf), 0);

  // Sequence — будет упакован в SendHighPriority через PackSeqBytes,
  // но здесь мы шлём raw буфер напрямую
  Buf[0] := (FSeqHP shr 24) and $FF;
  Buf[1] := (FSeqHP shr 16) and $FF;
  Buf[2] := (FSeqHP shr  8) and $FF;
  Buf[3] :=  FSeqHP         and $FF;
  Inc(FSeqHP);

  // Byte 4: Run | PTT
  if FRunning then
  begin
    Buf[4] := HP_RUN;
    if FIsTransmitting then Buf[4] := Buf[4] or HP_PTT0;
  end;

  // DDC base: ORION/ORION2/ANGELIA/SATURN начинают с DDC2
  // IsOrion2: платы с Alex BPF и TxRx Status bit18 (ORION_MK2=5, SATURN=10)
  IsOrion2 := FDevice.BoardType in [5, 10];  // ORION_MK2=5, SATURN=10
  if FDevice.BoardType in [3, 4, 5, 10] then  // ANGELIA=3, ORION=4, ORION_MK2=5, SATURN=10
    DDCBase := 2
  else
    DDCBase := 0;

  // DDC RX frequency (bytes 9 + DDC*4)
  Ph := FreqToPhaseWord(FCurrentRXFreq);
  Buf[9  + DDCBase*4] := (Ph shr 24) and $FF;
  Buf[10 + DDCBase*4] := (Ph shr 16) and $FF;
  Buf[11 + DDCBase*4] := (Ph shr  8) and $FF;
  Buf[12 + DDCBase*4] :=  Ph         and $FF;

  // DUC TX frequency (bytes 329-332)
  Ph := FreqToPhaseWord(FCurrentTXFreq);
  Buf[329] := (Ph shr 24) and $FF;
  Buf[330] := (Ph shr 16) and $FF;
  Buf[331] := (Ph shr  8) and $FF;
  Buf[332] :=  Ph         and $FF;

  // Drive level (byte 345)
  if FIsTransmitting then
    Buf[345] := FCurrentDrive;

  // ALEX0 filter bits (bytes 1432-1435)
  if FAlexEnabled then
  begin
    Alex0 := CalcAlex0(FCurrentRXFreq, FCurrentTXFreq,
                       FIsTransmitting, IsOrion2);
    Buf[1432] := (Alex0 shr 24) and $FF;
    Buf[1433] := (Alex0 shr 16) and $FF;
    Buf[1434] := (Alex0 shr  8) and $FF;
    Buf[1435] :=  Alex0         and $FF;
  end;

  // Step attenuators ADC0/ADC1 (bytes 1443/1442)
  // 0 dB = 0, max 31 dB
  Buf[1443] := 0;   // ADC0 attenuation
  Buf[1442] := 0;   // ADC1 attenuation

  DoSendTo(FSocket, Buf, SizeOf(Buf), FDevice.IPAddress, FPortHPFromPC);
end;

procedure THPSDRNetwork.SetRunAndFreq(Run: Boolean; DDC0FreqHz, DUCFreqHz: Double;
                                      DriveLevel: Byte);
begin
  FRunning        := Run;
  FCurrentRXFreq  := DDC0FreqHz;
  FCurrentTXFreq  := DUCFreqHz;
  FCurrentDrive   := DriveLevel;
  SendFullHP;
end;

procedure THPSDRNetwork.SendDDCAudio(const LeftRight: array of SmallInt);
var
  Pkt: TDDCAudioPacket;
  i:   Integer;
  V:   SmallInt;
begin
  FillChar(Pkt, SizeOf(Pkt), 0);
  PackSeqBytes(Pkt.Seq, NextSeq(FSeqAudio));
  for i := 0 to Min(127, High(LeftRight)) do
  begin
    V := LeftRight[i];
    Pkt.AudioData[i * 2]     := Byte((V shr 8) and $FF);
    Pkt.AudioData[i * 2 + 1] := Byte(V and $FF);
  end;
  DoSendTo(FSocket, Pkt, SizeOf(Pkt), FDevice.IPAddress, FPortDDCAudio);
end;

procedure THPSDRNetwork.SendDUCIQ(const IData, QData: array of Integer);
var
  Pkt:    TDUCIQPacket;
  i, Off: Integer;
  IV, QV: Integer;
begin
  FillChar(Pkt, SizeOf(Pkt), 0);
  PackSeqBytes(Pkt.Seq, NextSeq(FSeqDUCIQ));
  for i := 0 to Min(239, Min(High(IData), High(QData))) do
  begin
    Off := i * 6;
    IV  := IData[i];
    QV  := QData[i];
    Pkt.IQData[Off]     := Byte((IV shr 16) and $FF);
    Pkt.IQData[Off + 1] := Byte((IV shr  8) and $FF);
    Pkt.IQData[Off + 2] := Byte( IV         and $FF);
    Pkt.IQData[Off + 3] := Byte((QV shr 16) and $FF);
    Pkt.IQData[Off + 4] := Byte((QV shr  8) and $FF);
    Pkt.IQData[Off + 5] := Byte( QV         and $FF);
  end;
  DoSendTo(FSocket, Pkt, SizeOf(Pkt), FDevice.IPAddress, FPortDUCIQ);
end;


initialization
{$IFDEF WINDOWS}
  WinSock2.WSAStartup($0202, WSAData_);
{$ENDIF}

finalization
{$IFDEF WINDOWS}
  WinSock2.WSACleanup;
{$ENDIF}

end.