source: trunk/UFileStreamEx.pas

unit UFileStreamEx;

{$mode delphi}

interface

uses
  Classes, SysUtils;

type
  { THandleStreamEx }

  THandleStreamEx = class(TStream)
  private
    FHandle: THandle;
  protected
    procedure SetSize(NewSize: Longint); override;
    procedure SetSize(const NewSize: Int64); override;
  public
    constructor Create(AHandle: THandle);
    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;
    property Handle: THandle read FHandle;
  end;

  TFileFlag = (ffDirect, ffSync);
  TFileFlags = set of TFileFlag;

  { TFileStreamEx }

  TFileStreamEx = class(THandleStreamEx)
  Private
    FFileName : String;
  public
    constructor Create(const AFileName: string; Mode: Word; Flags: TFileFlags); overload;
    constructor Create(const AFileName: string; Mode: Word; Rights: Cardinal; Flags: TFileFlags); overload;
    destructor Destroy; override;
    property FileName : String Read FFilename;
  end;


implementation

uses
  RtlConsts{$IFDEF Linux}, BaseUnix{$ENDIF};

const
{ File access modes for `open' and `fcntl'.    }
O_RDONLY  =          0;        { Open read-only.  }
O_WRONLY  =          1;        { Open write-only. }
O_RDWR    =          2;        { Open read/write. }
O_CREAT   =        $40;
O_EXCL    =        $80;
O_NOCTTY  =       $100;
O_TRUNC   =       $200;
O_APPEND  =       $400;
O_NONBLOCK =      $800;
O_NDELAY  =     O_NONBLOCK;
O_SYNC    =      $1000;
O_DIRECT  =      $4000;
O_DIRECTORY =   $10000;
O_NOFOLLOW =    $20000;


function FileOpenEx(const FileName: RawbyteString; Mode: Integer; Flags: TFileFlags): Longint;
var
  SystemFileName: RawByteString;
  LinuxFlags: Longint;
begin
  {$IFDEF Linux}
  LinuxFlags := 0;
  case (Mode and (fmOpenRead or fmOpenWrite or fmOpenReadWrite)) of
    fmOpenRead: LinuxFlags := LinuxFlags or O_RDONLY;
    fmOpenWrite: LinuxFlags := LinuxFlags or O_WRONLY;
    fmOpenReadWrite: LinuxFlags := LinuxFlags or O_RDWR;
  end;
  if ffDirect in Flags then LinuxFlags := LinuxFlags or O_DIRECT;
  if ffSync in Flags then LinuxFlags := LinuxFlags or O_SYNC;

  SystemFileName := ToSingleByteFileSystemEncodedFileName(FileName);
  repeat
    Result := fpOpen(Pointer(SystemFileName), LinuxFlags);
  until (Result <> -1) or (fpgeterrno <> ESysEINTR);

  //Result := DoFileLocking(Result, Mode);
  {$ENDIF}
end;

function FileCreateEx(const FileName: RawByteString; Flags: TFileFlags): Longint; overload;
var
  SystemFileName: RawByteString;
  LinuxFlags: Longint;
begin
  {$IFDEF Linux}
  LinuxFlags := O_RDWR or O_CREAT or O_TRUNC;
  if ffDirect in Flags then LinuxFlags := LinuxFlags or O_DIRECT;
  if ffSync in Flags then LinuxFlags := LinuxFlags or O_SYNC;
  SystemFileName := ToSingleByteFileSystemEncodedFileName(FileName);
  repeat
    Result := fpOpen(pointer(SystemFileName), LinuxFlags);
  until (Result <> -1) or (fpgeterrno <> ESysEINTR);
  {$ENDIF}
end;

function FileCreateEx(const FileName: RawByteString; Rights: Longint; Flags: TFileFlags): Longint; overload;
var
  SystemFileName: RawByteString;
  LinuxFlags: Longint;
begin
  {$IFDEF Linux}
  LinuxFlags := O_RDWR or O_CREAT or O_TRUNC;
  if ffDirect in Flags then LinuxFlags := LinuxFlags or O_DIRECT;
  if ffSync in Flags then LinuxFlags := LinuxFlags or O_SYNC;
  SystemFileName := ToSingleByteFileSystemEncodedFileName(FileName);
  repeat
    Result := fpOpen(pointer(SystemFileName), LinuxFlags, Rights);
  until (Result <> -1) or (fpgeterrno <> ESysEINTR);
  {$ENDIF}
end;

function FileCreateEx(const FileName: RawByteString; ShareMode: Longint; Rights: LongInt; Flags: TFileFlags): Longint; overload;
begin
  Result := FileCreateEx(FileName, Rights, Flags);
  //Result := DoFileLocking(Result, ShareMode);
end;

function FileReadEx(Handle: Longint; out Buffer; Count: Longint): Longint;
begin
  {$IFDEF Linux}
  repeat
    Result := fpRead(Handle, Buffer, Count);
  until (Result <> -1) or (fpgeterrno <> ESysEINTR);
  {$ENDIF}
end;

function FileWriteEx(Handle: Longint; const Buffer; Count: Longint): Longint;
begin
  {$IFDEF Linux}
  repeat
    Result := fpWrite(Handle, Buffer, Count);
  until (Result <> -1) or (fpgeterrno <> ESysEINTR);
  {$ENDIF}
end;




{ THandleStreamEx }

constructor THandleStreamEx.Create(AHandle: THandle);
begin
  inherited Create;
  FHandle := AHandle;
end;

function THandleStreamEx.Read(var Buffer; Count: Longint): Longint;
begin
  Result := FileReadEx(FHandle, Buffer, Count);
  if Result = -1 then Result := 0;
end;

function THandleStreamEx.Write(const Buffer; Count: Longint): Longint;
begin
  Result := FileWriteEx(FHandle, Buffer, Count);
  if Result = -1 then Result := 0;
end;

procedure THandleStreamEx.SetSize(NewSize: Longint);
begin
  SetSize(Int64(NewSize));
end;

procedure THandleStreamEx.SetSize(const NewSize: Int64);
begin
  FileTruncate(FHandle, NewSize);
end;

function THandleStreamEx.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
begin
  Result := FileSeek(FHandle, Offset, Ord(Origin));
end;

{ TFileStreamEx }

constructor TFileStreamEx.Create(const AFileName: string; Mode: Word; Flags: TFileFlags);
begin
  Create(AFileName, Mode, 438, Flags);
end;

constructor TFileStreamEx.Create(const AFileName: string; Mode: Word; Rights: Cardinal; Flags: TFileFlags);
begin
  FFileName := AFileName;
  if (Mode and fmCreate) > 0 then
    FHandle := FileCreateEx(AFileName, Mode, Rights, Flags)
  else
    FHandle := FileOpenEx(AFileName, Mode, Flags);

  if THandle(FHandle) = feInvalidHandle then
    if Mode = fmcreate then
      raise EFCreateError.createfmt(SFCreateError,[AFileName])
    else
      raise EFOpenError.Createfmt(SFOpenError,[AFilename]);
end;

destructor TFileStreamEx.Destroy;
begin
  FileClose(FHandle);
end;


end.