The DWin Graphical User Interface Code

unit dFile;

interface

uses drvbase, Classes, oslib;

type
  TFile = class(TIO)
    constructor create; overload; override;
    constructor create(f: string); overload;
    {TIO}
    function readblock(var b: byteArray): cardinal; override;
    function writeblock(var b: byteArray): cardinal; override;
    function size: cardinal; override; {Amount of data available, in bytes}
    procedure seek(p: cardinal); override;
    function status: TIOStatus; override;
    procedure flush; override;
    destructor destroy; override;
    private
      s: TIOStatus;
      fs: TFileStream;
      fn: string;
      mutex: TMutex;
  end;

implementation

uses SysUtils;

constructor TFile.create;
begin
  s := Unsupported;
end;

constructor TFile.create(f: string);
begin
  mutex := TMutex.create;
  s := Unsupported;
  try
    fs := TFileStream.Create(f, fmOpenReadWrite);
  except on E: Exception do
    exit;
  end;
  fn := f;
  s := Ready;
end;

function TFile.readblock(var b: byteArray): cardinal;
begin
  mutex.acquire;
  try
    s := Busy;
    result := fs.Read(b.getAddrOf^, b.length);
    if result = 0 then s := NoData
      else s := Ready;
  finally
    mutex.release;
  end;
end;

function TFile.writeblock(var b: byteArray): cardinal;
begin
  mutex.acquire;
  try
    s := Busy;
    result := fs.Write(b.getAddrOf^, b.length);
    s := Ready;
  finally
    mutex.release;
  end;
end;

function TFile.size: cardinal;
begin
  mutex.acquire;
  try
    s := Busy;
    result := fs.Size;
    s := Ready;
  finally
    mutex.release;
  end;
end;

procedure TFile.seek(p: cardinal);
begin
  mutex.acquire;
  try
    s := Busy;
    fs.Seek(p, soFromCurrent);
    s := Ready;
  finally
    mutex.release;
  end;
end;

function TFile.status: TIOStatus;
begin
  mutex.acquire;
  result := s;
  mutex.release;
end;

procedure TFile.flush;
begin
  mutex.acquire;
  try
    s := Busy;
    fs.Destroy;
    fs := TFileStream.Create(fn, fmOpenReadWrite);
    s := Ready;
  finally
    mutex.release;
  end;
end;

destructor TFile.destroy;
begin
  if assigned(fs) then
    fs.Destroy;
  mutex.destroy;
end;

end.