Files
ewsdr/TCIProtocol.pas
T
ew8bakandClaude Opus 5 79132f133c fix(tci): рекордер линейного выхода — память под потолком, файл только в своём каталоге
Два дефекта уровня P1 в LINE_OUT_RECORDER_*. Авторизации в протоколе нет
(§3.1), bind наружу разрешён — значит «сколько стоит одна строка из сети»
это вопрос живучести процесса, а не аккуратности.

1. Неограниченное выделение памяти. CmdRecorder проверял только ValidRx
   (номер в потолке), а конструктор выделял буфер целиком: 300 с × 48 кГц
   × 2 канала × int16 = 57.6 МБ на команду, приёмников 1+MAX_SLICES=7, то
   есть 403 МБ семью строками. У мёртвого приёмника Feed не зовут — значит
   срок записи никто не проверял; уход клиента рекордеры не трогал вовсе;
   DropDeadRxStreams бежит только на rfDevice/rfConnected и смене карты
   слайсов, в покое не срабатывает. Память жила до остановки сервера.

   Лечение тремя замками:
   - память набирается кусками по секунде, START не стоит ни байта;
     куски не перевыделяются (никакого realloc в DSP-потоке) и склеиваются
     один раз в Take — уже после того, как рекордер вынут из таблицы;
   - общий бюджет TCI_RECORD_MAX_BYTES (128 МБ) на все рекордеры сразу,
     спрашивается на каждый кусок; отказ не рушит запись, набранное
     остаётся сохраняемым;
   - освобождение по трём событиям: START требует живого приёмника
     (RxActive, ответ receiver is not running), тик сервера подметает
     истёкшие окна по часам (SweepRecorders — окно закрывается от START
     и без единого блока звука), уход клиента забирает его записи
     (DropClientRecorders; рекордер живёт на приёмнике, но платит за него
     тот, кто нажал START).

2. Перезапись произвольного файла. Путь из сети уходил в fmCreate почти
   как пришёл — вместе с '..' и абсолютными путями. Теперь TCIRecordPath
   берёт из строки ТОЛЬКО имя файла, каталог — настроенный tci.record_dir
   (пусто = <каталог конфигурации>/records). Каталог из просьбы
   отбрасывается молча: полный путь на сервере клиенту всё равно
   бесполезен, файл ложится не на его машину. Имя валидируется (пусто,
   '.', '..', управляющие, ':', длиннее 120, расширение не .wav →
   bad file name); после ExtractFileName выйти за каталог нечем. Файл
   создаётся эксклюзивно (TCICreateNewFile: O_EXCL|O_NOFOLLOW на Unix,
   CREATE_NEW на Windows) — ни перезаписи, ни симлинка, без окна между
   FileExists и созданием; клиенту заранее file exists.

Попутно: MainForm.ApplyTCISettings собирал TTCISettings по полям с
чистого листа — новое поле RecordDir обнулялось бы при каждом применении
вкладки CAT. В uses TCIStreams Windows стоит первым намеренно: иначе его
TCriticalSection перекрыл бы SyncObjs (та же грабля, что в DX-кластере).

Стенд 189/189 (было 169): 11 проверок имени файла (/etc/passwd.wav,
../../.., D|\rec\a.wav), бюджет (START не выделяет, растёт кусками,
потолок, отказ не рушит запись, срок истекает без Feed), существующий WAV
не перезаписывается, START на мёртвом приёмнике и с чужим номером, и
сквозная проверка в части E — клиент стартует запись, набирает память
живым звуком через WDSP, рвёт TCP, бюджет возвращается к нулю. Без фиксов
новые проверки краснеют. GUI (--ws=qt6) и демон зелёные.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
2026-08-19 12:30:36 +03:00

680 lines
29 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.
unit TCIProtocol;
{
TCIProtocol.pas — протокол TCI 2.0 (Expert Electronics), чистый слой.
Только разбор/сборка строк и словари протокола: ни сокетов, ни контроллера.
Роль та же, что у CATEngine в CAT-подсистеме, но парсер тут тривиальный, и
вся логика команд живёт в TCIAdapter — команд у TCI мало, а аргументы у них
типизированы (номер приёмника/канала), поэтому таблица команд вырождается в
case по имени.
Формат (док, §3.1):
<имя>:<арг1>,<арг2>,…; команда с аргументами
<имя>; команда без аргументов
Зарезервированные символы: ':' ',' ';' — внутри аргументов запрещены и
заменяются на '^' '~' '*' (§3.2.1), обратная подстановка — TCIUnescape.
Регистр значения не имеет. ExpertSDR3 шлёт всё в нижнем регистре, и часть
клиентов сравнивает строки как есть — поэтому наружу тоже пишем строчными,
а внутрь принимаем любой.
}
{$IFDEF FPC}
{$MODE Delphi}
{$LONGSTRINGS ON}
{$ENDIF}
interface
uses
Classes, SysUtils, Math, RadioModes;
const
TCI_VERSION = '2.0'; // версия протокола, отдаётся в PROTOCOL
TCI_APP_NAME = 'EWSDR';
TCI_DEFAULT_PORT = 40001; // порт TCI-сервера ExpertSDR3
TCI_CHANNELS = 2; // каналов приёма на приёмник (A/B)
// Список видов связи для MODULATIONS_LIST. Первые десять — словарь
// ExpertSDR3 (клиенты сверяются именно с ними), dmr/fmraw — наше
// расширение: протокол расширяемый по замыслу (§1.4).
TCI_MODULATIONS = 'am,sam,dsb,lsb,usb,cw,nfm,wfm,digl,digu,dmr,fmraw';
// Границы, оговорённые протоколом (клампим сами — клиент шлёт что угодно).
// Бинарные потоки (§3.4). data[16384] в структуре Stream — это ПОТОЛОК блока,
// а не его размер: больше в один блок не кладут ни ExpertSDR3, ни клиенты.
TCI_STREAM_DATA_MAX = 16384; // байт данных в блоке
TCI_STREAM_HDR_SIZE = 64; // 16 × uint32
TCI_STREAM_MAX = TCI_STREAM_HDR_SIZE + TCI_STREAM_DATA_MAX;
// Умолчания параметров потоков (§4.3).
TCI_IQ_RATE_DEF = 48000;
TCI_AUDIO_RATE_DEF = 48000;
TCI_AUDIO_CHAN_DEF = 2;
TCI_TX_BUFFERING_DEF = 50; // мс
TCI_AUDIO_SAMPLES_MIN = 100;
TCI_AUDIO_SAMPLES_MAX = 2048;
TCI_TX_BUFFERING_MIN = 50;
TCI_TX_BUFFERING_MAX = 500;
TCI_RECORD_MAX_SEC = 300; // потолок записи линейного выхода
// ★Общий потолок памяти ВСЕХ рекордеров сразу. Приёмников у нас
// 1 + MAX_SLICES, и предельные 300 с на каждом — это 57.6 МБ × 7 ≈ 403 МБ,
// которые неавторизованный клиент выпрашивал бы семью строками. Бюджет
// общий на адаптер, спрашивается при выделении КАЖДОГО куска (см.
// TTCIRecorder): 128 МБ — это две полных записи предельной длины, больше
// одновременно не нужно никому.
TCI_RECORD_MAX_BYTES = Int64(128) * 1024 * 1024;
// Кусок кольца записи — секунда звука (48000 × 2 канала × int16 = 192 КБ).
// Выделяем их по мере набора: команда START больше не стоит ни байта, а
// молчащий или мёртвый приёмник не стоит ничего вовсе.
TCI_RECORD_CHUNK_SEC = 1;
TCI_VOL_MIN_DB = -60; TCI_VOL_MAX_DB = 0;
TCI_SQL_MIN_DB = -140; TCI_SQL_MAX_DB = 0;
TCI_AGC_MIN_DB = -20; TCI_AGC_MAX_DB = 120;
TCI_SENSOR_MIN_MS = 30; TCI_SENSOR_MAX_MS = 1000;
type
TTCIArgs = array of string;
{ Разобранная команда. Name — в ВЕРХНЕМ регистре (сравнивать в case),
аргументы — как пришли, с уже снятым экранированием только там, где это
нужно вызывающему (текст CW), поэтому здесь их не трогаем. }
TTCIMessage = record
Name: string;
Args: TTCIArgs;
ArgCount: Integer;
end;
{ Тип бинарного потока (§3.4). }
TTCIStreamType = (tstIQ, tstRXAudio, tstTXAudio, tstTXChrono, tstLineOut);
TTCISampleType = (tsyInt16, tsyInt24, tsyInt32, tsyFloat32);
{ Заголовок блока потока: 16 × uint32 перед сэмплами. }
TTCIStreamHeader = packed record
Receiver: LongWord;
SampleRate: LongWord;
Format: LongWord; // TTCISampleType
Codec: LongWord; // всегда 0 (сжатие не реализовано)
CRC: LongWord; // всегда 0
DataLength: LongWord; // вещественных отсчётов всего блока
// (комплексных/на канал = length/channels)
StreamType: LongWord; // TTCIStreamType
Channels: LongWord;
Reserv: array[0..7] of LongWord;
end;
{ ── Разбор ─────────────────────────────────────────────────────────────── }
{ Разбирает ОДНУ команду (без завершающей ';' или с ней). False — мусор. }
function TCIParse(const S: string; out M: TTCIMessage): Boolean;
{ Режет полученный текстовый фрейм на отдельные команды по ';'. Клиенты
склеивают команды в один фрейм, и это законно. }
function TCISplit(const Payload: string; Lines: TStrings): Integer;
function TCIArg(const M: TTCIMessage; Idx: Integer): string;
function TCIArgInt(const M: TTCIMessage; Idx, Def: Integer): Integer;
function TCIArgFloat(const M: TTCIMessage; Idx: Integer; Def: Double): Double;
function TCIArgBool(const M: TTCIMessage; Idx: Integer; Def: Boolean): Boolean;
{ Строгий разбор аргумента: False — аргумента нет или он не число/не Boolean.
Всё, что ставит параметр радио, обязано ходить через эти функции: варианты с
умолчанием превращали «vfo^0~0~abc;» в честный ноль и перестраивали приёмник
на 0 Гц. Умолчания остаются только там, где значение необязательно. }
function TCITryArgInt(const M: TTCIMessage; Idx: Integer; out V: Integer): Boolean;
function TCITryArgFloat(const M: TTCIMessage; Idx: Integer; out V: Double): Boolean;
function TCITryArgBool(const M: TTCIMessage; Idx: Integer; out V: Boolean): Boolean;
{ Наборы значений, оговорённые протоколом для параметров потоков (§4.3). }
function TCIValidIQRate(V: Integer): Boolean; // 48/96/192/384 кГц
function TCIValidAudioRate(V: Integer): Boolean; // 8/12/24/48 кГц
function TCIValidSampleType(const S: string): Boolean; // int16/int24/int32/float32
{ ── Бинарные потоки (§3.4) ─────────────────────────────────────────────── }
function TCISampleTypeByName(const S: string; out T: TTCISampleType): Boolean;
function TCISampleTypeName(T: TTCISampleType): string;
function TCISampleBytes(T: TTCISampleType): Integer;
{ Сколько сэмплов НА КАНАЛ класть в блок по умолчанию (§4.3): у ExpertSDR3
своё число на каждую частоту дискретизации, и все они дают ~42 мс звучания. }
function TCIDefaultAudioSamples(RateHz: Integer): Integer;
{ Сколько сэмплов на канал влезает в блок с таким форматом и числом каналов. }
function TCIMaxBlockSamples(T: TTCISampleType; Channels: Integer): Integer;
{ Заголовок блока. Count — сэмплов НА КАНАЛ, а в DataLength всегда уходит
Count × Channels: length измеряется ВЕЩЕСТВЕННЫМИ ОТСЧЁТАМИ всего блока, и
для IQ, и для аудио.
Для IQ так прямо написано в §3.4 («количество комплексных вычисляется как
Stream.length/Stream.channels»), а для аудио формулировка §4.3 про
AUDIO_STREAM_SAMPLES («arg1 — количество сэмплов, указываемое в поле
Stream.length») однажды уже увела нас в «сэмплы на канал». ★Так делать
нельзя, и вот доказательство из живого клиента — MSHV, network.cpp:
int cr2 = (int)pStream->length*bit_s; // сколько БАЙТ разбирать
for (int i = 0; i < cr2; i+=chan*bit_s) // шаг = кадр всех каналов
...
quint32 cr3 = pStream->length*bit_s; //plength = plength*channels*4-bytes
То есть клиент считает по length число байт блока. Стоит объявить length «на
канал» — и у стерео он разбирает ровно половину блока, а вторую выбрасывает:
звук идёт с дырами в 50%, водопад становится шире и грязнее, FT4/FT8 не
декодируются вовсе. Замерено стендом test/tci/ft4_bench.py: 50% темпа набора
звука и 1649 не до конца разобранных блоков за минуту.
Размер блока при этом остаётся прежним: AUDIO_STREAM_SAMPLES — сэмплы НА
КАНАЛ (2048 при 48 кГц = 42.7 мс, как у ExpertSDR3), и потолок data[16384]
сходится ровно: 2048 × 2 канала × float32. }
procedure TCIFillHeader(out H: TTCIStreamHeader; Kind: TTCIStreamType;
Rx, RateHz: Integer; T: TTCISampleType; Count, Channels: Integer);
{ Упаковка вещественных отсчётов в формат клиента. Возвращает число байт.
Src читается подряд (уже с чередованием каналов), Dest обязан вмещать
N × TCISampleBytes(T) байт. }
function TCIPackSamples(const Src: array of Single; N: Integer;
T: TTCISampleType; Dest: PByte): Integer;
{ Обратная распаковка (TX-аудио от клиента). Возвращает число распакованных
вещественных отсчётов; лишнее сверх Length(Dest) отбрасывается. }
function TCIUnpackSamples(Src: PByte; Bytes: Integer; T: TTCISampleType;
var Dest: array of Single): Integer;
{ ── Сборка ─────────────────────────────────────────────────────────────── }
function TCIBuild(const Name: string): string; overload;
function TCIBuild(const Name: string; const Args: array of string): string; overload;
function TCIBoolStr(B: Boolean): string;
function TCIIntStr(V: Int64): string;
function TCIFloatStr(V: Double; Digits: Integer = 1): string;
{ ── Экранирование текстовых аргументов (§3.2.1) ────────────────────────── }
function TCIUnescape(const S: string): string;
function TCIEscape(const S: string): string;
{ ── Виды связи ─────────────────────────────────────────────────────────── }
{ Имя вида связи для TCI по индексу RadioModes (CWL/CWU схлопываются в 'cw'). }
function TCIModeName(ModeIdx: Integer): string;
{ Индекс RadioModes по имени TCI. 'cw' сам по себе боковую не задаёт:
оставляем текущую, если уже телеграф, иначе выбираем по частоте (ниже
10 МГц — CWL, выше — CWU, общепринятая конвенция). -1 = имя неизвестно. }
function TCIModeIndex(const Name: string; CurMode: Integer; FreqHz: Double): Integer;
{ ── Пересчёт величин ───────────────────────────────────────────────────── }
function TCIVolumeToDb(V: Integer): Double; // громкость 0..100 → -60..0 дБ
function TCIDbToVolume(Db: Double): Integer; // и обратно
function TCISqlToLevel(Db: Double): Integer; // порог -140..0 дБ → 0..100
function TCILevelToSql(V: Integer): Double;
implementation
var
// Числа протокола — только с точкой, независимо от локали хоста.
TCIFormatSettings: TFormatSettings;
{ ═══════════════════════════════════════════════════════════════════════════
Разбор
═══════════════════════════════════════════════════════════════════════════ }
function TCIParse(const S: string; out M: TTCIMessage): Boolean;
var
Body, ArgStr: string;
P, Start, i: Integer;
begin
Result := False;
M.Name := '';
M.ArgCount := 0;
SetLength(M.Args, 0);
Body := Trim(S);
// Хвостовая ';' необязательна: транспорт мог её уже срезать при нарезке.
if (Body <> '') and (Body[Length(Body)] = ';') then
Body := Copy(Body, 1, Length(Body) - 1);
Body := Trim(Body);
if Body = '' then Exit;
P := Pos(':', Body);
if P = 0 then
begin
M.Name := UpperCase(Body);
Result := M.Name <> '';
Exit;
end;
M.Name := UpperCase(Trim(Copy(Body, 1, P - 1)));
if M.Name = '' then Exit;
ArgStr := Copy(Body, P + 1, MaxInt);
Start := 1;
for i := 1 to Length(ArgStr) + 1 do
if (i > Length(ArgStr)) or (ArgStr[i] = ',') then
begin
SetLength(M.Args, M.ArgCount + 1);
M.Args[M.ArgCount] := Trim(Copy(ArgStr, Start, i - Start));
Inc(M.ArgCount);
Start := i + 1;
end;
Result := True;
end;
function TCISplit(const Payload: string; Lines: TStrings): Integer;
var
i, Start: Integer;
Piece: string;
begin
Lines.Clear;
Start := 1;
for i := 1 to Length(Payload) do
if Payload[i] = ';' then
begin
Piece := Trim(Copy(Payload, Start, i - Start));
if Piece <> '' then Lines.Add(Piece);
Start := i + 1;
end;
// Хвост без ';' — недоприехавшая команда; протокол её игнорирует (§3.1).
Result := Lines.Count;
end;
function TCIArg(const M: TTCIMessage; Idx: Integer): string;
begin
if (Idx >= 0) and (Idx < M.ArgCount) then Result := M.Args[Idx] else Result := '';
end;
function TCIArgInt(const M: TTCIMessage; Idx, Def: Integer): Integer;
var
D: Double;
begin
// Клиенты шлют и «7100000», и «7100000.0» — берём через Float и округляем.
if not TryStrToFloat(StringReplace(TCIArg(M, Idx), ',', '.', [rfReplaceAll]),
D, TCIFormatSettings) then
Result := Def
else
Result := Round(D);
end;
function TCIArgFloat(const M: TTCIMessage; Idx: Integer; Def: Double): Double;
begin
if not TryStrToFloat(StringReplace(TCIArg(M, Idx), ',', '.', [rfReplaceAll]),
Result, TCIFormatSettings) then
Result := Def;
end;
function TCIArgBool(const M: TTCIMessage; Idx: Integer; Def: Boolean): Boolean;
var
S: string;
begin
S := LowerCase(TCIArg(M, Idx));
if (S = 'true') or (S = '1') then Result := True
else if (S = 'false') or (S = '0') then Result := False
else Result := Def;
end;
function TCITryArgFloat(const M: TTCIMessage; Idx: Integer; out V: Double): Boolean;
var S: string;
begin
V := 0;
S := Trim(TCIArg(M, Idx));
if S = '' then Exit(False);
Result := TryStrToFloat(StringReplace(S, ',', '.', [rfReplaceAll]), V,
TCIFormatSettings);
end;
function TCITryArgInt(const M: TTCIMessage; Idx: Integer; out V: Integer): Boolean;
var D: Double;
begin
V := 0;
Result := TCITryArgFloat(M, Idx, D);
// Величины протокола целочисленные, но клиенты шлют и «100.0»; за пределами
// Integer округлять нечего — это не значение, а мусор.
if Result then
begin
Result := (D >= -2147483648.0) and (D <= 2147483647.0);
if Result then V := Round(D);
end;
end;
function TCITryArgBool(const M: TTCIMessage; Idx: Integer; out V: Boolean): Boolean;
var S: string;
begin
V := False;
S := LowerCase(Trim(TCIArg(M, Idx)));
if (S = 'true') or (S = '1') then begin V := True; Result := True; end
else if (S = 'false') or (S = '0') then begin V := False; Result := True; end
else Result := False;
end;
function TCIValidIQRate(V: Integer): Boolean;
begin
Result := (V = 48000) or (V = 96000) or (V = 192000) or (V = 384000);
end;
function TCIValidAudioRate(V: Integer): Boolean;
begin
Result := (V = 8000) or (V = 12000) or (V = 24000) or (V = 48000);
end;
function TCIValidSampleType(const S: string): Boolean;
var T: TTCISampleType;
begin
Result := TCISampleTypeByName(S, T);
end;
{ ═══════════════════════════════════════════════════════════════════════════
Бинарные потоки (§3.4)
═══════════════════════════════════════════════════════════════════════════ }
function TCISampleTypeByName(const S: string; out T: TTCISampleType): Boolean;
var N: string;
begin
Result := True;
N := LowerCase(Trim(S));
if N = 'int16' then T := tsyInt16
else if N = 'int24' then T := tsyInt24
else if N = 'int32' then T := tsyInt32
else if N = 'float32' then T := tsyFloat32
else begin T := tsyFloat32; Result := False; end;
end;
function TCISampleTypeName(T: TTCISampleType): string;
begin
case T of
tsyInt16: Result := 'int16';
tsyInt24: Result := 'int24';
tsyInt32: Result := 'int32';
else Result := 'float32';
end;
end;
function TCISampleBytes(T: TTCISampleType): Integer;
begin
case T of
tsyInt16: Result := 2;
tsyInt24: Result := 3;
else Result := 4; // int32 и float32
end;
end;
function TCIDefaultAudioSamples(RateHz: Integer): Integer;
begin
case RateHz of
8000: Result := 256;
12000: Result := 512;
24000: Result := 1024;
else Result := 2048; // 48 кГц и всё непонятное
end;
end;
function TCIMaxBlockSamples(T: TTCISampleType; Channels: Integer): Integer;
begin
if Channels < 1 then Channels := 1;
Result := TCI_STREAM_DATA_MAX div (TCISampleBytes(T) * Channels);
end;
procedure TCIFillHeader(out H: TTCIStreamHeader; Kind: TTCIStreamType;
Rx, RateHz: Integer; T: TTCISampleType; Count, Channels: Integer);
begin
FillChar(H, SizeOf(H), 0);
H.Receiver := LongWord(Rx);
H.SampleRate := LongWord(RateHz);
H.Format := LongWord(Ord(T));
// ★length — вещественные отсчёты всего блока, у всех типов потока одинаково
// (см. шапку объявления: «на канал» ломает реальных клиентов).
H.DataLength := LongWord(Count * Channels);
H.StreamType := LongWord(Ord(Kind));
H.Channels := LongWord(Channels);
end;
function TCIPackSamples(const Src: array of Single; N: Integer;
T: TTCISampleType; Dest: PByte): Integer;
// Клампим на входе: перегруз в целочисленных форматах иначе заворачивается
// через знак и вместо ограничения даёт треск обратной полярности.
var
i, V: Integer;
F: Single;
P: PByte;
begin
if N > Length(Src) then N := Length(Src);
if N < 0 then N := 0;
P := Dest;
for i := 0 to N - 1 do
begin
F := Src[i];
if F > 1.0 then F := 1.0;
if F < -1.0 then F := -1.0;
case T of
tsyInt16:
begin
V := Round(F * 32767);
P[0] := Byte(V); P[1] := Byte(V shr 8);
Inc(P, 2);
end;
tsyInt24:
begin
V := Round(F * 8388607);
P[0] := Byte(V); P[1] := Byte(V shr 8); P[2] := Byte(V shr 16);
Inc(P, 3);
end;
tsyInt32:
begin
// 2^31-1 в Single не представимо точно, поэтому масштаб берём
// на единицу младше — иначе Round на полной шкале переполняется.
V := Round(F * 2147483520.0);
P[0] := Byte(V); P[1] := Byte(V shr 8);
P[2] := Byte(V shr 16); P[3] := Byte(V shr 24);
Inc(P, 4);
end;
else
begin
PSingle(P)^ := F;
Inc(P, 4);
end;
end;
end;
Result := N * TCISampleBytes(T);
end;
function TCIUnpackSamples(Src: PByte; Bytes: Integer; T: TTCISampleType;
var Dest: array of Single): Integer;
var
i, N, W: Integer;
P: PByte;
begin
Result := 0;
if (Src = nil) or (Bytes <= 0) then Exit;
N := Bytes div TCISampleBytes(T);
if N > Length(Dest) then N := Length(Dest);
P := Src;
for i := 0 to N - 1 do
begin
case T of
tsyInt16:
begin
W := SmallInt(Word(P[0]) or (Word(P[1]) shl 8));
Dest[i] := W / 32768.0;
Inc(P, 2);
end;
tsyInt24:
begin
W := LongInt(P[0]) or (LongInt(P[1]) shl 8) or (LongInt(P[2]) shl 16);
if (W and $800000) <> 0 then W := W or LongInt($FF000000);
Dest[i] := W / 8388608.0;
Inc(P, 3);
end;
tsyInt32:
begin
W := LongInt(LongWord(P[0]) or (LongWord(P[1]) shl 8) or
(LongWord(P[2]) shl 16) or (LongWord(P[3]) shl 24));
Dest[i] := W / 2147483648.0;
Inc(P, 4);
end;
else
begin
Dest[i] := PSingle(P)^;
Inc(P, 4);
end;
end;
end;
Result := N;
end;
{ ═══════════════════════════════════════════════════════════════════════════
Сборка
═══════════════════════════════════════════════════════════════════════════ }
function TCIBuild(const Name: string): string;
begin
Result := LowerCase(Name) + ';';
end;
function TCIBuild(const Name: string; const Args: array of string): string;
var
i: Integer;
begin
if Length(Args) = 0 then begin Result := TCIBuild(Name); Exit; end;
Result := LowerCase(Name) + ':';
for i := 0 to High(Args) do
begin
if i > 0 then Result := Result + ',';
Result := Result + Args[i];
end;
Result := Result + ';';
end;
function TCIBoolStr(B: Boolean): string;
begin
if B then Result := 'true' else Result := 'false';
end;
function TCIIntStr(V: Int64): string;
begin
Result := IntToStr(V);
end;
function TCIFloatStr(V: Double; Digits: Integer): string;
begin
if IsNan(V) or IsInfinite(V) then V := 0;
Result := FloatToStrF(V, ffFixed, 15, Digits, TCIFormatSettings);
end;
{ ═══════════════════════════════════════════════════════════════════════════
Экранирование
═══════════════════════════════════════════════════════════════════════════ }
function TCIUnescape(const S: string): string;
begin
Result := StringReplace(S, '^', ':', [rfReplaceAll]);
Result := StringReplace(Result, '~', ',', [rfReplaceAll]);
Result := StringReplace(Result, '*', ';', [rfReplaceAll]);
end;
function TCIEscape(const S: string): string;
begin
Result := StringReplace(S, ':', '^', [rfReplaceAll]);
Result := StringReplace(Result, ',', '~', [rfReplaceAll]);
Result := StringReplace(Result, ';', '*', [rfReplaceAll]);
end;
{ ═══════════════════════════════════════════════════════════════════════════
Виды связи
═══════════════════════════════════════════════════════════════════════════ }
function TCIModeName(ModeIdx: Integer): string;
begin
case ModeIdx of
MODE_LSB: Result := 'lsb';
MODE_USB: Result := 'usb';
MODE_DSB: Result := 'dsb';
MODE_CWL,
MODE_CWU: Result := 'cw';
MODE_FM: Result := 'nfm';
MODE_AM: Result := 'am';
MODE_SAM: Result := 'sam';
MODE_DIGU: Result := 'digu';
MODE_DIGL: Result := 'digl';
MODE_WFM: Result := 'wfm';
MODE_DMR: Result := 'dmr';
MODE_FMRAW: Result := 'fmraw';
else
Result := 'usb';
end;
end;
function TCIModeIndex(const Name: string; CurMode: Integer; FreqHz: Double): Integer;
var
S: string;
begin
S := LowerCase(Trim(Name));
if S = 'lsb' then Result := MODE_LSB
else if S = 'usb' then Result := MODE_USB
else if S = 'dsb' then Result := MODE_DSB
else if S = 'am' then Result := MODE_AM
else if S = 'sam' then Result := MODE_SAM
else if (S = 'nfm') or (S = 'fm') then Result := MODE_FM
else if S = 'wfm' then Result := MODE_WFM
else if S = 'digu' then Result := MODE_DIGU
else if S = 'digl' then Result := MODE_DIGL
else if S = 'dmr' then Result := MODE_DMR
else if S = 'fmraw' then Result := MODE_FMRAW
else if S = 'cwl' then Result := MODE_CWL
else if S = 'cwu' then Result := MODE_CWU
else if S = 'cw' then
begin
if (CurMode = MODE_CWL) or (CurMode = MODE_CWU) then
Result := CurMode // боковую телеграфа не трогаем
else if FreqHz < 10000000 then
Result := MODE_CWL
else
Result := MODE_CWU;
end
else
Result := -1; // 'drm' и всё незнакомое — молча игнорируем (§3.1)
end;
{ ═══════════════════════════════════════════════════════════════════════════
Пересчёт величин
═══════════════════════════════════════════════════════════════════════════ }
function TCIVolumeToDb(V: Integer): Double;
begin
if V <= 0 then Result := TCI_VOL_MIN_DB
else if V >= 100 then Result := 0
else Result := TCI_VOL_MIN_DB + (TCI_VOL_MIN_DB * -1) * (V / 100.0);
end;
function TCIDbToVolume(Db: Double): Integer;
begin
if Db <= TCI_VOL_MIN_DB then Result := 0
else if Db >= 0 then Result := 100
else Result := Round((Db - TCI_VOL_MIN_DB) / (TCI_VOL_MIN_DB * -1) * 100.0);
end;
function TCISqlToLevel(Db: Double): Integer;
begin
// Порог шумоподавителя: у нас 0..100 (FM squelch), у TCI — dBm -140..0.
if Db <= TCI_SQL_MIN_DB then Result := 0
else if Db >= 0 then Result := 100
else Result := Round((Db - TCI_SQL_MIN_DB) / (TCI_SQL_MIN_DB * -1) * 100.0);
end;
function TCILevelToSql(V: Integer): Double;
begin
if V <= 0 then Result := TCI_SQL_MIN_DB
else if V >= 100 then Result := 0
else Result := TCI_SQL_MIN_DB + (TCI_SQL_MIN_DB * -1) * (V / 100.0);
end;
initialization
TCIFormatSettings := DefaultFormatSettings;
TCIFormatSettings.DecimalSeparator := '.';
end.