This class allows to create a TStream descendant in Delphi that allocates memory directly using VirtualAlloc allowing the developer to control the MemoryAttributes he/she wishes to use. I wrote this class in order to use with a JIT compiler that generated code using a TStream descendant object that was being blocked by DEP. With this you can cre…

uWinVMMemoryStream.pas

unit uWinVMMemoryStream;

interface

uses
  Classes, Windows;

type
  TWinVMMemoryStream = class(TMemoryStream)
  private
    FMemAttributes: DWORD;
    function GetCapacity: Longint;
    procedure SetCapacity(const Value: Longint);
  protected
    function Realloc(var NewCapacity: Longint): Pointer; override;
  public
    constructor Create(AInitialSize: Cardinal; AInitialMemAttributes: DWORD);
    property MemAttributes: DWORD read FMemAttributes write FMemAttributes;
    property Capacity: Longint read GetCapacity write SetCapacity;
  end;

implementation

uses
  SysUtils, Consts, RTLConsts, Math;

const
  MemoryDelta = $8000; { Must be a power of 2 }

constructor TWinVMMemoryStream.Create(AInitialSize: Cardinal;
    AInitialMemAttributes: DWORD);
begin
  inherited Create;
  MemAttributes := AInitialMemAttributes;
  Size := AInitialSize;
end;

function TWinVMMemoryStream.GetCapacity: Longint;
begin
  Result := inherited Capacity;
end;

function TWinVMMemoryStream.Realloc(var NewCapacity: Longint): Pointer;
begin
  if (NewCapacity > 0) and (NewCapacity <> Size) then
    NewCapacity := (NewCapacity + (MemoryDelta - 1)) and not (MemoryDelta - 1);
  Result := Memory;
  if NewCapacity <> Capacity then
  begin
    if NewCapacity = 0 then
    begin
      VirtualFree(Memory, Capacity, MEM_DECOMMIT);
      Result := nil;
    end else
    begin
      Result := VirtualAlloc(nil, NewCapacity, MEM_COMMIT, MemAttributes);
      if Capacity > 0 then
        begin
          move(Memory^, Result^, Min(Capacity, NewCapacity));
          VirtualFree(Memory, Capacity, MEM_DECOMMIT);
        end;
      if Result = nil then raise EStreamError.Create(SMemoryStreamError);
    end;
  end;
end;

procedure TWinVMMemoryStream.SetCapacity(const Value: Longint);
begin
  inherited Capacity := Value;  
end;

end.