* fixed stdinput reading under win32

This commit is contained in:
peter 2005-02-14 16:39:51 +00:00
parent f4011dabba
commit 540c2c5bea

View File

@ -15,94 +15,84 @@
unit iostream; unit iostream;
Interface interface
Uses Classes; uses Classes;
Type type
TIOSType = (iosInput,iosOutPut,iosError);
EIOStreamError = class(EStreamError);
TiosType = (iosInput,iosOutPut,iosError); TIOStream = class(THandleStream)
EIOStreamError = Class(EStreamError); private
FType,
FPos : LongInt;
zIOSType : TIOSType;
public
constructor Create(aIOSType : TiosType);
function Read(var Buffer; Count : LongInt) : Longint; override;
function Write(const Buffer; Count : LongInt) : LongInt; override;
procedure SetSize(NewSize: Longint); override;
function Seek(Offset: Longint; Origin: Word): Longint; override;
end;
TIOStream = Class(THandleStream) implementation
Private
FType,
FPos : Longint;
Public
Constructor Create(IOSType : TiosType);
Function Read(var Buffer; Count: Longint): Longint;override;
Function Write(const Buffer; Count: Longint): Longint;override;
Procedure SetSize(NewSize: Longint); override;
Function Seek(Offset: Longint; Origin: Word): Longint; override;
end;
Implementation const
Const
SReadOnlyStream = 'Cannot write to an input stream.'; SReadOnlyStream = 'Cannot write to an input stream.';
SWriteOnlyStream = 'Cannot read from an output stream.'; SWriteOnlyStream = 'Cannot read from an output stream.';
SInvalidOperation = 'Cannot perform this operation on a IOStream.'; SInvalidOperation = 'Cannot perform this operation on a IOStream.';
Constructor TIOStream.Create(IOSType : TiosType); constructor TIOStream.Create(aIOSType : TIOSType);
begin begin
{$ifdef win32} {$ifdef win32}
Case IOSType of case aIOSType of
iosOutput : FType:=Stdoutputhandle; iosInput : FType := StdInputHandle;
iosInput : FType:=Stdinputhandle; iosOutput : FType := StdOutputHandle;
iosError : FType:=StdErrorHandle; iosError : FType := StdErrorHandle;
end; end;
{$else} {$else}
FType:=Ord(IOSType); FType := Ord(aIOSType);
{$endif} {$endif}
Inherited Create(Ftype); inherited Create(FType);
zIOSType := aIOSType;
end; end;
function TIOStream.Read(var Buffer; Count : LongInt) : Longint;
Function TIOStream.Read(var Buffer; Count: Longint): Longint;
begin begin
If Ftype>0 then if (zIOSType = iosOutput) then
Raise EIOStreamError.Create(SWriteOnlyStream) raise EIOStreamError.Create(SWriteOnlyStream)
else else begin
begin result := inherited Read(Buffer,Count);
Result:=Inherited Read(Buffer,Count); inc(FPos,result);
Inc(FPos,Result); end;
end;
end; end;
function TIOStream.Write(const Buffer; Count : LongInt) : LongInt;
Function TIOStream.Write(const Buffer; Count: Longint): Longint;
begin begin
If Ftype=0 then if (zIOSType = iosInput) then
Raise EIOStreamError.Create(SReadOnlyStream) raise EIOStreamError.Create(SReadOnlyStream)
else else begin
begin result := inherited Write(Buffer,Count);
Result:=Inherited Write(Buffer,Count); inc(FPos,result);
Inc(FPos,Result); end;
end;
end; end;
procedure TIOStream.SetSize(NewSize: Longint);
Procedure TIOStream.SetSize(NewSize: Longint);
begin begin
Raise EIOStreamError.Create(SInvalidOperation); raise EIOStreamError.Create(SInvalidOperation);
end; end;
function TIOStream.Seek(Offset: Longint; Origin: Word): Longint;
Function TIOStream.Seek(Offset: Longint; Origin: Word): Longint; const
BufSize = 100;
Const BufSize = 100; var
Buf : array[1..BufSize] of Byte;
Var Buf : array[1..BufSize] of Byte;
begin begin
If (Origin=soFromCurrent) and (Offset=0) then If (Origin=soFromCurrent) and (Offset=0) then
result:=FPos; result:=FPos;
{ Try to fake seek by reading and discarding } { Try to fake seek by reading and discarding }
if (Ftype>0) or if (zIOSType = iosOutput) or
Not((Origin=soFromCurrent) and (Offset>=0) or Not((Origin=soFromCurrent) and (Offset>=0) or
((Origin=soFrombeginning) and (OffSet>=FPos))) then ((Origin=soFrombeginning) and (OffSet>=FPos))) then
Raise EIOStreamError.Create(SInvalidOperation); Raise EIOStreamError.Create(SInvalidOperation);
@ -120,7 +110,10 @@ end.
{ {
$Log$ $Log$
Revision 1.3 2002-09-07 15:15:24 peter Revision 1.4 2005-02-14 16:39:51 peter
* fixed stdinput reading under win32
Revision 1.3 2002/09/07 15:15:24 peter
* old logs removed and tabs fixed * old logs removed and tabs fixed
} }