Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
TSharedStream — класс упрощающий работу с файлом подкачки

Открывает программер как-то холодильник после недельной попойки, глядит, а там нечто аж позеленело от плесени:
- ShareWare, trial version... - подумал программер.


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.

Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.