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 завершиться без зависания. } {$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; 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; // ── 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; TWebCmdNR = procedure(On_: Boolean) of object; TWebCmdNB = procedure(On_: Boolean) of object; TWebCmdANF = procedure(On_: Boolean) 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; FOpusReady: Boolean; // ── 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) // ── Состояние (обновляется из 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; FNR: Boolean; FNB: Boolean; FANF: Boolean; FCenterHz: Double; FFilterIdx: 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: TWebCmdNR; FOnNB: TWebCmdNB; FOnANF: TWebCmdANF; FWebClientActive: Boolean; // ── Внутренние методы ── function LoadOpus: Boolean; procedure UnloadOpus; 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); destructor Destroy; override; function Start: Boolean; procedure Stop; // Вызывается из 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, NR, NB, ANF: Boolean; CenterHz: Double; FilterIdx: Integer); property WebClientActive: Boolean read FWebClientActive; 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 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: TWebCmdNR read FOnNR write FOnNR; property OnNB: TWebCmdNB read FOnNB write FOnNB; property OnANF: TWebCmdANF read FOnANF write FOnANF; 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); {$IFDEF WINDOWS} var WSAData: TWSAData; {$ENDIF} begin {$IFDEF WINDOWS} // Инициализация Winsock2 — обязательна перед любыми вызовами socket API WSAStartup($0202, WSAData); {$ENDIF} inherited Create; FAuthToken := Base64EncodeStr(Username + ':' + Password); FListenSock := SOCK_INVALID; FRunning := False; FClientCount := 0; FOpusReady := False; FOpusBufPos := 0; FWebClientActive := False; FClientLock := TCriticalSection.Create; FStateLock := TCriticalSection.Create; // Начальные значения состояния FFreq := 14200000; FMode := 1; FFilterBW:= 2700; FAGCMode := 1; FAGCTop := 90; FSpanHz := 192000; FVolume := 70; FSMeter := -120; FBandIdx := 5; 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')); if not Assigned(FOpusCreate) or not Assigned(FOpusEncode) then begin FreeLibrary(FOpusLib); FOpusLib := 0; Exit; end; FOpusEnc := FOpusCreate(OPUS_SAMPLE_RATE, OPUS_CHANNELS, 2101 {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); FOpusBufPos := 0; FOpusReady := True; Result := True; end; procedure TWebServer.UnloadOpus; begin if FOpusReady and Assigned(FOpusDestroy) and (FOpusEnc <> nil) then FOpusDestroy(FOpusEnc); FOpusEnc := nil; FOpusReady := False; if FOpusLib <> 0 then begin FreeLibrary(FOpusLib); FOpusLib := 0; end; end; { ═══════════════════════════════════════════════════════════════════════════ Start / Stop ═══════════════════════════════════════════════════════════════════════════ } 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(WEB_PORT); Addr.sin_addr.S_addr := INADDR_ANY; 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(WEB_PORT); Addr.sin_addr.s_addr := htonl(INADDR_ANY); 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; { ═══════════════════════════════════════════════════════════════════════════ 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; 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; 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; $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 = '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', FNR); FStateLock.Enter; FNR := On_; FStateLock.Leave; if Assigned(FOnNR) then FOnNR(On_); end else if Cmd = 'set_nb' then begin On_ := JsonGetBool(Json, 'on', FNB); FStateLock.Enter; FNB := On_; FStateLock.Leave; if Assigned(FOnNB) then FOnNB(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; 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 TWebServer.BuildStateJson: string; const MODE_N: array[0..7] of string = ('LSB','USB','DSB','CWL','CWU','FM','AM','SAM'); begin FStateLock.Enter; try Result := Format( '{"vfo_a_hz":%.0f,"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":%s,"nb":%s,"anf":%s,"connected":%s}', [FFreq, 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'), BoolToStr(FNR, 'true', 'false'), BoolToStr(FNB, 'true', 'false'), BoolToStr(FANF, 'true', 'false'), BoolToStr(FConnected, 'true', 'false') ]); finally FStateLock.Leave; end; end; { ═══════════════════════════════════════════════════════════════════════════ Аудио push (вызывается из DSP-потока) ═══════════════════════════════════════════════════════════════════════════ } procedure TWebServer.PushAudio(const Samples: PSingle; Count: Integer); var HasWs: Boolean; i, n, Enc: Integer; Pkt: array of Byte; begin if not FRunning then begin AudioLog('EXIT: FRunning=false'); Exit; end; FClientLock.Enter; HasWs := FClientCount > 0; FClientLock.Leave; if not HasWs then begin AudioLog('EXIT: FClientCount=0'); Exit; end; if (Samples = nil) or (Count <= 0) then begin AudioLog('EXIT: Samples nil/Count=0'); Exit; end; if not FOpusReady then begin AudioLog('EXIT: FOpusReady=false'); Exit; end; 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 SetLength(Pkt, 1 + Enc); Pkt[0] := WS_MSG_AUDIO; Move(FOpusOut[0], Pkt[1], Enc); BroadcastBinary(Pkt[0], Length(Pkt)); AudioLog('SENT opus bytes=' + IntToStr(Enc) + ' clients=' + IntToStr(FClientCount)); end else AudioLog('ENCODE FAILED Enc=' + IntToStr(Enc)); 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, NR, NB, ANF: Boolean; CenterHz: Double; FilterIdx: Integer); 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; FNR := NR; FNB := NB; FANF := ANF; FCenterHz := CenterHz; FFilterIdx := FilterIdx; 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.