home *** CD-ROM | disk | FTP | other *** search
- {$R-} {Range checking off}
- {$B-} {Boolean complete evaluation off}
- {$S-} {Stack checking off}
- {$N-} {No numeric coprocessor}
- {$I-} {IO Checking Off}
- {$D-}
- {$T-}
-
- Unit ErrProcs;
- Interface
- {JW Sparks, last modified 06/30/88}
-
- uses Crt, Colors;
-
- Type
- ErrorByteSet = Set of Byte;
- Var
- IOErr : Boolean;
- ErrorMessage : String;
- SelectedErrCodes : ErrorByteSet;
- ErrorNumber : Integer;
-
- Procedure DisplayErrorMessages(ErrNum: Integer; SelectedErrCodes : ErrorByteSet);
-
- Procedure IOCheck(var ErrorNumber : Integer; SelectedErrCodes : ErrorByteSet);
-
- {-----}
-
- Implementation
-
- {***}
-
- Procedure DisplayErrorMessages(ErrNum: Integer; SelectedErrCodes : ErrorByteSet);
- begin
- if not (ErrNum in SelectedErrCodes) then exit;
-
- case ErrNum of
- {Dos Errors}
- 0 : ErrorMessage := 'Input/Output Operation performed normally';
- 2 : ErrorMessage := 'File not Found';
- 3 : ErrorMessage := 'Path not Found';
- 4 : ErrorMessage := 'Too Many Open Files';
- 5 : ErrorMessage := 'Access Denied';
- 6 : ErrorMessage := 'Invalid Handle';
- 8 : ErrorMessage := 'Not Enough Memory';
- 10 : ErrorMessage := 'Invalid Environment';
- 11 : ErrorMessage := 'Invalid Format';
- 15 : ErrorMessage := 'Invalid Drive Number';
- 18 : ErrorMessage := 'No More Files';
-
- {I/O Errors}
- 100 : ErrorMessage := 'Disk Read Error';
- 101 : ErrorMessage := 'Disk Write Error';
- 150 : ErrorMessage := 'Disk is Write Protected';
- 152 : ErrorMessage := 'Drive is Not Ready';
-
- {User defined Errors}
- 200 : ErrorMessage := 'Not Enough Space on Destination Drive';
- 210 : ErrorMessage := 'File Copy Aborted';
- 211 : ErrorMessage := 'File Compare Aborted';
- else begin
- Str(ErrNum:3, ErrorMessage);
- ErrorMessage := 'Unknown I/O error: ' + ErrorMessage;
- end;
- end; {Case}
- TextColor(Warning);
- WriteLn(ErrorMessage);
- TextColor(Foreground);
- end; {DisplayErrorMessages}
-
- {***}
-
- procedure IOCheck(var ErrorNumber : Integer; SelectedErrCodes : ErrorByteSet);
- {Stores IOresult in ErrorNumber and
- Sets IOErr to TRUE if ErrorNumber in SelectedErrCodes}
- begin
- ErrorNumber := IOresult;
- IOErr := (ErrorNumber in SelectedErrCodes);
- DisplayErrorMessages(ErrorNumber, SelectedErrCodes);
- end; {IOCheck}
-
- {***}
- end.