unit WebServer; { WebServer.pas — HTTP + WebSocket сервер для удалённого управления трансивером. Архитектура (по образцу OpenWebRX): ───────────────────────────────── HTTP GET / → index.html (см. WebPageHtml) HTTP GET /ws → Upgrade: WebSocket WebSocket сессия: • Сервер → клиент: - каждые ~50 ms: бинарный фрейм типа 'S' + 1024×Float32 спектр - каждые ~50 ms: бинарный фрейм типа 'W' + N×Float32 waterfall строка - каждые ~100ms: бинарный фрейм типа 'A' + Opus-пакет (48kHz mono) - каждые ~200ms: JSON-текст со state (freq, mode, smeter, …) • Клиент → сервер: JSON-команды "cmd":"freq","hz":14200000 "cmd":"mode","mode":1 "cmd":"filter","bw":2700 "cmd":"agc","mode":1 "cmd":"agctop","db":90 "cmd":"band","idx":5 "cmd":"span","hz":192000 "cmd":"volume","v":70 "cmd":"wfagc","on":true "cmd":"wfnf","on":true Аудио: 48kHz mono Float32 → Opus (20ms frames, 32 kbps) Спектр: 1024 Float32 dBm значений Авторизация: Basic Auth через HTTP заголовок при первом запросе Зависимости: WebUtils, WsClient, WebPageHtml + RTL + libopus (динамическая загрузка) Платформы: Windows + Linux (Winsock2 / BSD sockets) ИСПРАВЛЕНИЯ: - (Windows build fix) SyncObjs перенесён в конец блока uses — устраняет конфликт идентификатора Create с символами из WinSock2 в {$MODE Delphi}. - (Windows runtime fix) Добавлены WSAStartup/WSACleanup в конструктор и деструктор — без этого socket/bind/listen возвращают WSANOTINITIALISED. - (Linux shutdown fix) В Stop: перед SockClose вызывается SockShutdown для listen-сокета и для каждого клиентского сокета. На Linux закрытие дескриптора не прерывает блокирующий fpAccept/fpRecv в чужом потоке — только shutdown(SHUT_RDWR) гарантированно разблокирует их, позволяя потокам выйти и WaitFor завершиться без зависания. - (Audio fix 1) Исправлена константа OPUS_APPLICATION_AUDIO: было 2101 (невалидное значение), стало 2049 — правильное значение. Неверная константа приводила к Err!=0 из opus_encoder_create, FOpusEnc=nil, FOpusReady=false — аудио не кодировалось совсем. - (Audio fix 2) Заголовки COOP/COEP убраны — они блокировали WebSocket и загрузку CDN ресурсов (fonts, opus-decoder), из-за чего FWebClientActive никогда не становился true и десктоп звук не отключался при подключении веб-клиента. - (Audio fix 3) В JS исправлен вызов декодера: decodeFrame → decode (актуальный API opus-decoder@0.7.7). decodeFrame не существует в этой версии — silent fail, звука нет. - (Audio fix 4) Добавлен оверлей "Click to start audio" — AudioContext нельзя создать из WebSocket callback (не user gesture). Оверлей гарантирует создание AudioContext при первом кликe пользователя. - (Audio fix 5) Буферизация Opus-пакетов пока WASM не инициализирован — первые пакеты больше не теряются при медленной загрузке CDN. } {$IFDEF FPC} {$MODE Delphi} {$LONGSTRINGS ON} {$ENDIF} interface uses Classes, SysUtils, Math, WebUtils, WsClient, WebPageHtml {$IFDEF WINDOWS}, Windows, WinSock2{$ELSE}, BaseUnix, Sockets{$ENDIF}, SyncObjs; // ← после платформенных юнитов: исключает конфликт идентификатора Create const WEB_PORT = 8080; OPUS_SAMPLE_RATE = 48000; OPUS_FRAME_MS = 20; OPUS_FRAME_SAMP = OPUS_SAMPLE_RATE * OPUS_FRAME_MS div 1000; // 960 samples OPUS_BITRATE = 32000; OPUS_CHANNELS = 1; // ── TX-mic jitter handling (web → server) ── // Pre-roll: при старте новой TX-сессии задерживаем 40мс аудио, чтобы дать // FTXMicRing запас перед началом потребления — иначе при джиттере WiFi // ring мгновенно пустеет и WDSP TX-thread заливает тишину = "робот". MIC_PREROLL_MS = 40; MIC_PREROLL_SAMP = OPUS_SAMPLE_RATE * MIC_PREROLL_MS div 1000; // 1920 // Опоздание > MIC_IDLE_MS считаем концом TX-сессии: сбрасываем pre-roll // (на следующий пакет — снова накапливаем cushion). MIC_IDLE_MS = 200; // Максимум подряд синтезированных PLC-кадров (Opus PLC деградирует после ~3–5 кадров). MIC_MAX_PLC = 5; MAX_WS_CLIENTS = 4; WS_GUID = '258EAFA5-E914-47DA-95CA-C5AB0DC85B11'; // Типы бинарных фреймов (первый байт = тип) WS_MSG_SPECTRUM = Byte(Ord('S')); // S + 1024×Float32 WS_MSG_WATERFALL = Byte(Ord('W')); // W + N×Float32 WS_MSG_AUDIO = Byte(Ord('A')); // A + Opus bytes WS_MSG_AUDIO_PCM = Byte(Ord('P')); // P + N×Float32 (mono 48k) WS_MSG_STATE = Byte(Ord('J')); // J + JSON text type // ── Opus dynamic binding ────────────────────────────────────────────────── POpusEncoder = Pointer; TOpus_encoder_create = function(Fs, channels, application: Integer; error: PInteger): POpusEncoder; cdecl; TOpus_encoder_destroy = procedure(st: POpusEncoder); cdecl; TOpus_encode_float = function(st: POpusEncoder; pcm: PSingle; frame_size: Integer; data: PByte; max_data_bytes: Integer): Integer; cdecl; TOpus_encoder_ctl_set = function(st: POpusEncoder; request: Integer; value: Integer): Integer; cdecl; POpusDecoder = Pointer; TOpus_decoder_create = function(Fs, channels: Integer; error: PInteger): POpusDecoder; cdecl; TOpus_decode_float = function(st: POpusDecoder; data: PByte; len: Integer; pcm: PSingle; frame_size, decode_fec: Integer): Integer; cdecl; TOpus_decoder_destroy = procedure(st: POpusDecoder); cdecl; // ── Callbacks в MainForm ────────────────────────────────────────────────── TWebCmdFreq = procedure(Hz: Double) of object; TWebCmdMode = procedure(Mode: Integer) of object; TWebCmdFilter = procedure(BW: Integer) of object; TWebCmdAGC = procedure(Mode: Integer) of object; TWebCmdAGCTop = procedure(DB: Integer) of object; TWebCmdBand = procedure(Idx: Integer) of object; TWebCmdSpan = procedure(Hz: Integer) of object; TWebCmdVolume = procedure(V: Integer) of object; TWebCmdWfAGC = procedure(On_: Boolean) of object; TWebCmdWfNF = procedure(On_: Boolean) of object; TWebCmdRun = procedure(On_: Boolean) of object; TWebCmdMute = procedure(On_: Boolean) of object; TWebCmdCtun = procedure(On_: Boolean) of object; TWebCmdNRMode = procedure(Mode: Integer) of object; TWebCmdNBMode = procedure(Mode: Integer) of object; TWebCmdSNB = procedure(On_: Boolean) of object; TWebCmdANF = procedure(On_: Boolean) of object; TWebCmdFreqB = procedure(Hz: Double) of object; TWebCmdActiveVfo = procedure(Idx: Integer) of object; TWebCmdCenter = procedure(Hz: Double) of object; TWebCmdMOX = procedure(On_: Boolean) of object; TWebCmdDrive = procedure(V: Integer) of object; TWebCmdFreqA = procedure(Hz: Double) of object; TWebCmdAttn = procedure(Idx: Integer) of object; TWebCmdTun = procedure(On_: Boolean) of object; TWebCmdFMStep = procedure(Idx: Integer) of object; // XVTR-band: web клиент кликнул кнопку трансвертера (Idx 0..CFG_XVTR_COUNT-1). // Idx=-1 — выход в HF. TWebCmdXvtrBand = procedure(Idx: Integer) of object; // Один XVTR-слот для статуса (для отображения в web-bandSel). TWebXvtrInfo = record Idx: Integer; Name: string; end; TWebXvtrArray = array of TWebXvtrInfo; TWebMicCB = procedure(Samples: PSingle; Count: Integer) of object; // ── Главный класс сервера ───────────────────────────────────────────────── TWebServer = class private // ── Opus ── FOpusLib: THandle; FOpusEnc: POpusEncoder; FOpusCreate: TOpus_encoder_create; FOpusDestroy: TOpus_encoder_destroy; FOpusEncode: TOpus_encode_float; FOpusCtl: TOpus_encoder_ctl_set; FOpusBuf: array[0..OPUS_FRAME_SAMP-1] of Single; FOpusBufPos: Integer; FOpusOut: array[0..3999] of Byte; FWsAudioBuf: array[0..4000] of Byte; // 1 байт типа + до 4000 байт Opus FOpusReady: Boolean; // Opus decoder — для RX TX-mic аудио от браузера FOpusDec: POpusDecoder; FOpusDecCreate: TOpus_decoder_create; FOpusDecDecode: TOpus_decode_float; FOpusDecDestroy: TOpus_decoder_destroy; FOnWebMic: TWebMicCB; // ── Jitter buffer для TX-mic от веб-клиента ── // FMicLastTick = 0 → нет активной TX-сессии (на следующий пакет — pre-roll сброс) // FMicPreRollPos < MIC_PREROLL_SAMP → ещё копим pre-roll FMicLastTick: QWord; FMicPreRollPos: Integer; FMicPreRoll: array[0..MIC_PREROLL_SAMP-1] of Single; // ── Staging buffer: выравнивание по границе DSP-блока ────────────────── // Opus декодирует по 960 сэмплов, а TX DSP потребляет по 512. // 960 mod 512 = 448 — в ring всегда остаётся хвост меньше порога, // из-за чего TTXDSPThread пропускает тики и DUC hardware голодает. // FlushMicToCallback накапливает сэмплы здесь и вызывает FOnWebMic // ровно тогда, когда накопился полный блок 512 сэмплов. // Гарантия: FTXMicRing всегда получает данные кратными 512. FMicStageBuf: array[0..511] of Single; // буфер одного DSP-блока FMicStageLen: Integer; // сколько сэмплов накоплено // ── TCP ── FListenSock: TSocket; FClients: array[0..MAX_WS_CLIENTS-1] of TWsClient; FClientCount: Integer; FClientLock: TCriticalSection; // ── Потоки ── FAcceptThread: TThread; FPushThread: TThread; FRunning: Boolean; // ── Авторизация ── FAuthToken: string; // Base64(user:pass) // ── Сетевая конфигурация ── FPort: Word; FBindIP: string; // ── Состояние (обновляется из MainForm) ── FSpectrumBuf: array[0..1023] of Single; FWfBuf: array[0..1023] of Single; FWfCount: Integer; FSMeter: Double; FFreq: Double; FMode: Integer; FFilterBW: Integer; FAGCMode: Integer; FAGCTop: Integer; FSpanHz: Double; FVolume: Integer; FWfAGC: Boolean; FWfNF: Boolean; FBandIdx: Integer; FConnected: Boolean; FTrxRunning: Boolean; FMuted: Boolean; FCtun: Boolean; FNRMode: Integer; FNBMode: Integer; FSNB: Boolean; FANF: Boolean; FCenterHz: Double; FFilterIdx: Integer; FVfoB: Double; FActiveVfo: Integer; // 0=A, 1=B FFMStepIdx: Integer; FStateLock: TCriticalSection; // ── Callbacks ── FOnFreq: TWebCmdFreq; FOnMode: TWebCmdMode; FOnFilter: TWebCmdFilter; FOnAGC: TWebCmdAGC; FOnAGCTop: TWebCmdAGCTop; FOnBand: TWebCmdBand; FOnSpan: TWebCmdSpan; FOnVolume: TWebCmdVolume; FOnWfAGC: TWebCmdWfAGC; FOnWfNF: TWebCmdWfNF; FOnRun: TWebCmdRun; FOnMute: TWebCmdMute; FOnCtun: TWebCmdCtun; FOnNR: TWebCmdNRMode; FOnNB: TWebCmdNBMode; FOnSNB: TWebCmdSNB; FOnANF: TWebCmdANF; FOnFreqB: TWebCmdFreqB; FOnActiveVfo: TWebCmdActiveVfo; FOnCenter: TWebCmdCenter; FOnMOX: TWebCmdMOX; FOnDrive: TWebCmdDrive; FTransmitting: Boolean; FDriveLevel: Integer; FOnFreqA: TWebCmdFreqA; FOnAttn: TWebCmdAttn; FAttnIdx: Integer; FOnTun: TWebCmdTun; FOnFMStep: TWebCmdFMStep; FTuning: Boolean; FDuplex: Boolean; FFreqMhzDigits: Integer; // 3=999MHz, 4=9.999GHz, 5=99.999GHz FXvtrBands: TWebXvtrArray; // список enabled XVTR (для web-UI) FCurrentXvtr: Integer; // -1 = HF, иначе индекс активного XVTR FOnXvtrBand: TWebCmdXvtrBand; FFwdW: Double; FSWR: Double; FPAMaxPower: Double; FStatusText: string; FBoardText: string; FIPText: string; FSupplyText: string; FPLLText: string; FRXText: string; FTXText: string; FSeqText: string; FWebClientActive: Boolean; // ── Внутренние методы ── function LoadOpus: Boolean; procedure UnloadOpus; procedure PushMicSamples(P: PSingle; N: Integer); procedure FlushMicToCallback(P: PSingle; N: Integer); function InitListen: Boolean; procedure AcceptLoop; procedure PushLoop; procedure HandleClient(Client: TWsClient); procedure ProcessCommand(Client: TWsClient; const Json: string); procedure BroadcastBinary(const Data; Len: Integer); procedure BroadcastText(const S: string); procedure RemoveClient(Client: TWsClient); function BuildStateJson: string; function CheckAuth(const Header: string): Boolean; procedure SendHttp(Client: TWsClient; Code: Integer; const ContentType, Body: string); // Stub-методы (реализация встроена в HandleClient) procedure DoHandshake(Client: TWsClient); procedure ProcessWsFrame(Client: TWsClient; const Data: array of Byte; Len: Integer; Opcode: Byte); public constructor Create(const Username, Password: string; Port: Word = 8080; const BindIP: string = '0.0.0.0'); destructor Destroy; override; function Start: Boolean; procedure Stop; procedure Reconfigure(const Username, Password, BindIP: string; Port: Word); // Вызывается из DSP-потока (аудио, 48kHz mono) procedure PushAudio(const Samples: PSingle; Count: Integer); // Вызывается из таймера спектра (UI thread) procedure PushSpectrum( const Buf: array of Single; Count: Integer; const WfBuf_: array of Single; SMeter: Double; Freq: Double; Mode, FilterBW, AGCMode, AGCTop: Integer; SpanHz: Double; Volume: Integer; WfAGC, WfNF: Boolean; BandIdx: Integer; TrxConnected: Boolean; TrxRunning, Muted, Ctun: Boolean; NRMode, NBMode: Integer; SNB, ANF: Boolean; CenterHz: Double; FilterIdx: Integer; VfoB: Double; ActiveVfo: Integer; Transmitting: Boolean; DriveLevel: Integer; AttnIdx: Integer; Tuning: Boolean; Duplex: Boolean; FwdW, SWRV, PAMaxPower: Double; const StatusText, BoardText, IPText, SupplyText, PLLText, RXText, TXText, SeqText: string); property WebClientActive: Boolean read FWebClientActive; property FreqMhzDigits: Integer read FFreqMhzDigits write FFreqMhzDigits; property FMStepIdx: Integer read FFMStepIdx write FFMStepIdx; property OnFreq: TWebCmdFreq read FOnFreq write FOnFreq; property OnMode: TWebCmdMode read FOnMode write FOnMode; property OnFilter: TWebCmdFilter read FOnFilter write FOnFilter; property OnAGC: TWebCmdAGC read FOnAGC write FOnAGC; property OnAGCTop: TWebCmdAGCTop read FOnAGCTop write FOnAGCTop; property OnBand: TWebCmdBand read FOnBand write FOnBand; property OnXvtrBand: TWebCmdXvtrBand read FOnXvtrBand write FOnXvtrBand; procedure SetXvtrBands(const ABands: TWebXvtrArray; ACurrent: Integer); property OnSpan: TWebCmdSpan read FOnSpan write FOnSpan; property OnVolume: TWebCmdVolume read FOnVolume write FOnVolume; property OnWfAGC: TWebCmdWfAGC read FOnWfAGC write FOnWfAGC; property OnWfNF: TWebCmdWfNF read FOnWfNF write FOnWfNF; property OnRun: TWebCmdRun read FOnRun write FOnRun; property OnMute: TWebCmdMute read FOnMute write FOnMute; property OnCtun: TWebCmdCtun read FOnCtun write FOnCtun; property OnNR: TWebCmdNRMode read FOnNR write FOnNR; property OnNB: TWebCmdNBMode read FOnNB write FOnNB; property OnSNB: TWebCmdSNB read FOnSNB write FOnSNB; property OnANF: TWebCmdANF read FOnANF write FOnANF; property OnFreqB: TWebCmdFreqB read FOnFreqB write FOnFreqB; property OnActiveVfo: TWebCmdActiveVfo read FOnActiveVfo write FOnActiveVfo; property OnCenter: TWebCmdCenter read FOnCenter write FOnCenter; property OnMOX: TWebCmdMOX read FOnMOX write FOnMOX; property OnDrive: TWebCmdDrive read FOnDrive write FOnDrive; property OnFreqA: TWebCmdFreqA read FOnFreqA write FOnFreqA; property OnAttn: TWebCmdAttn read FOnAttn write FOnAttn; property OnTun: TWebCmdTun read FOnTun write FOnTun; property OnFMStep: TWebCmdFMStep read FOnFMStep write FOnFMStep; property OnWebMic: TWebMicCB read FOnWebMic write FOnWebMic; end; implementation { ═══════════════════════════════════════════════════════════════════════════ Внутренние классы потоков ═══════════════════════════════════════════════════════════════════════════ } type TAcceptThread = class(TThread) private FServer: TWebServer; protected procedure Execute; override; public constructor Create(AServer: TWebServer); end; TPushThread = class(TThread) private FServer: TWebServer; protected procedure Execute; override; public constructor Create(AServer: TWebServer); end; TClientThread = class(TThread) private FServer: TWebServer; FClient: TWsClient; protected procedure Execute; override; public constructor Create(AServer: TWebServer; AClient: TWsClient); end; constructor TAcceptThread.Create(AServer: TWebServer); begin inherited Create(True); FServer := AServer; FreeOnTerminate := False; end; procedure TAcceptThread.Execute; begin FServer.AcceptLoop; end; constructor TPushThread.Create(AServer: TWebServer); begin inherited Create(True); FServer := AServer; FreeOnTerminate := False; end; procedure TPushThread.Execute; begin FServer.PushLoop; end; constructor TClientThread.Create(AServer: TWebServer; AClient: TWsClient); begin inherited Create(True); FServer := AServer; FClient := AClient; FreeOnTerminate := True; end; procedure TClientThread.Execute; begin FServer.HandleClient(FClient); end; { ═══════════════════════════════════════════════════════════════════════════ TWebServer — конструктор / деструктор ═══════════════════════════════════════════════════════════════════════════ } constructor TWebServer.Create(const Username, Password: string; Port: Word; const BindIP: string); {$IFDEF WINDOWS} var WSAData: TWSAData; {$ENDIF} begin {$IFDEF WINDOWS} // Инициализация Winsock2 — обязательна перед любыми вызовами socket API WSAStartup($0202, WSAData); {$ENDIF} inherited Create; FAuthToken := Base64EncodeStr(Username + ':' + Password); FPort := Port; FBindIP := BindIP; FListenSock := SOCK_INVALID; FRunning := False; FClientCount := 0; FOpusReady := False; FOpusBufPos := 0; FWebClientActive := False; FClientLock := TCriticalSection.Create; FStateLock := TCriticalSection.Create; // Начальные значения состояния FFreq := 14200000; FMode := 1; FFMStepIdx := 3; // 25 kHz default FFilterBW:= 2700; FAGCMode := 1; FAGCTop := 90; FSpanHz := 192000; FVolume := 70; FSMeter := -120; FFwdW := 0; FSWR := 1.0; FPAMaxPower := 100.0; FStatusText := 'Disconnected'; FBoardText := 'Board --'; FIPText := 'IP --'; FSupplyText := 'Supply --'; FPLLText := 'PLL --'; FRXText := 'RX idle'; FTXText := 'TX idle'; FSeqText := 'SEQ --'; FBandIdx := 5; FCurrentXvtr := -1; FFreqMhzDigits := 3; SetLength(FXvtrBands, 0); end; procedure TWebServer.SetXvtrBands(const ABands: TWebXvtrArray; ACurrent: Integer); var i: Integer; begin FStateLock.Enter; try SetLength(FXvtrBands, Length(ABands)); for i := 0 to High(ABands) do FXvtrBands[i] := ABands[i]; FCurrentXvtr := ACurrent; finally FStateLock.Leave; end; end; destructor TWebServer.Destroy; begin Stop; FClientLock.Free; FStateLock.Free; inherited; {$IFDEF WINDOWS} // Освобождение ресурсов Winsock2 WSACleanup; {$ENDIF} end; { ═══════════════════════════════════════════════════════════════════════════ Загрузка / выгрузка Opus ═══════════════════════════════════════════════════════════════════════════ } function TWebServer.LoadOpus: Boolean; const {$IFDEF WINDOWS} LIBNAME = 'libopus-0.dll'; {$ELSE} LIBNAME = 'libopus.so.0'; {$ENDIF} var Err: Integer; begin Result := False; FOpusLib := LoadLibrary(LIBNAME); if FOpusLib = 0 then Exit; FOpusCreate := TOpus_encoder_create( GetProcAddress(FOpusLib, 'opus_encoder_create')); FOpusDestroy := TOpus_encoder_destroy(GetProcAddress(FOpusLib, 'opus_encoder_destroy')); FOpusEncode := TOpus_encode_float( GetProcAddress(FOpusLib, 'opus_encode_float')); FOpusCtl := TOpus_encoder_ctl_set(GetProcAddress(FOpusLib, 'opus_encoder_ctl')); FOpusDecCreate := TOpus_decoder_create( GetProcAddress(FOpusLib, 'opus_decoder_create')); FOpusDecDecode := TOpus_decode_float( GetProcAddress(FOpusLib, 'opus_decode_float')); FOpusDecDestroy := TOpus_decoder_destroy(GetProcAddress(FOpusLib, 'opus_decoder_destroy')); if not Assigned(FOpusCreate) or not Assigned(FOpusEncode) then begin FreeLibrary(FOpusLib); FOpusLib := 0; Exit; end; FOpusEnc := FOpusCreate(OPUS_SAMPLE_RATE, OPUS_CHANNELS, 2049 {OPUS_APPLICATION_AUDIO}, @Err); if (FOpusEnc = nil) or (Err <> 0) then begin FreeLibrary(FOpusLib); FOpusLib := 0; Exit; end; // OPUS_SET_BITRATE_REQUEST = 4002 if Assigned(FOpusCtl) then FOpusCtl(FOpusEnc, 4002, OPUS_BITRATE); // Декодер для TX mic (браузер → Opus → WDSP) if Assigned(FOpusDecCreate) then begin Err := 0; FOpusDec := FOpusDecCreate(OPUS_SAMPLE_RATE, OPUS_CHANNELS, @Err); if Err <> 0 then FOpusDec := nil; end; FOpusBufPos := 0; FOpusReady := True; Result := True; end; procedure TWebServer.FlushMicToCallback(P: PSingle; N: Integer); // Аккумулирует сэмплы в FMicStageBuf и вызывает FOnWebMic ровно когда // накопился полный DSP-блок (512 сэмплов). Неполный остаток хранится // в буфере до следующего вызова. // // Почему 512: TX DSP поток читает из FTXMicRing блоками по FAudioBufSize=512. // Если ring содержит 0 < Avail < 512, поток пропускает тик → DUC underflow. // Staging гарантирует что ring всегда получает данные кратными 512. var Src: PSingle; Fill: Integer; begin if not Assigned(FOnWebMic) or (N <= 0) then Exit; Src := P; while N > 0 do begin // Докладываем в stage сколько нужно до полного блока (или сколько есть) Fill := Min(N, 512 - FMicStageLen); Move(Src^, FMicStageBuf[FMicStageLen], Fill * SizeOf(Single)); Inc(FMicStageLen, Fill); Inc(Src, Fill); Dec(N, Fill); // Полный блок готов — передаём в DSP-цепь и сбрасываем stage if FMicStageLen = 512 then begin FOnWebMic(@FMicStageBuf[0], 512); FMicStageLen := 0; end; end; end; procedure TWebServer.PushMicSamples(P: PSingle; N: Integer); // Прокладка между Opus-декодером и FlushMicToCallback с pre-roll cushion. // Первые MIC_PREROLL_SAMP сэмплов TX-сессии копим в FMicPreRoll и сливаем // одним блоком — это даёт FTXMicRing запас глубины ~40мс на джиттер. // После pre-roll все сэмплы уходят через FlushMicToCallback, которая // выравнивает поток по границе 512 сэмплов. var Want, Remainder: Integer; P2: PSingle; begin if not Assigned(FOnWebMic) or (N <= 0) then Exit; if FMicPreRollPos < MIC_PREROLL_SAMP then begin Want := MIC_PREROLL_SAMP - FMicPreRollPos; if N <= Want then begin Move(P^, FMicPreRoll[FMicPreRollPos], N * SizeOf(Single)); Inc(FMicPreRollPos, N); // N = Want точно заполняет pre-roll — надо слить (иначе буфер потерян) if FMicPreRollPos = MIC_PREROLL_SAMP then FlushMicToCallback(@FMicPreRoll[0], MIC_PREROLL_SAMP); end else begin // Pre-roll заполнен: сливаем накопленный буфер + остаток пакета Move(P^, FMicPreRoll[FMicPreRollPos], Want * SizeOf(Single)); FMicPreRollPos := MIC_PREROLL_SAMP; FlushMicToCallback(@FMicPreRoll[0], MIC_PREROLL_SAMP); Remainder := N - Want; P2 := P; Inc(P2, Want); FlushMicToCallback(P2, Remainder); end; end else FlushMicToCallback(P, N); end; procedure TWebServer.UnloadOpus; begin if FOpusReady and Assigned(FOpusDestroy) and (FOpusEnc <> nil) then FOpusDestroy(FOpusEnc); FOpusEnc := nil; if Assigned(FOpusDec) and Assigned(FOpusDecDestroy) then FOpusDecDestroy(FOpusDec); FOpusDec := nil; FOpusReady := False; if FOpusLib <> 0 then begin FreeLibrary(FOpusLib); FOpusLib := 0; end; end; { ═══════════════════════════════════════════════════════════════════════════ Start / Stop ═══════════════════════════════════════════════════════════════════════════ } function ParseIPv4(const S: string): LongWord; // Парсит dotted-decimal '1.2.3.4', возвращает сетевой порядок байт. // '0.0.0.0' и '' → INADDR_ANY (0). var P, Start: PChar; Parts: array[0..3] of Byte; Idx, V: Integer; begin Result := 0; if (S = '') or (S = '0.0.0.0') then Exit; Idx := 0; P := PChar(S); Start := P; while True do begin if (P^ = '.') or (P^ = #0) then begin if Idx > 3 then Exit; V := StrToIntDef(Copy(S, Start - PChar(S) + 1, P - Start), -1); if (V < 0) or (V > 255) then Exit; Parts[Idx] := Byte(V); Inc(Idx); if P^ = #0 then Break; Inc(P); Start := P; end else Inc(P); end; if Idx <> 4 then Exit; // Сетевой порядок: старший байт первый Result := (LongWord(Parts[0]) shl 24) or (LongWord(Parts[1]) shl 16) or (LongWord(Parts[2]) shl 8) or LongWord(Parts[3]); Result := htonl(Result); end; function TWebServer.InitListen: Boolean; var Addr: {$IFDEF WINDOWS}TSockAddrIn{$ELSE}TInetSockAddr{$ENDIF}; One: Integer; begin Result := False; {$IFDEF WINDOWS} FListenSock := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP); {$ELSE} FListenSock := fpSocket(AF_INET, SOCK_STREAM, IPPROTO_TCP); {$ENDIF} if FListenSock = SOCK_INVALID then Exit; One := 1; {$IFDEF WINDOWS} setsockopt(FListenSock, SOL_SOCKET, SO_REUSEADDR, @One, SizeOf(One)); FillChar(Addr, SizeOf(Addr), 0); Addr.sin_family := AF_INET; Addr.sin_port := htons(FPort); Addr.sin_addr.S_addr := ParseIPv4(FBindIP); if bind(FListenSock, @Addr, SizeOf(Addr)) = SOCKET_ERROR then Exit; if listen(FListenSock, 5) = SOCKET_ERROR then Exit; {$ELSE} fpSetSockOpt(FListenSock, SOL_SOCKET, SO_REUSEADDR, @One, SizeOf(One)); FillChar(Addr, SizeOf(Addr), 0); Addr.sin_family := AF_INET; Addr.sin_port := htons(FPort); Addr.sin_addr.s_addr := ParseIPv4(FBindIP); if fpBind(FListenSock, @Addr, SizeOf(Addr)) <> 0 then Exit; if fpListen(FListenSock, 5) <> 0 then Exit; {$ENDIF} Result := True; end; function TWebServer.Start: Boolean; begin Result := False; if FRunning then Exit; if not LoadOpus then ; // Opus опционален — продолжаем без него if not InitListen then Exit; FRunning := True; FAcceptThread := TAcceptThread.Create(Self); TAcceptThread(FAcceptThread).Start; FPushThread := TPushThread.Create(Self); TPushThread(FPushThread).Start; Result := True; end; procedure TWebServer.Stop; var i: Integer; begin if not FRunning then Exit; FRunning := False; // ── Шаг 1: shutdown + close listen-сокета ──────────────────────────────── // SockShutdown ОБЯЗАТЕЛЕН перед SockClose на Linux: закрытие дескриптора // не прерывает fpAccept в AcceptThread — только shutdown разблокирует его. // На Windows это тоже корректно (SD_BOTH). if FListenSock <> SOCK_INVALID then begin SockShutdown(FListenSock); SockClose(FListenSock); FListenSock := SOCK_INVALID; end; // ── Шаг 2: shutdown всех клиентских сокетов ────────────────────────────── // Разблокирует все HandleClient, заблокированные в Client.Recv (fpRecv). // FreeOnTerminate=True у TClientThread — они освободятся сами после выхода. FClientLock.Enter; try for i := 0 to FClientCount - 1 do if FClients[i] <> nil then begin FClients[i].State := wsClosed; SockShutdown(FClients[i].Socket); // ← разблокирует fpRecv в клиентском потоке end; finally FClientLock.Leave; end; // ── Шаг 3: ждём завершения фоновых потоков ─────────────────────────────── // После shutdown потоки получат ошибку из recv/accept и выйдут сами. if FAcceptThread <> nil then begin FAcceptThread.WaitFor; FreeAndNil(FAcceptThread); end; if FPushThread <> nil then begin FPushThread.WaitFor; FreeAndNil(FPushThread); end; // ── Шаг 4: освобождаем клиентов ────────────────────────────────────────── FClientLock.Enter; try for i := 0 to FClientCount - 1 do FreeAndNil(FClients[i]); FClientCount := 0; finally FClientLock.Leave; end; UnloadOpus; end; procedure TWebServer.Reconfigure(const Username, Password, BindIP: string; Port: Word); begin Stop; FAuthToken := Base64EncodeStr(Username + ':' + Password); FPort := Port; FBindIP := BindIP; end; { ═══════════════════════════════════════════════════════════════════════════ Accept loop ═══════════════════════════════════════════════════════════════════════════ } procedure TWebServer.AcceptLoop; var CSock: TSocket; Addr: {$IFDEF WINDOWS}TSockAddrIn{$ELSE}TInetSockAddr{$ENDIF}; ALen: {$IFDEF WINDOWS}Integer{$ELSE}TSockLen{$ENDIF}; Client: TWsClient; T: TClientThread; begin while FRunning do begin ALen := SizeOf(Addr); {$IFDEF WINDOWS} CSock := accept(FListenSock, @Addr, @ALen); {$ELSE} CSock := fpAccept(FListenSock, @Addr, @ALen); {$ENDIF} if CSock = SOCK_INVALID then begin if FRunning then Sleep(10); Continue; end; if FClientCount >= MAX_WS_CLIENTS then begin SockClose(CSock); Continue; end; // 1 секунда на отправку: если TCP-буфер клиента переполнен, SockSend // вернёт ошибку вместо того чтобы висеть и держать FClientLock вечно. SockSetSndTimeout(CSock, 1000); Client := TWsClient.Create(CSock); FClientLock.Enter; try FClients[FClientCount] := Client; Inc(FClientCount); finally FClientLock.Leave; end; T := TClientThread.Create(Self, Client); T.Start; end; end; { ═══════════════════════════════════════════════════════════════════════════ HTTP / WebSocket обработчик клиента ═══════════════════════════════════════════════════════════════════════════ } function TWebServer.CheckAuth(const Header: string): Boolean; var Pos_: Integer; Token, HeaderLC: string; begin Result := False; HeaderLC := LowerCase(Header); Pos_ := System.Pos('authorization: basic ', HeaderLC); if Pos_ = 0 then Exit; Token := Copy(Header, Pos_ + 21, 200); Pos_ := System.Pos(#13, Token); if Pos_ > 0 then Token := Copy(Token, 1, Pos_ - 1); Pos_ := System.Pos(#10, Token); if Pos_ > 0 then Token := Copy(Token, 1, Pos_ - 1); Token := Trim(Token); Result := (Token = FAuthToken); end; procedure TWebServer.SendHttp(Client: TWsClient; Code: Integer; const ContentType, Body: string); var StatusText, Response: string; begin case Code of 200: StatusText := 'OK'; 401: StatusText := 'Unauthorized'; 404: StatusText := 'Not Found'; else StatusText := 'Error'; end; Response := Format('HTTP/1.1 %d %s'#13#10 + 'Content-Type: %s'#13#10 + 'Content-Length: %d'#13#10 + 'Connection: close'#13#10 + #13#10 + '%s', [Code, StatusText, ContentType, Length(Body), Body]); Client.SendRaw(Response[1], Length(Response)); end; procedure TWebServer.HandleClient(Client: TWsClient); var R, HeaderEnd: Integer; Header, HeaderLC, Key, Path, AcceptKey: string; Response: string; WsHandled: Boolean; IsWsRequest: Boolean; // WS frame parsing B0, B1: Byte; Masked: Boolean; PayLen: Integer; Mask: array[0..3] of Byte; Payload: array of Byte; Opcode: Byte; i, Need: Integer; j: Integer; P1, P2: Integer; KPos, KEnd: Integer; Consumed: Integer; Raw: array[0..8191] of Byte; RawLen: Integer; PcmBuf: array[0..5759] of Single; // 120ms max @ 48kHz (для RX TX-mic) Decoded: Integer; NowTick: QWord; MissedFrames: Integer; PlcDecoded: Integer; k: Integer; begin WsHandled := False; RawLen := 0; // ── Фаза 1: чтение HTTP-запроса ────────────────────────────────────────── Header := ''; repeat R := SockRecv(Client.Socket, @Raw[RawLen], SizeOf(Raw) - RawLen, 0); if R <= 0 then begin Client.State := wsClosed; Break; end; Inc(RawLen, R); SetLength(Header, RawLen); Move(Raw[0], Header[1], RawLen); HeaderEnd := System.Pos(#13#10#13#10, Header); until (HeaderEnd > 0) or (RawLen >= SizeOf(Raw)); if (Client.State = wsClosed) or (HeaderEnd = 0) then begin RemoveClient(Client); Exit; end; Header := Copy(Header, 1, HeaderEnd + 3); HeaderLC := LowerCase(Header); // Извлечь путь Path := ''; if System.Pos('GET /', Header) > 0 then begin P1 := System.Pos('GET ', Header) + 4; P2 := System.Pos(' HTTP', Header); if P2 > P1 then Path := Copy(Header, P1, P2 - P1); end; IsWsRequest := (Path = '/ws') and (System.Pos('upgrade: websocket', HeaderLC) > 0); // Basic Auth (только для HTTP-страниц; WS handshake без авторизации) if (not IsWsRequest) and (not CheckAuth(Header)) then begin Response := 'HTTP/1.1 401 Unauthorized'#13#10 + 'WWW-Authenticate: Basic realm="HPSDR"'#13#10 + 'Content-Length: 0'#13#10 + 'Connection: close'#13#10#13#10; Client.SendRaw(Response[1], Length(Response)); RemoveClient(Client); Exit; end; // WebSocket upgrade if System.Pos('upgrade: websocket', HeaderLC) > 0 then begin KPos := System.Pos('sec-websocket-key: ', HeaderLC); if KPos > 0 then begin Key := Copy(Header, KPos + 19, 100); KEnd := System.Pos(#13, Key); if KEnd > 0 then Key := Copy(Key, 1, KEnd - 1); Key := Trim(Key); end; AcceptKey := Base64EncodeBytes(SHA1(Key + WS_GUID), 20); Response := 'HTTP/1.1 101 Switching Protocols'#13#10 + 'Upgrade: websocket'#13#10 + 'Connection: Upgrade'#13#10 + 'Sec-WebSocket-Accept: ' + AcceptKey + #13#10#13#10; Client.SendRaw(Response[1], Length(Response)); Client.State := wsOpen; FStateLock.Enter; FWebClientActive := True; FStateLock.Leave; Client.SendText(BuildStateJson); WsHandled := True; end else if Path = '/' then begin SendHttp(Client, 200, 'text/html; charset=utf-8', GetIndexHtml); RemoveClient(Client); Exit; end else begin SendHttp(Client, 404, 'text/plain', 'Not Found'); RemoveClient(Client); Exit; end; if not WsHandled then begin RemoveClient(Client); Exit; end; // ── Фаза 2: цикл WebSocket-сообщений ───────────────────────────────────── Client.BufLen := 0; while FRunning and (Client.State = wsOpen) do begin R := Client.Recv; if R <= 0 then Break; while Client.BufLen >= 2 do begin B0 := Client.BufData[0]; B1 := Client.BufData[1]; Opcode := B0 and $0F; Masked := (B1 and $80) <> 0; PayLen := B1 and $7F; Need := 2; if PayLen = 126 then Inc(Need, 2) else if PayLen = 127 then Inc(Need, 8); if Masked then Inc(Need, 4); if Client.BufLen < Need then Break; i := 2; if PayLen = 126 then begin PayLen := (Client.BufData[2] shl 8) or Client.BufData[3]; Inc(i, 2); end else if PayLen = 127 then begin PayLen := (Client.BufData[6] shl 24) or (Client.BufData[7] shl 16) or (Client.BufData[8] shl 8) or Client.BufData[9]; Inc(i, 8); end; if Client.BufLen < Need + PayLen then Break; if Masked then begin Mask[0] := Client.BufData[i]; Mask[1] := Client.BufData[i+1]; Mask[2] := Client.BufData[i+2]; Mask[3] := Client.BufData[i+3]; Inc(i, 4); end; SetLength(Payload, PayLen); if PayLen > 0 then begin Move(Client.BufData[i], Payload[0], PayLen); if Masked then for j := 0 to PayLen - 1 do Payload[j] := Payload[j] xor Mask[j and 3]; end; Consumed := i + PayLen; if Client.BufLen > Consumed then Move(Client.BufData[Consumed], Client.BufData[0], Client.BufLen - Consumed); Client.BufLen := Client.BufLen - Consumed; case Opcode of $01: // Text → команда begin SetLength(Header, PayLen); if PayLen > 0 then Move(Payload[0], Header[1], PayLen); ProcessCommand(Client, Header); end; $02: // Binary — TX mic Opus frame: byte 'M' + raw Opus packet begin if (PayLen > 1) and (Payload[0] = Ord('M')) and Assigned(FOpusDec) and Assigned(FOpusDecDecode) and Assigned(FOnWebMic) then begin NowTick := GetTickCount64; if (FMicLastTick = 0) or ((NowTick - FMicLastTick) > MIC_IDLE_MS) then begin // Новая TX-сессия (первый пакет или длинный простой): // сбрасываем pre-roll и staging, PLC не применяем — // нет состояния для предсказания. FMicPreRollPos := 0; FMicStageLen := 0; end else begin // PLC для опоздавших/потерянных кадров по wall-clock. // expected_packets ≈ elapsed_ms / 20ms; out of them один — текущий, // остальные считаем "потерянными" и синтезируем Opus PLC. MissedFrames := Integer((NowTick - FMicLastTick) div OPUS_FRAME_MS); if MissedFrames > 0 then Dec(MissedFrames); if MissedFrames > MIC_MAX_PLC then MissedFrames := MIC_MAX_PLC; for k := 1 to MissedFrames do begin // opus_decode_float(dec, NULL, 0, pcm, frame_size, 0) → PLC frame PlcDecoded := FOpusDecDecode(FOpusDec, nil, 0, @PcmBuf[0], OPUS_FRAME_SAMP, 0); if PlcDecoded > 0 then PushMicSamples(@PcmBuf[0], PlcDecoded); end; end; FMicLastTick := NowTick; Decoded := FOpusDecDecode(FOpusDec, @Payload[1], PayLen - 1, @PcmBuf[0], Length(PcmBuf), 0); if Decoded > 0 then PushMicSamples(@PcmBuf[0], Decoded); end; end; $08: // Close begin Client.State := wsClosed; Break; end; $09: // Ping → Pong Client.SendWsFrame($0A, Payload[0], PayLen); end; end; end; FStateLock.Enter; FWebClientActive := (FClientCount > 1); FStateLock.Leave; RemoveClient(Client); end; procedure TWebServer.RemoveClient(Client: TWsClient); var i, j: Integer; begin FClientLock.Enter; try for i := 0 to FClientCount - 1 do if FClients[i] = Client then begin FClients[i].Free; for j := i to FClientCount - 2 do FClients[j] := FClients[j+1]; FClients[FClientCount-1] := nil; Dec(FClientCount); Break; end; FWebClientActive := False; for i := 0 to FClientCount - 1 do if (FClients[i] <> nil) and (FClients[i].State = wsOpen) then begin FWebClientActive := True; Break; end; finally FClientLock.Leave; end; end; { ═══════════════════════════════════════════════════════════════════════════ Обработка JSON-команд от браузера ═══════════════════════════════════════════════════════════════════════════ } procedure TWebServer.ProcessCommand(Client: TWsClient; const Json: string); var Cmd: string; HzF: Double; HzI, ModeValue, BW, DB, Idx, V: Integer; On_: Boolean; begin Cmd := JsonGetStr(Json, 'cmd'); if Cmd = 'freq' then begin HzF := JsonGetFloat(Json, 'hz', FFreq); FStateLock.Enter; FFreq := HzF; FStateLock.Leave; if Assigned(FOnFreq) then FOnFreq(HzF); end else if Cmd = 'mode' then begin ModeValue := JsonGetInt(Json, 'mode', FMode); FStateLock.Enter; FMode := ModeValue; FStateLock.Leave; if Assigned(FOnMode) then FOnMode(ModeValue); end else if Cmd = 'filter' then begin BW := JsonGetInt(Json, 'bw', FFilterBW); FStateLock.Enter; FFilterBW := BW; FStateLock.Leave; if Assigned(FOnFilter) then FOnFilter(BW); end else if Cmd = 'agc' then begin ModeValue := JsonGetInt(Json, 'mode', FAGCMode); FStateLock.Enter; FAGCMode := ModeValue; FStateLock.Leave; if Assigned(FOnAGC) then FOnAGC(ModeValue); end else if Cmd = 'agctop' then begin DB := JsonGetInt(Json, 'db', FAGCTop); FStateLock.Enter; FAGCTop := DB; FStateLock.Leave; if Assigned(FOnAGCTop) then FOnAGCTop(DB); end else if Cmd = 'band' then begin Idx := JsonGetInt(Json, 'idx', FBandIdx); FStateLock.Enter; FBandIdx := Idx; FStateLock.Leave; if Assigned(FOnBand) then FOnBand(Idx); end else if Cmd = 'xvtr_band' then begin // Idx 0..CFG_XVTR_COUNT-1 — активировать XVTR; -1 — выйти в HF Idx := JsonGetInt(Json, 'idx', -1); if Assigned(FOnXvtrBand) then FOnXvtrBand(Idx); end else if Cmd = 'span' then begin HzI := JsonGetInt(Json, 'hz', Round(FSpanHz)); FStateLock.Enter; FSpanHz := HzI; FStateLock.Leave; if Assigned(FOnSpan) then FOnSpan(HzI); end else if Cmd = 'volume' then begin V := JsonGetInt(Json, 'v', FVolume); FStateLock.Enter; FVolume := V; FStateLock.Leave; if Assigned(FOnVolume) then FOnVolume(V); end else if Cmd = 'wfagc' then begin On_ := JsonGetBool(Json, 'on', FWfAGC); FStateLock.Enter; FWfAGC := On_; FStateLock.Leave; if Assigned(FOnWfAGC) then FOnWfAGC(On_); end else if Cmd = 'wfnf' then begin On_ := JsonGetBool(Json, 'on', FWfNF); FStateLock.Enter; FWfNF := On_; FStateLock.Leave; if Assigned(FOnWfNF) then FOnWfNF(On_); end else if Cmd = 'set_run' then begin On_ := JsonGetBool(Json, 'on', FTrxRunning); FStateLock.Enter; FTrxRunning := On_; FStateLock.Leave; if Assigned(FOnRun) then FOnRun(On_); end else if Cmd = 'set_mute' then begin On_ := JsonGetBool(Json, 'on', FMuted); FStateLock.Enter; FMuted := On_; FStateLock.Leave; if Assigned(FOnMute) then FOnMute(On_); end else if Cmd = 'set_ctun' then begin On_ := JsonGetBool(Json, 'on', FCtun); FStateLock.Enter; FCtun := On_; FStateLock.Leave; if Assigned(FOnCtun) then FOnCtun(On_); end else if Cmd = 'set_nr' then begin On_ := JsonGetBool(Json, 'on', FNRMode <> 0); ModeValue := Ord(On_); FStateLock.Enter; FNRMode := ModeValue; FStateLock.Leave; if Assigned(FOnNR) then FOnNR(ModeValue); end else if Cmd = 'set_nr_mode' then begin ModeValue := JsonGetInt(Json, 'mode', FNRMode); if ModeValue < 0 then ModeValue := 0; if ModeValue > 4 then ModeValue := 4; FStateLock.Enter; FNRMode := ModeValue; FStateLock.Leave; if Assigned(FOnNR) then FOnNR(ModeValue); end else if Cmd = 'set_nb' then begin On_ := JsonGetBool(Json, 'on', FNBMode <> 0); ModeValue := Ord(On_); FStateLock.Enter; FNBMode := ModeValue; FStateLock.Leave; if Assigned(FOnNB) then FOnNB(ModeValue); end else if Cmd = 'set_nb_mode' then begin ModeValue := JsonGetInt(Json, 'mode', FNBMode); if ModeValue < 0 then ModeValue := 0; if ModeValue > 2 then ModeValue := 2; FStateLock.Enter; FNBMode := ModeValue; FStateLock.Leave; if Assigned(FOnNB) then FOnNB(ModeValue); end else if Cmd = 'set_snb' then begin On_ := JsonGetBool(Json, 'on', FSNB); FStateLock.Enter; FSNB := On_; FStateLock.Leave; if Assigned(FOnSNB) then FOnSNB(On_); end else if Cmd = 'set_anf' then begin On_ := JsonGetBool(Json, 'on', FANF); FStateLock.Enter; FANF := On_; FStateLock.Leave; if Assigned(FOnANF) then FOnANF(On_); end else if Cmd = 'freq_b' then begin HzF := JsonGetFloat(Json, 'hz', FVfoB); FStateLock.Enter; FVfoB := HzF; FStateLock.Leave; if Assigned(FOnFreqB) then FOnFreqB(HzF); end else if Cmd = 'set_active_vfo' then begin ModeValue := JsonGetInt(Json, 'idx', FActiveVfo); if ModeValue < 0 then ModeValue := 0; if ModeValue > 1 then ModeValue := 1; FStateLock.Enter; FActiveVfo := ModeValue; FStateLock.Leave; if Assigned(FOnActiveVfo) then FOnActiveVfo(ModeValue); end else if Cmd = 'set_center' then begin HzF := JsonGetFloat(Json, 'hz', FCenterHz); FStateLock.Enter; FCenterHz := HzF; FStateLock.Leave; if Assigned(FOnCenter) then FOnCenter(HzF); end else if Cmd = 'set_mox' then begin On_ := JsonGetBool(Json, 'on', FTransmitting); FStateLock.Enter; FTransmitting := On_; FStateLock.Leave; if Assigned(FOnMOX) then FOnMOX(On_); end else if Cmd = 'drive' then begin V := JsonGetInt(Json, 'v', FDriveLevel); if V < 0 then V := 0; if V > 100 then V := 100; FStateLock.Enter; FDriveLevel := V; FStateLock.Leave; if Assigned(FOnDrive) then FOnDrive(V); end else if Cmd = 'set_tun' then begin On_ := JsonGetBool(Json, 'on', FTuning); FStateLock.Enter; FTuning := On_; FStateLock.Leave; if Assigned(FOnTun) then FOnTun(On_); end else if Cmd = 'freq_a' then begin HzF := JsonGetFloat(Json, 'hz', FFreq); FStateLock.Enter; FFreq := HzF; FStateLock.Leave; if Assigned(FOnFreqA) then FOnFreqA(HzF); end else if Cmd = 'attn' then begin Idx := JsonGetInt(Json, 'idx', FAttnIdx); if Idx < 0 then Idx := 0; if Idx > 2 then Idx := 2; FStateLock.Enter; FAttnIdx := Idx; FStateLock.Leave; if Assigned(FOnAttn) then FOnAttn(Idx); end else if Cmd = 'fm_step' then begin Idx := JsonGetInt(Json, 'idx', FFMStepIdx); if Idx < 0 then Idx := 0; if Idx > 3 then Idx := 3; FStateLock.Enter; FFMStepIdx := Idx; FStateLock.Leave; if Assigned(FOnFMStep) then FOnFMStep(Idx); end; end; { ═══════════════════════════════════════════════════════════════════════════ Push-цикл — рассылает спектр / водопад / состояние всем клиентам ═══════════════════════════════════════════════════════════════════════════ } procedure TWebServer.PushLoop; var Tick, StateLastTick: QWord; SpecBuf: array[0..4096] of Byte; WfBuf: array[0..4096] of Byte; i: Integer; HasClients: Boolean; begin StateLastTick := GetTickCount64; while FRunning do begin Sleep(50); // 20 fps Tick := GetTickCount64; FClientLock.Enter; HasClients := FClientCount > 0; FClientLock.Leave; if not HasClients then Continue; FStateLock.Enter; try SpecBuf[0] := WS_MSG_SPECTRUM; for i := 0 to 1023 do PSingle(Pointer(PByte(@SpecBuf[1]) + i*4))^ := FSpectrumBuf[i]; WfBuf[0] := WS_MSG_WATERFALL; for i := 0 to 1023 do PSingle(Pointer(PByte(@WfBuf[1]) + i*4))^ := FWfBuf[i]; finally FStateLock.Leave; end; BroadcastBinary(SpecBuf[0], 1 + 1024*4); BroadcastBinary(WfBuf[0], 1 + 1024*4); if Tick - StateLastTick >= 200 then begin StateLastTick := Tick; BroadcastText(BuildStateJson); end; end; end; procedure TWebServer.BroadcastBinary(const Data; Len: Integer); var i: Integer; begin FClientLock.Enter; try for i := 0 to FClientCount - 1 do if (FClients[i] <> nil) and (FClients[i].State = wsOpen) then FClients[i].SendBinary(Data, Len); finally FClientLock.Leave; end; end; procedure TWebServer.BroadcastText(const S: string); var i: Integer; begin FClientLock.Enter; try for i := 0 to FClientCount - 1 do if (FClients[i] <> nil) and (FClients[i].State = wsOpen) then FClients[i].SendText(S); finally FClientLock.Leave; end; end; { ═══════════════════════════════════════════════════════════════════════════ Формирование JSON-состояния ═══════════════════════════════════════════════════════════════════════════ } function JsonEscape(const S: string): string; var I: Integer; begin Result := ''; for I := 1 to Length(S) do case S[I] of '\': Result := Result + '\\'; '"': Result := Result + '\"'; #8: Result := Result + '\b'; #9: Result := Result + '\t'; #10: Result := Result + '\n'; #12: Result := Result + '\f'; #13: Result := Result + '\r'; else Result := Result + S[I]; end; end; function TWebServer.BuildStateJson: string; const MODE_N: array[0..7] of string = ('LSB','USB','DSB','CWL','CWU','FM','AM','SAM'); var FS: TFormatSettings; XvtrJson: string; i: Integer; begin FS := DefaultFormatSettings; FS.DecimalSeparator := '.'; FStateLock.Enter; try // Сборка массива xvtr_bands: [{"idx":0,"name":"2m"},...] XvtrJson := '['; for i := 0 to High(FXvtrBands) do begin if i > 0 then XvtrJson := XvtrJson + ','; XvtrJson := XvtrJson + Format('{"idx":%d,"name":"%s"}', [FXvtrBands[i].Idx, FXvtrBands[i].Name], FS); end; XvtrJson := XvtrJson + ']'; Result := Format( '{"vfo_a_hz":%.0f,"vfo_b_hz":%.0f,"active_vfo":%d,' + '"mode":%d,"mode_name":"%s",' + '"filter":%d,"filter_bw":%d,' + '"agc_mode":%d,"agc_top":%d,' + '"span_hz":%.0f,"center_hz":%.0f,"volume":%d,' + '"wf_agc":%s,"wf_nf":%s,"band_idx":%d,"smeter_dbm":%.1f,' + '"running":%s,"mute":%s,"ctun":%s,' + '"nr_mode":%d,"nr":%s,"nb_mode":%d,"nb":%s,"snb":%s,"anf":%s,"connected":%s,' + '"transmitting":%s,"drive":%d,"attn_idx":%d,"tuning":%s,"dup":%s,' + '"fwd_w":%.1f,"swr":%.2f,"pa_max_power":%.0f,' + '"status_text":"%s","board_text":"%s","ip_text":"%s","supply_text":"%s",' + '"pll_text":"%s","rx_text":"%s","tx_text":"%s","seq_text":"%s",' + '"xvtr_current":%d,"xvtr_bands":%s,"freq_mhz_digits":%d,' + '"fmstep_idx":%d}', [FFreq, FVfoB, FActiveVfo, FMode, MODE_N[FMode mod 8], FFilterIdx, FFilterBW, FAGCMode, FAGCTop, FSpanHz, FCenterHz, FVolume, BoolToStr(FWfAGC, 'true', 'false'), BoolToStr(FWfNF, 'true', 'false'), FBandIdx, FSMeter, BoolToStr(FTrxRunning, 'true', 'false'), BoolToStr(FMuted, 'true', 'false'), BoolToStr(FCtun, 'true', 'false'), FNRMode, BoolToStr(FNRMode <> 0, 'true', 'false'), FNBMode, BoolToStr(FNBMode <> 0, 'true', 'false'), BoolToStr(FSNB, 'true', 'false'), BoolToStr(FANF, 'true', 'false'), BoolToStr(FConnected, 'true', 'false'), BoolToStr(FTransmitting, 'true', 'false'), FDriveLevel, FAttnIdx, BoolToStr(FTuning, 'true', 'false'), BoolToStr(FDuplex, 'true', 'false'), FFwdW, FSWR, FPAMaxPower, JsonEscape(FStatusText), JsonEscape(FBoardText), JsonEscape(FIPText), JsonEscape(FSupplyText), JsonEscape(FPLLText), JsonEscape(FRXText), JsonEscape(FTXText), JsonEscape(FSeqText), FCurrentXvtr, XvtrJson, FFreqMhzDigits, FFMStepIdx ], FS); finally FStateLock.Leave; end; end; { ═══════════════════════════════════════════════════════════════════════════ Аудио push (вызывается из DSP-потока) ═══════════════════════════════════════════════════════════════════════════ } procedure TWebServer.PushAudio(const Samples: PSingle; Count: Integer); var HasWs: Boolean; i, n, Enc: Integer; begin if not FRunning then Exit; FClientLock.Enter; HasWs := FClientCount > 0; FClientLock.Leave; if not HasWs then Exit; if (Samples = nil) or (Count <= 0) then Exit; if not FOpusReady then Exit; i := 0; while i < Count do begin n := Count - i; if n > OPUS_FRAME_SAMP - FOpusBufPos then n := OPUS_FRAME_SAMP - FOpusBufPos; Move(Samples[i], FOpusBuf[FOpusBufPos], n * SizeOf(Single)); Inc(FOpusBufPos, n); Inc(i, n); if FOpusBufPos >= OPUS_FRAME_SAMP then begin Enc := FOpusEncode(FOpusEnc, @FOpusBuf[0], OPUS_FRAME_SAMP, @FOpusOut[0], SizeOf(FOpusOut)); if Enc > 0 then begin FWsAudioBuf[0] := WS_MSG_AUDIO; Move(FOpusOut[0], FWsAudioBuf[1], Enc); BroadcastBinary(FWsAudioBuf[0], 1 + Enc); end; FOpusBufPos := 0; end; end; end; { ═══════════════════════════════════════════════════════════════════════════ Обновление состояния из MainForm (UI thread, из таймера спектра) ═══════════════════════════════════════════════════════════════════════════ } procedure TWebServer.PushSpectrum( const Buf: array of Single; Count: Integer; const WfBuf_: array of Single; SMeter: Double; Freq: Double; Mode, FilterBW, AGCMode, AGCTop: Integer; SpanHz: Double; Volume: Integer; WfAGC, WfNF: Boolean; BandIdx: Integer; TrxConnected: Boolean; TrxRunning, Muted, Ctun: Boolean; NRMode, NBMode: Integer; SNB, ANF: Boolean; CenterHz: Double; FilterIdx: Integer; VfoB: Double; ActiveVfo: Integer; Transmitting: Boolean; DriveLevel: Integer; AttnIdx: Integer; Tuning: Boolean; Duplex: Boolean; FwdW, SWRV, PAMaxPower: Double; const StatusText, BoardText, IPText, SupplyText, PLLText, RXText, TXText, SeqText: string); var N, i: Integer; begin if not FRunning then Exit; N := Min(Count, 1024); FStateLock.Enter; try for i := 0 to N-1 do FSpectrumBuf[i] := Buf[i]; for i := 0 to Min(High(WfBuf_), 1023) do FWfBuf[i] := WfBuf_[i]; FSMeter := SMeter; FFreq := Freq; FMode := Mode; FFilterBW := FilterBW; FAGCMode := AGCMode; FAGCTop := AGCTop; FSpanHz := SpanHz; FVolume := Volume; FWfAGC := WfAGC; FWfNF := WfNF; FBandIdx := BandIdx; FConnected := TrxConnected; FTrxRunning := TrxRunning; FMuted := Muted; FCtun := Ctun; FNRMode := NRMode; FNBMode := NBMode; FSNB := SNB; FANF := ANF; FCenterHz := CenterHz; FFilterIdx := FilterIdx; FVfoB := VfoB; FActiveVfo := ActiveVfo; FTransmitting := Transmitting; FDriveLevel := DriveLevel; FAttnIdx := AttnIdx; FTuning := Tuning; FDuplex := Duplex; FFwdW := FwdW; FSWR := SWRV; FPAMaxPower := PAMaxPower; FStatusText := StatusText; FBoardText := BoardText; FIPText := IPText; FSupplyText := SupplyText; FPLLText := PLLText; FRXText := RXText; FTXText := TXText; FSeqText := SeqText; finally FStateLock.Leave; end; end; { ═══════════════════════════════════════════════════════════════════════════ Stub-методы (реализация встроена в HandleClient) ═══════════════════════════════════════════════════════════════════════════ } procedure TWebServer.DoHandshake(Client: TWsClient); begin // Not used separately — handshake is in HandleClient end; procedure TWebServer.ProcessWsFrame(Client: TWsClient; const Data: array of Byte; Len: Integer; Opcode: Byte); begin // Not used separately — frame processing is inlined in HandleClient end; end.