Буферы для потоков
Материал из DRKB
Буферы для потоков[править | править код]
Кэширование файлов в Windows весьма эффективно, особенно в Vista и выше. TFileStream использует системные функции ReadFile() и WriteFile() и в большинстве случаев этого вполне достаточно. Быстрее только отображение файла в память (Memory Mapped File).
Однако, есть случаи, когда TFileStream тормозит. Это когда вы читаете или пишете данные маленькими кусочками, много раз вызывая функции чтения-записи. Например, читаете из файла по одному байту.
В этом случае поможет отображение файла в память. Но можно просто читать больше данных в буфер памяти, сразу несколько килобайт. И в дальнейшем читать не с диска, а из буфера. Это хорошо работает при последовательном доступе к файлу.
unit BufferedFileStream;
interface
uses
SysUtils, Math, Classes, Windows;
type
TBaseCachedFileStream = class(TStream)
private
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
protected
FHandle: THandle;
FOwnsHandle: Boolean;
FCache: PByte;
FCacheSize: Integer;
FPosition: Int64;//the current position in the file (relative to the beginning of the file)
FCacheStart: Int64;//the postion in the file of the start of the cache (relative to the beginning of the file)
FCacheEnd: Int64;//the postion in the file of the end of the cache (relative to the beginning of the file)
FFileName: string;
FLastError: DWORD;
procedure HandleError(const Msg: string);
procedure RaiseSystemError(const Msg: string; LastError: DWORD); overload;
procedure RaiseSystemError(const Msg: string); overload;
procedure RaiseSystemErrorFmt(const Msg: string; const Args: array of const);
function CreateHandle(FlagsAndAttributes: DWORD): THandle; virtual; abstract;
function GetFileSize: Int64; virtual;
procedure SetSize(NewSize: Longint); override;
procedure SetSize(const NewSize: Int64); override;
function FileRead(var Buffer; Count: Longword): Integer;
function FileWrite(const Buffer; Count: Longword): Integer;
function FileSeek(const Offset: Int64; Origin: TSeekOrigin): Int64;
public
constructor Create(const FileName: string); overload;
constructor Create(const FileName: string; CacheSize: Integer); overload;
constructor Create(const FileName: string; CacheSize: Integer; Handle: THandle); overload; virtual;
destructor Destroy; override;
property CacheSize: Integer read FCacheSize;
function Read(var Buffer; Count: Longint): Longint; override;
function Write(const Buffer; Count: Longint): Longint; override;
function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
end;
TBaseCachedFileStreamClass = class of TBaseCachedFileStream;
IDisableStreamReadCache = interface
['{0B6D0004-88D1-42D5-BC0F-447911C0FC21}']
procedure DisableStreamReadCache;
procedure EnableStreamReadCache;
end;
TReadOnlyCachedFileStream = class(TBaseCachedFileStream, IDisableStreamReadCache)
(* This class works by filling the cache each time a call to Read is made and
FPosition is outside the existing cache. By filling the cache we mean
reading from the file into the temporary cache. Calls to Read when
FPosition is in the existing cache are then dealt with by filling the
buffer with bytes from the cache.
*)
private
FUseAlignedCache: Boolean;
FViewStart: Int64;
FViewLength: Int64;
FDisableStreamReadCacheRefCount: Integer;
procedure DisableStreamReadCache;
procedure EnableStreamReadCache;
procedure FlushCache;
protected
function CreateHandle(FlagsAndAttributes: DWORD): THandle; override;
function GetFileSize: Int64; override;
public
constructor Create(const FileName: string; CacheSize: Integer; Handle: THandle); overload; override;
property UseAlignedCache: Boolean read FUseAlignedCache write FUseAlignedCache;
function Read(var Buffer; Count: Longint): Longint; override;
procedure SetViewWindow(const ViewStart, ViewLength: Int64);
end;
TWriteCachedFileStream = class(TBaseCachedFileStream, IDisableStreamReadCache)
(* This class works by caching calls to Write. By this we mean temporarily
storing the bytes to be written in the cache. As each call to Write is
processed the cache grows. The cache is written to file when:
1. A call to Write is made when the cache is full.
2. A call to Write is made and FPosition is outside the cache (this
must be as a result of a call to Seek).
3. The class is destroyed.
Note that data can be read from these streams but the reading is not
cached and in fact a read operation will flush the cache before
attempting to read the data.
*)
private
FFileSize: Int64;
FReadStream: TReadOnlyCachedFileStream;
FReadStreamCacheSize: Integer;
FReadStreamUseAlignedCache: Boolean;
procedure DisableStreamReadCache;
procedure EnableStreamReadCache;
procedure CreateReadStream;
procedure FlushCache;
protected
function CreateHandle(FlagsAndAttributes: DWORD): THandle; override;
function GetFileSize: Int64; override;
public
constructor Create(const FileName: string; CacheSize, ReadStreamCacheSize: Integer; ReadStreamUseAlignedCache: Boolean); overload;
destructor Destroy; override;
function Read(var Buffer; Count: Longint): Longint; override;
function Write(const Buffer; Count: Longint): Longint; override;
end;
implementation
function GetFileSizeEx(hFile: THandle; var FileSize: Int64): BOOL; stdcall; external kernel32;
function SetFilePointerEx(hFile: THandle; DistanceToMove: Int64; lpNewFilePointer: PInt64; dwMoveMethod: DWORD): BOOL; stdcall; external kernel32;
{ TBaseCachedFileStream }
constructor TBaseCachedFileStream.Create(const FileName: string);
begin
Create(FileName, 0);
end;
constructor TBaseCachedFileStream.Create(const FileName: string; CacheSize: Integer);
begin
Create(FileName, CacheSize, 0);
end;
constructor TBaseCachedFileStream.Create(const FileName: string; CacheSize: Integer; Handle: THandle);
const
DefaultCacheSize = 16 * 1024;
// 16kb - this was chosen empirically - don't make it too large otherwise the progress report is 'jerky'
begin
inherited Create;
FFileName := FileName;
FOwnsHandle := Handle=0;
if FOwnsHandle then
FHandle := CreateHandle(FILE_ATTRIBUTE_NORMAL)
else
FHandle := Handle;
FCacheSize := CacheSize;
if FCacheSize <= 0 then
FCacheSize := DefaultCacheSize;
GetMem(FCache, FCacheSize);
end;
destructor TBaseCachedFileStream.Destroy;
begin
FreeMem(FCache);
if FOwnsHandle and (FHandle <> 0) then
CloseHandle(FHandle);
inherited;
end;
function TBaseCachedFileStream.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
if GetInterface(IID, Obj) then
Result := S_OK
else
Result := E_NOINTERFACE;
end;
function TBaseCachedFileStream._AddRef: Integer;
begin
Result := -1;
end;
function TBaseCachedFileStream._Release: Integer;
begin
Result := -1;
end;
procedure TBaseCachedFileStream.HandleError(const Msg: string);
begin
if FLastError <> 0 then
RaiseSystemError(Msg, FLastError);
end;
procedure TBaseCachedFileStream.RaiseSystemError(const Msg: string; LastError: DWORD);
begin
raise EStreamError.Create(Trim(Msg + ' ') + SysErrorMessage(LastError));
end;
procedure TBaseCachedFileStream.RaiseSystemError(const Msg: string);
begin
RaiseSystemError(Msg, GetLastError);
end;
procedure TBaseCachedFileStream.RaiseSystemErrorFmt(const Msg: string; const Args: array of const);
var
LastError: DWORD;
begin
LastError := GetLastError; // must call GetLastError before Format
RaiseSystemError(Format(Msg, Args), LastError);
end;
function TBaseCachedFileStream.GetFileSize: Int64;
begin
if not GetFileSizeEx(FHandle, Result) then
begin
RaiseSystemErrorFmt('GetFileSizeEx failed for %s.', [FFileName]);
end;
end;
procedure TBaseCachedFileStream.SetSize(NewSize: Longint);
begin
SetSize(Int64(NewSize));
end;
procedure TBaseCachedFileStream.SetSize(const NewSize: Int64);
begin
Seek(NewSize, soBeginning);
if not Windows.SetEndOfFile(FHandle) then
RaiseSystemErrorFmt('SetEndOfFile for %s.', [FFileName]);
end;
function TBaseCachedFileStream.FileRead(var Buffer; Count: Longword): Integer;
begin
if Windows.ReadFile(FHandle, Buffer, Count, LongWord(Result), nil) then
FLastError := 0
else
begin
FLastError := GetLastError;
Result := -1;
end;
end;
function TBaseCachedFileStream.FileWrite(const Buffer; Count: Longword): Integer;
begin
if Windows.WriteFile(FHandle, Buffer, Count, LongWord(Result), nil) then
FLastError := 0
else
begin
FLastError := GetLastError;
Result := -1;
end;
end;
function TBaseCachedFileStream.FileSeek(const Offset: Int64; Origin: TSeekOrigin): Int64;
begin
if not SetFilePointerEx(FHandle, Offset, @Result, ord(Origin)) then
RaiseSystemErrorFmt('SetFilePointerEx failed for %s.', [FFileName]);
end;
function TBaseCachedFileStream.Read(var Buffer; Count: Integer): Longint;
begin
raise EAssertionFailed.Create('Cannot read from this stream');
end;
function TBaseCachedFileStream.Write(const Buffer; Count: Integer): Longint;
begin
raise EAssertionFailed.Create('Cannot write to this stream');
end;
// Set FPosition to the value specified - if this has implications for the
// cache then overriden Write and Read methods must deal with those.
function TBaseCachedFileStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
begin
case Origin of
soBeginning:
FPosition := Offset;
soEnd:
FPosition := GetFileSize+Offset;
soCurrent:
Inc(FPosition, Offset);
end;
Result := FPosition;
end;
{ TReadOnlyCachedFileStream }
constructor TReadOnlyCachedFileStream.Create(const FileName: string; CacheSize: Integer; Handle: THandle);
begin
inherited;
SetViewWindow(0, inherited GetFileSize);
end;
function TReadOnlyCachedFileStream.CreateHandle(FlagsAndAttributes: DWORD): THandle;
begin
Result := Windows.CreateFile(
PChar(FFileName),
GENERIC_READ,
FILE_SHARE_READ,
nil,
OPEN_EXISTING,
FlagsAndAttributes,
0
);
if Result = INVALID_HANDLE_VALUE then
begin
RaiseSystemErrorFmt('Cannot open %s.', [FFileName]);
end;
end;
procedure TReadOnlyCachedFileStream.DisableStreamReadCache;
begin
Inc(FDisableStreamReadCacheRefCount);
end;
procedure TReadOnlyCachedFileStream.EnableStreamReadCache;
begin
Dec(FDisableStreamReadCacheRefCount);
end;
procedure TReadOnlyCachedFileStream.FlushCache;
begin
FCacheStart := 0;
FCacheEnd := 0;
end;
function TReadOnlyCachedFileStream.GetFileSize: Int64;
begin
Result := FViewLength;
end;
procedure TReadOnlyCachedFileStream.SetViewWindow(const ViewStart, ViewLength: Int64);
begin
if ViewStart < 0 then
raise EAssertionFailed.Create('Invalid view window');
if (ViewStart+ViewLength) > inherited GetFileSize then
raise EAssertionFailed.Create('Invalid view window');
FViewStart := ViewStart;
FViewLength := ViewLength;
FPosition := 0;
FCacheStart := 0;
FCacheEnd := 0;
end;
function TReadOnlyCachedFileStream.Read(var Buffer; Count: Longint): Longint;
var
NumOfBytesToCopy, NumOfBytesLeft, NumOfBytesRead: Longint;
CachePtr, BufferPtr: PByte;
begin
if FDisableStreamReadCacheRefCount > 0 then
begin
FileSeek(FPosition+FViewStart, soBeginning);
Result := FileRead(Buffer, Count);
if Result = -1 then
begin
Result := 0; // contract is to return number of bytes that were read
end;
Inc(FPosition, Result);
end
else
begin
Result := 0;
NumOfBytesLeft := Count;
BufferPtr := @Buffer;
while NumOfBytesLeft > 0 do
begin
if (FPosition < FCacheStart) or (FPosition >= FCacheEnd) then
begin
// the current position is not available in the cache so we need to re-fill the cache
FCacheStart := FPosition;
if UseAlignedCache then
begin
FCacheStart := FCacheStart - (FCacheStart mod CacheSize);
end;
FileSeek(FCacheStart + FViewStart, soBeginning);
NumOfBytesRead := FileRead(FCache^, CacheSize);
if NumOfBytesRead = -1 then
begin
exit;
end;
Assert(NumOfBytesRead >= 0);
FCacheEnd := FCacheStart + NumOfBytesRead;
if NumOfBytesRead = 0 then
begin
FLastError := ERROR_HANDLE_EOF; // must be at the end of the file
break;
end;
end;
// read from cache to Buffer
NumOfBytesToCopy := Min(FCacheEnd - FPosition, NumOfBytesLeft);
CachePtr := FCache;
Inc(CachePtr, FPosition - FCacheStart);
Move(CachePtr^, BufferPtr^, NumOfBytesToCopy);
Inc(Result, NumOfBytesToCopy);
Inc(FPosition, NumOfBytesToCopy);
Inc(BufferPtr, NumOfBytesToCopy);
Dec(NumOfBytesLeft, NumOfBytesToCopy);
end;
end;
end;
{ TWriteCachedFileStream }
constructor TWriteCachedFileStream.Create(const FileName: string; CacheSize, ReadStreamCacheSize: Integer;
ReadStreamUseAlignedCache: Boolean);
begin
inherited Create(FileName, CacheSize);
FReadStreamCacheSize := ReadStreamCacheSize;
FReadStreamUseAlignedCache := ReadStreamUseAlignedCache;
end;
destructor TWriteCachedFileStream.Destroy;
begin
FlushCache; // make sure that the final calls to Write get recorded in the file
FreeAndNil(FReadStream);
inherited;
end;
function TWriteCachedFileStream.CreateHandle(FlagsAndAttributes: DWORD): THandle;
begin
Result := Windows.CreateFile(
PChar(FFileName),
GENERIC_READ or GENERIC_WRITE,
0,
nil,
CREATE_ALWAYS,
FlagsAndAttributes,
0
);
if Result = INVALID_HANDLE_VALUE then
RaiseSystemErrorFmt('Cannot create %s.', [FFileName]);
end;
procedure TWriteCachedFileStream.DisableStreamReadCache;
begin
CreateReadStream;
FReadStream.DisableStreamReadCache;
end;
procedure TWriteCachedFileStream.EnableStreamReadCache;
begin
Assert(Assigned(FReadStream));
FReadStream.EnableStreamReadCache;
end;
function TWriteCachedFileStream.GetFileSize: Int64;
begin
Result := FFileSize;
end;
procedure TWriteCachedFileStream.CreateReadStream;
begin
if not Assigned(FReadStream) then
begin
FReadStream := TReadOnlyCachedFileStream.Create(FFileName, FReadStreamCacheSize, FHandle);
FReadStream.UseAlignedCache := FReadStreamUseAlignedCache;
end;
end;
procedure TWriteCachedFileStream.FlushCache;
var
NumOfBytesToWrite: Longint;
begin
if Assigned(FCache) then
begin
NumOfBytesToWrite := FCacheEnd - FCacheStart;
if NumOfBytesToWrite > 0 then
begin
FileSeek(FCacheStart, soBeginning);
if FileWrite(FCache^, NumOfBytesToWrite) <> NumOfBytesToWrite then
RaiseSystemErrorFmt('FileWrite failed for %s.', [FFileName]);
if Assigned(FReadStream) then
FReadStream.FlushCache;
end;
FCacheStart := FPosition;
FCacheEnd := FPosition;
end;
end;
function TWriteCachedFileStream.Read(var Buffer; Count: Integer): Longint;
begin
FlushCache;
CreateReadStream;
Assert(FReadStream.FViewStart = 0);
if FReadStream.FViewLength <> FFileSize then
FReadStream.SetViewWindow(0, FFileSize);
FReadStream.Position := FPosition;
Result := FReadStream.Read(Buffer, Count);
Inc(FPosition, Result);
end;
function TWriteCachedFileStream.Write(const Buffer; Count: Longint): Longint;
var
NumOfBytesToCopy, NumOfBytesLeft: Longint;
CachePtr, BufferPtr: PByte;
begin
Result := 0;
NumOfBytesLeft := Count;
BufferPtr := @Buffer;
while NumOfBytesLeft > 0 do
begin
if ((FPosition<FCacheStart) or (FPosition>FCacheEnd)) // the current position is outside the cache
or (FPosition-FCacheStart = FCacheSize) // the cache is full
then
begin
FlushCache;
Assert(FCacheStart = FPosition);
end;
// write from Buffer to the cache
NumOfBytesToCopy := Min(FCacheSize - (FPosition - FCacheStart), NumOfBytesLeft);
CachePtr := FCache;
Inc(CachePtr, FPosition - FCacheStart);
Move(BufferPtr^, CachePtr^, NumOfBytesToCopy);
Inc(Result, NumOfBytesToCopy);
Inc(FPosition, NumOfBytesToCopy);
FCacheEnd := Max(FCacheEnd, FPosition);
Inc(BufferPtr, NumOfBytesToCopy);
Dec(NumOfBytesLeft, NumOfBytesToCopy);
end;
FFileSize := Max(FFileSize, FPosition);
end;
end.
Source: https://stackoverflow.com/questions/5639531/buffered-files-for-faster-disk-access
Author: David Heffernan
См.также[править | править код]
ID: 03133