nmfifobuffer.pas

DELPHI里面一些常用的控件

unit NMFifoBuffer;

interface

uses
  Classes, Windows, SysUtils;

type
  TNMFifoBuffer = class( TObject )
  private
    // BufStream
    FBufferSize: LongInt;                       // Current size of the BufStream

    // Memory Buffer
    FMemoryBufferCapacity: LongInt;             // Total Capacity of the memory buffer
    FMemoryBuffer: TMemoryStream;               // Memory stream
    FMemorySize: LongInt;                       // Current size of the memory buffer
    FMemoryAddPosition: LongInt;                // Current add position in memory buffer
    FMemoryRemovePosition: LongInt;             // Current remove position in memory buffer
    FMemoryLow: LongInt;                        // Shuffle when memory drops below this.

    // Disk Buffer
    FFilename: string;                          // Filename of the disk buffer
    FDiskBuffer: TFileStream;                   // File stream for the disk buffer
    FDiskSize: LongInt;                         // Current size of the disk buffer
    FDiskAddPosition: LongInt;                  // Current add position in disk buffer
    FDiskRemovePosition: LongInt;               // Current remove position in disk buffer

    FThreadRunning: Boolean;                    // Shuffle thread is running

    function _CreateTemporaryFileName: string;

    procedure _Init;
    procedure InitDiskBuffer;
    function _CalculateThreshold( const PercentMemory: Real ): LongInt;
    procedure _Shuffle( Data: Pointer );

    procedure _SetMemoryBufferCapacity( const NewCapacity: LongInt );
  protected
    property ThreadRunning: Boolean read FThreadRunning;
  public
    constructor Create;

    destructor Destroy; override;

    procedure Clear;

    procedure LoadFromStream( Stream: TStream );
    procedure LoadFromFile( const FileName: string );

    function Append( const Buffer: Pointer; const Count: LongInt ): LongInt;
    function Remove( Buffer: Pointer; const Count: LongInt ): LongInt;
    function Peek( Buffer: Pointer; const Count: LongInt ): LongInt;
    function Search( const Substr: Pointer ): LongInt;

    property BufferSize: Longint read FBufferSize;
    property MemorySize: Longint read FMemorySize;
    property DiskSize: Longint read FDiskSize;
  published
    property MemoryBufferCapacity: Longint read FMemoryBufferCapacity write _SetMemoryBufferCapacity;
    property MemoryLow: LongInt read FMemoryLow write FMemoryLow;
  end;

implementation
uses
  PSock;

// ***************************************************************************
//TNMFifoBuffer

constructor TNMFifoBuffer.Create;
begin
  inherited Create;
  FMemoryBufferCapacity := _CalculateThreshold( 0.05 ); // Init Threshold to 5% of free memory!
  _Init;
end;

destructor TNMFifoBuffer.Destroy;
begin
  if FDiskBuffer <> nil then
    begin
      FDiskBuffer.Free;
      DeleteFile( FFilename );
    end;
  FMemoryBuffer.Free;
  inherited;
end;

// Support routines.
// ***************************************************************************

function TNMFifoBuffer.Remove( Buffer: Pointer; const Count: LongInt ): LongInt;
var
  tmp                 : LongInt;
begin
  while FThreadRunning do
    Sleep( 50 );
  Result := 0;

  if ( Count > 0 ) and ( FBufferSize > 0 ) then
    begin
      if IsBadWritePtr( PByteArray( Buffer ), Count ) then
        raise Exception.Create( 'Can''t write to the destination buffer' );

      tmp := Count;
      if FMemoryRemovePosition + Count > FMemoryBufferCapacity then
        tmp := FMemoryBufferCapacity - FMemoryRemovePosition;

      FMemorybuffer.Position := FMemoryRemovePosition;
      if tmp > 0 then
        begin
          Result := FMemorybuffer.Read( Buffer^, tmp );
          dec( FMemorySize, Result );
          inc( FMemoryRemovePosition, Result );
        end
      else
        Result := 0;

      tmp := 0;
      if FDiskBuffer <> nil then
        begin
          if Result < Count then
            begin
              FDiskBuffer.Position := FDiskRemovePosition;
              tmp := FDiskBuffer.Read( Pointer( Longint( Buffer ) + Result )^, Count - Result );
              Dec( FDiskSize, tmp );
              inc( FDiskRemovePosition, tmp );
            end;
        end;

      Result := Result + tmp;
      dec( FBufferSize, Result );

      if FMemorySize = 0 then
        begin
          FMemoryAddPosition := 0;
          FMemoryRemovePosition := 0;
          if FDiskSize > 0 then
            begin
              FThreadRunning := True;
              ExecuteInThread( _Shuffle, nil );
            end;
        end;
    end;
end;

function TNMFifoBuffer.Peek( Buffer: Pointer; const Count: LongInt ): LongInt;
var
  tmp                 : LongInt;
begin
  while FThreadRunning do
    Sleep( 50 );
  Result := 0;

  if ( Count > 0 ) and ( FBufferSize > 0 ) then
    begin
      if IsBadWritePtr( PByteArray( Buffer ), Count ) then
        raise Exception.Create( 'Can''t write to the destination buffer' );

      tmp := Count;
      if FMemoryRemovePosition + Count > FMemoryBufferCapacity then
        tmp := FMemoryBufferCapacity - FMemoryRemovePosition;

      FMemorybuffer.Position := FMemoryRemovePosition;
      Result := FMemorybuffer.Read( Buffer^, tmp );

      tmp := 0;
      if FDiskBuffer <> nil then
        begin
          if Result < Count then
            begin
              FDiskBuffer.Position := FDiskRemovePosition;
              tmp := FDiskBuffer.Read( Pointer( Longint( Buffer ) + Result )^, Count - Result );
            end;
        end;

      Result := Result + tmp;
    end;
end;

function TNMFifoBuffer.Search( const Substr: Pointer ): LongInt;
var
  Ptr, Ptr1           : PChar;
  SubLen              : LongInt;

  function InternalSearch: LongInt;
  var
    Sav1, Sav2        : PChar;
  begin
    Sav1 := Ptr;
    Sav2 := StrPos( Ptr, Ptr1 );
    Result := LongInt( Sav2 - Sav1 );
    inc( Result, SubLen );
    if Result < 0 then
      Result := 0;
  end;

const
  MaxBufSize          = $FFFF;

var
  Buffer              : PChar;
  DiskPosition, DiskSize, Count, FoundAt, A1, A2: LongInt;

begin
  Result := 0;
  SubLen := StrLen( SubStr );
  // we must have something in the buffer and
  // the search must be less or equal the buffer size.
  if ( FMemorySize > 0 ) then
    if ( SubLen > FBufferSize ) or ( SubLen > MaxBufSize ) then
      Result := -1
    else
      begin
        Ptr1 := SubStr;

        while FThreadRunning do
          Sleep( 50 );

        Ptr := Pointer( FMemoryBuffer.Memory );
        inc( Ptr, FMemoryRemovePosition );

        FoundAt := 0;

        if SubLen <= FMemorySize then
          FoundAt := InternalSearch;

        if FoundAt > FMemorySize then
          FoundAt := 0;

        if FoundAt = 0 then
          begin
            if FDiskSize > 0 then
              begin
                DiskPosition := 0;
                DiskSize := FDiskSize;
                Buffer := AllocMem( MaxBufSize );
                try
                  // take care of the possibility that the substr spans both buffers
                  if subLen = FBufferSize then  // Exact match entire buffer
                    begin
                      A1 := FMemorySize;
                      A2 := FDiskSize;
                    end
                  else if SubLen > FMemorySize then // all of memory and part of disk
                    begin
                      A1 := FMemorySize;
                      A2 := SubLen - 1;
                    end
                  else
                    begin                       // part of memory and part of disk
                      A1 := SubLen - 1;
                      A2 := SubLen - 1;
                    end;
                  move( Pointer( LongInt( FMemoryBuffer.Memory ) + FMemoryBufferCapacity - A1 )^, Buffer^, A1 );
                  FDiskBuffer.Position := DiskPosition + FDiskRemovePosition;
                  FDiskBuffer.Read( Pointer( Longint( Buffer ) + A1 )^, A2 );
                  Ptr := Buffer;