Невозможно выделить память более 2 Гб для класса TMemoryStream даже в 64-битном режиме

#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-х бит.