Einzelnen Beitrag anzeigen

Benutzerbild von Sir Rufo
Sir Rufo

Registriert seit: 5. Jan 2005
Ort: Stadthagen
9.454 Beiträge
 
Delphi 10 Seattle Enterprise
 
#1

TMemFileStream - Ein Zwitter aus TMemoryStream und TFileStream

  Alt 1. Nov 2010, 17:16
Falls es mal jemand gebrauchen kann hier mein TMemFileStream
Delphi-Quellcode:
unit uMemFileStream;

{ **********************************************************************
  Version: 1.1 (2010-11-01)
  ----------------------------------------------------------------------
  TMemFileStream

  Dieser Stream verbindet die Vorteile von TMemoryStream und TFileStream
  Wenn der SystemCache ausreicht befindet sich der Stream komplett im
  RAM und auch nur dort. Erst wenn der SystemCache die Datenmenge nicht
  mehr speichern kann, wird der Stream physisch auf den Datenträger
  geschrieben.

  Der Vorteil bei der Verwendung, man braucht sich nicht mehr darum zu
  kümmern, ob das System genug RAM-Speicher für den Stream zur Verfügung
  hat. Die Grenze ist hierbei der freie Speicher auf dem Datenträger.

  Ein System mit ausreichend Hauptspeicher profitiert automatisch, weil
  der Stream auch direkt im Hauptspeicher verwaltet wird.

  Ein TMemoryStream ist allerdings deutlich performanter im Zugriff
  Ein TFileStream ist langsamer im Zugriff

  Hierbei handelt es sich um eine umgeschriebene TFileStream-Klasse

  ----------------------------------------------------------------------
  Historie:
  2010-11-01 Version 1.1
  + SetSize
  2010-11-01 Version 1.0

  ********************************************************************** }


interface

uses
  Classes;

type
  { TMemFileStream class }

  TMemFileStream = class( THandleStream )
  strict private
    FFileName : string;

  public
    procedure SetSize( const NewSize : Int64 ); override;
    procedure SaveToStream( const Stream : TStream );
    procedure SaveToFile( const FileName : string );
    procedure LoadFromStream( const Stream : TStream );
    procedure LoadFromFile( const FileName : string );
    constructor Create( const APath : string = '' );
    destructor Destroy; override;
  end;

implementation

uses
  Windows, SysUtils, RTLConsts;

const
  TEMP_FILE_PREFIX = 'mfs';

  // Ermittelt das TEMP-Verzeichnis

function GetDirTemp : string;
  var
    BufSize : Cardinal;
  begin
    SetLength( RESULT, MAX_PATH );
    BufSize := Windows.GetTempPath( Length( RESULT ), PChar( RESULT ) );
    SetLength( RESULT, BufSize );
    RESULT := ExcludeTrailingPathDelimiter( PChar( RESULT ) );
  end;

function GetTempFileName( const APath : string; const APrefix : string = TEMP_FILE_PREFIX ) : string;
  var
    NewTemp : array [ 0 .. MAX_PATH ] of Char;
    MPath : string;
  begin
    FillChar( NewTemp, SizeOf( NewTemp ), #0 );
    MPath := IncludeTrailingPathDelimiter( APath );
    Windows.GetTempFileName( PChar( MPath ), PChar( Copy( APrefix, 1, 3 ) ), 0, @NewTemp );
    RESULT := NewTemp;
  end;

function FileCreateTemp( const FileName : string; Mode : LongWord; Rights : Integer ) : Integer;
  const
    ShareMode : array [ 0 .. 4 ] of LongWord = ( 0, 0, FILE_SHARE_READ, FILE_SHARE_WRITE,
      FILE_SHARE_READ or FILE_SHARE_WRITE );
  begin
    RESULT := -1;
    if ( Mode and $F0 ) <= fmShareDenyNone then
      RESULT := Integer( CreateFile( PChar( FileName ),
          // Zugriff natürlich lesend und schreibend
          GENERIC_READ or GENERIC_WRITE,
          // wie auch immer
          ShareMode[ ( Mode and $F0 ) shr 4 ],
          // keine SecurityAttributes
          nil,
          // auf jeden Fall erzeugen, auch wenn der Dateiname schon existiert
          CREATE_ALWAYS,
          // Temporäre Datei
          // Daten werden nur dann physisch auf den Datenträger geschrieben,
          // wenn der Cache nicht mehr ausreicht
          FILE_ATTRIBUTE_TEMPORARY or
          // nicht indizieren
          // die Datei verschwindet ja eh wieder und würde somit nur Zeit kosten
            FILE_ATTRIBUTE_NOT_CONTENT_INDEXED or
          // verstecken
          // braucht darum auch niemand zu sehen
            FILE_ATTRIBUTE_HIDDEN or
          // am Ende automatisch löschen
          // und damit keinen Datei-Müll zurücklassen
          // Wir sind ja saubere Schweinchen
            FILE_FLAG_DELETE_ON_CLOSE,
          // keine Template benutzen
          0 ) );
  end;

{ TMemFileStream }

constructor TMemFileStream.Create( const APath : string );
  var
    Path : string;
    AFileName : string;
  begin
    if APath = 'then
      // Temp-Pfad holen
      Path := IncludeTrailingPathDelimiter( GetDirTemp )
    else
      Path := IncludeTrailingPathDelimiter( APath );

    // eindeutigen Dateinamen für eine temp. Datei holen
    AFileName := GetTempFileName( Path );

    // temp. Datei erzeugen
    inherited Create( FileCreateTemp( AFileName, fmShareExclusive, 0 ) );
    // gab es kein Handle, dann haben wir einen Fehler
    if FHandle = INVALID_HANDLE_VALUE then
      // tue Gutes und sprich davon :D
      raise EFCreateError.CreateResFmt( @SFCreateErrorEx, [ ExpandFileName( AFileName ),
        SysErrorMessage( GetLastError ) ] );

    FFileName := AFileName;
  end;

destructor TMemFileStream.Destroy;
  begin
    if FHandle <> INVALID_HANDLE_VALUE then
      FileClose( FHandle );
    inherited Destroy;
  end;

procedure SetSize( const NewSize : Int64 );
  begin
    inherited SetSize( NewSize );
  end;

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

procedure TMemFileStream.LoadFromStream( const Stream : TStream );
  begin
    Stream.Position := 0;
    SetSize( Stream.Size );
    Position := 0;
    CopyFrom( Stream, Stream.Size );
  end;

procedure TMemFileStream.SaveToFile( const FileName : string );
  var
    Stream : TFileStream;
  begin
    Stream := TFileStream.Create( FileName, fmCreate or fmShareExclusive );
    try
      SaveToStream( Stream );
    finally
      Stream.Free;
    end;
  end;

procedure TMemFileStream.SaveToStream( const Stream : TStream );
  var
    MPosition : Int64;
  begin
    MPosition := Position;
    Position := 0;
    Stream.CopyFrom( Self, Size );
    Position := MPosition;
  end;

end.
Kaum macht man's richtig - schon funktioniert's
Zertifikat: Sir Rufo (Fingerprint: ‎ea 0a 4c 14 0d b6 3a a4 c1 c5 b9 dc 90 9d f0 e9 de 13 da 60)

Geändert von Sir Rufo ( 1. Nov 2010 um 19:25 Uhr)
  Mit Zitat antworten Zitat