mirror of
https://git.vladimir.cc/vladimir/ewsdr.git
synced 2026-08-25 18:43:51 +00:00
Phase 3 (batch 33+34): web device discovery/connect parity
Move discovery into the controller and add a full web device overlay (discovery + connect + saved-device CRUD), reaching parity with the desktop device dialog. - RadioController: OnDeviceFound/Discover/DiscoverFinishedNone + rfDeviceList; TDiscoverThread moved in from MainForm. - WebServer: device protocol (discover/connect/disconnect/dev_add/ dev_remove/dev_autostart) + "devices" in BuildStateJson. - MainForm: web handlers (marshalled), PushDeviceListToWeb, extracted DoStopAndDisconnect, detached WebOnRun from BtnStartStopClick; web connect resolves board type from discovered then saved by IP. - DeviceForm: RefreshFound renders the found list from the store. - WebPageHtml: DEV overlay; START opens it, STOP disconnects. Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
Uladzimir Karpenka
co-authored by
Claude Opus 4.8
Claude Opus 4.8
parent
9dec47a6ca
commit
c4981fcb19
+91
-3
@@ -162,6 +162,21 @@ type
|
||||
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
|
||||
@@ -281,6 +296,7 @@ type
|
||||
FDuplex: Boolean;
|
||||
FFreqMhzDigits: Integer; // 3=999MHz, 4=9.999GHz, 5=99.999GHz
|
||||
FXvtrBands: TWebXvtrArray; // список enabled XVTR (для web-UI)
|
||||
FDevices: TWebDeviceArray; // saved+discovered устройства (для web-overlay)
|
||||
FCurrentXvtr: Integer; // -1 = HF, иначе индекс активного XVTR
|
||||
FOnXvtrBand: TWebCmdXvtrBand;
|
||||
|
||||
@@ -299,6 +315,14 @@ type
|
||||
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);
|
||||
@@ -367,6 +391,7 @@ type
|
||||
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);
|
||||
property OnSpan: TWebCmdSpan read FOnSpan write FOnSpan;
|
||||
property OnVolume: TWebCmdVolume read FOnVolume write FOnVolume;
|
||||
property OnWfAGC: TWebCmdWfAGC read FOnWfAGC write FOnWfAGC;
|
||||
@@ -388,6 +413,12 @@ type
|
||||
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
|
||||
@@ -520,6 +551,19 @@ begin
|
||||
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;
|
||||
|
||||
destructor TWebServer.Destroy;
|
||||
begin
|
||||
Stop;
|
||||
@@ -1171,6 +1215,7 @@ var
|
||||
HzF: Double;
|
||||
HzI, ModeValue, BW, DB, Idx, V: Integer;
|
||||
On_: Boolean;
|
||||
S1, S2: string;
|
||||
begin
|
||||
Cmd := JsonGetStr(Json, 'cmd');
|
||||
|
||||
@@ -1361,6 +1406,36 @@ begin
|
||||
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;
|
||||
|
||||
@@ -1467,7 +1542,7 @@ const
|
||||
('LSB','USB','DSB','CWL','CWU','FM','AM','SAM');
|
||||
var
|
||||
FS: TFormatSettings;
|
||||
XvtrJson: string;
|
||||
XvtrJson, DevJson: string;
|
||||
i: Integer;
|
||||
begin
|
||||
FS := DefaultFormatSettings;
|
||||
@@ -1484,6 +1559,19 @@ begin
|
||||
[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",' +
|
||||
@@ -1498,7 +1586,7 @@ begin
|
||||
'"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}',
|
||||
'"fmstep_idx":%d,"devices":%s}',
|
||||
[FFreq, FVfoB, FActiveVfo,
|
||||
FMode, MODE_N[FMode mod 8],
|
||||
FFilterIdx, FFilterBW,
|
||||
@@ -1527,7 +1615,7 @@ begin
|
||||
JsonEscape(FSupplyText), JsonEscape(FPLLText), JsonEscape(FRXText),
|
||||
JsonEscape(FTXText), JsonEscape(FSeqText),
|
||||
FCurrentXvtr, XvtrJson, FFreqMhzDigits,
|
||||
FFMStepIdx
|
||||
FFMStepIdx, DevJson
|
||||
], FS);
|
||||
finally
|
||||
FStateLock.Leave;
|
||||
|
||||
Reference in New Issue
Block a user