nmfifobuffer.pas

DELPHI里面一些常用的控件

                  FoundAt := InternalSearch;
                  if FoundAt > 0 then
                    begin
                      if ( subLen <= FMemorySize ) then
                        FoundAt := FMemorySize + FoundAt - A1;
                    end
                  else
                    begin
                      if SubLen <= FDiskSize then
                        begin
                          Count := 0;
                          while ( FoundAt = 0 ) and ( DiskSize > 0 ) do
                            begin
                              inc( DiskPosition, Count );
                              FDiskBuffer.Position := DiskPosition + FDiskRemovePosition;
                              Count := FDiskBuffer.Read( Buffer^, MaxBufSize );
                              if Count <= 0 then
                                break;
                              Ptr := Buffer;
                              FoundAt := InternalSearch;
                            end;
                          if FoundAt > 0 then
                            FoundAt := FMemorySize + DiskPosition + FoundAt;
                        end;
                    end;
                finally
                  FreeMem( Buffer, MaxBufSize );
                end;
              end;
          end;
        Result := FoundAt;
      end;
end;

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

  if Count > 0 then
    begin
      if IsBadReadPtr( PByteArray( Buffer ), Count ) then
        raise Exception.Create( 'Can''t read the source buffer' );

      Result := Count;
      if FMemoryAddPosition + Count > FMemoryBufferCapacity then
        Result := FMemoryBufferCapacity - FMemoryAddPosition;

      FMemoryBuffer.Position := FMemoryAddPosition;
      Result := FMemoryBuffer.Write( Buffer^, Result );
      inc( FMemorySize, Result );
      inc( FMemoryAddPosition, Result );
      inc( FBufferSize, Result );

      if Result < Count then
        begin
          if FDiskBuffer = nil then
            InitDiskBuffer;

          FDiskBuffer.Position := FDiskAddPosition;
          Result := FDiskBuffer.Write( Pointer( Longint( Buffer ) + Result )^, Count - Result );
          inc( FDiskSize, Result );
          inc( FDiskAddPosition, Result );
          inc( FBufferSize, Result );
        end;
    end;
end;

procedure TNMFifoBuffer._Init;
var
  Zero                : string;
begin
  FDiskSize := 0;                               // Current size of the disk buffer
  FDiskAddPosition := 0;                        // Current add position in disk buffer
  FDiskRemovePosition := 0;                     // Current remove position in disk buffer

  FBufferSize := 0;                             // Current size of the BufStream

  FMemoryBuffer := TMemoryStream.Create;        // Memory stream
  FMemoryBuffer.Size := FMemoryBufferCapacity;
  FMemoryBuffer.Position := FMemoryBuffer.Size;
  Zero := #0;
  FMemoryBuffer.Write( PChar( Zero )^, 1 );     // Put a zero at the end of the memory buffer
  FMemorySize := 0;                             // Current size of the memory buffer
  FMemoryAddPosition := 0;                      // Current add position in memory buffer
  FMemoryRemovePosition := 0;                   // Current remove position in memory buffer
  FMemoryLow := 0;                              // Shuffle when memory drops below this.
  FThreadRunning := False;                      // Shuffle thread is running
end;

procedure TNMFifobuffer.InitDiskBuffer;
begin
  FFilename := _CreateTemporaryFileName;        // Filename of the disk buffer
  FDiskBuffer := TFileStream.Create( FFilename, fmOpenReadWrite or fmShareExclusive ); // File stream for the disk buffer
  FDiskBuffer.Size := 1024;                     // pre-allocate a small disk file size.
  FDiskSize := 0;                               // Current size of the disk buffer
  FDiskAddPosition := 0;                        // Current add position in disk buffer
  FDiskRemovePosition := 0;                     // Current remove position in disk buffer
end;

procedure TNMFifoBuffer._SetMemoryBufferCapacity( const NewCapacity: LongInt );
begin
  if NewCapacity < FMemorysize then
    raise Exception.Create( 'Can not lower memory capacity at this time' );
  FMemoryBuffer.SetSize( NewCapacity );
  FMemoryBufferCapacity := NewCapacity;
end;

function TNMFifoBuffer._CalculateThreshold( const PercentMemory: Real ): LongInt;
const
  MinCapacity         = 64 * 1024;
var
  MS                  : TMemoryStatus;
begin
  MS.dwLength := SizeOf( TMemoryStatus );
  GlobalMemoryStatus( MS );
  Result := Trunc( MS.dwAvailPhys * PercentMemory ) - ( Trunc( MS.dwAvailPhys * PercentMemory ) mod 1024 );
  if Result < MinCapacity then
    Result := MinCapacity;
end;

function TNMFifoBuffer._CreateTemporaryFileName: string;
var
  nBufferLength       : DWORD;
  lpPathName, lpTempFileName: PChar;
begin
  Result := '';
  lpPathName := nil;
  lpTempFileName := nil;

  // first get the length of the tempory path
  nBufferLength := GetTempPath( 0, lpPathName );
  Win32Check( BOOL( nBufferLength ) );
  // Allocate a buffer of the specified length + 1
  lpPathName := AllocMem( nBufferLength );
  try
    // Get the tempory path
    Win32Check( BOOL( GetTempPath( nBufferLength, lpPathName ) ) );
    // Increase the tempory path to hold the file name also.
    lpTempFileName := AllocMem( 256 );
    try
      // Get the temporary file name
      Win32Check( BOOL( GetTempFileName( lpPathName, PChar( 'Buf' ), 0, lpTempFileName ) ) );
      // return the file name and path
      SetString( Result, lpTempFileName, StrLen( lpTempFileName ) );
      // Lastly free the buffers.
    finally
      FreeMem( lpPathName );
    end;
  finally
    FreeMem( lpTempFileName );
  end;
  if Result = '' then
    raise Exception.Create( 'Can''t create a temporary file' );
end;

procedure TNMFifoBuffer._Shuffle( Data: Pointer );
var
  tmp                 : LongInt;
  Size                : LongInt;
begin
  if FDiskBuffer <> nil then
    begin
      FDiskBuffer.Position := FDiskRemovePosition;
      if FDiskSize < FMemoryBufferCapacity then
        Size := FDiskSize
      else
        Size := FMemoryBufferCapacity;
      tmp := FDiskBuffer.Read( FMemoryBuffer.Memory^, Size );
      FMemorySize := tmp;
      FMemoryAddPosition := tmp;
      FMemoryRemovePosition := 0;

      Dec( FDiskSize, tmp );
      if FDiskSize > 0 then
        inc( FDiskRemovePosition, tmp )
      else
        begin
          FDiskAddPosition := 0;
          FDiskRemovePosition := 0;
        end;
    end;

  FThreadRunning := False;
end;

procedure TNMFifoBuffer.Clear;
begin
  while FThreadRunning do
    Sleep( 50 );

  if FDiskBuffer <> nil then
    begin
      FDiskBuffer.Free;
      DeleteFile( FFilename );
    end;

  FMemoryBuffer.Free;
  _Init;
end;

procedure TNMFifoBuffer.LoadFromStream( Stream: TStream );
var
  Count               : Longint;
begin
  Stream.Position := 0;
  Count := Stream.Size;
  if Count > 0 then
    if Count <= FMemoryBufferCapacity then
      begin
        FMemoryBuffer.LoadFromStream( Stream );
        FBufferSize := Count;

        FMemorySize := Count;
        FMemoryAddPosition := Count;
        FMemoryRemovePosition := 0;

        FDiskSize := 0;
        FDiskAddPosition := 0;
        FDiskRemovePosition := 0;
      end
    else
      begin
        if FDiskBuffer = nil then
          InitDiskBuffer;

        FDiskBuffer.CopyFrom( Stream, Count );
        FBufferSize := Count;

        FMemorySize := 0;
        FMemoryAddPosition := FMemoryBufferCapacity; // set to max so shuffle can shuffle
        FMemoryRemovePosition := FMemoryBufferCapacity; // set to max so shuffle can shuffle

        FDiskSize := Count;
        FDiskAddPosition := Count;
        FDiskRemovePosition := 0;

        FThreadRunning := True;                 // do this here so that thread initialization is counted as thread running
        ExecuteInThread( _Shuffle, nil );
      end;
end;

procedure TNMFifoBuffer.LoadFromFile( const FileName: string );
var
  Stream              : TStream;
begin
  Stream := TFileStream.Create( FileName, fmOpenRead or fmShareDenyWrite );
  try
    LoadFromStream( Stream );
  finally
    Stream.Free;
  end;
end;

end.