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.
|
