带Cache的FileStream

当创建一个TFileStream并顺序读取的时候，如果每次读取的字节比较少时，效率是相当低的。大家可以做一个测试：

var
  aStream: TStream;
  B: Byte;
  T: TDateTime;
begin
  if not OpenDialog1.Execute then
    Exit;
  Caption := '';
  Application.ProcessMessages;
  T := Now;
  aStream := TFileStream.Create(OpenDialog1.FileName, fmOpenRead or fmShareDenyWrite);
  try
    repeat
    until aStream.Read(B, 1) = 0;
  finally
    aStream.Free;
  end;
  Caption := TimeToStr(Now - T);
end;

在我的笔记本上，处理一个3M的文件就用了12秒。

因此就有了如下的带Cache的FileStream：

 

unit BambooCachedFileStream;

interface

uses
  SysUtils,
  Classes;

type

  TBambooCachedFileStream = class(TStream)
  private
    FCacheBlockSize: Integer;
    FCacheBuffer: TBytes;
    FCacheStartPos: Int64;
    FCacheValid: Boolean;
    FChanged: Boolean;
    FFileName: string;
    FFileStream: TStream;
    FPosition: Int64;
    FSize: Int64;
    procedure Check_Cache;
    procedure Submit_Cache;
  protected
    function GetSize: Int64; override;
    procedure SetSize(const NewSize: Int64); override;
    procedure SetSize(NewSize: Longint); override;
  public
    constructor Create(const aFileName: string; aMode: Word; aCacheBlockSize_KB: Word = 64);
    destructor Destroy; override;
    function Read(var Buffer; Count: Longint): Longint; override;
    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; overload; override;
    function Seek(Offset: Longint; Origin: Word): Longint; overload; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    property FileName: string read FFileName;
  end;

implementation

{ TBambooCachedFileStream }

procedure TBambooCachedFileStream.Check_Cache;
var
  aFilePosition: Int64;
  aFileReadCount: Int64;
  aFileStreamSize: Int64;
begin
  if (not FCacheValid) or (FPosition < FCacheStartPos) or (FPosition >= FCacheStartPos + FCacheBlockSize) then
  begin
    Submit_Cache;
    aFilePosition := (FPosition div FCacheBlockSize) * FCacheBlockSize;
    aFileReadCount := FCacheBlockSize;
    aFileStreamSize := FFileStream.Size;
    if aFilePosition + aFileReadCount > aFileStreamSize then
      aFileReadCount := aFileStreamSize - aFilePosition;
    if aFileReadCount > 0 then
    begin
      FFileStream.Seek(Int64(aFilePosition), TSeekOrigin.soBeginning);
      FFileStream.Read(FCacheBuffer[0], aFileReadCount);
    end;
    FCacheValid := True;
    FCacheStartPos := aFilePosition;
  end;
end;

constructor TBambooCachedFileStream.Create(const aFileName: string; aMode: Word; aCacheBlockSize_KB: Word);
begin
  inherited Create;
  FFileName := aFileName;
  if FileExists(aFileName) then
    FFileStream := TFileStream.Create(aFileName, aMode)
  else
    FFileStream := TFileStream.Create(aFileName, fmCreate);

  FCacheStartPos := 0;
  FCacheValid := False;
  FSize := FFileStream.Size;
  FPosition := 0;
  FFileStream.Position := 0;
  if aCacheBlockSize_KB < 4 then
    aCacheBlockSize_KB := 4;
  FCacheBlockSize := aCacheBlockSize_KB * 1024;
  SetLength(FCacheBuffer, FCacheBlockSize);
end;

destructor TBambooCachedFileStream.Destroy;
begin
  Submit_Cache;
  if FFileStream.Size <> FSize then
    FFileStream.Size := FSize;
  SetLength(FCacheBuffer, 0);
  FFileStream.Free;
  inherited Destroy;
end;

function TBambooCachedFileStream.GetSize: Int64;
begin
  Result := FSize;
end;

function TBambooCachedFileStream.Read(var Buffer; Count: Integer): Longint;
var
  aReadCount: Int64;
begin
  Result := 0;
  if FPosition >= FSize then
    Exit;
  while Count > 0 do
  begin
    Check_Cache;
    aReadCount := Count;
    if FPosition + aReadCount > FSize then
      aReadCount := FSize - FPosition;
    if aReadCount <= 0 then
      Exit;
    if FPosition + aReadCount > FCacheStartPos + FCacheBlockSize then
      aReadCount := FCacheStartPos + FCacheBlockSize - FPosition;
    if aReadCount <= 0 then
      Exit;
    System.Move(FCacheBuffer[FPosition - FCacheStartPos], Buffer, aReadCount);
    FPosition := FPosition + aReadCount;
    Result := Result + aReadCount;
    Count := Count - aReadCount;
  end;
end;

function TBambooCachedFileStream.Seek(Offset: Integer; Origin: Word): Longint;
var
  aInt64: Int64;
begin
  aInt64 := Offset;
  Result := Seek(Int64(aInt64), TSeekOrigin(Origin));
end;

function TBambooCachedFileStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
begin
  case Origin of
    TSeekOrigin.soBeginning:
      FPosition := Offset;
    TSeekOrigin.soCurrent:
      FPosition := FPosition + Offset;
    TSeekOrigin.soEnd:
      FPosition := FSize + Offset;
  end;
  Result := FPosition;
end;

procedure TBambooCachedFileStream.SetSize(const NewSize: Int64);
begin
  FSize := NewSize;
end;

procedure TBambooCachedFileStream.Submit_Cache;
var
  aWriteCount: Int64;
begin
  if FChanged and FCacheValid and (FCacheStartPos < FSize) then
  begin
    aWriteCount := FCacheBlockSize;
    if FCacheStartPos + aWriteCount > FSize then
      aWriteCount := FSize - FCacheStartPos;
    if aWriteCount > 0 then
    begin
      if FFileStream.Size < FCacheStartPos + aWriteCount then
        FFileStream.Size := FCacheStartPos + aWriteCount;
      FFileStream.Seek(Int64(FCacheStartPos), TSeekOrigin.soBeginning);
      FFileStream.Write(FCacheBuffer[0], aWriteCount);
    end;
  end;
  FChanged := False;
end;

procedure TBambooCachedFileStream.SetSize(NewSize: Integer);
begin
  FSize := NewSize;
end;

function TBambooCachedFileStream.Write(const Buffer; Count: Integer): Longint;
var
  aWriteCount: Int64;
begin
  Result := 0;
  if Count <= 0 then
    Exit;
  if FSize < FPosition + Count then
    FSize := FPosition + Count;
  while Count > 0 do
  begin
    Check_Cache;
    aWriteCount := Count;
    if FPosition + aWriteCount > FCacheStartPos + FCacheBlockSize then
      aWriteCount := FCacheStartPos + FCacheBlockSize - FPosition;
    if aWriteCount <= 0 then
      Exit;
    System.Move(Buffer, FCacheBuffer[FPosition - FCacheStartPos], aWriteCount);
    FPosition := FPosition + aWriteCount;
    FChanged := True;
    Result := Result + aWriteCount;
    Count := Count - aWriteCount;
  end;
end;

end.

在我的笔记本上，使用TBambooCachedFileStream处理同一个文件只用了不到0.2秒。

大家可以测试一下其效率。