administrator/pascalabcnet
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Merge branch 'master' of https://github.com/pascalabcnet/pascalabcnet

Browse source
This commit is contained in:
miks1965 2018-09-27 17:59:43 +03:00
parent b4edebd2f0 78d789fb99
commit 50d3c255ec
19 changed files with 1949 additions and 361 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
CodeCompletion/DomSyntaxTreeVisitor.cs
View file

@ -4028,7 +4028,9 @@ namespace CodeCompletion
public override void visit(typecast_node _typecast_node)
{
if (_typecast_node.cast_op == op_typecast.is_op)
{
returned_scope = TypeTable.bool_type;
}
else
_typecast_node.type_def.visit(this);
}
@ -4703,6 +4705,10 @@ namespace CodeCompletion
{
//throw new Exception("The method or operation is not implemented.");
_var_statement.var_def.visit(this);
foreach (var_def_statement vds in pending_is_pattern_vars)
{
vds.visit(this);
}
}
public override void visit(PascalABCCompiler.SyntaxTree.question_colon_expression _question_colon_expression)

49
CodeCompletion/ExpressionVisitor.cs
View file

@ -226,8 +226,24 @@ namespace CodeCompletion
tright = (returned_scope as ElementScope).sc as TypeScope;
if (tleft != null && tright != null)
{
List<SymScope> lst = tleft.FindOverloadNamesOnlyInType
(PascalABCCompiler.TreeConverter.name_reflector.get_name(_bin_expr.operation_type));
string name = PascalABCCompiler.TreeConverter.name_reflector.get_name(_bin_expr.operation_type);
List<SymScope> lst = tleft.FindOverloadNamesOnlyInType(name);
List<SymScope> lst_right = tright.FindOverloadNamesOnlyInType(name);
if (lst.Count == 0 && !char.IsLetter(name[0]))
lst = tleft.FindOverloadNamesOnlyInType("operator" + name);
if (lst_right.Count == 0 && !char.IsLetter(name[0]))
lst_right = tright.FindOverloadNamesOnlyInType("operator" + name);
if (!char.IsLetter(name[0]))
name = "operator" + name;
else
name = "operator " + name;
List<ProcScope> meths = entry_scope.GetExtensionMethods(name, tleft);
foreach (ProcScope meth in meths)
lst.Add(meth);
lst.AddRange(lst_right);
meths = entry_scope.GetExtensionMethods(name, tright);
foreach (ProcScope meth in meths)
lst.Add(meth);
ProcScope ps = select_method(lst.ToArray(), tleft, tright, null, _bin_expr.left, _bin_expr.right);
if (ps != null)
returned_scope = new ElementScope(ps.return_type);
@ -456,10 +472,24 @@ namespace CodeCompletion
//throw new NotImplementedException();
_indexer.dereferencing_value.visit(this);
if (returned_scope != null)
if (returned_scope is ElementScope && (returned_scope as ElementScope).sc is ProcScope && ((returned_scope as ElementScope).sc as ProcScope).return_type != null)
returned_scope = new ElementScope(((returned_scope as ElementScope).sc as ProcScope).return_type.GetElementType());
else
returned_scope = new ElementScope(returned_scope.GetElementType());
{
if (returned_scope != null)
if (returned_scope is ElementScope && (returned_scope as ElementScope).sc is ProcScope && ((returned_scope as ElementScope).sc as ProcScope).return_type != null)
returned_scope = new ElementScope(((returned_scope as ElementScope).sc as ProcScope).return_type.GetElementType());
else
returned_scope = new ElementScope(returned_scope.GetElementType());
}
else
{
for (int i = 0; i < returned_scopes.Count; i++)
{
if (returned_scopes[i] is ElementScope && (returned_scopes[i] as ElementScope).sc is ProcScope && ((returned_scopes[i] as ElementScope).sc as ProcScope).return_type != null)
returned_scopes[i] = new ElementScope(((returned_scopes[i] as ElementScope).sc as ProcScope).return_type.GetElementType());
else
returned_scopes[i] = new ElementScope(returned_scopes[i].GetElementType());
}
search_all = false;
}
}
public override void visit(for_node _for_node)
@ -755,7 +785,12 @@ namespace CodeCompletion
if (ts != null)
returned_scope = new ElementScope(ts);
}
else if ((returned_scope != null && returned_scope is ElementScope && (returned_scope as ElementScope).sc is CompiledScope))
{
ProcScope invoke_meth = ((returned_scope as ElementScope).sc as CompiledScope).FindNameOnlyInThisType("Invoke") as ProcScope;
if (invoke_meth != null)
returned_scope = new ElementScope(invoke_meth.return_type);
}
if (returned_scope != null)
{
if (!search_all)

16
InstallerSamples/ExperimentalUnits/BlockFileOfT/FileArray.pas → InstallerSamples/BlockFileOfT/FileDatabase/FileArray.pas
View file

@ -75,11 +75,25 @@ type
f := new BlockFileOf<T>(fname);
f.Open(mode);
end;
///Использует заданный файл как основу для массива
///Если файл не открыт - его откроет в режиме System.IO.FileMode.OpenOrCreate
public constructor(&file: BlockFileOf<T>);
begin
f := &file;
if not f.Opened then
f.Open(System.IO.FileMode.OpenOrCreate);
end;
///Открывает заданный файл в режиме mode и использует его как основу для массива
public constructor(&file: BlockFileOf<T>; mode: System.IO.FileMode);
begin
f := &file;
f.Open(mode);
end;
///Создаёт новый массив хранящий данные в новом временном файл (в системной папке)
///Созданный файл будет удалёт в произвольное время (после завершения пользования переменной) или при вызове Finalize
public constructor;
begin
Create(System.IO.Path.GetTempFileName);
Create(System.IO.Path.GetTempFileName, System.IO.FileMode.CreateNew);
DeleteOnExit := true;
end;
///Выполняет необходимую отчистку при завершении работы с переменной

203
InstallerSamples/BlockFileOfT/FileDatabase/База данных на файле.pas Normal file
View file

@ -0,0 +1,203 @@
uses BlockFileOfT;
uses System.Runtime.InteropServices;//нужно чтоб не писать System.Runtime.InteropServices.StructLayout и т.п.
uses FileArray;
type
DataType1 = record
b: byte;
constructor(b:byte) :=
self.b := b;
end;
DataType2 = record
i: integer;
constructor(i:integer) :=
self.i := i;
end;
DataType3 = record
ch: char;
constructor(ch:char) :=
self.ch := ch;
end;
DataType4 = record
r: real;
constructor(r:real) :=
self.r := r;
end;
DataType = (
ByteData = 1,
IntData = 2,
CharData = 3,
RealData = 4
);
[StructLayout(LayoutKind.&Explicit, Size=16)]//Значит - мы сами указываем куда ставит каждое поле
DataUnit = record
[FieldOffset(0)] DataT: byte;
[FieldOffset(8)] DataT1: DataType1;//У этих 4 полей одинаковая позиция
[FieldOffset(8)] DataT2: DataType2;//Значит, у них будет общая память
[FieldOffset(8)] DataT3: DataType3;//Но это так же значит что если записать данные 1 типа -
[FieldOffset(8)] DataT4: DataType4;//данные другого типа считать не выйдет (выведет мусор)
constructor(data: DataType1);
begin
DataT := 1;
DataT1 := data;
end;
constructor(data: DataType2);
begin
DataT := 2;
DataT2 := data;
end;
constructor(data: DataType3);
begin
DataT := 3;
DataT3 := data;
end;
constructor(data: DataType4);
begin
DataT := 4;
DataT4 := data;
end;
function ToString:string; override;
begin
var sb := new StringBuilder;
sb.AppendFormat(
'DataUnit({0,8}, ',
System.Enum.GetName(typeof(DataType), DataT)
);
case DataType(DataT) of
ByteData: sb.AppendFormat('{0})',DataT1.b);
IntData : sb.AppendFormat('{0})',DataT2.i);
CharData: sb.AppendFormat('{0})',DataT3.ch);
RealData: sb.AppendFormat('{0})',DataT4.r);
else raise new System.FormatException($'Не правильный тип данных: {DataT}');
end;
Result := sb.ToString;
end;
end;
Database = class(System.IDisposable)
public version: byte;
public DatabaseType: string;
public BlockFile:BlockFileOf<DataUnit>;
public Data: FileArr<DataUnit>;
public constructor := exit;
public constructor(fname:string; version:byte; DatabaseType:string);
begin
self.version := version;
self.DatabaseType := DatabaseType;
self.BlockFile := new BlockFileOf<DataUnit>(fname);
self.BlockFile.Offset := 5;
self.BlockFile.Open(System.IO.FileMode.Create);
self.Data := new FileArr<DataUnit>(self.BlockFile);
end;
public class function Load(fname:string): Database;
begin
Result := new Database;
Result.BlockFile := new BlockFileOf<DataUnit>(fname,5);
Result.BlockFile.Reset;
begin//заголовок
var str := Result.BlockFile.BaseStream;
var sr := new System.IO.StreamReader(Result.BlockFile.BaseStream, System.Text.Encoding.UTF8);
//str.Position := 0;//Мы только что открыли файл, Reset само поставило указатель в начало
Result.version := str.ReadByte;
var buff := new char[4];
sr.ReadBlock(buff,0,4);
Result.DatabaseType := new string(buff);
end;
Result.Data := new FileArr<DataUnit>(Result.BlockFile);
Result.Data.AutoFlush := false;
Result.Data.DeleteOnExit := false;
end;
public procedure Save;
begin
begin//заголовок
var str := self.BlockFile.BaseStream;
var sw := new System.IO.StreamWriter(str, System.Text.Encoding.UTF8);
str.Position := 0;
str.WriteByte(self.version);
var buff := (self.DatabaseType+'_'*4).ToCharArray;
sw.Write(buff, 0,4);
sw.Flush;
end;
self.Data.Flush;
end;
public function ToString:string; override;
begin
var sb := new StringBuilder;
sb += $'version: {version}{#10}';
sb += $'Database Type: {DatabaseType}{#10}';
sb += $'Data:[{#10}';
BlockFile.Pos := 0;
foreach var du in BlockFile.Read(BlockFile.Size) do
sb += $'{#9}{du}{#10}';
sb += $']';
Result := sb.ToString;
end;
public procedure Dispose;
begin
Data.Finalize;
end;
end;
begin
var db1 := new Database('temp.bin',1,'JSBD');//JSBD = Just Some Basic Data
db1.version := 5;//Была 1, изменили на 5
db1.Data[0] := new DataUnit(new DataType1(123));
db1.Data[1] := new DataUnit(new DataType2(456));
db1.Data[2] := new DataUnit(new DataType3('A'));
db1.Data[3] := new DataUnit(new DataType4(123.456));
db1.Save;
db1.Dispose;
db1 := Database.Load('temp.bin');
writeln(db1);
writeln;
writeln('int from real: ',db1.Data[3].DataT2.i);//Пытаемся прочитать переменную типа integer там - где записана переменная типа real
//Это, конечно, выводит мусор
end.

0
InstallerSamples/ExperimentalUnits/BlockFileOfT/Дополнительно.pas → InstallerSamples/BlockFileOfT/Дополнительно.pas
View file

0
InstallerSamples/ExperimentalUnits/BlockFileOfT/Основы.pas → InstallerSamples/BlockFileOfT/Основы.pas
View file

22
InstallerSamples/BlockFileOfT/Справка.html Normal file
View file

@ -0,0 +1,22 @@
<html>
<head>
<style type="text/css">
</style>
</head>
<body>
<font size="3">Выберете раздел:</font>
<ul>
<li><font size="4"><a href="СправкаData/main.html">Основы</a></font></li>
<li><font size="4"><a href="СправкаData/WhyOffset.html">Для чего нужен Offset</a></font></li>
<li><font size="4"><a href="СправкаData/RefTSaving.html">Сохранение ссылочных и особых типов</a></font></li>
</ul>
<br>
Если найдёте что то неправильное/ошибку (в том числе грамматическую) в справке - пишите <a href=https://github.com/SunSerega/PascalABC.Net-BlockFileOfT/issues>сюда</a>.
</body>
</html>

490
InstallerSamples/BlockFileOfT/СправкаData/RefTSaving.html Normal file
View file

@ -0,0 +1,490 @@
<html>
<head>
<style type="text/css">
.code_block {
background: #c0c0c0;
padding: 5px;
padding-right: 20px;
border: solid 1px black;
}
</style>
<script type="text/javascript">
function toggle_show(id) {
document.getElementById(id).style.display = document.getElementById(id).style.display == 'none' ? 'block' : 'none';
}
</script>
</head>
<body>
<font size="3"><a href="../Справка.html"><=</a></font><br>
<br>
<font size="5">Сохранение ссылочных и особых типов в блочный файл.</font><br>
<hr />
<p onClick="toggle_show('spet')"><font size="4" color="008000" style="cursor: pointer">В чём проблема особых типов</font></p>
<div id=spet style="display: none">
<p class=code_block>
<t style="margin-left: 00px">uses BlockFileOfT; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 00px">type </t>
<br><t style="margin-left: 10px">r1=record </t>
<br><t style="margin-left: 20px">ch: char; </t>
<br><t style="margin-left: 20px">constructor(ch: char) := </t>
<br><t style="margin-left: 20px">self.ch := ch; </t>
<br><t style="margin-left: 10px">end; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 00px">begin </t>
<br><t style="margin-left: 10px">var f := new BlockFileOf&ltr1>('temp.bin'); </t>
<br><t style="margin-left: 10px">f.Rewrite; </t>
<br><t style="margin-left: 10px">f.Write(new r1('a')); </t>
<br><t style="margin-left: 10px">f.Write(new r1('b'),new r1('c'));//Ошибка: Объект содержит данные, которые не являются примитивами или требуют преобразования. </t>
<br><t style="margin-left: 10px">f.Close; </t>
<br><t style="margin-left: 00px">end. </t>
</p>
Тут второе Write вызовет ошибку описаную выше.<br>
Это потому - что во второй Write передаётся array of r1.<br>
Когда для копирования памяти из этого массива в массив байт запрашивается блокировка памяти -<br>
.Net видит что r1 содержит поле типа - char. Я так и не нашёл однозначного определения что с ним не так.<br>
Но, вроде, проблема в том - что в разных системах и версиях char может по разному хранится в памяти.<br>
И эта ошибка - защита от дурака, чтоб не дать данные из 1 системы скопировать в другую.<br>
<br>
char - не единственный такой "особый тип"<br>
если получаете такую же ошибку - записывайте и считывайте по 1 элементу<br>
или воспользуйтесь следующим способом обхода:<br>
<br>
<p class=code_block>
<t style="margin-left: 00px">uses BlockFileOfT; </t>
<br><t style="margin-left: 00px">uses System.Runtime.InteropServices; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 00px">type </t>
<br><t style="margin-left: 10px">[StructLayout(LayoutKind.&Explicit)] </t>
<br><t style="margin-left: 10px">CWConv = record </t>
<br><t style="margin-left: 20px">[FieldOffset(0)] ch:char;//У обоих этих полей одинаковая позиция в памяти (0 байт от начала записси) и объём (2 байт) </t>
<br><t style="margin-left: 20px">[FieldOffset(0)] id:word;//Поэтому можно записать в 1 поле, а считать из другого, не теряя информацию </t>
<br><t style="margin-left: 10px">end; </t>
<br><t style="margin-left: 10px">r1=record </t>
<br><t style="margin-left: 20px">ch: word; </t>
<br><t style="margin-left: 20px">constructor(ch: char) := </t>
<br><t style="margin-left: 20px">begin </t>
<br><t style="margin-left: 30px">var a: CWConv; </t>
<br><t style="margin-left: 30px">a.ch := ch; </t>
<br><t style="margin-left: 30px">self.ch := a.id; </t>
<br><t style="margin-left: 20px">end; </t>
<br><t style="margin-left: 20px">function GetCh:char; </t>
<br><t style="margin-left: 20px">begin </t>
<br><t style="margin-left: 30px">var a: CWConv; </t>
<br><t style="margin-left: 30px">a.id := self.ch; </t>
<br><t style="margin-left: 30px">Result := a.ch; </t>
<br><t style="margin-left: 20px">end; </t>
<br><t style="margin-left: 10px">end; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 00px">begin </t>
<br><t style="margin-left: 10px">var f := new BlockFileOf&ltr1>('temp.bin'); </t>
<br><t style="margin-left: 10px">f.Rewrite; </t>
<br><t style="margin-left: 10px">f.Write(new r1('a')); </t>
<br><t style="margin-left: 10px">f.Write(new r1('b'),new r1('c')); </t>
<br><t style="margin-left: 10px">f.Close; </t>
<br><t style="margin-left: 00px">end. </t>
</p>
Тип word занимает в памяти 2 байта, так же как char, поэтому char можно заменить на word.<br>
Узнать объём типа можно вызвав sizeof(word), sizeof(char) и т.д.<br>
Конечно, в данном случае создавать CWConv не обязательно, потому что word(ch) и char(id) и без того работает.<br>
Но с другими особыми типами это может не сработать.<br>
<hr />
</div>
<p onClick="toggle_show('decl')"><font size="4" color="008000" style="cursor: pointer">В чём проблема ссылочных типов</font></p>
<div id=decl style="display: none">
<p class=code_block>
<t style="margin-left: 00px">type </t>
<br><t style="margin-left: 10px">r1=record </t>
<br><t style="margin-left: 20px">b:byte; </t>
<br><t style="margin-left: 20px">i:integer; </t>
<br><t style="margin-left: 20px">s:string; </t>
<br><t style="margin-left: 10px">end; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 00px">begin </t>
<br><t style="margin-left: 10px">var a: r1; </t>
<br><t style="margin-left: 10px">a.b := 5; </t>
<br><t style="margin-left: 10px">a.i := 12345; </t>
<br><t style="margin-left: 10px">a.s := 'abcdef'*10000;//Это 60 000 символов, ~120KB </t>
<br><t style="margin-left: 00px">end. </t>
</p>
Проблема заключается в том, как хранится элементы этой записи в оперативной памяти.<br>
"a.b" и "a.i" будут находится прямо друг за другом.<br>
Но "a.s" будет где то в случайной области памяти.<br>
При этом, после "a.i", вместо "a.s" будет номер ячейки памяти (по сути - ссылка, отсюда название), в которую сохранило "a.s".<br>
Блочное сохранение обычно работает потому, что все элементы записи хранит друг за другом, 1 блоком в памяти.<br>
Этот блок можно целиком скопировать в файл, что является главным принципом "BlockFileOf&ltT>".<br>
Но раз "a.s" находится не в теле записи - вместо него в файл сохранит только номер ячейки где "a.s" хранится.<br>
Если, потом, попытаться загрузить эту запись назад - в "a.s" запишет номер ячейки где раньше была наша строка.<br>
Но строки по тому адресу уже может и не быть. Если так - попытка получить её значение выведет мусор или даст ошибку чтения защищённой памяти.<br>
Кроме всего прочего, сборщик мусора от .Net может перемещать ссылочные типы в памяти, для экономии места.<br>
Если запись ещё находится в оперативной памяти в момент сборки мусора - адрес строки не забудет поменять.<br>
Но если запись сохранили в файл, потом произошла сборка мусора, а затем мы загрузили запись назад - адрес строки будет уже устаревший.<br>
<br>
В общем, сохранение записей с полями ссылочных типов - ни к чему хорошему не приведёт.<br>
Но, все записи имеют неизменяемую длину, в то время как, к примеру, у массивов и строк - практически нету ограничения.<br>
Это 1 из причин, почему ссылочные типы удобнее хранить отдельно, по ссылке.<br>
И неизменяемая длина - не только ограничение записей, это так же ограничение алгоритмов "file of T" и "BlockFileOf&ltT>",<br>
потому что для нормальной работы "Seek" - надо чтоб все элементы имели одинаковую длину.<br>
По этому, в примерах сохранения ссылочных типов, описаных далее - всегда стоит определённое ограничение на рамер,<br>
которое можно менять только перед компиляцией.<br>
<hr />
</div>
<p onClick="toggle_show('io_basics')"><font size="4" color="008000" style="cursor: pointer">Массивы (статичные)</font></p>
<div id=io_basics style="display: none">
<p class=code_block>
<t style="margin-left: 00px">uses BlockFileOfT; </t>
<br><t style="margin-left: 00px">uses System.Runtime.InteropServices; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 00px">type </t>
<br><t style="margin-left: 10px">[StructLayout(LayoutKind.&Explicit)] </t>
<br><t style="margin-left: 10px">CharArr15 = record </t>
<br><t style="margin-left: 20px">private const MaxLength = 15;//Ограничение кол-ва элементов </t>
<br><t style="margin-left: 20px">private const TSize = 2;//То что возвращает sizeof(T) где T - тип элементов массива (в нашем случае - char) </t>
<br><t style="margin-left: 20px">private const Size = MaxLength * TSize; </t>
<br><t style="margin-left: 20px">private [FieldOffset(Size-1)] last: byte; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 20px">public class function operator explicit(a: array of char): CharArr15; </t>
<br><t style="margin-left: 20px">begin </t>
<br><t style="margin-left: 30px">if a.Length &lt MaxLength then </t>
<br><t style="margin-left: 40px">a := a + new char[MaxLength - a.Length];//Если не добавить тут лишние нули - копирование содержимого попытается прочитать после конца массива </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 30px">var hnd := GCHandle.Alloc(a, GCHandleType.Pinned);//Надо заблокировать память, иначе сборщик мусора может очень невовремя переместить массив </t>
<br><t style="margin-left: 30px">try </t>
<br><t style="margin-left: 40px">var ptr: ^CharArr15 := pointer(hnd.AddrOfPinnedObject); </t>
<br><t style="margin-left: 40px">Result := ptr^;//Тут содержимое массива читает как CharArr15. Обычно так делать не стоит, но тут это лучший вариант, ибо единственный </t>
<br><t style="margin-left: 30px">finally </t>
<br><t style="margin-left: 40px">hnd.Free;//Если возникнет какая то ошибка - надо всё равно освободить дескриптор, иначе будет утечка памяти </t>
<br><t style="margin-left: 30px">end; </t>
<br><t style="margin-left: 20px">end; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 20px">public class function operator explicit(a: CharArr15): array of char; </t>
<br><t style="margin-left: 20px">begin </t>
<br><t style="margin-left: 30px">Result := new char[MaxLength]; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 30px">var hnd := GCHandle.Alloc(Result, GCHandleType.Pinned); </t>
<br><t style="margin-left: 30px">try </t>
<br><t style="margin-left: 40px">var ptr: ^CharArr15 := pointer(hnd.AddrOfPinnedObject); </t>
<br><t style="margin-left: 40px">ptr^ := a;//А тут назад, содержимое "a" копируется в результат </t>
<br><t style="margin-left: 30px">finally </t>
<br><t style="margin-left: 40px">hnd.Free; </t>
<br><t style="margin-left: 30px">end; </t>
<br><t style="margin-left: 20px">end; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 20px">public function ToRefArr: array of char; </t>
<br><t style="margin-left: 20px">type </t>
<br><t style="margin-left: 30px">CharArr = array of char; </t>
<br><t style="margin-left: 20px">begin </t>
<br><t style="margin-left: 30px">Result := CharArr(self); </t>
<br><t style="margin-left: 20px">end; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 10px">end; </t>
<br><t style="margin-left: 10px">r1 = record </t>
<br><t style="margin-left: 20px">public a: CharArr15; </t>
<br><t style="margin-left: 20px">public i: integer; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 20px">public constructor(a: array of char; i: integer); </t>
<br><t style="margin-left: 20px">begin </t>
<br><t style="margin-left: 30px">self.a := CharArr15(a); </t>
<br><t style="margin-left: 30px">self.i := i; </t>
<br><t style="margin-left: 20px">end; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 20px">public constructor(s: string; i: integer) := </t>
<br><t style="margin-left: 20px">Create(s.ToCharArray, i); </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 20px">public function ToString: string; override := </t>
<br><t style="margin-left: 20px">//Replace(#0,#32) заменяет пустые символы на пробелы </t>
<br><t style="margin-left: 20px">//IDE паскаля немного ломается, если попытаться вывести char(0) </t>
<br><t style="margin-left: 20px">$'r1("{(new string(a.ToRefArr)).Replace(#0,#32)}", {i})'; </t>
<br><t style="margin-left: 10px">end; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 00px">begin </t>
<br><t style="margin-left: 10px">var f := new BlockFileOf&ltr1>('temp.bin'); </t>
<br><t style="margin-left: 10px">var a1 := new r1(new char[]('a', 'b', 'd', 'q'), 6); </t>
<br><t style="margin-left: 10px">var b1 := new r1('Hello, world!', 278); </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 10px">{ </t>
<br><t style="margin-left: 10px">f.Reset; </t>
<br><t style="margin-left: 10px">{} </t>
<br><t style="margin-left: 10px">f.Rewrite; </t>
<br><t style="margin-left: 10px">f.Write(a1, b1); </t>
<br><t style="margin-left: 10px">{} </t>
<br><t style="margin-left: 10px">f.Pos := 0; </t>
<br><t style="margin-left: 10px">var a2 := f.Read; </t>
<br><t style="margin-left: 10px">var b2 := f.Read; </t>
<br><t style="margin-left: 10px">f.Close; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 10px">writeln(a1); </t>
<br><t style="margin-left: 10px">writeln(b1); </t>
<br><t style="margin-left: 10px">writeln(a1.a.ToRefArr.Length); </t>
<br><t style="margin-left: 10px">writeln(b1.a.ToRefArr.Length); </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 10px">writeln(a2); </t>
<br><t style="margin-left: 10px">writeln(b2); </t>
<br><t style="margin-left: 10px">writeln(a2.a.ToRefArr.Length); </t>
<br><t style="margin-left: 10px">writeln(b2.a.ToRefArr.Length); </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 00px">end. </t>
</p>
Что делают "[StructLayout(LayoutKind.&Explicit)]" и "[FieldOffset(Size-1)]"?<br>
"FieldOffset" указывает где в записи будет размещено поле "last: byte"<br>
Таким образом, мы, как бы, резервируем "Size" байт для записи.<br>
Они оказываются ничем не заняты, но в них можно сохранить информацию, что далее и происходит.<br>
А "LayoutKind.&Explicit" разрешает использовать "FieldOffset" для "CharArr15".<br>
<br>
"StructLayout", "LayoutKind.&Explicit" и "FieldOffset" находятся в пространстве имён<br>
"System.Runtime.InteropServices", поэтому я подключил его в начале файла.<br>
Но его можно не подключать, тогда придётся писать "System.Runtime.InteropServices.StructLayout" и т.п.<br>
Хотя есть ещё третий вариант - добавить свои синонимы в начале файла:
<p class=code_block>
<t style="margin-left: 00px">type </t>
<br><t style="margin-left: 10px">StructLayout = System.Runtime.InteropServices.StructLayoutAttribute; </t>
<br><t style="margin-left: 10px">LayoutKind = System.Runtime.InteropServices.LayoutKind; </t>
<br><t style="margin-left: 10px">FieldOffset = System.Runtime.InteropServices.FieldOffsetAttribute; </t>
</p>
Как видите, с тем что уже есть - можно хранить и строки, как массивы символов.<br>
Но, хотя мы сохраняли массив из 4 элемента и строку на 13 символов - при чтении назад им дало длину 15.<br>
Это вполне реально исправить, надо лишь сохранять - сколько символов было использовано.<br>
Но, конечно, это будут дополнительные затраты памяти и производительности:
<p class=code_block>
<t style="margin-left: 00px">uses BlockFileOfT; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 00px">type </t>
<br><t style="margin-left: 10px">StructLayout = System.Runtime.InteropServices.StructLayoutAttribute; </t>
<br><t style="margin-left: 10px">LayoutKind = System.Runtime.InteropServices.LayoutKind; </t>
<br><t style="margin-left: 10px">FieldOffset = System.Runtime.InteropServices.FieldOffsetAttribute; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 10px">GCHandle = System.Runtime.InteropServices.GCHandle; </t>
<br><t style="margin-left: 10px">GCHandleType = System.Runtime.InteropServices.GCHandleType; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 10px">[StructLayout(LayoutKind.&Explicit)] </t>
<br><t style="margin-left: 10px">CharArr15Body = record </t>
<br><t style="margin-left: 20px">private const MaxLength = 15; </t>
<br><t style="margin-left: 20px">private const TSize = 2; </t>
<br><t style="margin-left: 20px">private const Size = MaxLength * TSize; </t>
<br><t style="margin-left: 20px">[FieldOffset(Size-1)] last: byte; </t>
<br><t style="margin-left: 10px">end; </t>
<br><t style="margin-left: 10px">[StructLayout(LayoutKind.&Explicit)] </t>
<br><t style="margin-left: 10px">CharArr15 = record </t>
<br><t style="margin-left: 20px">//shortint занимает 1 байт и принимает значения от -128 до 127 </t>
<br><t style="margin-left: 20px">//У нас максимум 15 элементов, поэтому этого вполне хватит. </t>
<br><t style="margin-left: 20px">public [FieldOffset(0)] length: shortint; </t>
<br><t style="margin-left: 20px">//Тут FieldOffset=1, потому что length занимает 1 байт в памяти </t>
<br><t style="margin-left: 20px">//Если в вашей реализации "length" будет занимать бОльший объём - не забудьте поменять </t>
<br><t style="margin-left: 20px">public [FieldOffset(1)] body: CharArr15Body; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 20px">public class function operator explicit(a: array of char): CharArr15; </t>
<br><t style="margin-left: 20px">begin </t>
<br><t style="margin-left: 30px">Result.length := a.Length;//Если передать массив с длиной больше чем помещается в shortint - произвойдёт переполнение. </t>
<br><t style="margin-left: 30px">//Если такая возможность существует - надо поставить тут проверку, чтоб длине не присваивало ничего > 127 </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 30px">if a.Length &lt CharArr15Body.MaxLength then </t>
<br><t style="margin-left: 40px">a := a + new char[CharArr15Body.MaxLength - a.Length]; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 30px">var hnd := GCHandle.Alloc(a, GCHandleType.Pinned); </t>
<br><t style="margin-left: 30px">try </t>
<br><t style="margin-left: 40px">var ptr: ^CharArr15Body := pointer(hnd.AddrOfPinnedObject); </t>
<br><t style="margin-left: 40px">Result.body := ptr^; </t>
<br><t style="margin-left: 30px">finally </t>
<br><t style="margin-left: 40px">hnd.Free; </t>
<br><t style="margin-left: 30px">end; </t>
<br><t style="margin-left: 20px">end; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 20px">public class function operator explicit(a: CharArr15): array of char; </t>
<br><t style="margin-left: 20px">begin </t>
<br><t style="margin-left: 30px">//Если кол-во сохранённых байт &lt MaxLength - a.body будет занимать бОльший объём в памяти, чем поместится в Result </t>
<br><t style="margin-left: 30px">//Поэтому надо сначала прочитать всё, включая пустые символы на конце, во временную переменную </t>
<br><t style="margin-left: 30px">//А затем скопировать нужное кол-во символов в Result </t>
<br><t style="margin-left: 30px">var temp := new char[CharArr15Body.MaxLength]; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 30px">var hnd := GCHandle.Alloc(temp, GCHandleType.Pinned); </t>
<br><t style="margin-left: 30px">try </t>
<br><t style="margin-left: 40px">var ptr: ^CharArr15Body := pointer(hnd.AddrOfPinnedObject); </t>
<br><t style="margin-left: 40px">ptr^ := a.body; </t>
<br><t style="margin-left: 30px">finally </t>
<br><t style="margin-left: 40px">hnd.Free; </t>
<br><t style="margin-left: 30px">end; </t>
<br><t style="margin-left: 30px">Result := new char[a.length]; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 30px">//Если в "explicit(a:array of char):CharArr15" вы запретили length>MaxLength, </t>
<br><t style="margin-left: 30px">//То "Min(a.length, CharArr15Body.MaxLength)" можно заменить на "a.length" </t>
<br><t style="margin-left: 30px">System.Array.Copy(temp, Result, Min(a.length, CharArr15Body.MaxLength)); </t>
<br><t style="margin-left: 20px">end; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 20px">public function ToRefArr: array of char; </t>
<br><t style="margin-left: 20px">type </t>
<br><t style="margin-left: 30px">CharArr = array of char; </t>
<br><t style="margin-left: 20px">begin </t>
<br><t style="margin-left: 30px">Result := CharArr(self); </t>
<br><t style="margin-left: 20px">end; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 10px">end; </t>
<br><t style="margin-left: 10px">r1 = record </t>
<br><t style="margin-left: 20px">public a: CharArr15; </t>
<br><t style="margin-left: 20px">public i: integer; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 20px">public constructor(a: array of char; i: integer); </t>
<br><t style="margin-left: 20px">begin </t>
<br><t style="margin-left: 30px">self.a := CharArr15(a); </t>
<br><t style="margin-left: 30px">self.i := i; </t>
<br><t style="margin-left: 20px">end; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 20px">public constructor(s: string; i: integer) := </t>
<br><t style="margin-left: 20px">Create(s.ToCharArray, i); </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 20px">public function ToString: string; override := </t>
<br><t style="margin-left: 20px">$'r1("{(new string(a.ToRefArr)).Replace(#0,#32)}", {i})'; </t>
<br><t style="margin-left: 10px">end; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 00px">begin </t>
<br><t style="margin-left: 10px">var f := new BlockFileOf&ltr1>('temp.bin'); </t>
<br><t style="margin-left: 10px">var a1 := new r1(new char[]('a', 'b', 'd', 'q'), 6); </t>
<br><t style="margin-left: 10px">var b1 := new r1('Hello, world!', 278); </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 10px">{ </t>
<br><t style="margin-left: 10px">f.Reset; </t>
<br><t style="margin-left: 10px">{} </t>
<br><t style="margin-left: 10px">f.Rewrite; </t>
<br><t style="margin-left: 10px">f.Write(a1, b1); </t>
<br><t style="margin-left: 10px">{} </t>
<br><t style="margin-left: 10px">f.Pos := 0; </t>
<br><t style="margin-left: 10px">var a2 := f.Read; </t>
<br><t style="margin-left: 10px">var b2 := f.Read; </t>
<br><t style="margin-left: 10px">f.Close; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 10px">writeln(a1); </t>
<br><t style="margin-left: 10px">writeln(b1); </t>
<br><t style="margin-left: 10px">writeln(a1.a.ToRefArr.Length); </t>
<br><t style="margin-left: 10px">writeln(b1.a.ToRefArr.Length); </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 10px">writeln(a2); </t>
<br><t style="margin-left: 10px">writeln(b2); </t>
<br><t style="margin-left: 10px">writeln(a2.a.ToRefArr.Length); </t>
<br><t style="margin-left: 10px">writeln(b2.a.ToRefArr.Length); </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 00px">end. </t>
</p>
В этот раз, уже, нулевые символы в конеце строки обрезало при чтении,<br>
потому что знало после какого символа надо обрезать.<br>
<hr />
</div>
<p onClick="toggle_show('to_seq')"><font size="4" color="008000" style="cursor: pointer">Использование сериализаторов</font></p>
<div id=to_seq style="display: none">
<p class=code_block>
<t style="margin-left: 00px">uses BlockFileOfT; </t>
<br><t style="margin-left: 00px">uses System.Runtime.InteropServices; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 00px">type </t>
<br><t style="margin-left: 10px">[StructLayout(LayoutKind.&Explicit)] </t>
<br><t style="margin-left: 10px">Str15 = record </t>
<br><t style="margin-left: 20px">private const MaxLength = 15; </t>
<br><t style="margin-left: 20px">//Я провёл много тестов чтоб убедится: </t>
<br><t style="margin-left: 20px">//-BinaryFormatter всегда делает для string заголовок в 25 байт </t>
<br><t style="margin-left: 20px">//-В разных случаях тело строки может сохранять как MaxLength*1, MaxLength*2 и MaxLength*3 байт. </t>
<br><t style="margin-left: 20px">//-Предыдущее зависит от того, на сколько редкие символы были использованы. Для более редких символов надо больше памяти </t>
<br><t style="margin-left: 20px">//Поэтому, на всякий случай, я сделал Size с расчётом на то, что все MaxLength символов могут быть редкими. </t>
<br><t style="margin-left: 20px">private const Size = 25 + MaxLength * 3; </t>
<br><t style="margin-left: 20px">private [FieldOffset(Size-1)] last: byte; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 20px">private class f := new System.Runtime.Serialization.Formatters.Binary.BinaryFormatter; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 20px">public class function operator explicit(s: string): Str15; </t>
<br><t style="margin-left: 20px">begin </t>
<br><t style="margin-left: 30px">if s.Length > MaxLength then s := s.Substring(0, MaxLength); </t>
<br><t style="margin-left: 30px">var str := new System.IO.MemoryStream(Size); </t>
<br><t style="margin-left: 30px">str.SetLength(Size); </t>
<br><t style="margin-left: 30px">f.Serialize(str, s); </t>
<br><t style="margin-left: 30px">var a := str.ToArray; </t>
<br><t style="margin-left: 30px">var hnd := GCHandle.Alloc(a, GCHandleType.Pinned); </t>
<br><t style="margin-left: 30px">try </t>
<br><t style="margin-left: 40px">var ptr: ^Str15 := pointer(hnd.AddrOfPinnedObject); </t>
<br><t style="margin-left: 40px">Result := ptr^; </t>
<br><t style="margin-left: 30px">finally </t>
<br><t style="margin-left: 40px">hnd.Free; </t>
<br><t style="margin-left: 30px">end; </t>
<br><t style="margin-left: 20px">end; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 20px">public class function operator explicit(s: Str15): string; </t>
<br><t style="margin-left: 20px">begin </t>
<br><t style="margin-left: 30px">var a := new byte[Size]; </t>
<br><t style="margin-left: 30px">var hnd := GCHandle.Alloc(a, GCHandleType.Pinned); </t>
<br><t style="margin-left: 30px">try </t>
<br><t style="margin-left: 40px">var ptr: ^Str15 := pointer(hnd.AddrOfPinnedObject); </t>
<br><t style="margin-left: 40px">ptr^ := s; </t>
<br><t style="margin-left: 30px">finally </t>
<br><t style="margin-left: 40px">hnd.Free; </t>
<br><t style="margin-left: 30px">end; </t>
<br><t style="margin-left: 30px">var str := new System.IO.MemoryStream(a); </t>
<br><t style="margin-left: 30px">Result := string(f.Deserialize(str)); </t>
<br><t style="margin-left: 20px">end; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 10px">end; </t>
<br><t style="margin-left: 10px">r1 = record </t>
<br><t style="margin-left: 20px">public s: Str15; </t>
<br><t style="margin-left: 20px">public i: integer; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 20px">public constructor(s: string; i: integer); </t>
<br><t style="margin-left: 20px">begin </t>
<br><t style="margin-left: 30px">self.s := Str15(s); </t>
<br><t style="margin-left: 30px">self.i := i; </t>
<br><t style="margin-left: 20px">end; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 20px">public function ToString: string; override := </t>
<br><t style="margin-left: 20px">$'r1("{string(s)}", {i})'; </t>
<br><t style="margin-left: 10px">end; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 00px">begin </t>
<br><t style="margin-left: 10px">var f := new BlockFileOf&ltr1>('temp.bin'); </t>
<br><t style="margin-left: 10px">var a1 := new r1('abcd', 1234); </t>
<br><t style="margin-left: 10px">var b1 := new r1('abcd' * 4, 5678); </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 10px">{ </t>
<br><t style="margin-left: 10px">f.Reset; </t>
<br><t style="margin-left: 10px">{} </t>
<br><t style="margin-left: 10px">f.Rewrite; </t>
<br><t style="margin-left: 10px">f.Write(a1, b1); </t>
<br><t style="margin-left: 10px">{} </t>
<br><t style="margin-left: 10px">f.Pos := 0; </t>
<br><t style="margin-left: 10px">var a2 := f.Read; </t>
<br><t style="margin-left: 10px">var b2 := f.Read; </t>
<br><t style="margin-left: 10px">f.Close; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 10px">writeln(a1); </t>
<br><t style="margin-left: 10px">writeln(b1); </t>
<br><t style="margin-left: 10px">writeln(string(a1.s).Length); </t>
<br><t style="margin-left: 10px">writeln(string(b1.s).Length); </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 10px">writeln(a2); </t>
<br><t style="margin-left: 10px">writeln(b2); </t>
<br><t style="margin-left: 10px">writeln(string(a2.s).Length); </t>
<br><t style="margin-left: 10px">writeln(string(b2.s).Length); </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 00px">end. </t>
</p>
Конечно, памяти будет нужен на много больший объём для такого сохранения.<br>
А т.к. памяти будет больше - значит и записывать/читать придётся больше, то есть производительность тоже ниже.<br>
Хотя в целом - такой способ должен быть проще в реализации.
<hr />
</div>
</body>
</html>

107
InstallerSamples/BlockFileOfT/СправкаData/WhyOffset.html Normal file
View file

@ -0,0 +1,107 @@
<html>
<head>
<style type="text/css">
.code_block {
background: #c0c0c0;
padding: 5px;
padding-right: 20px;
border: solid 1px black;
}
</style>
<script type="text/javascript">
function toggle_show(id) {
document.getElementById(id).style.display = document.getElementById(id).style.display == 'none' ? 'block' : 'none';
}
</script>
</head>
<body>
<font size="3"><a href="../Справка.html"><=</a></font><br>
<br>
<hr />
<p onClick="toggle_show('io_basics')"><font size="4" color="008000" style="cursor: pointer">Что такое "Offset"</font></p>
<div id=io_basics style="display: none">
"Offset", он же отступ - это кол-во байт в начале файла, которые запрещенно использовать под элементы, сохранённые в файл.<br>
При этом, в эту область можно использовать под что угодно.<br>
Чаще всего - заголовок файла, описывающий какую то, общую для всех элементов файла, информацию.<br>
<br>
Если у файла есть отступ - "Size" и "Pos" будут учитывать его.<br>
То есть, если длина файла 11 байт, 1 элемент занимает 2 байт, а отступ 3 байт - "Size" будет возвращать 4, потому что (11-3)/2 .<br>
<br>
Но, что очень важно помнить - когда файл только открыт/создан любым способом, кроме "Append" -<br>
позиция в файле находится в самом начале, то есть на отсутпе.<br>
А попытка прочитать/записать элемент на отустп, конечно, ничем хорошим не закончится.<br>
Поэтому, в большинстве случаев лучше вызвать "f.Pos := 0" перед чтением/записью.<br>
Это поставить позицию в файле на элемент #0, то есть сразу после отступа.
<hr />
</div>
<p onClick="toggle_show('decl')"><font size="4" color="008000" style="cursor: pointer">Заголовки</font></p>
<div id=decl style="display: none">
И так, как написано выше, основное применение - заголовок файла:
<p class=code_block>
<t style="margin-left: 00px">uses BlockFileOfT; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 00px">type </t>
<br><t style="margin-left: 10px">HeaderT = record </t>
<br><t style="margin-left: 20px">version: integer; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 20px">public function ToString:string; override := </t>
<br><t style="margin-left: 20px">$'Header:[version={version}]'; </t>
<br><t style="margin-left: 10px">end; </t>
<br><t style="margin-left: 10px">ElementT = byte; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 00px">begin </t>
<br><t style="margin-left: 10px">var f := new BlockFileOf&ltElementT>('temp.bin',sizeof(HeaderT));//Этот конструктор установит Offset на sizeof(HeaderT) </t>
<br><t style="margin-left: 10px">f.Rewrite; </t>
<br><t style="margin-left: 10px">begin </t>
<br><t style="margin-left: 20px">var hf := new BlockFileOf&ltHeaderT>(f);//Этот конструктор создаст новый "BlockFileOf&ltT>", у которого будет общий фаловый поток с "f" </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 20px">var h: HeaderT; </t>
<br><t style="margin-left: 20px">h.version := 5; </t>
<br><t style="margin-left: 20px">hf.Write(h); </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 20px">hf.Close;//Эта строчка не закроет поток, потому что файл сейчас открыт в 2 переменных </t>
<br><t style="margin-left: 65px">//Но она отвяжет "hf" от файла открытого в "f", чтоб когда "f" закроется - файл тоже был закрыт </t>
<br><t style="margin-left: 10px">end; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 10px">f.Write( </t>
<br><t style="margin-left: 20px">1,2,3,4,5,6,7,8,9 </t>
<br><t style="margin-left: 10px">); </t>
<br><t style="margin-left: 10px">f.Close;//А вот теперь поток будет закрыт и файл сохранён, потому что теперь это последняя перменная, в которой открыт файл </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 10px">f.Reset; </t>
<br><t style="margin-left: 10px">begin </t>
<br><t style="margin-left: 20px">var hf := new BlockFileOf&ltHeaderT>(f); </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 20px">var h := hf.Read; </t>
<br><t style="margin-left: 20px">writeln(h); </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 20px">hf.Close;//Опять же, надо закрыть сразу, как закончили пользоваться </t>
<br><t style="margin-left: 10px">end; </t>
<br><t style="margin-left: 10px">f.Read(9).Print </t>
<br><t style="margin-left: 10px">f.Close </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 00px">end. </t>
</p>
Прошу обратить внимание на то, что я не поставил тут "f.Pos := 0" перед чтением/записью только по стечению 2 обстоятельств:<br>
1. Этот код линейный, в нём хорошо видно что прямо перед чтением/записью элементов идёт чтение/запись заголовка. А значит, файловая позиция сама передвинется на sizeof(HeaderT).<br>
2. Написав этот короткий участок кода - я протестировал его, чтоб быть увереным что ничего не забыл и не перепутал.
<hr />
</div>
</body>
</html>

263
InstallerSamples/BlockFileOfT/СправкаData/main.html Normal file
View file

@ -0,0 +1,263 @@
<html>
<head>
<style type="text/css">
.code_block {
background: #c0c0c0;
padding: 5px;
padding-right: 20px;
border: solid 1px black;
}
</style>
<script type="text/javascript">
function toggle_show(id) {
document.getElementById(id).style.display = document.getElementById(id).style.display == 'none' ? 'block' : 'none';
}
</script>
</head>
<body>
<font size="3"><a href="../Справка.html"><=</a></font><br>
<br>
Перед тем как начать, хоть уточнить:<br>
Ожидается что у вас есть хоть какое то представление о "file of T".<br>
Конечно, без того можно разобраться, но будет сложнее.
<hr />
<p onClick="toggle_show('decl')"><font size="4" color="008000" style="cursor: pointer">Объявление</font></p>
<div id=decl style="display: none">
<font size="3">"file of T":</font>
<p class=code_block>
<t style="margin-left: 00px">begin </t>
<br><t style="margin-left: 10px">var f: file of T; </t>
<br><t style="margin-left: 10px">Assign(f, 'temp.bin'); </t>
<br><t style="margin-left: 00px">end. </t>
</p>
<font size="3">"BlockFileOf&ltT>":</font>
<p class=code_block>
<t style="margin-left: 00px">uses BlockFileOfT; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 00px">begin </t>
<br><t style="margin-left: 10px">var f: BlockFileOf&ltT>; </t>
<br><t style="margin-left: 10px">f := new BlockFileOf&ltT>;//В отличии от file of T - BlockFileOf&ltT> надо всегда инициализировать </t>
<br><t style="margin-left: 10px">f.Assign('temp.bin'); </t>
<br><t style="margin-left: 00px">end. </t>
</p>
<font size="3">Последнее можно сократить:</font>
<p class=code_block>
<t style="margin-left: 00px">uses BlockFileOfT; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 00px">begin </t>
<br><t style="margin-left: 10px">var f := new BlockFileOf&ltT>; </t>
<br><t style="margin-left: 10px">f.Assign('temp.bin'); </t>
<br><t style="margin-left: 00px">end. </t>
</p>
<font size="3">И ещё больше сократить:</font>
<p class=code_block>
<t style="margin-left: 00px">uses BlockFileOfT; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 00px">begin </t>
<br><t style="margin-left: 10px">var f := new BlockFileOf&ltbyte>('temp.bin'); </t>
<br><t style="margin-left: 00px">end. </t>
</p>
<hr />
</div>
<p onClick="toggle_show('io_basics')"><font size="4" color="008000" style="cursor: pointer">Основы записи/чтения</font></p>
<div id=io_basics style="display: none">
<font size="3">"file of T":</font>
<p class=code_block>
<t style="margin-left: 00px">begin </t>
<br><t style="margin-left: 10px">var f: file of integer; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 10px">Rewrite(f, 'temp.bin'); </t>
<br><t style="margin-left: 10px">f.Write( </t>
<br><t style="margin-left: 20px">1,2,3,4,5 </t>
<br><t style="margin-left: 10px">); </t>
<br><t style="margin-left: 10px">f.Close; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 10px">Reset(f); </t>
<br><t style="margin-left: 10px">loop 5 do </t>
<br><t style="margin-left: 20px">f.Read.Print; </t>
<br><t style="margin-left: 10px">f.Close; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 00px">end. </t>
</p>
<font size="3">"BlockFileOf&ltT>":</font>
<p class=code_block>
<t style="margin-left: 00px">uses BlockFileOfT; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 00px">begin </t>
<br><t style="margin-left: 10px">var f := new BlockFileOf&ltinteger>('temp.bin'); </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 10px">f.Rewrite; </t>
<br><t style="margin-left: 10px">f.Write( </t>
<br><t style="margin-left: 20px">1,2,3,4,5 </t>
<br><t style="margin-left: 10px">); </t>
<br><t style="margin-left: 10px">f.Close; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 10px">f.Reset; </t>
<br><t style="margin-left: 10px">f.Read(5).Print; </t>
<br><t style="margin-left: 10px">f.Close; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 00px">end. </t>
</p>
В случае с "BlockFileOf&ltT>" все 5 элементов читаются как 1 блок памяти.<br>
В то время как "file of T" может прочитать только по 1 элементу.<br>
<hr />
</div>
<p onClick="toggle_show('to_seq')"><font size="4" color="008000" style="cursor: pointer">Перечисление всех элементов в файле</font></p>
<div id=to_seq style="display: none">
<font size="3">"file of T":</font>
<p class=code_block>
<t style="margin-left: 00px">begin </t>
<br><t style="margin-left: 10px">var f: file of integer; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 10px">Rewrite(f, 'temp.bin'); </t>
<br><t style="margin-left: 10px">f.Write( </t>
<br><t style="margin-left: 20px">1,2,3,4,5 </t>
<br><t style="margin-left: 10px">); </t>
<br><t style="margin-left: 10px">f.Close; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 10px">Reset(f); </t>
<br><t style="margin-left: 10px">f.ReadElements.Print </t>
<br><t style="margin-left: 10px">f.Close; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 00px">end. </t>
</p>
<font size="3">"BlockFileOf&ltT>":</font>
<p class=code_block>
<t style="margin-left: 00px">uses BlockFileOfT; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 00px">begin </t>
<br><t style="margin-left: 10px">var f := new BlockFileOf&ltinteger>('temp.bin'); </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 10px">f.Rewrite; </t>
<br><t style="margin-left: 10px">f.Write( </t>
<br><t style="margin-left: 20px">1,2,3,4,5 </t>
<br><t style="margin-left: 10px">); </t>
<br><t style="margin-left: 10px">f.Close; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 10px">f.Reset; </t>
<br><t style="margin-left: 10px">f.ToSeq.Print; </t>
<br><t style="margin-left: 10px">f.Close; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 00px">end. </t>
</p>
"BlockFileOf&ltT>.ToSeq" работает так же как и "(file of T).ReadElements" (если не считать более продвинутой защиты от дурака):<br>
Они оба читают файл по 1 элементу, и после каждого из них проверяют, не достигнут ли конец файла.<br>
<br>
Но в "BlockFileOf&ltT>" есть альтернатива - "ToSeqBlocks".<br>
Эта функция читает всё из файла блоками заданной (в байтах) длины. Если её не задать - будет по умолчанию, то есть 4КБ.<br>
В нашем случае, "integer" занимает 4 байта в памяти, значит в каждом блоке по 4КБ поместится 1024 элемента типа "integer"<br>
(Объём типа T можно узнать из свойства "BlockFileOf&ltT>.TSize", или с помощью sizeof(T) )<br>
В случае с 5 элементами это едва ли даст преимущество, но если записывать и считывать сразу много элементов - считывание блоками будет на много быстрее:
<p class=code_block>
<t style="margin-left: 00px">uses BlockFileOfT; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 00px">begin </t>
<br><t style="margin-left: 10px">var f := new BlockFileOf&ltinteger>('temp.bin'); </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 10px">f.Rewrite; </t>
<br><t style="margin-left: 10px">f.Write( </t>
<br><t style="margin-left: 20px">1,2,3,4,5 </t>
<br><t style="margin-left: 10px">); </t>
<br><t style="margin-left: 10px">f.Close; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 10px">f.Reset; </t>
<br><t style="margin-left: 10px">var blocks := f.ToSeqBlocks; </t>
<br><t style="margin-left: 10px">var AsSeq := blocks.SelectMany(bl->bl); </t>
<br><t style="margin-left: 10px">AsSeq.Print; </t>
<br><t style="margin-left: 10px">f.Close; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 00px">end. </t>
</p>
"AsSeq := blocks.SelectMany(bl->bl)" здесь делает так, что хоть всё считывается из файла блоками,<br>
переменную "AsSeq" будет воспринимать как последовательность элементов, а не последовательность блоков.<br>
И - я расписал вывод как 3 строчки чтоб было виднее. Можно и сократить:
<p class=code_block>
<t style="margin-left: 10px">f.Reset; </t>
<br><t style="margin-left: 10px">f.ToSeqBlocks.SelectMany(bl->bl).Print; </t>
<br><t style="margin-left: 10px">f.Close; </t>
</p>
<hr />
</div>
<p onClick="toggle_show('bfo_record')"><font size="4" color="008000" style="cursor: pointer">Основное преимущество: сохранение записей (record)</font></p>
<div id=bfo_record style="display: none">
<p class=code_block>
<t style="margin-left: 00px">uses BlockFileOfT; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 00px">type </t>
<br><t style="margin-left: 10px">r1=record </t>
<br><t style="margin-left: 20px">b1:byte; </t>
<br><t style="margin-left: 20px">i:integer; </t>
<br><t style="margin-left: 20px">b2:byte; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 20px">constructor(b1:byte; i:integer; b2:byte); </t>
<br><t style="margin-left: 20px">begin </t>
<br><t style="margin-left: 30px">self.b1 := b1; </t>
<br><t style="margin-left: 30px">self.i := i; </t>
<br><t style="margin-left: 30px">self.b2 := b2; </t>
<br><t style="margin-left: 20px">end; </t>
<br><t style="margin-left: 20px">///Эта функция определяет, как данную запись выведет на экран </t>
<br><t style="margin-left: 20px">function ToString:string; override := </t>
<br><t style="margin-left: 20px">$'r1(b1={b1}, i={i}, b2={b2})'; </t>
<br><t style="margin-left: 10px">end; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 00px">begin </t>
<br><t style="margin-left: 10px">var f := new BlockFileOf&ltr1>('temp.bin'); </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 10px">f.Rewrite; </t>
<br><t style="margin-left: 10px">f.Write( </t>
<br><t style="margin-left: 20px">new r1(1,2,3) </t>
<br><t style="margin-left: 10px">); </t>
<br><t style="margin-left: 10px">f.Close; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 10px">f.Reset; </t>
<br><t style="margin-left: 10px">writeln(f.Read); </t>
<br><t style="margin-left: 10px">f.Close; </t>
<br><t style="margin-left: 00px"> </t>
<br><t style="margin-left: 00px">end. </t>
</p>
Казалось бы, тот же самый код будет работать и для "file of T".<br>
Но вся разница находится в реализации:<br>
<br>
"file of T" в данном случае, при вызове "Read" сначала прочитал бы названия и типы полей "r1" из его типа (через "System.Runtime"),<br>
а затем, по очереди, читал бы из файла значение того же типа, что и у поля ("byte", затем "integer" и снова "byte"),<br>
сохраняя прочитаные значения в соответствующих полях результата.<br>
<br>
А "BlockFileOf&ltT>" подходит к этому с другой стороны.<br>
Когда вы первый раз инициализируете переменную типа "BlockFileOf&ltr1>" -<br>
объём в памяти занимаемый переменными типа "r1" вычисляется и сохраняется во внутрее статичное поле<br>
(Его можно получить через свойство "TSize")<br>
И когда вызывается функция "Read" - "BlockFileOf&ltT>" читает из файла столько байт, сколько занимают переменные типа "r1",<br>
А потом копирует содержимое полученного массива байт в результат.<br>
<br>
То есть, "file of T" читает 3 блока, а "BlockFileOf&ltT>" только 1.<br>
И когда объём данных одинаковый - количество блоков очень важный фактор.<br>
Поэтому "BlockFileOf&ltT>" будет быстрее.<br>
И размер 1 блока не ограничивается размером 1 переменной типа "r1".<br>
"Read(10)", к примеру, прочитает 1 блоком то, что "file of T" читал бы как 30 блоков.<br>
<br>
Ну и, конечно, всё то же самое касается и "Write", не только "Read".<br>
<hr />
</div>
</body>
</html>

305
InstallerSamples/BlockFileOfT/Сравнение скорости.pas Normal file
View file

@ -0,0 +1,305 @@
uses BlockFileOfT;
type
StructLayout = System.Runtime.InteropServices.StructLayoutAttribute;
LayoutKind = System.Runtime.InteropServices.LayoutKind;
FieldOffset = System.Runtime.InteropServices.FieldOffsetAttribute;
GCHandle = System.Runtime.InteropServices.GCHandle;
GCHandleType = System.Runtime.InteropServices.GCHandleType;
//Эти 2 типа взят из справки, и по рекомендациям от туда переделан под наш случай
//имеется в виду справка, которая html файл, лежащий в папке с этим примером
[StructLayout(LayoutKind.&Explicit)]
CharArr255Body = record
private const MaxLength = 255;
private const TSize = 2;
private const Size = MaxLength * TSize;
[FieldOffset(Size-1)] last: byte;
end;
[StructLayout(LayoutKind.&Explicit)]
CharArr255 = record
public [FieldOffset(0)] length: byte;
public [FieldOffset(1)] body: CharArr255Body;
public class function operator explicit(a: array of char): CharArr255;
begin
Result.length := Min(CharArr255Body.MaxLength, a.Length);//если a.Length>MaxLength - length присвоит MaxLength
if a.Length < CharArr255Body.MaxLength then
a := a + new char[CharArr255Body.MaxLength - a.Length];//если a.Length<MaxLength - надо удлинить
//иначе можем иногда получать ошибки чтения защищённой памяти
//если откажет в доступе к памяти, которая находиться полсе массива
//надо заблокировать массив на 1 месте в памяти, чтоб сборщик мусора не двигал пока мы копируем
var hnd := GCHandle.Alloc(a, GCHandleType.Pinned);
// try
var ptr: ^CharArr255Body := pointer(hnd.AddrOfPinnedObject);
Result.body := ptr^;
// finally
hnd.Free;//в finally, чтоб если возникнет какая то ошибка - блокировку всё равно сняло
//иначе получим утечку памяти, потому что блокировка запрещает сборщику мусора освобождать память
//Но пока что я убрал, потому что github.com/pascalabcnet/pascalabcnet/issues/1267
// end;
end;
public class function operator explicit(s: string): CharArr255 :=
CharArr255(s.ToCharArray);
public class function operator explicit(a: CharArr255): array of char;
begin
//Если кол-во сохранённых байт < MaxLength - a.body будет занимать бОльший объём в памяти, чем поместится в Result
//Поэтому надо сначала прочитать всё, включая пустые символы на конце, во временную переменную
//А затем скопировать нужное кол-во символов в Result
var temp := new char[CharArr255Body.MaxLength];
var hnd := GCHandle.Alloc(temp, GCHandleType.Pinned);
// try
var ptr: ^CharArr255Body := pointer(hnd.AddrOfPinnedObject);
ptr^ := a.body;
// finally
hnd.Free;
// end;
if a.length = CharArr255Body.MaxLength then
begin
Result := temp;//всё же, копирование ссылки - это быстрее, чем копировать всё содержимое массива
exit;
end;
Result := new char[a.length];
System.Array.Copy(temp, Result, a.length);
end;
public function ToRefArr: array of char;
type
CharArr = array of char;
begin
Result := CharArr(self);
end;
public function ToString: string; override :=
new string(ToRefArr);
public class function operator explicit(s: CharArr255): string :=
s.ToString;
end;
///Это будет сохранять в file of T
AR = record
s: string[255];
//dt: System.DateTime;//Не даёт ¯\_(ツ)_/¯
dt: int64;//Ну ландо, в System.DateTime всё хранится в 1 поле типа int64
i: integer;
ch: char;
b: byte;
end;
///Это будет сохранять в BlockFileOfT
BR = record
s: CharArr255;
//dt: System.DateTime;//И тут тоже - DateTime это "особый тип", подробнее в справке
dt: int64;//Ну а мы - знаем 1 версию, ту что сейчас, и в ней всё хранится как внутренне поле типа int64
i: integer;
//ch: char;//И тут, опять, особый тип. Ну, word хранит информацию так же как char
ch: word;//В типе IOR описаны все преобразования, как превратить эти типы в System.DateTime и char
b: byte;
end;
///Этот тип для ввода/вывода
///Чтоб и string[255] и CharArr255 преобразовывало в string
///Так честнее
///Хотя при преобразовании string[255] к string почти ничего не происходит, только копируется одна ссылка
IOR = record
s: string;
dt: System.DateTime;
i: integer;
ch: char;
b: byte;
class function operator explicit(a: IOR): AR;
begin
Result.s := a.s;
Result.dt := a.dt.Ticks;
Result.i := a.i;
Result.ch := a.ch;
Result.b := a.b;
end;
class function operator explicit(a: IOR): BR;
begin
Result.s := CharArr255(a.s);
Result.dt := a.dt.Ticks;
Result.i := a.i;
Result.ch := word(a.ch);
Result.b := a.b;
end;
class function operator explicit(a: AR): IOR;
begin
Result.s := a.s;
Result.dt := new System.DateTime(a.dt);
Result.i := a.i;
Result.ch := a.ch;
Result.b := a.b;
end;
class function operator explicit(a: BR): IOR;
begin
Result.s := new string(a.s.ToRefArr);
Result.dt := new System.DateTime(a.dt);
Result.i := a.i;
Result.ch := char(a.ch);
Result.b := a.b;
end;
class function GetRandom: IOR;
begin
Result.s := new string(ArrGen(Random(256), i -> ChrAnsi(Random(byte.MaxValue))));
Result.dt := System.DateTime.Now.AddTicks(System.Convert.ToInt64(((Random * 2 - 1) * 1024 * 1024 * 1024 * 1024)));
Result.i := (Random(word.MaxValue) shl 16) + Random(word.MaxValue);
Result.ch := ChrAnsi(Random(byte.MaxValue));
Result.b := Random(256);
end;
public function ToString: string; override :=
$'IOR( s.Length={s.Length}, dt={dt}, i={i}, ch="{ch}", b={b} )';
end;
procedure TestIntegrity1(c: integer);
begin
var f: file of AR;
var test_arr := ArrGen(c, i -> IOR.GetRandom);
Rewrite(f, 'temp.bin');
foreach var a in test_arr.Select(a -> AR(a)) do
f.Write(a);
f.Close;
Reset(f);
var n_test_arr := f.ReadElements.Select(a -> IOR(a)).ToArray;
f.Close;
if not test_arr.SequenceEqual(n_test_arr) then
begin
writeln('тест 1 (file of T) не пройден');
if test_arr.Length <> n_test_arr.Length then
writeln($'len: {test_arr.Length} <> {n_test_arr.Length}') else
for var i := 0 to test_arr.Length - 1 do
if test_arr[i] <> n_test_arr[i] then
begin
writeln($'el:{#10}{test_arr[i]}{#10}{n_test_arr[i]}{#10}');
end;
readln;
exit;
end;
end;
procedure TestIntegrity2(c: integer);
begin
var f := new BlockFileOf<BR>('temp.bin');
var test_arr := ArrGen(c, i -> IOR.GetRandom);
f.Rewrite;
f.Write(test_arr.ConvertAll(a -> BR(a)));
f.Close;
f.Reset;
var n_test_arr := f.Read(f.Size).ConvertAll(a -> IOR(a));
f.Close;
if not test_arr.SequenceEqual(n_test_arr) then
begin
writeln('тест 2 (BlockFileOf<T>) не пройден');
if test_arr.Length <> n_test_arr.Length then
writeln($'len: {test_arr.Length} <> {n_test_arr.Length}') else
for var i := 0 to test_arr.Length - 1 do
if test_arr[i] <> n_test_arr[i] then
begin
writeln($'el:{#10}{test_arr[i]}{#10}{n_test_arr[i]}{#10}');
end;
readln;
exit;
end;
end;
procedure TestIntegrity;
begin
TestIntegrity1(1);
writeln('тест 1 ok');
TestIntegrity2(1024);
writeln('тест 2 ok');
writeln('тесты ok');
end;
procedure TestSpeed;
begin
var sw := new System.Diagnostics.Stopwatch;//точнее чем этим замерить невозможно
var lc := 10;
var ec := 10000;//Чем больше элементов - тем больше преимущество BlockFileOf<T>, потому что он сохраняет их всех сразу.
//Но он быстрее даже если сохранять по 1 элементу
var t1, t2: int64;
var f1: file of AR;
Assign(f1, 'temp.bin');
var f2 := new BlockFileOf<BR>('temp.bin');
while true do
begin
var test_arr := ArrGen(ec, i -> IOR.GetRandom);
sw.Restart;
loop lc do
begin
Rewrite(f1);
var AR_arr := test_arr.ConvertAll(a -> AR(a));
foreach var a in AR_arr do f1.Write(a);
f1.Close;
Reset(f1);
ArrGen(ec, i -> IOR(f1.Read));
f1.Close;
end;
sw.Stop;
t1 += sw.ElapsedTicks;
sw.Restart;
loop lc do
begin
f2.Rewrite;
f2.Write(test_arr.ConvertAll(a -> BR(a)));
f2.Close;
f2.Reset;
f2.Read(ec).ConvertAll(a -> IOR(a));
f2.Close;
end;
sw.Stop;
t2 += sw.ElapsedTicks;
System.GC.Collect;
System.Console.Clear;
writeln($'file of T: {t1}');
writeln($'BlockFile: {t2}');
end;
end;
begin//Уберите флажок "Debug версия" в сервис>>настройки>>опции компиляции и запускайте по Shift+F9, иначе не честно
TestIntegrity;//можно закомментировать
TestSpeed;
end.

65
InstallerSamples/ExperimentalUnits/BlockFileOfT/SpeedTest.pas
View file

@ -1,65 +0,0 @@
uses BlockFileOfT;
type
r1=record
b1:byte;
i:integer;
b2:byte;
class function GetRandom:r1;
begin
Result.b1 := Random(256);
Result.i := Random(256) shl 24 + Random(256) shl 16 + Random(256) shl 8 + Random(256);
Result.b2 := Random(256);
end;
end;
begin//Уберите флажок "Debug версия" в сервис>>настройки>>опции компиляции и запускайте по Shift+F9, иначе не честно
var sw := new System.Diagnostics.Stopwatch;//точнее чем этим замерить невозможно
var lc := 1000;
var ec := 100;
var t1,t2:int64;
var f1: file of r1;
var f2 := new BlockFileOf<r1>;
while true do
begin
var test_arr := ArrGen(ec,i->r1.GetRandom);
sw.Restart;
loop lc do
begin
Rewrite(f1,'temp.bin');
f1.Write(test_arr);
f1.Close;
Reset(f1);
foreach var el in f1.ReadElements do;
f1.Close;
end;
sw.Stop;
t1 += sw.ElapsedTicks;
sw.Restart;
loop lc do
begin
f2.Rewrite('temp.bin');
f2.Write(test_arr);
f2.Close;
f2.Reset;
f2.Read(f2.FileSize);
f2.Close;
end;
sw.Stop;
t2 += sw.ElapsedTicks;
System.Console.Clear;
writeln($'file of T: {t1}');
writeln($'BlockFile: {t2}');
end;
end.

152
InstallerSamples/ExperimentalUnits/BlockFileOfT/База данных на файле.pas
View file

@ -1,152 +0,0 @@
uses BlockFileOfT;
uses System.Runtime.InteropServices;//нужно чтоб не писать System.Runtime.InteropServices.StructLayout и т.п.
uses FileArray;
type
DataType1 = record
b: byte;
end;
DataType2 = record
i: integer;
end;
DataType3 = record
ch: char;
end;
DataType4 = record
r: real;
end;
DataType = (
ByteData = 1,
IntData = 2,
CharData = 3,
RealData = 4
);
[StructLayout(LayoutKind.&Explicit)]//Значит - мы сами указываем куда ставит каждое поле
DataUnit = record
[FieldOffset(0)] DataT: byte;
[FieldOffset(1)] DataT1: DataType1;//У этих 3 полей одинаковая позиция
[FieldOffset(1)] DataT2: DataType2;//Значит, у них будет общая память
[FieldOffset(1)] DataT3: DataType3;//Но это так же значит что если записать данные 1 типа -
[FieldOffset(1)] DataT4: DataType4;//данные другого типа считать не выйдет (выведет мусор)
function ToString:string; override;
begin
var sb := new StringBuilder;
sb.AppendFormat(
'DataUnit(DataT: {0,8}, ',
System.Enum.GetName(typeof(DataType), DataT)
);
case DataType(DataT) of
ByteData: sb.AppendFormat('{0})',DataT1.b);
IntData : sb.AppendFormat('{0})',DataT2.i);
CharData: sb.AppendFormat('{0})',DataT3.ch);
RealData: sb.AppendFormat('{0})',DataT4.r);
else raise new System.FormatException($'Не правильный тип данных: {DataT}');
end;
Result := sb.ToString;
end;
end;
Database = class(System.IDisposable)
public version: byte;
public DatabaseType: string;
public Data: FileArr<DataUnit>;
public constructor := exit;
public class function Load(fname:string): Database;
begin
Result := new Database;
Result.Data := new FileArr<DataUnit>(fname, System.IO.FileMode.Open);
Result.Data.AutoFlush := false;
Result.Data.DeleteOnExit := false;
begin//заголовок
var f: BlockFileOf<DataUnit> := Result.Data.InnerFile;
f.Offset := 5;//1 версия+4 длина строки-типа базы данных
Result.version := f.BinReader.ReadByte;
var sr := new System.IO.StreamReader(f.BaseStream, System.Text.Encoding.UTF8);
var buff := new char[4];
sr.ReadBlock(buff,0,4);
Result.DatabaseType := new string(buff);
end;
end;
public procedure Save;
begin
var f:BlockFileOf<DataUnit> := Data.InnerFile;
f.PosByte := 0;
f.BinWriter.Write(version);
f.BaseStream.Position := 1;
var sw := new System.IO.StreamWriter(f.BaseStream,System.Text.Encoding.UTF8);
sw.Write(DatabaseType.ToCharArray,0,4);
sw.Flush;
Data.Flush;
end;
public function ToString:string; override;
begin
var sb := new StringBuilder;
sb += $'version: {version}{#10}';
sb += $'Database Type: {DatabaseType}{#10}';
sb += $'Data:[{#10}';
Data.InnerFile.Pos := 0;
foreach var du in Data.InnerFile.Read(Data.InnerFile.Size) do
sb += $'{#9}{du}{#10}';
sb += $']';
Result := sb.ToString;
end;
public procedure Dispose;
begin
Data.Finalize;
end;
end;
begin
var db1 := new Database;
db1.version := 1;
db1.DatabaseType := 'JSBD';//Just Some Basic Data
db1.Data := new FileArr<DataUnit>('temp database.bin', System.IO.FileMode.Create);
db1.Data.InnerFile.Offset := 5;
db1.Data.AutoFlush := false;
db1.Data.DeleteOnExit := false;
var c := 10;
db1.Data.Section64[0,c] := ArrGen&<DataUnit>(c,
i->
begin
Result := new DataUnit;
Result.DataT := Random(1,4);
case DataType(Result.DataT) of
ByteData: Result.DataT1.b := Random(256);
IntData : Result.DataT2.i := (Random(256*256) shl 16) + Random(256*256);
CharData: Result.DataT3.ch := char(Random(word('A'),word('Z')));
RealData: Result.DataT4.r := Random;
end;
end
);
db1.Save;
db1.Dispose;
db1 := nil;
db1 := Database.Load('temp database.bin');
writeln(db1);
db1.Dispose;
end.

1
SyntaxTreeConverters/StandardSyntaxConverter.cs
View file

@ -15,6 +15,7 @@ namespace PascalABCCompiler.SyntaxTreeConverters
public string Name { get; } = "Standard";
public syntax_tree_node Convert(syntax_tree_node root)
{
CapturedNamesHelper.Reset();
// Прошивание ссылками на Parent nodes. Должно идти первым
// FillParentNodeVisitor расположен в SyntaxTree/tree как базовый визитор, отвечающий за построение дерева
FillParentNodeVisitor.New.ProcessNode(root);

5
SyntaxVisitors/YieldVisitors/ProcessYieldsCapturedVars.cs
View file

@ -21,6 +21,11 @@ namespace SyntaxVisitors
{
public static int CurrentLocalVariableNum = 0;
public static void Reset()
{
CurrentLocalVariableNum = 0;
}
public static string MakeCapturedFormalParameterName(string formalParamName)
{
return string.Format("<>{0}__{1}", YieldConsts.ReservedNum.MethodFormalParam, formalParamName);

6
TestSuite/intellisense_tests/extensionmethods8.pas Normal file
View file

@ -0,0 +1,6 @@
begin
var ch: char;
var n: integer;
(ch*n).Replace{@function string.Replace(oldChar: char; newChar: char): string;@}(#0,#32);
(2+3).Between{@(расширение) function integer.Between(a: integer; b: integer): boolean;@}(2,3);
end.

5
TestSuite/intellisense_tests/indexer1.pas Normal file
View file

@ -0,0 +1,5 @@
begin
var d := new Dictionary<byte, string->string>;
d.Add(5, s->s*2);
d[0]('abc').IndexOf{@function string.IndexOf(value: char): integer;@}('a');
end.

6
TestSuite/intellisense_tests/ispattern3.pas Normal file
View file

@ -0,0 +1,6 @@
begin
var o: object := byte(5);
var ok := (o is byte(var b)) and (b{@var b: byte;@}=5);
ok.Print;
writeln(b{@var b: byte;@});
end.

609
bin/Lib/BlockFileOfT.pas
View file

@ -1,4 +1,19 @@
unit BlockFileOfT;
(************************************************************************************)
// Copyright (©) Cergey Latchenko ( github.com/SunSerega | forum.mmcs.sfedu.ru/u/sun_serega )
// This code is distributed under the Unlicense
// For details please see LICENSE.md or here:
// https://github.com/SunSerega/PascalABC.Net-BlockFileOfT/blob/master/LICENSE.md
(************************************************************************************)
// Copyright (©) Сергей латченко ( github.com/SunSerega | forum.mmcs.sfedu.ru/u/sun_serega )
// Этот код распространяется под Unlicense
// Для деталей смотрите в файл LICENSE.md или сюда:
// https://github.com/SunSerega/PascalABC.Net-BlockFileOfT/blob/master/LICENSE.md
(************************************************************************************)
///Модуль содержащий тип BlockFileOf<T>
///Этот тип - альтернатива стандартному file of T
///Основное преимущество - скорость работы
unit BlockFileOfT;
interface
@ -6,6 +21,26 @@ uses System.Runtime.InteropServices;
uses System.IO;
type
///--
BlockFileBase = abstract class
protected fi:FileInfo;
protected _offset:int64;
protected str:FileStream;
protected bw:BinaryWriter;
protected br:BinaryReader;
protected linked := new List<BlockFileBase>;
protected procedure Link(f:BlockFileBase);
protected procedure UnLink;
private class function MessageBox(wnd: System.IntPtr; message, caption: string; flags: cardinal):integer;
external 'User32.dll';
end;
///Тип, записывающий данные в файл по принципу схожему с "file of <T>"
///Но в отличии от "file of <T>" - данный тип сохраняет всю запись одним блоком,
///так, как она записа в памяти.
@ -15,67 +50,148 @@ type
///Ожидается, что в видет шаблонного параметра <T> будет передана запись,
///не содержащая динамичных полей.
///Иначе целостность данных будет терятся
///Это значит, что поля записи T и всех вложенных записей - не могут быть:
///Это значит, что поля записи T и всех вложенных записей - НЕ могут быть:
/// -Указатели
/// -Ссылочные типы (то есть все классы)
///
///В будущих билдах ожидаются так же модули "BlockString", "BlockArray" и т.п.
///содержащие соответствующие типы для работы с BlockFileOf
BlockFileOf<T>=class
where T: record;
/// -Ссылочных типов (то есть классами)
/// -Особых типов, которые .Net считает "опасными". Как char или System.DateTime
///Но эти ограничения можно обойти, про это в справке
BlockFileOf<T>=class(BlockFileBase)
private class sz: integer;
private fi:FileInfo;
private str:FileStream;
private bw:BinaryWriter;
private br:BinaryReader;
private class constructor;
private class procedure TestForRefT(tt: System.Type);
begin
if tt.IsClass then
begin
MessageBox(new System.IntPtr(nil),
$'Тип {tt} ссылочный.{#10}Ссылочные типы нельзя сохранять в типизированный файл.{#10}Нажмите OK для выхода.',
$'Тип T из BlockFileOf<T> содержет ссылочные типы',
$10
);
Halt(-1);
end;
foreach var fi in
tt.GetFields(
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
if fi.FieldType <> tt then//integer имеет поле типа integer, без этой строчки StackOwerflow
TestForRefT(fi.FieldType);
end;
private class constructor :=
try
TestForRefT(typeof(T));
(*
try
var a := new T[0];
GCHandle.Alloc(a,GCHandleType.Pinned).Free;
except
on e: System.ArgumentException do
begin
MessageBox(new System.IntPtr(nil),
$'.Net не принимает какой то из типов полей записи, для которой вы создали BlockFileOf<T>{#10}Говорит - его нельзя превратить в набор байт{#10}Нажмите OK для выхода.',
$'Тип T содержет ссылочные типы',
$10
);
Halt(-1);
end;
end;
(**)
sz := Marshal.SizeOf(typeof(T));
except
on e:Exception do
begin
MessageBox(new System.IntPtr(nil),
e.ToString,
$'При инициализации BlockFileOf<{typeof(T)}> произошла ошибка',
$10
);
Halt(-1);
end;
end;
private function GetName:string;
private function GetFullName:string;
private function GetFileSize:int64;
private procedure SetFileSize(size:int64);
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;
private procedure SetPos(pos: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);
private function InternalReadLazy(c:integer; start_pos:int64):sequence of T;
///Инициализирует переменную файла, не привязывая её к файлу на диске
public constructor := exit;
///Инициализирует переменную файла, привязывая её к файлу fname
public constructor(fname:string) :=
Assign(fname);
///Инициализирует переменную файла, привязывая её к файлу fname
///А так же устанавливая значение смещени от начала в байтах на offset
public constructor(fname:string; offset:int64) :=
Assign(fname, offset);
///- constructor BlockFileOf<>(f:BlockFileOf<>);
///Инициализирует новую переменную, создавая связку данной переменной
///После вызова этого конструктора - переданная и созданная переменная будут
///использовать общий файловый поток, но записывать разные типы данных (у них может быть разный T)
///Это значит, что переменная которую передали в конструктор должно уже иметь открытый файловый поток
///Метод Close разрывает эту связь.
public constructor(f: BlockFileBase) :=
Link(f);
///Размер блока из одного элемента типа T, в байтах
public property TSize:integer read integer(sz);
///Хоть это свойство и можно перезаписывать, но это не рекомендуется
///Если перезаписать на число, большее чем было - в файл будет сохранять лишние нули
///А если на меньшее - получите неопределённое поведение (скорее всего вылет, но далеко не сразу)
public property TSize:integer read integer(sz) write sz := value;
///Смещение от начала файла до начала элементов (в байтах)
public property Offset:int64 read _offset write _offset;
///Количество сохранённых в файл элементов типа T
///Чтоб установить длину файла - надо открыть файл. Но прочитать длину можно не открывая
public property FileSize:int64 read GetFileSize write SetFileSize;
///Размер файла, в байтах
public property Size:int64 read GetFileSize write SetFileSize;
///Полный размер файла, в байтах
///Чтоб установить длину файла - надо открыть файл. Но прочитать длину можно не открывая
public property FileByteSize:int64 read GetByteFileSize write SetByteFileSize;
///Имя файла
public property ByteSize:int64 read GetByteFileSize write SetByteFileSize;
///Имя файла (только имя самого файла, без имени папки)
public property Name:string read GetName;
///Полное имя файла
///Полное имя файла (вместе с именами всех под-папок, вплодь до корня диска)
public property FullName:string read GetFullName;
///Возвращает номер текущего элемента в файле (нумеруя с 0)
///Существует ли файл
public property Exists:boolean read GetExists;
///Номер текущего элемета типа T в файле (нумеруя с 0)
public property Pos:int64 read GetPos write SetPos;
///Возвращает номер текущего байта в файле (нумеруя с 0)
///Номер текущего байта от начала файла (нумеруя с 0)
public property PosByte:int64 read GetPosByte write SetPosByte;
///Привязана ли переменная к файлу
public property Assigned:boolean read fi <> nil;
///Открыт ли файл
public property Opened:boolean read str <> nil;
///Достигнут ли конец файла
public property EOF:boolean read ByteSize-PosByte < sz;
///Основной поток открытого файла (или nil если файл не открыт)
///Внимание!!! Любое действие которое изменит этот поток - приведёт к неожиданным последствиям, используйте его только если знаете что делаете
///Внимание! Любое действие которое изменит этот поток - приведёт к неожиданным последствиям, используйте его только если знаете что делаете
public property BaseStream:FileStream read str;
///Переменная, которая записывает данные в основной поток (или nil если файл не открыт)
///Внимание!!! Любое действие которое изменит основной поток файла - приведёт к неожиданным последствиям, используйте его только если знаете что делаете
///Внимание! Любое действие которое изменит основной поток файла - приведёт к неожиданным последствиям, используйте его только если знаете что делаете
public property BinWriter:BinaryWriter read bw;
///Переменная, которая читает данные из основного потока (или nil если файл не открыт)
///Внимание!!! Любое действие которое изменит основной поток файла - приведёт к неожиданным последствиям, используйте его только если знаете что делаете
///Внимание! Любое действие которое изменит основной поток файла - приведёт к неожиданным последствиям, используйте его только если знаете что делаете
public property BinReader:BinaryReader read br;
///Переменная, показывающая данные о файле (или nil, если переменная не привязана к файлу)
public property FileInfo:System.IO.FileInfo read fi;
@ -85,13 +201,17 @@ type
///Привязывает данную переменную к файлу {fname}
///Привязывать можно и к не существующим файлам, при откритии определёнными способами (как Rewrite) новый файл будет создан
public procedure Assign(fname:string);
///Привязывает данную переменную к файлу {fname}
///А так же устанавливая значение смещени от начала в байтах на offset
///Привязывать можно и к не существующим файлам, при откритии определёнными способами (как Rewrite) новый файл будет создан
public procedure Assign(fname:string; offset:int64);
///Убирает свять переменной и файла, если связь есть
public procedure UnAssign;
///Открывает файл, способом описанным в переменной mode
///Чтоб получить переменную этого типа - пишите System.IO.FileMode.<способ_открытия_файла>
public procedure Open(mode:FileMode);
///Удаляет связаный файл, если он существует
public procedure Erase;
public procedure Delete;
///Переименовывает файл
///Если указать другое расположение - файл будет перемещён
public procedure Rename(NewName:string);
@ -100,105 +220,180 @@ type
public procedure Rewrite;
///Привязывает данную переменную к файлу {fname} и создает (или обнуляет) этот файл
public procedure Rewrite(fname:string);
///Привязывает данную переменную к файлу {fname} и создает (или обнуляет) этот файл
///А так же устанавливая значение смещени от начала в байтах на offset
public procedure Rewrite(fname:string; offset:int64);
///Открывает файл на чтение (ожидается, что он уже существует) и устанавливает позицию на начало файла
///Открывает файл (ожидается, что он уже существует) и устанавливает позицию на начало файла
public procedure Reset;
///Привязывает данную переменную к файлу {fname}, открывает этот файл на чтение (ожидается, что файл уже существует) и устанавливает позицию на начало файла
///Привязывает данную переменную к файлу {fname}, открывает этот файл (ожидается, что файл уже существует) и устанавливает позицию на начало файла
public procedure Reset(fname:string);
///Привязывает данную переменную к файлу {fname}, открывает этот файл (ожидается, что файл уже существует) и устанавливает позицию на начало файла
///А так же устанавливая значение смещени от начала в байтах на offset
public procedure Reset(fname:string; offset:int64);
///Открывает файл на чтение (ожидается, что он уже существует) и устанавливает позицию в конце файла
///Открывает файл (ожидается, что он уже существует) и устанавливает позицию в конце файла
public procedure Append;
///Привязывает данную переменную к файлу {fname}, открывает этот файл на чтение (ожидается, что файл уже существует) и устанавливает позицию в конце файла
///Привязывает данную переменную к файлу {fname}, открывает этот файл (ожидается, что файл уже существует) и устанавливает позицию в конце файла
public procedure Append(fname:string);
///Привязывает данную переменную к файлу {fname}, открывает этот файл (ожидается, что файл уже существует) и устанавливает позицию в конце файла
///А так же устанавливая значение смещени от начала в байтах на offset
public procedure Append(fname:string; offset:int64);
///Переставляет позицию в файле на элемент #pos (нумеруя с 0)
public procedure Seek(pos:int64);
///Переставляет позицию в файле на байт #pos (нумеруя с 0)
public procedure SeekByte(pos:int64);
///Достигнут ли конец файла
public function EOF := FileByteSize-PosByte < sz;
///Существует ли файл
public function Exists := fi.Exists;
public procedure Seek(pos:int64) := self.Pos := pos;
///Переставляет файловый курсор на байт #pos (нумеруя с 0) от начала файла
public procedure SeekByte(pos:int64) := self.PosByte := pos;
///Записывает все изменения в файл
///Записывает все изменения в файл и отчищает внутренние буферы
///До вызова Flush или Close - все изменения и кеш хранятся в оперативной памяти
///Поэтому, если вы записываете/читаете много (сотни мегабайт) - лучше вызывать Flush время от времени
public procedure Flush;
///Сохраняет и закрывает файл, если он был открыт
///Сохраняет и закрывает файл, если он открыт
public procedure Close;
///Записывает один элемент одним блоком в файл
///И переставляет файловый курсор на 1 элемет вперёд
public procedure Write(o: T);
///Записывает массив элементов одним блоком в файл
///И переставляет файловый курсор на o.Length элеметов вперёд
public procedure Write(params o:array of T);
///Записывает последовательность элементов, у которой можно узнать длину, одним блоком в файл
///И переставляет файловый курсор на o.Count элеметов вперёд
public procedure Write(o:ICollection<T>);
///Записывает последовательность элементов, у которой нельзя узнать длину, по 1 элементу типа T в файл
///И переставляет файловый курсор на o.Count элеметов вперёд
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);
///Читает один элемент из файла одним блоком
///И переставляет файловый курсор на 1 элемет вперёд
public function Read:T;
///Читает массив элементов из файла одним блоком
public function Read(c:integer):array of T;
///Возвращает ленивую последовательность
///При попытке доступа к элементам этой последовательности - начнёт читать элементы из файла, по блоку на элемент типа T
public function ReadLazy(c:integer):sequence of T;
private function InternalReadLazy(c:integer; start_pos:int64):sequence of 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;
///Возвращает ленивую последовательность из count элементов
///После завершения чтения - курсор окажется на эдлементе #(start_elm+count)
///Каждый раз читать будет начиная с элемента, на котором сейчас стоит файловый курсор
public function ReadLazy(count:integer):sequence of T := InternalReadLazy(count, PosByte);
///Возвращает ленивую последовательность из count элементов, начиная с элемента #start_elm
///После прочтения i элементов последовательности - позиция в файле будет передвигаться на элемент #(start_elm+i)
///Каждый раз читать будет начиная с элемента #start_elm
public function ReadLazy(start_elm, count:integer):sequence of T := InternalReadLazy(count, _offset + start_elm*sz);
///Возвращает ленивую последовательность из блоков-массивов с элементами типа T
///Каждый блок хранит столько элементов - чтоб не превышать объём в 4096 байт (4КБ)
///После прочтения каждого блока - файловый корсор будет переставлен на его конец
public function ToSeqBlocks:sequence of array of T := ToSeqBlocks(4096);
///Возвращает ленивую последовательность из блоков-массивов с элементами типа T
///Каждый блок хранит столько элементов - чтоб не превышать объём в последовательность байт
///После прочтения каждого блока - файловый корсор будет переставлен на его конец
public function ToSeqBlocks(blocks_size:integer):sequence of array of T;
///Возвращает ленивую последовательность из всех элементов хранящихся в файле
///После прочтения i элементов последовательности - позиция в файле будет передвигаться на элемент #i
public function ToSeq:sequence of T;
protected procedure Finalize; override;
begin
Close;
end;
end;
implementation
{$region Exception's}
type
FileNotAssignedException = class(Exception)
constructor :=
Create($'Данная переменная не была привязана к файлу{10}Используйте метод Assign');
inherited Create($'Данная переменная не была привязана к файлу{10}Используйте метод Assign');
end;
FileNotOpenedException = class(Exception)
constructor(fname:string) :=
Create($'Файл {fname} ещё не открыт, откройте его с помощью Open, Reset или Append');
inherited Create($'Файл {fname} ещё не открыт, откройте его с помощью Open, Reset, Append или Rewrite');
end;
FileNotClosedException = class(Exception)
constructor(fname:string) :=
Create($'Файл {fname} ещё открыт, закройте его методом Close перед тем как продолжать');
inherited Create($'Файл {fname} ещё открыт, закройте его методом Close перед тем как продолжать');
end;
CannotReadAfterEOF = class(Exception)
constructor :=
inherited Create($'Нельзя читать за пределами файла. Можно только записывать');
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.br := f.br;
self.bw := f.bw;
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;
//fi.Refresh;//А тут не надо
Result := fi.FullName;
end;
function BlockFileOf<T>.GetFileSize:int64;
begin
if fi = nil then raise new FileNotAssignedException;
Result := fi.Length div sz;
end;
procedure BlockFileOf<T>.SetFileSize(size:int64);
begin
if fi = nil then raise new FileNotAssignedException;
if str = nil then raise new FileNotOpenedException(fi.FullName);
str.SetLength(size*sz);
end;
function BlockFileOf<T>.GetByteFileSize:int64;
begin
if fi = nil then raise new FileNotAssignedException;
if str <> nil then
begin
Result := str.Length;
exit;
end;
fi.Refresh;
Result := fi.Length;
end;
@ -211,21 +406,6 @@ end;
function BlockFileOf<T>.GetPos:int64;
begin
if fi = nil then raise new FileNotAssignedException;
if str = nil then raise new FileNotOpenedException(fi.FullName);
Result := str.Position div sz;
end;
procedure BlockFileOf<T>.SetPos(pos:int64);
begin
if fi = nil then raise new FileNotAssignedException;
if str = nil then raise new FileNotOpenedException(fi.FullName);
str.Position := pos*sz;
end;
function BlockFileOf<T>.GetPosByte:int64;
begin
if fi = nil then raise new FileNotAssignedException;
@ -252,6 +432,12 @@ begin
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);
@ -267,12 +453,19 @@ begin
br := new BinaryReader(str);
end;
procedure BlockFileOf<T>.Erase;
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;
@ -293,6 +486,12 @@ begin
Rewrite;
end;
procedure BlockFileOf<T>.Rewrite(fname:string; offset:int64);
begin
Assign(fname, offset);
Rewrite;
end;
{$endregion Rewrite}
{$region Reset}
@ -306,6 +505,12 @@ begin
Reset;
end;
procedure BlockFileOf<T>.Reset(fname:string; offset:int64);
begin
Assign(fname, offset);
Reset;
end;
{$endregion Reset}
{$region Append}
@ -319,24 +524,14 @@ begin
Append;
end;
procedure BlockFileOf<T>.Append(fname:string; offset:int64);
begin
Assign(fname, offset);
Append;
end;
{$endregion Append}
{$region Seek}
procedure BlockFileOf<T>.Seek(pos:int64);
begin
if str = nil then raise new FileNotOpenedException;
str.Position := pos*sz;
end;
procedure BlockFileOf<T>.SeekByte(pos:int64);
begin
if str = nil then raise new FileNotOpenedException;
str.Position := pos;
end;
{$endregion Seek}
{$region Closing}
procedure BlockFileOf<T>.Flush;
@ -350,7 +545,9 @@ procedure BlockFileOf<T>.Close;
begin
if str <> nil then
begin
str.Close;
if linked.Count <> 0 then
UnLink else
str.Close;
str := nil;
br := nil;
bw := nil;
@ -365,81 +562,221 @@ end;
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];
var ptr:^T := pointer(@a[0]);
ptr^ := o;
var gc_hnd := GCHandle.Alloc(a, GCHandleType.Pinned);
System.Buffer.MemoryCopy(
@o,
gc_hnd.AddrOfPinnedObject.ToPointer,
sz,sz
);
gc_hnd.Free;
bw.Write(a);
end;
procedure BlockFileOf<T>.Write(params o:array of T);
begin
var a := new byte[sz*o.Length];
var ptr_id := integer(@a[0]);
for var i := 0 to o.Length - 1 do
begin
var ptr:^T := pointer(ptr_id);
ptr^ := o[i];
ptr_id += sz;
end;
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];
var gc_hnd1 := GCHandle.Alloc(o, GCHandleType.Pinned);
var gc_hnd2 := GCHandle.Alloc(a, GCHandleType.Pinned);
System.Buffer.MemoryCopy(
gc_hnd1.AddrOfPinnedObject.ToPointer,
gc_hnd2.AddrOfPinnedObject.ToPointer,
bl,bl
);
gc_hnd1.Free;
gc_hnd2.Free;
bw.Write(a);
end;
procedure BlockFileOf<T>.Write(o:ICollection<T>);
type TArr = array of T;
begin
if o is TArr(var a) then
begin
Write(a);
exit;
end;
if fi = nil then raise new FileNotAssignedException;
if str = nil then raise new FileNotOpenedException(fi.FullName);
var a := new byte[sz*o.Count];
var ptr_id := integer(@a[0]);
var gc_hnd := GCHandle.Alloc(a, GCHandleType.Pinned);
var hnd := gc_hnd.AddrOfPinnedObject;
foreach var el in o do
begin
var ptr:^T := pointer(ptr_id);
ptr^ := el;
ptr_id += sz;
System.Buffer.MemoryCopy(
@el,
hnd.ToPointer,
sz,sz
);
System.IntPtr.Add(hnd, sz);
end;
gc_hnd.Free;
bw.Write(a);
end;
procedure BlockFileOf<T>.Write(o:sequence of T) :=
if o is ICollection<T>(var c) then
Write(c) else
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);
var bl := sz*count;
var a := new byte[bl];
var gc_hnd1 := GCHandle.Alloc(o, GCHandleType.Pinned);
var gc_hnd2 := GCHandle.Alloc(a, GCHandleType.Pinned);
System.Buffer.MemoryCopy(
System.IntPtr.Add(gc_hnd1.AddrOfPinnedObject, from * sz).ToPointer,
gc_hnd2.AddrOfPinnedObject.ToPointer,
bl,bl
);
gc_hnd1.Free;
gc_hnd2.Free;
bw.Write(a);
end;
procedure BlockFileOf<T>.Write(o:ICollection<T>; from,count:integer);
type TArr = array of T;
begin
if o is TArr(var a) then
begin
Write(a, from, count);
exit;
end;
if fi = nil then raise new FileNotAssignedException;
if str = nil then raise new FileNotOpenedException(fi.FullName);
var a := new byte[sz*o.Count];
var gc_hnd := GCHandle.Alloc(a, GCHandleType.Pinned);
var hnd := gc_hnd.AddrOfPinnedObject;
foreach var el in o do
if from > 0 then from -= 1 else
if count > 0 then
begin
System.Buffer.MemoryCopy(
@el,
hnd.ToPointer,
sz,sz
);
hnd := System.IntPtr.Add(hnd, sz);
count -= 1;
end;
gc_hnd.Free;
bw.Write(a);
end;
procedure BlockFileOf<T>.Write(o:sequence of T; from,count:integer) :=
if o is ICollection<T>(var c) then
Write(c,from,count) else
Write(o.Skip(from).Take(count));
{$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;
var a := br.ReadBytes(sz);
var ptr:^T := pointer(@a[0]);
Result := ptr^;
var gc_hnd := GCHandle.Alloc(a, GCHandleType.Pinned);
System.Buffer.MemoryCopy(
gc_hnd.AddrOfPinnedObject.ToPointer,
@Result,
sz,sz
);
gc_hnd.Free;
end;
function BlockFileOf<T>.Read(c:integer):array of T;
function BlockFileOf<T>.Read(count:integer):array of T;
begin
var a := br.ReadBytes(sz*c);
Result := new T[c];
var ptr_id := integer(@a[0]);
for var i := 0 to c - 1 do
begin
var ptr:^T := pointer(ptr_id);
Result[i] := ptr^;
ptr_id += sz;
end;
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;
var a := br.ReadBytes(bl);
Result := new T[count];
var gc_hnd1 := GCHandle.Alloc(a, GCHandleType.Pinned);
var gc_hnd2 := GCHandle.Alloc(Result, GCHandleType.Pinned);
System.Buffer.MemoryCopy(
gc_hnd1.AddrOfPinnedObject.ToPointer,
gc_hnd2.AddrOfPinnedObject.ToPointer,
bl,bl
);
gc_hnd1.Free;
gc_hnd2.Free;
end;
function BlockFileOf<T>.ReadLazy(c:integer):sequence of T :=
InternalReadLazy(c,PosByte);
function BlockFileOf<T>.Read(start_elm, count:integer):array of T;
begin
Pos := start_elm;
Result := Read(count);
end;
function BlockFileOf<T>.InternalReadLazy(c:integer; start_pos:int64):sequence of T;
begin
PosByte := start_pos;
loop c do
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;
for var i := 0 to c-1 do
begin
PosByte := start_pos + i*sz;
yield Read;
end;
end;
function BlockFileOf<T>.ToSeqBlocks(blocks_size:integer):sequence of array of T;
begin
var c := blocks_size div sz;
var i := 0;
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;
end;
end;
function BlockFileOf<T>.ToSeq:sequence of T;
begin
var i := 0;
while not EOF do
begin
Pos := i;
yield Read;
i += 1;
end;
end;
{$endregion Read}