+ Error detection of streams

This commit is contained in:
carl 2000-02-06 19:58:24 +00:00
parent b6d9988f22
commit e8f58e804f

View File

@ -27,9 +27,11 @@ Var
Function StrToInt(Const S : String) : Integer; Function StrToInt(Const S : String) : Integer;
Var Code : integer; Var Code : integer;
Int : integer;
begin begin
Val(S,StrToInt,Code); Val(S,int,Code);
StrToInt := int;
If Code<>0 then StrToInt:=0; If Code<>0 then StrToInt:=0;
end; end;
@ -57,7 +59,9 @@ Var S : PBufStream;
begin begin
S:=New(PBufStream,Init(ConfigFile,stCreate,255)); S:=New(PBufStream,Init(ConfigFile,stCreate,255));
GeneratecfgFile(S); GeneratecfgFile(S);
{$ifndef tp}
S^.Close; S^.Close;
{$endif}
S^.Done; S^.Done;
end; end;
@ -115,7 +119,30 @@ Var DiagS : PMemoryStream;
P : Pchar; P : Pchar;
i : longint; i : longint;
Procedure StreamErrorProcedure(Var S: TStream); FAR;
Begin
If S.Status = StError then
WriteLn('ERROR: General Access failure. Halting');
If S.Status = StInitError then
WriteLn('ERROR: Cannot Init Stream. Halting. ');
If S.Status = StReadError then
WriteLn('ERROR: Read beyond end of Stream. Halting');
If S.Status = StWriteError then
WriteLn('ERROR: Cannot expand Stream. Halting');
If S.Status = StGetError then
WriteLn('ERROR: Get of Unregistered type. Halting');
If S.Status = StPutError then
WriteLn('ERROR: Put of Unregistered type. Halting');
end;
begin begin
{$IFDEF TP}
StreamError:= @StreamErrorProcedure;
{$ELSE}
StreamError:= StreamErrorProcedure;
{$ENDIF}
ProcessOpts; ProcessOpts;
If (Length(InfileName)=0) or (Length(OutFileName)=0) Then If (Length(InfileName)=0) or (Length(OutFileName)=0) Then
Usage; Usage;
@ -144,8 +171,12 @@ begin
getmem (P,I+1); getmem (P,I+1);
DiagS^.Read(P[0],I); DiagS^.Read(P[0],I);
P[I]:=#0; P[I]:=#0;
{$ifndef tp}
Writeln (stderr,P); Writeln (stderr,P);
Flush(stderr); Flush(stderr);
{$else}
Writeln (P);
{$endif}
DiagS^.Done; DiagS^.Done;
end; end;
If Assigned(CfgS) then If Assigned(CfgS) then
@ -156,7 +187,10 @@ end.
{ {
$Log$ $Log$
Revision 1.3 2000-01-07 16:46:04 daniel Revision 1.4 2000-02-06 19:58:24 carl
+ Error detection of streams
Revision 1.3 2000/01/07 16:46:04 daniel
* copyright 2000 * copyright 2000
Revision 1.2 1999/07/08 21:17:10 michael Revision 1.2 1999/07/08 21:17:10 michael