unit RySharedStream;
interface
uses
  SysUtils, Windows, Classes, RySharedMem;
{$IFDEF VER120}
{$DEFINE D5}
{$ENDIF}
{$IFDEF VER130}
{$DEFINE D5}
{$ENDIF}
{$IFDEF VER140}
{$DEFINE D6}
{$ENDIF}
type
  { TRyPageList }
  TRyPageList = class(TList)
  protected
    function Get(Index: Integer): TRySharedMem;
    procedure Put(Index: Integer; Item: TRySharedMem);
  public
    property Items[Index: Integer]: TRySharedMem read Get write Put; default;
  end;
  { TRySharedStream }
  TRySharedStream = class(TStream) { Для совместимости с TStream }
  private
    FSize: Longint; { Реальный размер записанных данных }
    FPosition: Longint;
    FPages: TRyPageList;
  protected
    function NewPage: TRySharedMem;
  public
    constructor Create;
    destructor Destroy; override;
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): 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
  end;
implementation
uses RyActiveX;
{resourcestring
  CouldNotMapViewOfFile = 'Could not map view of file.';}
{ TRySharedStream }
{
  * Класс TRySharedStream можно рассматривать как альтернативу
    временным файлам (т.е. как замену TFileStream).
    Преимущество :
      а. Данные никто не сможет просмотреть.
      б. Страницы, зарезервированные под данные, автомотически освобождаются
         после уничтожения создавшего ее ТRуShаrеdStrеаm'а.
 
  * Класс TRySharedStream можно рассматривать как альтернативу
    TMemoryStream.
    Преимущество :
      а. Не надо опасаться нехватки памяти при большом объеме записываемых данных.
         [случай когда физически нехватает места на диске здесь не рассматривается].
 
  Известные проблемы:
    На данный момент таких не выявлено.
    Но есть одно НО. Я не знаю как поведет себя TRySharedStream
    в результате нехватки места
      а. на диске
      б. в файле подкачки (т.е. в системе с ограниченным размером
                           файла подкачки).
}
const
  PageSize = 1024000; { размер страницы }
constructor TRySharedStream.Create;
begin
  FPosition := 0; { Позиция "курсора" }
  FSize := 0; { Размер данных }
  FPages := TRyPageList.Create;
  FPages.Add(NewPage);
end;
destructor TRySharedStream.Destroy;
begin
  with FPages do
    while Count > 0 do
    begin
      Items[Count - 1].Free;
      Delete(Count - 1);
    end;
  FPages.Free;
  inherited;
end;
function TRySharedStream.NewPage: TRySharedMem;
begin
  Result := TRySharedMem.Create(RyActiveX.GUIDToString(RyActiveX.GetGUID), 0,
    PageSize)
    {                                         |}
  {Я знаю что можно не именовать страницу __|}
  {но оказалось не всегда Win98 правильно создает новую}
  {неименнованную страницу. а другого способа получения}
  {уникальной строки я не знаю.                        }
  {если у кого-то будут идеи по этому поводу - милости просим.}
end;
function TRySharedStream.Read(var Buffer; Count: Longint): Longint;
var
  FPos, BPos, FPageNo: Integer;
  ACount, FCount: Longint;
  Buf: PChar;
begin
  Buf := @Buffer;
  ACount := 0;
  if Count > 0 then
  begin
    FCount := FSize - FPosition; {максимальное кол-во, которое можно прочитать}
    if FCount > 0 then
    begin
      if FCount > Count then
        FCount := Count; {если нам нужно прочитать меньше чем можем}
      ACount := FCount; {запоминаем сколько надо}
      FPageNo := FPosition div PageSize; {т.к. у нас многостраничный stream, то
      находим с какой страницы начать читать}
      BPos := 0;
      FPos := FPosition - (PageSize * FPageNo);
        {с какой позиции на странице читаем}
      while FCount > 0 do
      begin
        if FCount > (PageSize - FPos) then
          Count := PageSize - FPos
        else
          Count := FCount; {определяем
        сколько можно прочитать со страницы}
        Move(PChar(FPages.Items[FPageNo].Memory)[FPos], Buf[BPos], Count);
        {считаваем инфо. в буффер}
        Inc(FPageNo); {переходим на следующую страницу}
        Dec(FCount, Count);
        Inc(BPos, Count);
        FPos := 0;
      end;
      Inc(FPosition, ACount);
    end
  end;
  Result := ACount;
end;
function TRySharedStream.Write(const Buffer; Count: Longint): Longint;
var
  FPos, BPos, FPageNo: Integer;
  ASize, ACount, FCount: Longint;
  Buf: PChar;
begin { Функция аналогичная TStream.Write().
  Все пояснения по работе с ней см. в help'e. }
  Buf := @Buffer;
  if Count > 0 then
  begin
    ASize := FPosition + Count; {определяем сколько места нужно для данных}
    if FSize < ASize then
      Size := ASize; {если больше чем было, то увеличиваем размер стрима}
    FCount := Count; {запоминаем сколько надо записать}
    FPageNo := FPosition div PageSize;
      {определяем с какой страницы начинаем писать}
    BPos := 0;
    FPos := FPosition - (PageSize * FPageNo); {вычисляем позицию на странице}
    while FCount > 0 do {пока все не напишем ни куда не уходим}
    begin
      if FCount > (PageSize - FPos) then
        ACount := PageSize - FPos
      else
        ACount := FCount;
      Move(Buf[BPos], PChar(FPages.Items[FPageNo].Memory)[FPos], ACount);
      {пишем сколько влезает до конца страницы}
      Inc(FPageNo); {переходим на следующую страницу}
      Dec(FCount, ACount); {уменьшаем кол-во незаписанных на кол-во записанных}
      Inc(BPos, ACount);
      FPos := 0;
    end;
    FPosition := ASize;
  end;
  Result := Count;
end;
function TRySharedStream.Seek(Offset: Longint; 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 TRySharedStream.SetSize(NewSize: Longint);
var
  Sz: Longint;
begin { Функция аналогичная TStream.SetSize().
  Все пояснения по работе с ней см. в help'e. }
  inherited SetSize(NewSize);
  if NewSize > (PageSize * FPages.Count) then
    { Если размер необходимый для записи
    данных больше размера выделенного под наш stream, то мы должны
    увеличить размер stream'a}
  begin { ...но FileMapping не поддерживает изменения размеров "страницы",
    что не очень удобно, поэтому приходится выкручиваться. }
    Sz := NewSize div (PageSize * FPages.Count);
    { думаем сколько нужно досоздать страниц под данные }
    while Sz > 0 do {создаем страницы}
    begin
      FPages.Add(NewPage);
      Dec(Sz);
    end;
  end;
  FSize := NewSize; { Запоминаем размер данных }
  if FPosition > FSize then
    FPosition := FSize;
end;
procedure TRySharedStream.LoadFromFile(const FileName: string);
var
  Stream: TFileStream;
begin
  Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  try
    LoadFromStream(Stream)
  finally
    Stream.Free
  end
end;
procedure TRySharedStream.LoadFromStream(Stream: TStream);
begin
  CopyFrom(Stream, 0);
end;
procedure TRySharedStream.SaveToFile(const FileName: string);
var
  Stream: TFileStream;
begin
  Stream := TFileStream.Create(FileName, fmCreate);
  try
    SaveToStream(Stream)
  finally
    Stream.Free
  end
end;
procedure TRySharedStream.SaveToStream(Stream: TStream);
begin
  Stream.CopyFrom(Self, 0);
end;
{ TRyPageList }
function TRyPageList.Get(Index: Integer): TRySharedMem;
begin
  Result := TRySharedMem(inherited Get(Index))
end;
procedure TRyPageList.Put(Index: Integer; Item: TRySharedMem);
begin
  inherited Put(Index, Item)
end;
end.