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.