Этого будет достаточно для того, чтобы добавить полную поддержку нового кода.
Во всех модулях программы обработка ошибок основана на механизме исключительных ситуаций (exceptions). Описание модулей программы выполнено в виде комментариев в стиле Delphi к объявлениям классов, их полей и методов; функций и констант.
{ В этом модуле находится реализация класса для работы
с массивом бит, TBits }
unit BitsUtils;
interface
uses
Math, SysUtils, Windows, SysConst;
{ Для хранения битов используется массив 32-битных целых.
Т.е. для хранения от 1 до 32 бит будет использован один элемент массива, для хранения от 33 до 64 бит – 2 элемента и т.д. }
const
{ Число байт в элементе массива }
BITSUNIT_SIZE = 4;
{ Число бит в элементе массива }
BITSUNIT_BITS = BITSUNIT_SIZE * 8;
{ Маска элемента массива }
BITSUNIT_MASK = $FFFFFFFF;
type
{ Указатель на элемент }
PUnit = ^TUnit;
{ Тип элемента массива }
TUnit = DWORD;
type
{ Бит }
TBit = 0..1;
{ Исключение, которое генерируют большинство методов класса TBits }
EBits = class(Exception);
{ Класс TBits }
TBits = class(TObject)
private
{ Число бит в массиве }
FBitsCount: Integer;
{ Указатель на массив, в котором хранятся биты }
FData: PUnit;
{ Размер массива в байтах }
FDataSize: Integer;
{ Число элементов в массиве }
FUnitsCount: Integer;
procedure AllocMemory(ABitsCount: Integer);
{ На основе ABitsCount вычисляет значения FDataSize,
FUnitsCount и выделяет память размера FDataSize переводя
указатель FData на выделенный кусок }
function GetBit(Index: Integer): TBit;
{ Возвращает значение бита по его индексу. При
недопустимом индексе генерирует исключение EBits }
procedure SetBit(Index: Integer; const Value: TBit);
{ Присваивает указанному биту заданное значение.
При недопустимом индексе генерирует исключение EBits }
public
constructor Create(ABitsCount: Integer); overload;
constructor Create(Src: TBits); overload;
{ Конструктор копирования }
constructor Create(Src: String); overload;
{ Конструктор копирования }
destructor Destroy; override;
{ Методы присваивания }
function Assign(Src: TBits): TBits; overload;
function Assign(S: String): TBits; overload;
{ Все символы отличные от ‘0’ воспринимаются как ‘1’ }
function Equals(Bits: TBits): Boolean;
{ Сравнивает массивы бит }
function Increase: TBits;
{ Массив бит интерпретируется как целое, которое
увеличивается на единицу. При переполнении генерируется
исключение EIntOverflow }
function Reset: TBits;
{ Сброс всех битов массива }
function ShiftLeft(BitsCount: Integer): TBits;
{ Сдвиг бит влево (аналог shl) }
function ShiftLeftTo(DestBits: TBits;
BitsCount: Integer): TBits;
{ Сдвиг бит влево двойной точности (аналог shld) }
{ Методы сдвига вправо используются при кодировании и
декодировании потоков }
function ShiftRight(BitsCount: Integer): TBits;
{ Сдвиг бит вправо (аналог shr) }
function ShiftRightTo(DestBits: TBits;
BitsCount: Integer): TBits;
{ Сдвиг бит вправо двойной точности (аналог shrd) }
function ToString: String;
{ Возвращает строкое представление массива бит.
Младший бит слева, старший – справа }
function XorWith(Bits: TBits): TBits;
{ Сложение по модулю 2 (xor) }
{ Свойства класса }
property Bit[Index: Integer]: TBit read GetBit write
SetBit; default;
property BitsCount: Integer read FBitsCount;
{ Прямой доступ к данным }
property Data: PUnit read FData;
property DataSize: Integer read FDataSize;
property UnitsCount: Integer read FUnitsCount;
end; { TBits }
unit MathUtils;
interface
{ Факториал }
function Factorial(N: LongWord): Extended;
{ Число сочетаний C из N по К.
Функция используется кодом Рида-Маллера }
function C(N, K: LongWord): LongWord;
unit Code;
interface
uses
Classes, SysUtils, BitsUtils, Windows, Math, Contnrs;
const
VERSION_MAJOR = 1;
VERSION_MINOR = 0;
VERSION_FULL:DWORD = (Word(VERSION_MAJOR) shl 16) or
Word(VERSION_MINOR);
{ Версия модуля Code, заложена для будущего контроля версий, при
декодировании потоков }
type
{ THeader
Заголовок в начале кодового потока }
THeader = packed record
Version: DWORD;
DecodedSize: DWORD; { размер исходного потока в байтах }
end;
{ Классы исключений }
EECC = class(Exception);
ECode = class(EECC);
EWord = class(EBits);
EDecoder = class(EECC);
EEncoder = class(EECC);
EInBuf = class(Exception);
EOutBuf = class(Exception);
{ Класс TWord
Информационное слово }
TWord = class(TBits)
public
{ Скалярное умножение двух слов }
function ScalarMul(Word: TBits): Integer;
{ Слово Self и Word рассматриваются как векторы }
{ Вес слова }
function Weight: Integer;
end;
{ Класс TCodeWord
Кодовое слово }
TCodeWord = TWord;
{ Forward declaration }
TCode = class;
{ Класс TInBuf
Буфер ввода. Используется для чтения бит из потока }
TInBuf = class(TObject)
private
FInStream: TStream;
FBuf: TBits;
FBufRest: Integer;
{ число оставшихся (с конца) значащих бит в буфере }
public
constructor Create(InStream: TStream;
UnitsCount: Cardinal = 4096);
{ InStream - поток, из которого будет производится чтение
UnitsCount - число элементов TUnit во входном буфере }
destructor Destroy; override;
procedure Read(Word: TWord);
{ Читает следующие Word.BitsCount бит из входного потока
Если во входном потоке осталось меньше бит чем
BitsCount, то оставшиеся биты приравниваются 0 }
function EoS: Boolean;
{ Возвращает истину, если входной поток закончился }
property InStream: TStream read FInStream;
end; { TInBuf }
{ Класс TOutBuf
Используется для записи бит в поток }
TOutBuf = class(TObject)
private
FOutStream: TStream;
FBuf: TBits;
FBufRest: Integer;
{ число оставшихся значащих бит в буфере }
public
constructor Create(OutStream: TStream;
UnitsCount: Cardinal = 4096);
{ OutStream - поток, в который будет производится запись
UnitsCount - число элементов TUnit в буфере }
destructor Destroy; override;
{ Уничтожает объект, предварительно вызвав Flush }
procedure Write(Word: TWord);
{ Записывает биты слова Word в буфер, вытесняя из него
имеющиеся данные в поток вывода }
procedure Flush;
{ Сбрасывает оставшуюся информацию из буфера в поток }
property OutStream: TStream read FOutStream;
end; { TOutBuf }
{ TCode
Базовый класс для кодов }
TCode = class(TComponent)
protected
FD: Integer;
{ Это поле хранит минимальное расстояние кода. Оно
вычисляется методом GetD }
function GetD: Integer; virtual;
{ Вычисляет минимальное расстояние кода перебором.
В наследниках рекомендуется перекрыть этот метод. }
function GetDescription: String; virtual;
{ Описание кода.
Возвращает пустую строку. Наследники могут перекрыть
этот метод }
function GetK: Integer; virtual; abstract;
{ Возвращает размер информационного слова.
Наследники должны перекрыть этот метод }
function GetN: Integer; virtual; abstract;
{ Возвращает размер кодового слова.
Наследники должны перекрыть этот метод }
function GetFullName: String; virtual;
{ Возвращает полное название кода, например,
Код Рида-Маллера(2, 5).
Наследники могут перекрыть этот метод. По умолчанию
Он возвращает результат GetName }
class function GetName: String; virtual;
{ Возвращает название кода.
Наследники должны перекрыть этот метод }
public
procedure Encode(Word: TWord; CodeWord: TCodeWord); virtual;
abstract;
{ Преобразует информационное слово в кодовое
Word - информационное слово. Размер информационного
слова должен
быть не меньше чем K. При кодировании
используются лишь первые K бит
информационного слова
CodeWord - кодовое слово. Размер должен быть не
меньше чем N
Наследники должны перекрыть этот метод }
procedure Decode(RecievedWord: TCodeWord; Word: TWord);
virtual; abstract;
{ Декодирование
RecievedWord - полученное слово, которое будет
декодировано. Размер должен быть
не меньше N. Используются лишь
первые N бит слова
Word - декодированное слово. Размер должен
быть не меньше K
Наследники должны перекрыть этот метод }
{ Свойства }
property Description: String read GetDescription;
property FullName: String read GetFullName;
property Name: String read GetName;
property D: Integer read GetD;
property K: Integer read GetK;
property N: Integer read GetN;
end; { TCode }
{ Тип класса для потоковой системы }
TPersistentCode = class of TCode;
{ TCodeListViewer
Класс для просмотра зарегистрированных в потоковой системе
кодов. Является прослойкой между приложением и классом
TCodeList, который находится в части
реализации модуля (implementation) и, следовательно, не виден
вне этого модуля. Это сделано для повышения надежности
системы в целом, т.к. TCodeList играет огромную роль в ее
работе }
TCodeListViewer = class(TObject)
private
function GetCount: Integer;
{ Возвращает число кодов зарегистрированных в потоковой