unit SharedStream;

interface

uses
  SysUtils, Windows, Classes, Consts;

type

{ TSharedStream }

  TSharedStream = class(TStream)  { Для совместимости с TStream }
  private
    FMemory   : Pointer;    { Указатель на данные }
    FSize     : Longint;    { Реальный размер записанных данных }
    FPageSize : Longint;     { Размер выделенной "страницы" под данные }
    FPosition : Longint;     { Текущая позиция "курсора" на "странице" }
  protected
  public
    constructor Create;
    destructor  Destroy; override;
    function  Read(var Buffer; Count: Longint): Longint; override;
    function  Write(const Buffer; Count: Integer): Longint; override;
    function  Seek(Offset: Longint; Origin: Word): Longint; override;
    procedure SetSize(NewSize: Longint); override;
    procedure LoadFromStream(Stream: TStream);
    procedure LoadFromFile(const FileName: string);
    procedure SaveToStream(Stream: TStream);
    procedure SaveToFile(const FileName: string);
  public
    property  Memory: Pointer read FMemory;
  end;

const
  SwapHandle = $FFFFFFFF; { Handle файла подкачки }

implementation

resourcestring
  CouldNotMapViewOfFile = 'Could not map view of file.';

{ TSharedStream }

{
  * TSharedStream работает правильно только с файлом подкачки,
    с обычным файлом проще и надежнее работать TFileStream'ом.

  * Для тех кто знаком с File Mapping Functions'ами :
      Класс TSharedStream не может использоваться для синхронизации(разделения)
      данных среди различных процессов(программ/приложений). [пояснения в конструкторе]

  * Класс TSharedStream можно рассматривать как альтернативу
    временным файлам (т.е. как замену TFileStream).
    Преимущество :
      а. Данные никто не сможет просмотреть.
      б. Страница, зарезервированная под данные, автомотически освобождается
         после уничтожения создавшего ее TSharedStream'а.

  * Класс TSharedStream можно рассматривать как альтернативу
    TMemoryStream.
    Преимущество :
      а. Не надо опасаться нехватки памяти при большом объеме записываемых данных.
         [случай когда физически нехватает места на диске здесь не рассматривается].

  Известные проблемы:
    На данный момент таких не выявлено.
    Но есть одно НО. Я не знаю как поведет себя TSharedStream
    в результате нехватки места
      а. на диске
      б. в файле подкачки (т.е. в системе с ограниченным размером
                           файла подкачки).
}

constructor TSharedStream.Create;
const
  Sz = 1024000;     { Первоначальный размер страницы }{ взят с потолка }
var
  SHandle : THandle;
begin
  FPosition := 0;   { Позиция "курсора" }
  FSize     := 0;   { Размер данных }
  FPageSize := Sz;  { Выделенная область под данные }
  { Создаем дескриптор объекта отображения данных. //эта формулировка взята из книги
    Проще сказать - создаем страницу под данные.   //разрешите, я здесь и далее
                                                   //буду употреблять более протые
                                                   //информационные вставки.
    Все подробности по CreateFileMapping в Help'e. }
  SHandle := CreateFileMapping( SwapHandle, nil, PAGE_READWRITE, 0, Sz, nil );
  { Создаем "страницу"}
  { Handle файла подкачки }
  { Задаем размер "страницы"[Sz]. Не может быть = нулю}
  { Имя "страницы" должно быть нулевым[nil]}
      иначе Вам в последствии не удастся изменить размер "страницы".
      (Подробнее см. в TSharedStream.SetSize).
      * Для тех кто знаком с File Mapping Functions'ами :
          раз страница осталась неименованной, то Вам не удастся использовать
          ее для синхронизации(разделения) данных среди различных процессов(программ/приложений).
          [остальных недолжно волновать это отступление] }
  if SHandle = 0 then
     raise Exception.Create(CouldNotMapViewOfFile); { ошибка -
     неудалось создать объект отображения[т.е. "страница" не создана и указатель на нее = 0].
     Это может быть:
        Если Вы что-либо изменяли в конструкторе -
            a. Из-за ошибки в параметрах, передоваемых функции CreateFileMapping
            б. Если Sz <= 0
        Если Вы ничего не изменяли -
            а. То такое бывает случается после исключительных ситуаций в OS или
               некорректной работы с FileMapping'ом в Вашей или чужой программе.
               Помогает перезагрузка виндуса }

  FMemory := MapViewOfFile(SHandle, FILE_MAP_WRITE, 0, 0, Sz); { Получаем
             указатель на данные }
  if FMemory = nil then
     raise Exception.Create(CouldNotMapViewOfFile); { Виндус наверно
     может взбрыкнуться и вернуть nil, но я таких ситуаций не встречал.
     естественно если на предыдущих дейсвиях не возникало ошибок и если
     переданы корректные параметры для функции MapViewOfFile() }

  CloseHandle(SHandle);
end;

destructor TSharedStream.Destroy;
begin
  UnmapViewOfFile(FMemory); { закрываем страницу.
  если у Вас не фиксированный размер файла подкачки, то через пару
  минут вы должны увидеть уменьшение его размера. }
  inherited Destroy;
end;

function TSharedStream.Read(var Buffer; Count: Longint): Longint;
begin { Функция аналогичная TStream.Read().
        Все пояснения по работе с ней см. в help'e. }
  if Count > 0 then
  begin
    Result := FSize - FPosition;
    if Result > 0 then
    begin
      if Result > Count then Result := Count;
      Move((PChar(FMemory) + FPosition)^, Buffer, Result);
      Inc(FPosition, Result);
    end
  end else
    Result := 0
end;

function TSharedStream.Write(const Buffer; Count: Integer): Longint;
var
  I : Integer;
begin { Функция аналогичная TStream.Write().
        Все пояснения по работе с ней см. в help'e. }
  if Count > 0 then
  begin
    I := FPosition + Count;
    if FSize < I then Size := I;
    System.Move(Buffer, (PChar(FMemory) + FPosition)^, Count);
    FPosition := I;
    Result := Count;
  end else
    Result := 0
end;

function TSharedStream.Seek(Offset: Integer; Origin: Word): Longint;
begin { Функция аналогичная TStream.Seek().
        Все пояснения по работе с ней см. в help'e. }
  case Origin of
    soFromBeginning : FPosition := Offset;
    soFromCurrent   : Inc(FPosition, Offset);
    soFromEnd       : FPosition := FSize - Offset;
  end;
  if FPosition > FSize then FPosition := FSize
  else if FPosition < 0 then FPosition := 0;
  Result := FPosition;
end;

procedure TSharedStream.SetSize(NewSize: Integer);
const
  Sz = 1024000;
var
  NewSz   : Integer;
  SHandle : THandle;
  SMemory : Pointer;
begin { Функция аналогичная TStream.SetSize().
        Все пояснения по работе с ней см. в help'e. }
  inherited SetSize(NewSize);

  if NewSize > FPageSize then { Если размер необходимый для записи
  данных больше размера выделенного под "страницу", то мы должны
  увеличить размер "страницы", но... }
  begin { ...но FileMapping не поддерживает изменения размеров "страницы",
    что не очень удобно, поэтому приходится выкручиваться. }
    NewSz := NewSize + Sz; { задаем размер страницы +
                             1Meтр[чтобы уменьшить работу со страницами]. }

    { Создаем новую страницу }{ возможные ошибки создания страницы
      описаны в конструкторе TSharedStream. }
    SHandle := CreateFileMapping( SwapHandle, nil, PAGE_READWRITE, 0, NewSz, nil );
    if SHandle = 0 then
       raise Exception.Create(CouldNotMapViewOfFile);

    SMemory := MapViewOfFile(SHandle, FILE_MAP_WRITE, 0, 0, NewSz);
    if SMemory = nil then
       raise Exception.Create(CouldNotMapViewOfFile);

    CloseHandle(SHandle);

    Move(FMemory^, SMemory^, FSize); { Перемещаем данные
    из старой "страницы" в новую }

    UnmapViewOfFile(FMemory); { Закрываем старую "страницу" }

    FMemory := SMemory;

    FPageSize := NewSz;  { Запоминаем размер "страницы" }
  end;

  FSize := NewSize;   { Запоминаем размер данных }

  if FPosition > FSize then FPosition := FSize;
end;

procedure TSharedStream.LoadFromFile(const FileName: string);
var
  Stream: TFileStream;
begin
  Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  try
    LoadFromStream(Stream)
  finally
    Stream.Free
  end
end;

procedure TSharedStream.LoadFromStream(Stream: TStream);
var
  Count: Longint;
begin
  Stream.Position := 0;
  Count := Stream.Size;
  SetSize(Count);
  if Count > 0 then Stream.Read(FMemory^, Count);
end;

procedure TSharedStream.SaveToFile(const FileName: string);
var
  Stream: TFileStream;
begin
  Stream := TFileStream.Create(FileName, fmCreate);
  try
    SaveToStream(Stream)
  finally
    Stream.Free
  end
end;

procedure TSharedStream.SaveToStream(Stream: TStream);
begin
  Stream.Write(FMemory^, FSize);
end;

end.
57