ew8bak/ewsdr
1
0
Fork 0
mirror of https://git.vladimir.cc/vladimir/ewsdr.git synced 2026-08-25 20:37:33 +00:00
Code Issues Packages Projects Releases Wiki Activity
Files
98d90e1e5aebb8f1c4fbaa54042390f72e953805
ewsdr/WebServer.pas
T

2030 lines
81 KiB
ObjectPascal
Raw Blame History

This file contains ambiguous Unicode characters
This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
{
Copyright (C)
2026 - Uladzimir Karpenka, EW8BAK
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
unit WebServer;
{
WebServer.pas — HTTP + WebSocket сервер для удалённого управления трансивером.
Архитектура веб-подсистемы:
─────────────────────────────────
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, RadioModes
{$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';
// Потолок точек в кадре спектра/водопада (настройка web.spec_pixels режет
// ниже). Совпадает с WDSPEngine.SPECTRUM_PIXELS — больше анализатор не даёт.
WEB_SPEC_MAX = 4096;
// Типы бинарных фреймов (первый байт = тип)
WS_MSG_SPECTRUM = Byte(Ord('S')); // S + N×Float32 (N = длина фрейма, <= WEB_SPEC_MAX)
WS_MSG_WATERFALL = Byte(Ord('W')); // W + N×Float32 (N = длина фрейма, <= WEB_SPEC_MAX)
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;
// QO-100 beacon lock: вкл/выкл лок и наведение (клик по маяку, доля 0..1 по ширине).
TWebCmdBeacon = procedure(On_: Boolean) of object;
TWebCmdBeaconSeed = procedure(Frac: Double) of object;
// Pluto RF-AGC (hw gain): режим FAST/SLOW/HYB/MAN + ручной gain дБ. RX MUTE — QO-100 self-monitor.
TWebCmdRxGainMode = procedure(Mode: Integer) of object;
TWebCmdRxGain = procedure(Db: Integer) of object;
TWebCmdRxMute = procedure(On_: Boolean) of object;
// Активность web-клиента изменилась (подключился/отключился последний клиент).
// Хозяин зеркалит это в ядро (FController.FWebClientActive) для выбора mic-source.
TWebClientActiveEvent = procedure(Active: Boolean) of object;
// Один XVTR-слот для статуса (для отображения в web-bandSel).
TWebXvtrInfo = record
Idx: Integer;
Name: string;
end;
TWebXvtrArray = array of TWebXvtrInfo;
TWebMicCB = procedure(Samples: PSingle; Count: Integer) of object;
// ── Discovery / connect / saved-CRUD (паритет с десктоп-диалогом) ──────────
TWebCmdConnect = procedure(const IP: string) of object; // подключиться к IP
TWebCmdSimple = procedure of object; // discover / disconnect
TWebCmdDevAdd = procedure(const AName, IP: string) of object;
TWebCmdDevIdx = procedure(Idx: Integer) of object; // dev_remove / dev_autostart
// Элемент списка устройств для web-overlay (saved или discovered).
TWebDeviceInfo = record
Name: string; // имя (saved) или display-строка (discovered)
IP: string;
BoardType: Integer;
IsSaved: Boolean; // true=сохранённое (с именем), false=найденное
AutoStart: Boolean; // только для saved
end;
TWebDeviceArray = array of TWebDeviceInfo;
// ── Главный класс сервера ─────────────────────────────────────────────────
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..WEB_SPEC_MAX-1] of Single;
FSpecCount: Integer; // точек в кадре спектра (0 = кадра ещё не было)
FWfBuf: array[0..WEB_SPEC_MAX-1] of Single;
FWfCount: Integer; // точек в строке водопада
FWfFresh: Boolean; // строка накапливается (max-hold) и ещё не отдана
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;
FAttnDB: Integer; // шаговый аттенюатор ADC, дБ (0..31)
FOnTun: TWebCmdTun;
FOnFMStep: TWebCmdFMStep;
FTuning: Boolean;
FDuplex: Boolean;
FFreqMhzDigits: Integer; // 3=999MHz, 4=9.999GHz, 5=99.999GHz
FXvtrBands: TWebXvtrArray; // список enabled XVTR (для web-UI)
FDevices: TWebDeviceArray; // saved+discovered устройства (для web-overlay)
FRatePresets: array of Integer; // sample-rate пресеты текущего бэкенда (для span-кнопок)
FBandNames: array of string; // band-план текущего бэкенда (имена кнопок)
FBandFreqs: array of Double; // band-план: дефолтные частоты (для подсветки selector)
FFreqMin: Double; // диапазон перестройки бэкенда (клампинг drag/wheel)
FFreqMax: Double;
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;
// QO-100 beacon lock (Pluto в трансвертере). Зеркалится в state как
// beacon_visible/on/text/ref_hz/track_hz; команды set_beacon/beacon_seed.
FBeaconVisible: Boolean; // кнопка/статус активны (Pluto + XVTR)
FBeaconOn: Boolean; // лок включён (подсветка кнопки)
FBeaconText: string; // компактный статус (ячейка PLL, как десктоп)
FBeaconRefHz: Double; // опорная частота маяка (маркер)
FBeaconTrackHz: Double; // измеренная частота маяка (маркер)
FOnBeacon: TWebCmdBeacon;
FOnBeaconSeed: TWebCmdBeaconSeed;
// Pluto RF-AGC (hw gain) + QO-100 RX MUTE. Зеркалится в state как
// rf_agc_visible/rx_gain_mode/rx_gain_db и rx_mute_visible/rx_mute_on;
// команды set_rx_gain_mode/set_rx_gain/set_rx_mute.
FRfAgcVisible: Boolean; // RF-AGC доступен (Pluto подключён, HasHWGain)
FRxGainMode: Integer; // 0=manual,1=fast,2=slow,3=hybrid
FRxGainDb: Integer; // ручной gain дБ (0..73)
FRxMuteVisible: Boolean; // RX MUTE доступна (Pluto + QO-100)
FRxMuteOn: Boolean; // self-monitor mute активен
FOnRxGainMode: TWebCmdRxGainMode;
FOnRxGain: TWebCmdRxGain;
FOnRxMute: TWebCmdRxMute;
FWebClientActive: Boolean;
FOnClientActiveChanged: TWebClientActiveEvent;
// Discovery / connect / saved-CRUD callbacks (маршалятся хозяином в GUI).
FOnConnect: TWebCmdConnect;
FOnDiscoverDev: TWebCmdSimple;
FOnDisconnectDev: TWebCmdSimple;
FOnDevAdd: TWebCmdDevAdd;
FOnDevRemove: TWebCmdDevIdx;
FOnDevAutoStart: TWebCmdDevIdx;
// Обновляет FWebClientActive и при изменении уведомляет хозяина. Вызывать
// под уже взятой блокировкой поля (FStateLock/FClientLock) — сам не лочит.
procedure SetClientActive(Value: 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; WfCount: Integer; WfNew: Boolean;
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;
AttnDB: 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 OnClientActiveChanged: TWebClientActiveEvent
read FOnClientActiveChanged write FOnClientActiveChanged;
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);
procedure SetDeviceList(const ADevices: TWebDeviceArray);
procedure SetRatePresets(const ARates: array of Integer);
procedure SetBands(const ANames: array of string; const AFreqs: array of Double);
procedure SetFreqRange(AMin, AMax: Double);
// QO-100 beacon lock: зеркало статуса в state (зовётся из PushState хозяина).
procedure SetBeaconStatus(AVisible, AOn: Boolean; const AText: string;
ARefHz, ATrackHz: Double);
// Pluto RF-AGC + QO-100 RX MUTE: зеркало в state (зовётся из PushState хозяина).
procedure SetRxGainStatus(AVisible: Boolean; AMode, ADb: Integer);
procedure SetRxMuteStatus(AVisible, AOn: Boolean);
property OnBeacon: TWebCmdBeacon read FOnBeacon write FOnBeacon;
property OnBeaconSeed: TWebCmdBeaconSeed read FOnBeaconSeed write FOnBeaconSeed;
property OnRxGainMode: TWebCmdRxGainMode read FOnRxGainMode write FOnRxGainMode;
property OnRxGain: TWebCmdRxGain read FOnRxGain write FOnRxGain;
property OnRxMute: TWebCmdRxMute read FOnRxMute write FOnRxMute;
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;
property OnConnect: TWebCmdConnect read FOnConnect write FOnConnect;
property OnDiscoverDev: TWebCmdSimple read FOnDiscoverDev write FOnDiscoverDev;
property OnDisconnectDev: TWebCmdSimple read FOnDisconnectDev write FOnDisconnectDev;
property OnDevAdd: TWebCmdDevAdd read FOnDevAdd write FOnDevAdd;
property OnDevRemove: TWebCmdDevIdx read FOnDevRemove write FOnDevRemove;
property OnDevAutoStart: TWebCmdDevIdx read FOnDevAutoStart write FOnDevAutoStart;
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 := MODE_USB;
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;
FBeaconVisible := False;
FBeaconOn := False;
FBeaconText := '';
FBeaconRefHz := 0;
FBeaconTrackHz := 0;
FRfAgcVisible := False;
FRxGainMode := 2; // slow_attack по умолчанию (как контроллер)
FRxGainDb := 40;
FRxMuteVisible := False;
FRxMuteOn := False;
SetLength(FXvtrBands, 0);
// Bootstrap-набор рейтов (до connect): хост перезапишет под бэкенд (HPSDR/Pluto).
SetRatePresets([48000, 96000, 192000, 384000, 768000, 1536000]);
// Bootstrap band-план (HF): хост перезапишет под бэкенд на connect.
SetBands(['160m','80m','60m','40m','30m','20m','17m','15m','12m','10m','6m'],
[1840000,3700000,5357000,7100000,10120000,14200000,
18130000,21300000,24940000,28400000,50150000]);
SetFreqRange(0, 61440000); // HPSDR bootstrap; хост перезапишет под бэкенд
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;
procedure TWebServer.SetBeaconStatus(AVisible, AOn: Boolean; const AText: string;
ARefHz, ATrackHz: Double);
begin
FStateLock.Enter;
try
FBeaconVisible := AVisible;
FBeaconOn := AOn;
FBeaconText := AText;
FBeaconRefHz := ARefHz;
FBeaconTrackHz := ATrackHz;
finally
FStateLock.Leave;
end;
end;
procedure TWebServer.SetRxGainStatus(AVisible: Boolean; AMode, ADb: Integer);
begin
FStateLock.Enter;
try
FRfAgcVisible := AVisible;
FRxGainMode := AMode;
FRxGainDb := ADb;
finally
FStateLock.Leave;
end;
end;
procedure TWebServer.SetRxMuteStatus(AVisible, AOn: Boolean);
begin
FStateLock.Enter;
try
FRxMuteVisible := AVisible;
FRxMuteOn := AOn;
finally
FStateLock.Leave;
end;
end;
procedure TWebServer.SetDeviceList(const ADevices: TWebDeviceArray);
var i: Integer;
begin
FStateLock.Enter;
try
SetLength(FDevices, Length(ADevices));
for i := 0 to High(ADevices) do
FDevices[i] := ADevices[i];
finally
FStateLock.Leave;
end;
end;
procedure TWebServer.SetRatePresets(const ARates: array of Integer);
// Список пресетов sample-rate текущего бэкенда (из TRadioController). Web строит
// span-кнопки из него — HPSDR и Pluto имеют разные наборы.
var i: Integer;
begin
FStateLock.Enter;
try
SetLength(FRatePresets, Length(ARates));
for i := 0 to High(ARates) do
FRatePresets[i] := ARates[i];
finally
FStateLock.Leave;
end;
end;
procedure TWebServer.SetBands(const ANames: array of string; const AFreqs: array of Double);
// Band-план текущего бэкенда (из TRadioController). Web строит band-selector из
// него — HPSDR (HF) и Pluto (VHF/UHF) имеют разные планы.
var i: Integer;
begin
FStateLock.Enter;
try
SetLength(FBandNames, Length(ANames));
SetLength(FBandFreqs, Length(AFreqs));
for i := 0 to High(ANames) do FBandNames[i] := ANames[i];
for i := 0 to High(AFreqs) do FBandFreqs[i] := AFreqs[i];
finally
FStateLock.Leave;
end;
end;
procedure TWebServer.SetFreqRange(AMin, AMax: Double);
// Диапазон перестройки текущего бэкенда (caps): web клампит drag/wheel/click по
// спектру в эти границы. HPSDR 0..61.44МГц / Pluto 46.875МГц..6ГГц.
begin
FStateLock.Enter;
try
FFreqMin := AMin;
FFreqMax := AMax;
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;
SetClientActive(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;
SetClientActive(FClientCount > 1);
FStateLock.Leave;
RemoveClient(Client);
end;
procedure TWebServer.SetClientActive(Value: Boolean);
begin
if FWebClientActive = Value then Exit;
FWebClientActive := Value;
if Assigned(FOnClientActiveChanged) then FOnClientActiveChanged(Value);
end;
procedure TWebServer.RemoveClient(Client: TWsClient);
var i, j: Integer; NewActive: Boolean;
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;
NewActive := False;
for i := 0 to FClientCount - 1 do
if (FClients[i] <> nil) and (FClients[i].State = wsOpen) then
begin NewActive := True; Break; end;
SetClientActive(NewActive);
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;
S1, S2: string;
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 = 'set_beacon' then
begin
On_ := JsonGetBool(Json, 'on', FBeaconOn);
FStateLock.Enter; FBeaconOn := On_; FStateLock.Leave;
if Assigned(FOnBeacon) then FOnBeacon(On_);
end
else if Cmd = 'beacon_seed' then
begin
// frac = доля позиции клика по ширине спектра (0..1). Абсолютную display-частоту
// считает контроллер из ЖИВЫХ FCenterFreq/FSpanHz (как десктоп PixelToFreq) —
// клиентский localCenter может отставать при ретюне LO во время лока.
HzF := JsonGetFloat(Json, 'frac', -1);
if (HzF >= 0) and Assigned(FOnBeaconSeed) then FOnBeaconSeed(HzF);
end
else if Cmd = 'set_rx_gain_mode' then
begin
Idx := JsonGetInt(Json, 'mode', FRxGainMode); // 0=man,1=fast,2=slow,3=hybrid
FStateLock.Enter; FRxGainMode := Idx; FStateLock.Leave;
if Assigned(FOnRxGainMode) then FOnRxGainMode(Idx);
end
else if Cmd = 'set_rx_gain' then
begin
DB := JsonGetInt(Json, 'db', FRxGainDb); // ручной gain 0..73 дБ
FStateLock.Enter; FRxGainDb := DB; FStateLock.Leave;
if Assigned(FOnRxGain) then FOnRxGain(DB);
end
else if Cmd = 'set_rx_mute' then
begin
On_ := JsonGetBool(Json, 'on', FRxMuteOn);
FStateLock.Enter; FRxMuteOn := On_; FStateLock.Leave;
if Assigned(FOnRxMute) then FOnRxMute(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, 'db', FAttnDB);
if Idx < 0 then Idx := 0;
if Idx > 31 then Idx := 31;
FStateLock.Enter; FAttnDB := 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
// ── Discovery / connect / saved-CRUD ──────────────────────────────────────
else if Cmd = 'discover' then
begin
if Assigned(FOnDiscoverDev) then FOnDiscoverDev;
end
else if Cmd = 'connect' then
begin
S1 := JsonGetStr(Json, 'ip');
if (S1 <> '') and Assigned(FOnConnect) then FOnConnect(S1);
end
else if Cmd = 'disconnect' then
begin
if Assigned(FOnDisconnectDev) then FOnDisconnectDev;
end
else if Cmd = 'dev_add' then
begin
S1 := JsonGetStr(Json, 'name');
S2 := JsonGetStr(Json, 'ip');
if (S2 <> '') and Assigned(FOnDevAdd) then FOnDevAdd(S1, S2);
end
else if Cmd = 'dev_remove' then
begin
Idx := JsonGetInt(Json, 'idx', -1);
if (Idx >= 0) and Assigned(FOnDevRemove) then FOnDevRemove(Idx);
end
else if Cmd = 'dev_autostart' then
begin
Idx := JsonGetInt(Json, 'idx', -1);
if (Idx >= 0) and Assigned(FOnDevAutoStart) then FOnDevAutoStart(Idx);
end;
end;
{ ═══════════════════════════════════════════════════════════════════════════
Push-цикл — рассылает спектр / водопад / состояние всем клиентам
═══════════════════════════════════════════════════════════════════════════ }
procedure TWebServer.PushLoop;
var
Tick, StateLastTick: QWord;
SpecBuf: array[0..1 + WEB_SPEC_MAX*4] of Byte;
WfBuf: array[0..1 + WEB_SPEC_MAX*4] of Byte;
i, SN, WN: 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
begin
// Без клиентов строку никто не забирает — иначе накопитель max-hold рос
// бы всё время простоя и первая строка после подключения была бы
// максимумом за минуты.
FStateLock.Enter;
FWfFresh := False;
FStateLock.Leave;
Continue;
end;
FStateLock.Enter;
try
// Длина фрейма = число реально заполненных точек: клиент считает N из
// byteLength и растягивает ровно их на всю ширину канваса.
SN := FSpecCount;
SpecBuf[0] := WS_MSG_SPECTRUM;
for i := 0 to SN - 1 do
PSingle(Pointer(PByte(@SpecBuf[1]) + i*4))^ := FSpectrumBuf[i];
// Водопад — ТОЛЬКО если с прошлой отправки пришла новая строка. Иначе в
// демоне (PushState 20 Гц и этот цикл 20 Гц идут вразнобой) на дрейфе фаз
// одна и та же строка уезжала клиенту дважды — водопад «двоил» и полз
// рывками, а на остановленном RX прокручивал застывшую строку вечно.
// Спектр так гейтить нельзя: это живая кривая, её надо перерисовывать.
if FWfFresh then
begin
WN := FWfCount;
WfBuf[0] := WS_MSG_WATERFALL;
for i := 0 to WN - 1 do
PSingle(Pointer(PByte(@WfBuf[1]) + i*4))^ := FWfBuf[i];
FWfFresh := False; // следующий кадр DSP начнёт новое накопление
end
else
WN := 0;
finally
FStateLock.Leave;
end;
// Кадр спектра шлём и пустым (SN=0, до первого кадра DSP): клиент
// перерисовывает по нему линейку и оверлеи, а пустой спектр не рисует.
BroadcastBinary(SpecBuf[0], 1 + SN*4);
if WN > 0 then BroadcastBinary(WfBuf[0], 1 + WN*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[RadioModes.MODE_MIN..RadioModes.MODE_MAX] of string =
('LSB','USB','DSB','CWL','CWU','FM','AM','SAM','DIGU','DIGL','WFM','DMR','FM RAW');
var
FS: TFormatSettings;
XvtrJson, DevJson, RateJson, BandJson: string;
i: Integer;
begin
FS := DefaultFormatSettings;
FS.DecimalSeparator := '.';
FStateLock.Enter;
try
// Сборка массива rate_presets: [48000,96000,...] (span-кнопки web).
RateJson := '[';
for i := 0 to High(FRatePresets) do
begin
if i > 0 then RateJson := RateJson + ',';
RateJson := RateJson + IntToStr(FRatePresets[i]);
end;
RateJson := RateJson + ']';
// Сборка массива bands: [{"name":"6m","freq":50150000},...] (band-selector web).
BandJson := '[';
for i := 0 to High(FBandNames) do
begin
if i > 0 then BandJson := BandJson + ',';
BandJson := BandJson +
Format('{"name":"%s","freq":%.0f}',
[JsonEscape(FBandNames[i]), FBandFreqs[i]], FS);
end;
BandJson := BandJson + ']';
// Сборка массива 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 + ']';
// Сборка списка устройств (saved+discovered) для overlay-диалога.
DevJson := '[';
for i := 0 to High(FDevices) do
begin
if i > 0 then DevJson := DevJson + ',';
DevJson := DevJson +
Format('{"name":"%s","ip":"%s","board":%d,"saved":%s,"autostart":%s}',
[JsonEscape(FDevices[i].Name), JsonEscape(FDevices[i].IP),
FDevices[i].BoardType,
BoolToStr(FDevices[i].IsSaved, 'true', 'false'),
BoolToStr(FDevices[i].AutoStart, 'true', 'false')], FS);
end;
DevJson := DevJson + ']';
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_db":%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,"devices":%s,"rate_presets":%s,"bands":%s,' +
'"freq_min":%.0f,"freq_max":%.0f,' +
'"beacon_visible":%s,"beacon_on":%s,"beacon_text":"%s",' +
'"beacon_ref_hz":%.0f,"beacon_track_hz":%.0f,' +
'"rf_agc_visible":%s,"rx_gain_mode":%d,"rx_gain_db":%d,' +
'"rx_mute_visible":%s,"rx_mute_on":%s}',
[FFreq, FVfoB, FActiveVfo,
FMode, MODE_N[EnsureRange(FMode, MODE_MIN, MODE_MAX)],
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,
FAttnDB,
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, DevJson, RateJson, BandJson,
FFreqMin, FFreqMax,
BoolToStr(FBeaconVisible, 'true', 'false'),
BoolToStr(FBeaconOn, 'true', 'false'),
JsonEscape(FBeaconText), FBeaconRefHz, FBeaconTrackHz,
BoolToStr(FRfAgcVisible, 'true', 'false'), FRxGainMode, FRxGainDb,
BoolToStr(FRxMuteVisible, 'true', 'false'),
BoolToStr(FRxMuteOn, 'true', 'false')
], 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; WfCount: Integer; WfNew: Boolean;
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;
AttnDB: Integer; Tuning: Boolean; Duplex: Boolean;
FwdW, SWRV, PAMaxPower: Double;
const StatusText, BoardText, IPText, SupplyText, PLLText,
RXText, TXText, SeqText: string);
var N, W, i: Integer;
begin
if not FRunning then Exit;
N := EnsureRange(Min(Count, Length(Buf)), 0, WEB_SPEC_MAX);
W := EnsureRange(Min(WfCount, Length(WfBuf_)), 0, WEB_SPEC_MAX);
FStateLock.Enter;
try
for i := 0 to N-1 do FSpectrumBuf[i] := Buf[i];
FSpecCount := N;
// Водопад: зовут нас чаще, чем PushLoop отдаёт строку (в GUI 60 против 20
// раз/с) — между отправками копим max-hold'ом, иначе кадры терялись бы.
// WfNew=False — новой строки от DSP не было: не трогаем ни накопитель, ни
// флаг, иначе PushLoop отправил бы прежнюю строку повторно.
if WfNew then
begin
if (not FWfFresh) or (W <> FWfCount) then
begin
for i := 0 to W-1 do FWfBuf[i] := WfBuf_[i];
FWfCount := W;
end
else
for i := 0 to W-1 do
if WfBuf_[i] > FWfBuf[i] then FWfBuf[i] := WfBuf_[i];
FWfFresh := True;
end;
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;
FAttnDB := AttnDB;
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.
Reference in New Issue View Git Blame Copy Permalink