TSharedStream — класс упрощающий работу с файлом подкачки

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
.

Другое по теме:

• Как скопировать все файлы вместе с подкаталогами
• Копирование файлов
• Удалить файл в корзину? Запросто!