2020-01-14
82
Если вы хотите добавить поддержку нового кода, то вы должны сделать следующее:
· Добавить новый модуль к проекту MagicCoder.dpr.
· В полученном модуле создать наследника класса TCode, например, TMyCode.
· Перекрыть методы[1]:
GetK
GetN
GetName
Encode
Decode
· При желании перекрыть методы:
GetD
GetDescription
GetFullName
· Добавить в модуль секции initialization и finalization следующего содержания:
initialization
RegisterCode(TMyCode)
finalization
UnRegisterCode(TMyCode)
Этого будет достаточно для того, чтобы добавить полную поддержку нового кода.
Описание модулей программы
Во всех модулях программы обработка ошибок основана на механизме исключительных ситуаций (exceptions). Описание модулей программы выполнено в виде комментариев в стиле Delphi к объявлениям классов, их полей и методов; функций и констант.
Модуль «BitsUtils.pas»
{ В этом модуле находится реализация класса для работы
с массивом бит, 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 }
Модуль «MathUtils.pas»
unit MathUtils;
Interface
{ Факториал }
function Factorial(N: LongWord): Extended;
{ Число сочетаний C из N по К.
Функция используется кодом Рида-Маллера }
function C(N, K: LongWord): LongWord;
Модуль «Code.pas»
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;
{ Возвращает число кодов зарегистрированных в потоковой
системе }
function GetCodeClassName(Index: Integer): String;
{ Возвращает имя класса кода по индексу. Например,
класс кода Рида-Маллера имеет имя TRMCode }
function GetCodeName(Index: Integer): String;
{ Возвращает название кода по индексу. Т.е. результат
|
|
|
вызова метода GetName для соответствующего кода. }
function GetIndexOfCodeName(CodeName: String): Integer;
{ Возвращает индекс первого найденного кода название
которого совпало с заданным. Если совпадений не найдено,
то возвращается -1 }
function GetIndexOfCodeClassName(CodeClassName:
String): Integer;
{ Возвращает индекс первого найденного кода, имя класса
которого совпало с заданным. Если совпадений не
найдено, то возвращается -1 }
Public
{ Свойства }
property Count: Integer read GetCount;
property CodeNames[Index: Integer]: String read GetCodeName;
property CodeClassNames[Index: Integer]: String read
GetCodeClassName;
property IndexOfCodeName[CodeName: String]: Integer read
GetIndexOfCodeName;
property IndexOfCodeClassName[CodeClassName: String]:
Integer read GetIndexOfCodeClassName;
end;
{ Функции общего назначения }
{ Вес слова (количество ненулевых бит) }
function WordWeight(const Word; Len: Integer): Integer;
{ Регистрация кода в потоковой системе.
Незарегистрированный код не может быть использован при
декодировании из потока }
procedure RegisterCode(C: TPersistentCode);
{ Удаление кода из потоковой системы }
procedure UnRegisterCode(C: TPersistentCode);
{ Проверка параметров при кодировании и декодировании }
procedure CheckEncoderParams(InStream, OutStream:
TStream; Code: TCode);
procedure CheckDecoderParams(InStream, OutStream:
TStream; Code: TCode = TCode($1));
{ Кодирование и декодирование потоков
При кодировании в выходной поток записывается
заголовок следующего содержания:
Версия - версия кодового потока
Размер входного потока в байтах
Информация о коде (сериализованный TCode)
Далее, до конца потока, следуют упакованные
кодовые слова
При декодировании, сначала анализируется заголовок.
Если в нем указана неизвестная версия то, генерируется
Исключение EDecoder. Затем происходит попытка создать
код, используя записанную в потоке информацию о нем. После
чего, начинается само декодирование }
procedure DecodeStream(InStream, OutStream: TStream);
procedure EncodeStream(InStream, OutStream: TStream;
Code: TCode);
{ Кодирование и декодирование файлов
Эти процедуры являются надстройками над DecodeStream и
EncodeStream }
procedure DecodeFile(InputFileName, OutputFileName: String);
procedure EncodeFile(InputFileName, OutputFileName: String; Code: TCode);
{ Кодирование и декодирование без заголовка
При кодировании в поток не записывается дополнительная
информация (заголовок).
Поэтому при декодировании нужно явно указывать код,
которым нужно его производить }
procedure RawDecodeStream(InStream, OutStream: TStream;
Code: TCode);
procedure RawEncodeStream(InStream, OutStream: TStream;
Code: TCode);
{ Запись заголовка в поток }
procedure WriteHeader(InStream, OutStream: TStream;
Code: TCode);
Implementation
Type
{ TCodeList
Этот класс хранит информацию о кодах зарегистрированных в
Потоковой системе системе }
TCodeList = class (TObject)
Private
FCodeList: TClassList;
{ Список классов }
function GetCount: Integer;
{ Число элементов в списке классов }
function GetCodeClassName(Index: Integer): String;
{ Имя класса кода по индексу, например TRMCode }
function GetCodeName(Index: Integer): String;
{ Название кода по индексу, например Код Рида-Маллера }
Public
constructor Create;
destructor Destroy; override;
function Add(Code: TPersistentCode): Integer;
{ Добавляет класс в список, если его там нет,
и возвращает его индекс.
Если класс уже есть, то просто возвращается его индекс }
procedure Delete(Code: TPersistentCode);
{ Удаляет класс из списка }
{ Свойства }
property Count: Integer read GetCount;
property CodeClassNames[Index: Integer]: String read
GetCodeClassName;
property CodeNames[Index: Integer]: String read GetCodeName;
end; { TCodeList }
Var
CodeList: TCodeList;
{ Экземпляр класса TCodeList. Создается в секции
инициализации данного модуля. Уничтожается в секции
финализации }
