#delphi #потоки_данных #x64
В Delphi, в том числе в последних версиях (могу проверить только до 10.1 Berlin,
хотя негативные отзывы есть и о 10.2 Tokyo), класс TMemoryStream не может выделить
под данные более 2 Гб даже при компиляции в 64-битном режиме. Попытки записать в поток
большие объёмы приводят к ошибке "Out of memory while expanding memory stream".
Можно ли решить эту проблему без создания собственного класса, реализующего поток
в памяти?
Ответы
Ответ 1
Давайте взглянем в определение класса TMemoryStream в файле System.Classes.pas:
TMemoryStream = class(TCustomMemoryStream)
private
FCapacity: Longint;
procedure SetCapacity(NewCapacity: Longint);
protected
function Realloc(var NewCapacity: Longint): Pointer; virtual;
property Capacity: Longint read FCapacity write SetCapacity;
public
destructor Destroy; override;
procedure Clear;
procedure LoadFromStream(Stream: TStream);
procedure LoadFromFile(const FileName: string);
procedure SetSize(const NewSize: Int64); override;
procedure SetSize(NewSize: Longint); override;
function Write(const Buffer; Count: Longint): Longint; override;
function Write(const Buffer: TBytes; Offset, Count: Longint): Longint; override;
end;
Сразу отмечаем, что для адресации памяти используются переменные типа longint, что,
естественно, объясняет невозможность использования более 2 Гб. Более того, если взглянуть
на методы Read (их два) непосредственного предка TMemoryStream - TCustomMemoryStream:
function TCustomMemoryStream.Read(var Buffer; Count: Longint): Longint;
begin
if (FPosition >= 0) and (Count >= 0) then
begin
Result := FSize - FPosition;
if Result > 0 then
begin
if Result > Count then Result := Count;
Move((PByte(FMemory) + FPosition)^, Buffer, Result);
Inc(FPosition, Result);
Exit;
end;
end;
Result := 0;
end;
function TCustomMemoryStream.Read(Buffer: TBytes; Offset, Count: Longint): Longint;
begin
if (FPosition >= 0) and (Count >= 0) then
begin
Result := FSize - FPosition;
if Result > 0 then
begin
if Result > Count then Result := Count;
Move((PByte(FMemory) + FPosition)^, Buffer[Offset], Result);
Inc(FPosition, Result);
Exit;
end;
end;
Result := 0;
end;
, то заметим, что результат может быть посчитан неправильно.
Поэтому решением было: заменить тип переменных внутри TMemoryStream на NativeInt
и Int64, в том числе локальных переменных, а методы TCustomMemoryStream.Read переписать,
например, так:
function TCustomMemoryStream.Read(var Buffer; Count: Longint): Longint;
var
diff: Int64;
begin
if (FPosition >= 0) and (Count >= 0) then
begin
diff := FSize - FPosition;
if diff > 0 then
begin
if diff > Count then
Result := Count
else
Result := diff;
Move((PByte(FMemory) + FPosition)^, Buffer, Result);
Inc(FPosition, Result);
Exit;
end;
end;
Result := 0;
end;
function TCustomMemoryStream.Read(Buffer: TBytes; Offset, Count: Longint): Longint;
var
diff: Int64;
begin
if (FPosition >= 0) and (Count >= 0) then
begin
diff := FSize - FPosition;
if diff > 0 then
begin
if diff > Count then
Result := Count
else Result := diff;
Move((PByte(FMemory) + FPosition)^, Buffer[Offset], Result);
Inc(FPosition, Result);
Exit;
end;
end;
Result := 0;
end;
Это позволяет работать с объёмами памяти более 2 Гб (тестовый пример спокойно обработал
5-гигабайтный файл, полностью скопировав его в поток.
Для тех, кто захочет внести изменения у себя в System.Classes, напомню, что предварительно
необходимо сохранить резервную копию этого файла - на всякий случай :)
Update 1
Для тех, кто по какой-то причине не хочет идти по предложенным выше вариантам, могу
предложить класс TSegmentedMemoryStream - он доступен для скачивания и работает (проверено!).
Ответ 2
В текущей версии Delphi (10.2.2), класс объявлен следующим образом:
TMemoryStream = class(TCustomMemoryStream)
private
FCapacity: NativeInt;
protected
procedure SetCapacity(NewCapacity: NativeInt); virtual;
function Realloc(var NewCapacity: Longint): Pointer; virtual;
property Capacity: NativeInt read FCapacity write SetCapacity;
public
destructor Destroy; override;
procedure Clear;
procedure LoadFromStream(Stream: TStream);
procedure LoadFromFile(const FileName: string);
procedure SetSize(const NewSize: Int64); override;
procedure SetSize(NewSize: Longint); override;
function Write(const Buffer; Count: Longint): Longint; override;
function Write(const Buffer: TBytes; Offset, Count: Longint): Longint; override;
end;
Видно, что они кое-как попытались исправить проблему, но она ещё не до конца исправлена
(например, функция Realloc всё ещё завязана на LongInt).
В квалити-центре есть несколько тикетов касательно TMemoryStream:
(баг, отработан) TCustomMemoryStream and TMemoryStream don't work with very large streams
(баг, не отработан) TMemoryStream Realloc not support Int64 For greater than 2G
(новая фича, не отработан) TMemoryStream does not support large (> 2 Gb) memory allocations
Так что есть надежда, что они наконец сделают в TMemoryStream поддержку 64-х бит.
