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; {$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 // Текущее состояние для построения HP пакетов FCurrentRXFreq: Double; FCurrentTXFreq: Double; FCurrentDrive: Byte; FIsTransmitting: Boolean; FPAEnabled: Boolean; FAlexEnabled: Boolean; 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; 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; end; destructor THPSDRNetwork.Destroy; begin Disconnect; 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); Result := fpSendTo(S, @Buf, BufLen, 0, @Addr, SizeOf(Addr)) = BufLen; 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; Sync: TMicSync; M: TThreadMethod; begin if not Assigned(FOnMic) then Exit; Move(Buf[0], Pkt, SizeOf(Pkt)); Sync := TMicSync.Create(FOnMic, Pkt); try M := Sync.Execute; TThread.Synchronize(nil, M); finally Sync.Free; end; 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 при передаче if Transmitting then Result := Result or $08000000; // ALEX_TX_RELAY // 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 имеют 2 ADC if FDevice.BoardType in [4, 5] then // ORION=4, ORION2=5 Pkt.NumADCs := 2 else Pkt.NumADCs := 1; // Для ANGELIA/ORION/ORION2 DDC начинается с индекса 2 (DDC0/1 — PureSignal) // Для HERMES/HL2 — с 0 if FDevice.BoardType in [3, 4, 5] then // ANGELIA=3, ORION=4, ORION2=5 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); 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 Buf[4] := HP_RUN; // DDC base: ORION/ORION2/ANGELIA начинают с DDC2 IsOrion2 := (FDevice.BoardType = 5); // ORION-II = 5 if FDevice.BoardType in [3, 4, 5] then // ANGELIA=3, ORION=4, ORION2=5 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.