stream.inc

将bmf在DOS下显示出来

{TMT/Turbo/Borland Pascal version}
{$IFNDEF stream}
{$DEFINE stream}
{$I SYST.INC}
type
  TStream=object
  private
    SI:dword;
    err:longint;
    opened:boolean;
    Procedure error;
  public
    Constructor init;
    Function  read(var source;count:dword):boolean; virtual;
    Function  write(var dest;count:dword):boolean; virtual;
    Procedure readOrSkip(var source;count:dword;var res:boolean);
    Procedure writeOrSkip(var dest;count:dword;var res:boolean);
    Function  position:dword; virtual;
    Procedure seek(newposition:dword); virtual;
    Function  ok:boolean;
    Procedure clear; virtual;
    Function  truncate:boolean; virtual;
    Function  isopened:boolean; virtual;
    Function  size:longint; virtual;
    Destructor done; virtual;
  end;  {TStream}

Constructor TStream.init;
begin
  clear;
end;  {TStream.init}

Procedure TStream.error;
begin
  err:=-1;
end;  {TStream.error}

Function  TStream.read(var source;count:dword):boolean;
begin
  RunError(errAbstractMethod);
end;  {TStream.read}

Function  TStream.write(var dest;count:dword):boolean;
begin
  RunError(errAbstractMethod);
end;  {TStream.write}

Procedure TStream.readOrSkip(var source;count:dword;var res:boolean);
begin
  if res then res:=read(source,count) else seek(position+count);
end;  {TStream.readOrSkip}

Procedure TStream.writeOrSkip(var dest;count:dword;var res:boolean);
begin
  if res then res:=write(dest,count) else seek(position+count);
end;  {TStream.writeOrSkip}

Function  TStream.position:dword;
begin
  result:=SI;
end;  {TStream.position}

Procedure TStream.seek(newposition:dword);
begin
  RunError(errAbstractMethod);
end;  {TStream.seek}

Function  TStream.ok:boolean;
begin
  result:=err=0;
end;  {TStream.ok}

Procedure TStream.clear;
begin
  SI:=0;
  err:=0;
  opened:=false;
end;  {TStream.clear}

Function  TStream.truncate:boolean;
begin
  RunError(errAbstractMethod);
end;  {TStream.truncate}

Function  TStream.isopened:boolean;
begin
  RunError(errAbstractMethod);
end;  {TStream.isopened}

Destructor TStream.done;
begin
end;  {TStream.done}

Function  TStream.size:longint;
begin
  RunError(errAbstractMethod);
end;  {TStream.size}

type
  TMemStream=object(TStream)
  public
    Constructor init(_SI:dword);
    Function  read(var source;count:dword):boolean; virtual;
    Function  write(var dest;count:dword):boolean; virtual;
    Procedure seek(newposition:dword); virtual;
  end;  {TMemStream}

Constructor TMemStream.init(_SI:dword);
begin
  inherited init;
  SI:=_SI;
end;  {TMemStream.init}

Function  TMemStream.read(var source;count:dword):boolean;
begin
  if (SI=0) or (@source=nil) then error;
  if ok and (count<>0) then
    move(ptr(SI)^,source,count);
end;  {TMemStream.read}

Function  TMemStream.write(var dest;count:dword):boolean;
begin
  if (SI=0) or (@dest=nil) then error;
  if ok and (count<>0) then
    move(dest,ptr(SI)^,count);
end;  {TMemStream.write}

Procedure TMemStream.seek(newposition:dword);
begin
  SI:=newposition;
end;  {TMemStream.seek}

type
  TFileStream=object(TStream)
  private
    f:file;
  public
    Constructor init(filename:string80);
    Constructor openOrCreate(filename:string80);
    Function  read(var source;count:dword):boolean; virtual;
    Function  write(var dest;count:dword):boolean; virtual;
    Function  position:dword; virtual;
    Procedure seek(newposition:dword); virtual;
    Function  ok:boolean; virtual;
    Function  isopened:boolean; virtual;
    Function  size:longint; virtual;
    Function  truncate:boolean; virtual;
    Destructor done; virtual;
  end;  {TFileStream}

Constructor TFileStream.init(filename:string80);
begin
  inherited init;
  assign(f,filename);
  FileMode:=2;
  {$IFOPT I+}
    {$I-}
    reset(f,1);
    {$I+}
  {$ELSE}
    reset(f,1);
  {$ENDIF}
  if IOResult<>0 then
    error
  else
    opened:=true;
end;  {TFileStream.init}

Constructor TFileStream.openOrCreate(filename:string80);
begin
  inherited init;
  assign(f,filename);
  FileMode:=2;
  {$IFOPT I+}
    {$I-}reset(f,1);{$I+}
  {$ELSE}
    reset(f,1);
  {$ENDIF}
  if IOResult=0 then exit;
  {$IFOPT I+}
    {$I-}rewrite(f,1);{$I+}
  {$ELSE}
    rewrite(f,1);
  {$ENDIF}
  if IOResult<>0 then error else opened:=true;
end;  {TFileStream.openOrCreate}

Function  TFileStream.read(var source;count:dword):boolean;
var check:dword;
begin
  if ok and (count<>0) then begin
    blockread(f,source,count,check);
    if check<>count then error;
  end;
  result:=ok;
end;  {TFileStream.read}

Function  TFileStream.position:dword;
begin
  if ok then result:=filepos(f)
  else result:=-1;
end;  {TFileStream.position}

Function  TFileStream.write(var dest;count:dword):boolean;
var check:dword;
begin
  if @dest=nil then error;
  if ok and (count<>0) then begin
    blockwrite(f,dest,count,check);
    if check<>count then error;
  end;
  result:=ok;
end;  {TFileStream.write}

Procedure TFileStream.seek(newposition:dword);
begin
  if ok then begin
    system.seek(f,newposition);
    if IOResult<>0 then error;
  end;
end;  {TFileStream.seek}

Function  TFileStream.ok:boolean;
begin
  result:=(err=0) and (IOResult=0);
end;  {TFileStream.ok}

Function  TFileStream.isopened;
begin
  result:=opened;
end;  {TFileStream.isopened}

Function  TFileStream.size:longint;
begin
  result:=-1;
  if opened then result:=filesize(f);
end;  {TFileStream.size}

Function  TFileStream.truncate:boolean;
begin
  if opened then system.truncate(f);
  result:=opened and (IOResult=0);
end;  {TFileStream.truncate}

Destructor TFileStream.done;
begin
  if isopened then begin
    close(f);
    if IOResult<>0 then error;
    opened:=false;
  end;
  inherited done;
end;  {TFileStream.done}

{$ENDIF}