2019-09-22 04:29:14 +03:00
//*****************************************************************************************************\\
2019-03-26 00:56:10 +03:00
// Copyright (©) Cergey Latchenko ( github.com/SunSerega | forum.mmcs.sfedu.ru/u/sun_serega )
// This code is distributed under the Unlicense
2019-09-22 04:29:14 +03:00
// For details see LICENSE file or this:
// https://github.com/SunSerega/POCGL/blob/master/LICENSE
2019-06-19 23:15:53 +03:00
//*****************************************************************************************************\\
// Copyright (©) Сергей Латченко ( github.com/SunSerega | forum.mmcs.sfedu.ru/u/sun_serega )
2019-09-22 04:29:14 +03:00
// Этот код распространяется с лицензией Unlicense
// Подробнее в файле LICENSE или тут:
// https://github.com/SunSerega/POCGL/blob/master/LICENSE
2019-06-19 23:15:53 +03:00
//*****************************************************************************************************\\
2019-03-26 00:56:10 +03:00
///Модуль, содержащий тип BlockFileOf<T>
2019-12-28 22:08:52 +03:00
///Тип BlockFileOf<T> - альтернатива стандартному file of T
2019-03-26 00:56:10 +03:00
///Главное преимущество - скорость работы
unit BlockFileOfT;
interface
uses System. Runtime. InteropServices;
uses System. IO;
type
///--
BlockFileBase = abstract class
protected fi: FileInfo;
protected _offset: int64 ;
protected str: FileStream;
protected linked : = new List< BlockFileBase> ;
protected procedure Link( f: BlockFileBase) ;
protected procedure UnLink;
private static function MessageBox( wnd: System. IntPtr ; message , caption: string ; flags: cardinal ) : integer ; external 'User32.dll' ;
end ;
///Тип, записывающий данные в файл по схожему с "file of <T>" принципу
2019-12-28 22:08:52 +03:00
///Н о , в отличие от типизированных файлов, данный тип сохраняет всю запись одним блоком так, как она записана в памяти.
2019-03-26 00:56:10 +03:00
///Это даёт значительное преимущество по скорости, но ограничивает типы, которые могут быть использованы в качестве полей типа <T>
///
2019-09-22 04:29:14 +03:00
///Это значит, что поля записи T и всех вложенных записей не могут быть:
/// - Указателями
2019-12-28 22:08:52 +03:00
/// - Ссылочными типами (классами, динамическими массивами)
///Однако эти ограничения можно обойти. О б этом можно прочитать в справке
2019-09-22 04:29:14 +03:00
BlockFileOf< T> = class( BlockFileBase) where T: record ;
{$region Internal}
2019-03-26 00:56:10 +03:00
private static sz: integer ;
private static procedure TestForRefT( tt: System. Type ) ;
begin
2019-09-22 04:50:06 +03:00
if tt = typeof( System. IntPtr ) then exit; // IntPtr содержит 1 поле типа pointer. Н о IntPtr это не указатель а число, с размером как у pointer
if tt. IsClass then raise new System. InvalidOperationException( $ 'Тип {tt} ссылочный.{#10}Ссылочные типы нельзя сохранять в типизированный файл' ) ;
foreach var fi in tt. GetFields(
2019-03-26 00:56:10 +03:00
System. Reflection. BindingFlags. GetField or
System. Reflection. BindingFlags. Instance or
System. Reflection. BindingFlags. Public or
System. Reflection. BindingFlags. NonPublic
) do
if not fi. IsLiteral then
2019-09-22 04:29:14 +03:00
if fi. FieldType < > tt then // тип integer имеет поле типа integer, без этой строчки StackOverflowException
2019-03-26 00:56:10 +03:00
TestForRefT( fi. FieldType) ;
end ;
private static constructor : =
try
TestForRefT( typeof( T) ) ;
2019-09-22 04:29:14 +03:00
sz : = Marshal. SizeOf & < T> ;
2019-03-26 00:56:10 +03:00
except
on e: Exception do
begin
MessageBox( new System. IntPtr( nil ) ,
e. ToString,
2019-09-22 04:29:14 +03:00
$ 'BlockFileOf<{typeof(T)}> не может инициализироваться:' ,
2019-03-26 00:56:10 +03:00
$10
) ;
Halt( - 1 ) ;
end ;
end ;
private function GetName: string ;
private function GetFullName: string ;
private function GetExists: boolean ;
private function GetFileSize: int64 : = ( GetByteFileSize - _offset) div sz;
private procedure SetFileSize( size: int64 ) : = SetByteFileSize( _offset + size* sz) ;
private function GetByteFileSize: int64 ;
private procedure SetByteFileSize( size: int64 ) ;
private function GetPos: int64 : = ( GetPosByte- _offset) div sz;
private procedure SetPos( pos: int64 ) : = SetPosByte( _offset + pos* sz) ;
private function GetPosByte: int64 ;
private procedure SetPosByte( pos: int64 ) ;
2019-09-22 04:29:14 +03:00
{$endregion Internal}
{$region constructor's}
2019-03-26 00:56:10 +03:00
///Инициализирует переменную файла, не привязывая её к файлу на диске
public constructor : = exit;
///Инициализирует переменную файла, привязывая её к файлу с именем fname
public constructor( fname: string ) : =
Assign( fname) ;
///Инициализирует переменную файла, привязывая её к файлу с именем fname
2019-09-22 04:29:14 +03:00
///Устанавливает значение смещения от начала файла в байтах на offset
2019-03-26 00:56:10 +03:00
public constructor( fname: string ; offset: int64 ) : =
Assign( fname, offset) ;
2019-09-22 04:29:14 +03:00
///- constructor BlockFileOf<>(f: BlockFileOf<>);
2019-03-26 00:56:10 +03:00
///Инициализирует новую переменную, создавая связку с заданной переменной
///После вызова этого конструктора переданная и созданная переменные будут использовать общий файловый поток, но записывать разные типы данных (у них может быть разный T)
///Это значит, что переменная, которую передали в конструктор, уже должна иметь открытый файловый поток
///Метод Close разрывает эту связь.
public constructor( f: BlockFileBase) : =
Link( f) ;
2019-09-22 04:29:14 +03:00
{$endregion constructor's}
{$region property's}
2019-03-26 00:56:10 +03:00
///Возвращает или задаёт размер блока из одного элемента в байтах
///Задавать это свойство не рекомендуется
public property TSize: integer read integer( sz) write sz : = value;
///Возвращает или задаёт смещение от начала файла до начала элементов в байтах
public property Offset: int64 read _offset write _offset;
///Возвращает или задаёт количество сохранённых в файл элементов
///Задавать можно только после открытия файла
public property Size: int64 read GetFileSize write SetFileSize;
///Возвращает или задаёт размер файла в байтах
///Задавать можно только после открытия файла
public property ByteSize: int64 read GetByteFileSize write SetByteFileSize;
///Возвращает неполное имя файла
public property Name : string read GetName;
///Возвращает полное имя файла
public property FullName: string read GetFullName;
///Определяет, существует ли файл
public property Exists: boolean read GetExists;
2019-09-22 04:29:14 +03:00
///Возвращает или задаёт номер текущего элемета в файле (нумеруя с 0)
2019-03-26 00:56:10 +03:00
public property Pos: int64 read GetPos write SetPos;
2019-09-22 04:29:14 +03:00
///Возвращает или задаёт номер текущего байта от начала файла (нумеруя с 0)
2019-03-26 00:56:10 +03:00
public property PosByte: int64 read GetPosByte write SetPosByte;
///Определяет, привязана ли переменная к файлу
2019-09-22 04:29:14 +03:00
public property Assigned: boolean read fi< > nil ;
2019-03-26 00:56:10 +03:00
///Определяет, открыт ли файл
2019-09-22 04:29:14 +03:00
public property Opened: boolean read str< > nil ;
2019-03-26 00:56:10 +03:00
///Определяет, достигнут ли конец файла
public property EOF: boolean read ByteSize- PosByte < sz;
///Возвращает поток текущего файла (или nil если файл не открыт)
2019-12-28 22:08:52 +03:00
///Внимание! Любое действие, связанное с изменением данного потока файла, приведёт к неожиданным последствиям. Используйте е г о только если знаете, что вы делаете
2019-03-26 00:56:10 +03:00
public property BaseStream: FileStream read str;
2019-09-22 04:29:14 +03:00
///Возвращает FileInfo текущего файла (или nil, если переменная не привязана к файлу)
public property FileInfo: System. IO. FileInfo read fi;
2019-03-26 00:56:10 +03:00
2019-09-22 04:29:14 +03:00
{$endregion property's}
2019-09-22 03:43:43 +03:00
2019-09-22 04:29:14 +03:00
{$region Setup IO}
2019-09-22 03:43:43 +03:00
2019-03-26 00:56:10 +03:00
///Привязывает текущий экземпляр BlockFileOf<T> к файлу с именем fname
///Привязывать можно и к несуществующим файлам, при открытии на запись будет создан новый файл
public procedure Assign( fname: string ) ;
///Привязывает данную переменную к файлу с именем fname
///Устанавливает смещение от начала файла до начала элементов в байтах на offset
2019-09-22 04:29:14 +03:00
///Привязывать можно и к несуществующим файлам, при открытии чем то вроде Rewrite будет создан новый файл
2019-03-26 00:56:10 +03:00
public procedure Assign( fname: string ; offset: int64 ) ;
///Удаляет связь переменной с файлом, если связь есть
public procedure UnAssign;
///Открывает файл способом mode
public procedure Open( mode: FileMode) ;
///Удаляет связаный файл, если он существует
public procedure Delete;
///Переименовывает файл
///При указании иного расположения файл будет перемещён
public procedure Rename( NewName: string ) ;
2019-09-22 04:29:14 +03:00
///Создает (или обнуляет) файл
2019-03-26 00:56:10 +03:00
public procedure Rewrite;
///Привязывает данную переменную к файлу с именем fname и создает (или обнуляет) е г о
public procedure Rewrite( fname: string ) ;
///Привязывает данную переменную к файлу с именем fname и создает (или обнуляет) е г о
///Устанавливает смещение от начала файла до начала элементов в байтах на offset
public procedure Rewrite( fname: string ; offset: int64 ) ;
///Открывает файл на чтение
public procedure Reset;
///Привязывает данную переменную к файлу с именем fname и открывает е г о на чтение
public procedure Reset( fname: string ) ;
///Привязывает данную переменную к файлу с именем fname и открывает е г о на чтение
///Устанавливает смещение от начала файла до начала элементов в байтах на offset
public procedure Reset( fname: string ; offset: int64 ) ;
///Открывает файл и устанавливает позицию на конец файла
public procedure Append;
///Привязывает данную переменную к файлу с именем fname и открывает е г о , устанавливая позицию на конец файла
public procedure Append( fname: string ) ;
///Привязывает данную переменную к файлу с именем fname и открывает е г о , устанавливая позицию на конец файла
///Устанавливает смещение от начала файла до начала элементов в байтах на offset
public procedure Append( fname: string ; offset: int64 ) ;
///Записывает все изменения в файл и отчищает внутренние буферы
///До вызова Flush или Close все изменения и кеш хранятся в оперативной памяти
2019-09-22 04:29:14 +03:00
///Если вы проводите операции с большими объёмами памяти - рекомендуется вызывать Flush время от времени
2019-03-26 00:56:10 +03:00
public procedure Flush;
///Сохраняет и закрывает файл, если он открыт
public procedure Close;
2019-09-22 04:29:14 +03:00
{$endregion Setup IO}
{$region Write}
2019-03-26 00:56:10 +03:00
///Записывает один элемент одним блоком в файл
///Переставляет файловый курсор на 1 элемет вперёд
public procedure Write( o: T) ;
///Записывает массив элементов одним блоком в файл
///Переставляет файловый курсор на количество элементов, равному количеству элементов в переданном массиве
public procedure Write( params o: array of T) ;
///Записывает последовательность элементов, у которой можно узнать длину, одним блоком в файл
///Переставляет файловый курсор на количество элементов, равному количеству элементов в переданной коллекции
public procedure Write( o: ICollection< T> ) ;
///Записывает последовательность элементов, у которой нельзя узнать длину, по 1 элементу в файл
///Переставляет файловый курсор на количество элементов, равному количеству элементов в переданной последовательности
public procedure Write( o: sequence of T) ;
///Записывает count элементов массива, начиная с элемента from, одним блоком в файл
///Переставляет файловый курсор на с ount элеметов вперёд
public procedure Write( o: array of T; from, count: integer ) ;
///Записывает count элементов последовательности, у которой можно узнать длину, начиная с элемента from, одним блоком в файл
///Переставляет файловый курсор на с ount элеметов вперёд
public procedure Write( o: ICollection< T> ; from, count: integer ) ;
///Записывает count элементов последовательности, у которой нельзя узнать длину, начиная с элемента from, одним блоком в файл
///После каждого элемента переставляет файловый курсор на 1 элемет вперёд
public procedure Write( o: sequence of T; from, count: integer ) ;
2019-09-22 04:29:14 +03:00
{$endregion Write}
{$region Read}
2019-03-26 00:56:10 +03:00
///Читает один элемент из файла одним блоком
2019-12-28 22:08:52 +03:00
///Переставляет файловый курсор на 1 элемент вперёд
2019-03-26 00:56:10 +03:00
public function Read : T;
///Читает массив из count элементов из файла одним блоком
///Переставляет файловый курсор на count элеметов вперёд
public function Read( count: integer ) : array of T;
///Читает массив из count элементов одним блоком, начиная с элемента start_elm
///И переставляет файловый курсор на count элеметов вперёд
public function Read( start_elm, count: integer ) : array of T;
2019-09-22 04:29:14 +03:00
///Читает один элемент из файла одним блоком и записывает в уже существующую переменную
2019-12-28 22:08:52 +03:00
///Переставляет файловый курсор на 1 элемент вперёд
2019-09-22 04:29:14 +03:00
public procedure Read( var o: T) ;
///Читает o.Length элементов из файла одним блоком и записывает их в уже существующий массив
2019-12-28 22:08:52 +03:00
///Переставляет файловый курсор на o.Length элементов вперёд
2019-09-22 04:29:14 +03:00
public procedure Read( o: array of T) ;
///Читает count элементов одним блоком, начиная с элемента start_elm
///Записывает их в массив o начиная с индекса arr_offset
2019-12-28 22:08:52 +03:00
///И переставляет файловый курсор на count элементов вперёд
2019-09-22 04:29:14 +03:00
public procedure Read( o: array of T; start_elm, arr_offset, count: integer ) ;
private function InternalReadLazy( c: integer ; start_pos: int64 ) : sequence of T;
2019-03-26 00:56:10 +03:00
///Возвращает ленивую последовательность из count элементов
///После завершения чтения курсор окажется на последнем элементе возвращаемой последовательности
2019-09-22 04:29:14 +03:00
///Перед чтением каждого элемента файловый курсор переставляется на start_elm+n
///Где start_elm - значение Pos на момент вызова ReadLazy, а n - количество уже считанных элементов
2019-03-26 00:56:10 +03:00
public function ReadLazy( count: integer ) : sequence of T : = InternalReadLazy( count, PosByte) ;
///Возвращает ленивую последовательность из count элементов, начиная с элемента start_elm
///После завершения чтения курсор окажется на последнем элементе возвращаемой последовательности
2019-09-22 04:29:14 +03:00
///Перед чтением каждого элемента файловый курсор переставляется на start_elm+n
///Где n - количество уже считанных элементов
2019-03-26 00:56:10 +03:00
public function ReadLazy( start_elm, count: integer ) : sequence of T : = InternalReadLazy( count, _offset + start_elm* sz) ;
2019-09-22 04:29:14 +03:00
{$endregion Read}
{$region Utils}
///Ставит позицию в файле на элемент pos (нумеруя с 0)
///Рекомендуется использовать свойство Pos вместо данного метода
public procedure Seek( pos: int64 ) : = self. Pos : = pos;
///Ставит файловый курсор на байт pos (нумеруя с 0) от начала файла
///Рекомендуется использовать свойство PosByte вместо данного метода
public procedure SeekByte( pos: int64 ) : = self. PosByte : = pos;
2019-03-26 00:56:10 +03:00
///Возвращает ленивую последовательность из блоков-массивов с элементами типа T
///Каждый блок хранит такое количество байт, которое не превышает 4 КБ
///После прочтения каждого блока файловый корсор будет переставлен на е г о конец
public function ToSeqBlocks: sequence of array of T : = ToSeqBlocks( 4 0 9 6 ) ;
///Возвращает ленивую последовательность из блоков-массивов с элементами типа T
///Каждый блок хранит такое количество байт, которое не превышает blocks_size
///После чтения каждого блока файловый корсор будет переставлен на е г о конец
public function ToSeqBlocks( blocks_size: integer ) : sequence of array of T;
///Возвращает ленивую последовательность из всех элементов, хранящихся в файле
///После прохода по элементам последовательности позиция в файле будет передвигаться на последний использованный элемент
public function ToSeq: sequence of T;
protected procedure Finalize; override ;
begin
Close;
end ;
2019-09-22 04:29:14 +03:00
{$endregion Utils}
2019-03-26 00:56:10 +03:00
end ;
{$region Exception's}
type
FileNotAssignedException = class( Exception)
constructor : =
inherited Create( $ 'Данная переменная не привязана к файлу{10}Используйте метод Assign' ) ;
end ;
FileNotOpenedException = class( Exception)
constructor( fname: string ) : =
inherited Create( $ 'Файл {fname} не открыт, откройте е г о с помощью Open, Reset, Append или Rewrite' ) ;
end ;
FileNotClosedException = class( Exception)
constructor( fname: string ) : =
2019-09-22 04:29:14 +03:00
inherited Create( $ 'Файл {fname} открыт, закройте е г о методом Close перед тем как продолжить' ) ;
2019-03-26 00:56:10 +03:00
end ;
CannotReadAfterEOF = class( Exception)
constructor : =
2019-09-22 04:58:07 +03:00
inherited Create( $ 'Нельзя читать за пределами файла' ) ;
2019-03-26 00:56:10 +03:00
end ;
{$endregion Exception's}
implementation
{$region Linking}
procedure BlockFileBase. Link( f: BlockFileBase) ;
begin
if f. str = nil then raise new FileNotOpenedException( $ '{f.fi.FullName}, чью переменную передали в конструктор BlockFileOf<T>,' ) ;
foreach var l in f. linked + f do
begin
self. linked. Add( l) ;
l. linked. Add( self) ;
end ;
self. str : = f. str;
self. fi : = new FileInfo( f. fi. FullName) ;
end ;
procedure BlockFileBase. UnLink;
begin
foreach var l in self. linked do
l. linked. Remove( self) ;
self. linked. Clear;
end ;
{$endregion Linking}
{$region property implementation}
function BlockFileOf< T> . GetName: string ;
begin
if fi = nil then raise new FileNotAssignedException;
fi. Refresh;
Result : = fi. Name ;
end ;
function BlockFileOf< T> . GetFullName: string ;
begin
if fi = nil then raise new FileNotAssignedException;
2019-09-22 04:29:14 +03:00
//fi.Refresh; // А тут не надо
2019-03-26 00:56:10 +03:00
Result : = fi. FullName;
end ;
function BlockFileOf< T> . GetByteFileSize: int64 ;
begin
if fi = nil then raise new FileNotAssignedException;
if str < > nil then
2019-09-22 04:29:14 +03:00
Result : = str. Length else
2019-03-26 00:56:10 +03:00
begin
2019-09-22 04:29:14 +03:00
fi. Refresh;
Result : = fi. Length ;
2019-03-26 00:56:10 +03:00
end ;
end ;
procedure BlockFileOf< T> . SetByteFileSize( size: int64 ) ;
begin
if fi = nil then raise new FileNotAssignedException;
if str = nil then raise new FileNotOpenedException( fi. FullName) ;
str. SetLength( size) ;
end ;
function BlockFileOf< T> . GetPosByte: int64 ;
begin
if fi = nil then raise new FileNotAssignedException;
if str = nil then raise new FileNotOpenedException( fi. FullName) ;
Result : = str. Position;
end ;
procedure BlockFileOf< T> . SetPosByte( pos: int64 ) ;
begin
if fi = nil then raise new FileNotAssignedException;
if str = nil then raise new FileNotOpenedException( fi. FullName) ;
str. Position : = pos;
end ;
{$endregion property implementation}
{$region Setup IO}
{$region Basic}
procedure BlockFileOf< T> . Assign( fname: string ) ;
begin
if str < > nil then raise new FileNotClosedException( fi. FullName) ;
fi : = new System. IO. FileInfo( fname) ;
end ;
procedure BlockFileOf< T> . Assign( fname: string ; offset: int64 ) ;
begin
Assign( fname) ;
_offset : = offset;
end ;
procedure BlockFileOf< T> . UnAssign;
begin
if str < > nil then raise new FileNotClosedException( fi. FullName) ;
fi : = nil ;
end ;
procedure BlockFileOf< T> . Open( mode: FileMode) ;
begin
if fi = nil then raise new FileNotAssignedException;
if str < > nil then raise new FileNotClosedException( fi. FullName) ;
str : = fi. Open( mode) ;
end ;
procedure BlockFileOf< T> . Delete;
begin
if fi = nil then raise new FileNotAssignedException;
fi. Delete;
end ;
function BlockFileOf< T> . GetExists: boolean ;
begin
if fi = nil then raise new FileNotAssignedException;
fi. Refresh;
Result : = fi. Exists;
end ;
procedure BlockFileOf< T> . Rename( NewName: string ) ;
begin
if fi = nil then raise new FileNotAssignedException;
if str < > nil then raise new FileNotClosedException( fi. FullName) ;
fi. MoveTo( NewName) ;
end ;
{$endregion Assign}
{$region Rewrite}
procedure BlockFileOf< T> . Rewrite : =
Open( FileMode. Create) ;
procedure BlockFileOf< T> . Rewrite( fname: string ) ;
begin
Assign( fname) ;
Rewrite;
end ;
procedure BlockFileOf< T> . Rewrite( fname: string ; offset: int64 ) ;
begin
Assign( fname, offset) ;
Rewrite;
end ;
{$endregion Rewrite}
{$region Reset}
procedure BlockFileOf< T> . Reset : =
Open( FileMode. Open) ;
procedure BlockFileOf< T> . Reset( fname: string ) ;
begin
Assign( fname) ;
Reset;
end ;
procedure BlockFileOf< T> . Reset( fname: string ; offset: int64 ) ;
begin
Assign( fname, offset) ;
Reset;
end ;
{$endregion Reset}
{$region Append}
procedure BlockFileOf< T> . Append;
begin
Open( FileMode. Open) ;
str. Position : = str. Length ;
end ;
procedure BlockFileOf< T> . Append( fname: string ) ;
begin
Assign( fname) ;
Append;
end ;
procedure BlockFileOf< T> . Append( fname: string ; offset: int64 ) ;
begin
Assign( fname, offset) ;
Append;
end ;
{$endregion Append}
{$region Closing}
procedure BlockFileOf< T> . Flush;
begin
if fi = nil then raise new FileNotAssignedException;
if str = nil then raise new FileNotOpenedException( fi. FullName) ;
str. Flush;
end ;
procedure BlockFileOf< T> . Close;
begin
if str < > nil then
begin
if linked. Count < > 0 then
UnLink else
str. Close;
str : = nil ;
end ;
end ;
{$endregion Closing}
{$endregion Setup IO}
2019-09-22 04:29:14 +03:00
{$region IO Utils}
procedure CopyMem< T1, T2> ( var o1: T1; var o2: T2; count: integer ) : =
System. Buffer. MemoryCopy(
@ o1, @ o2,
count, count
) ;
{$endregion IO Utils}
2019-03-26 00:56:10 +03:00
{$region Write}
procedure BlockFileOf< T> . Write( o: T) ;
begin
if fi = nil then raise new FileNotAssignedException;
if str = nil then raise new FileNotOpenedException( fi. FullName) ;
var a : = new byte [ sz] ;
2019-09-22 04:29:14 +03:00
CopyMem( o, a[ 0 ] , sz) ;
str. Write( a, 0 , sz) ;
2019-03-26 00:56:10 +03:00
end ;
procedure BlockFileOf< T> . Write( params o: array of T) ;
begin
if fi = nil then raise new FileNotAssignedException;
if str = nil then raise new FileNotOpenedException( fi. FullName) ;
var bl : = sz* o. Length ;
var a : = new byte [ bl] ;
2019-09-22 04:29:14 +03:00
CopyMem( o[ 0 ] , a[ 0 ] , bl) ;
str. Write( a, 0 , bl) ;
2019-03-26 00:56:10 +03:00
end ;
procedure BlockFileOf< T> . Write( o: ICollection< T> ) ;
begin
if fi = nil then raise new FileNotAssignedException;
if str = nil then raise new FileNotOpenedException( fi. FullName) ;
2019-09-22 04:29:14 +03:00
var bl : = sz* o. Count;
var a : = new byte [ bl] ;
var p : = 0 ;
var enm: IEnumerator< T> : = o. GetEnumerator( ) ;
while enm. MoveNext do
begin
var v : = enm. Current;
CopyMem( v, a[ p] , sz) ;
p + = sz;
2019-03-26 00:56:10 +03:00
end ;
2019-09-22 04:29:14 +03:00
str. Write( a, 0 , bl) ;
2019-03-26 00:56:10 +03:00
end ;
procedure BlockFileOf< T> . Write( o: sequence of T) : =
foreach var el in o do
Write( el) ;
procedure BlockFileOf< T> . Write( o: array of T; from, count: integer ) ;
begin
if fi = nil then raise new FileNotAssignedException;
if str = nil then raise new FileNotOpenedException( fi. FullName) ;
2019-09-22 04:29:14 +03:00
if from+ count > o. Length then raise new System. IndexOutOfRangeException;
2019-03-26 00:56:10 +03:00
var bl : = sz* count;
var a : = new byte [ bl] ;
2019-09-22 04:29:14 +03:00
CopyMem( o[ from] , a[ 0 ] , bl) ;
str. Write( a, 0 , bl) ;
2019-03-26 00:56:10 +03:00
end ;
procedure BlockFileOf< T> . Write( o: ICollection< T> ; from, count: integer ) ;
begin
if fi = nil then raise new FileNotAssignedException;
if str = nil then raise new FileNotOpenedException( fi. FullName) ;
2019-09-22 04:29:14 +03:00
if from+ count > o. Count then raise new System. IndexOutOfRangeException;
2019-09-22 03:43:43 +03:00
2019-09-22 04:29:14 +03:00
var bl : = sz* count;
var a : = new byte [ bl] ;
var p : = 0 ;
var enm: IEnumerator< T> : = o. Skip( from) . Take( count) . GetEnumerator;
while enm. MoveNext do
begin
var v : = enm. Current;
CopyMem( v, a[ p] , sz) ;
p + = sz;
2019-03-26 00:56:10 +03:00
end ;
2019-09-22 04:29:14 +03:00
str. Write( a, 0 , bl) ;
2019-03-26 00:56:10 +03:00
end ;
procedure BlockFileOf< T> . Write( o: sequence of T; from, count: integer ) : =
2019-09-22 04:29:14 +03:00
Write( o. Skip( from) . Take( count) ) ;
2019-03-26 00:56:10 +03:00
{$endregion Write}
{$region Read}
function BlockFileOf< T> . Read : T;
begin
if fi = nil then raise new FileNotAssignedException;
if str = nil then raise new FileNotOpenedException( fi. FullName) ;
if str. Length - str. Position < sz then raise new CannotReadAfterEOF;
2019-09-22 04:29:14 +03:00
var a : = new byte [ sz] ;
str. Read( a, 0 , sz) ;
CopyMem( a[ 0 ] , Result , sz) ;
2019-03-26 00:56:10 +03:00
end ;
function BlockFileOf< T> . Read( count: integer ) : array of T;
begin
if fi = nil then raise new FileNotAssignedException;
if str = nil then raise new FileNotOpenedException( fi. FullName) ;
if str. Length - str. Position < sz* count then raise new CannotReadAfterEOF;
var bl : = sz* count;
2019-09-22 04:29:14 +03:00
var a : = new byte [ bl] ;
str. Read( a, 0 , bl) ;
2019-03-26 00:56:10 +03:00
Result : = new T[ count] ;
2019-09-22 04:29:14 +03:00
CopyMem( a[ 0 ] , Result [ 0 ] , bl) ;
2019-03-26 00:56:10 +03:00
end ;
function BlockFileOf< T> . Read( start_elm, count: integer ) : array of T;
begin
2019-09-22 04:29:14 +03:00
if fi = nil then raise new FileNotAssignedException;
if str = nil then raise new FileNotOpenedException( fi. FullName) ;
if str. Length - str. Position < sz* count then raise new CannotReadAfterEOF;
2019-03-26 00:56:10 +03:00
Pos : = start_elm;
Result : = Read( count) ;
2019-09-22 04:29:14 +03:00
2019-09-22 03:43:43 +03:00
end ;
2019-09-22 04:29:14 +03:00
procedure BlockFileOf< T> . Read( var o: T) ;
begin
if fi = nil then raise new FileNotAssignedException;
if str = nil then raise new FileNotOpenedException( fi. FullName) ;
if str. Length - str. Position < sz then raise new CannotReadAfterEOF;
var a : = new byte [ sz] ;
str. Read( a, 0 , sz) ;
CopyMem( a[ 0 ] , o, sz) ;
end ;
procedure BlockFileOf< T> . Read( o: array of T) ;
begin
var bl : = sz* o. Length ;
if fi = nil then raise new FileNotAssignedException;
if str = nil then raise new FileNotOpenedException( fi. FullName) ;
if str. Length - str. Position < bl then raise new CannotReadAfterEOF;
var a : = new byte [ bl] ;
str. Read( a, 0 , bl) ;
CopyMem( a[ 0 ] , o[ 0 ] , bl) ;
end ;
procedure BlockFileOf< T> . Read( o: array of T; start_elm, arr_offset, count: integer ) ;
begin
var bl : = sz* count;
if fi = nil then raise new FileNotAssignedException;
if str = nil then raise new FileNotOpenedException( fi. FullName) ;
if str. Length - str. Position < bl then raise new CannotReadAfterEOF;
if arr_offset+ count > o. Length then raise new System. IndexOutOfRangeException;
Pos : = start_elm;
var a : = new byte [ bl] ;
str. Read( a, 0 , bl) ;
CopyMem( a[ 0 ] , o[ start_elm] , bl) ;
end ;
{$endregion Read}
{$region Utils}
2019-03-26 00:56:10 +03:00
function BlockFileOf< T> . InternalReadLazy( c: integer ; start_pos: int64 ) : sequence of T;
begin
if fi = nil then raise new FileNotAssignedException;
if str = nil then raise new FileNotOpenedException( fi. FullName) ;
if str. Length - start_pos < sz* c then raise new CannotReadAfterEOF;
2019-09-22 04:29:14 +03:00
loop c do
2019-03-26 00:56:10 +03:00
begin
2019-09-22 04:29:14 +03:00
PosByte : = start_pos;
2019-03-26 00:56:10 +03:00
yield Read ;
2019-09-22 04:29:14 +03:00
start_pos + = sz;
2019-03-26 00:56:10 +03:00
end ;
2019-09-22 04:29:14 +03:00
2019-03-26 00:56:10 +03:00
end ;
function BlockFileOf< T> . ToSeqBlocks( blocks_size: integer ) : sequence of array of T;
begin
var c : = blocks_size div sz;
var i : = 0 ;
2019-09-22 04:29:14 +03:00
2019-03-26 00:56:10 +03:00
while true do
begin
var left : = Size - i;
if left < c then
begin
if left > 0 then
begin
Pos : = i;
yield Read( left) ;
end ;
exit;
end else
begin
Pos : = i;
yield Read( c) ;
i + = c;
end ;
2019-09-22 04:29:14 +03:00
2019-03-26 00:56:10 +03:00
end ;
2019-09-22 04:29:14 +03:00
2019-03-26 00:56:10 +03:00
end ;
function BlockFileOf< T> . ToSeq: sequence of T;
begin
var i : = 0 ;
2019-09-22 04:29:14 +03:00
2019-03-26 00:56:10 +03:00
while not EOF do
begin
Pos : = i;
yield Read ;
i + = 1 ;
end ;
2019-09-22 04:29:14 +03:00
2019-03-26 00:56:10 +03:00
end ;
2019-09-22 04:29:14 +03:00
{$endregion Utils}
2019-03-26 00:56:10 +03:00
2020-11-01 12:42:10 +03:00
///--
procedure __InitModule__;
begin
end ;
///--
procedure __FinalizeModule__;
begin
end ;
2018-08-25 13:35:24 +03:00
end .