Type
FileNameType
= String[80];
Var
InputFileName
: FileNameType;
InputFileRecCtr
: Integer;
CarriageCntlChar
: Char;
CopiesRequested
: Integer;
AbendFlag
: Boolean;
CurrentCopyNumber
: Integer;
CarriageCntlError
: Boolean;
CarriageCntlString
: String;
{$I CRTPROC}
Procedure TalkToUser;
{*****************************************************************
*
100 TALK TO USER
*
*****************************************************************}
Begin {TalkToUser}
ClrScr;
WriteLn;
WriteLn;
CRT_TAB (15);
WriteLn ('IBM
CCTL PRINTING PROGRAM');
WriteLn;
WriteLn;
WriteLn ('This
program will accept a file name from you and will');
WriteLn ('print
the file on the printer. This file MUST have an');
WriteLn ('IBM
carriage control character in the first byte of');
WriteLn ('each
record, or the program will just produce an error');
WriteLn ('message
and abend.');
WriteLn;
WriteLn ('The
program can be stopped at any time by pressing the');
WriteLn ('control
and C keys simultaneously....');
WriteLn;
End {TalkToUser};
Procedure GetUserInput (var InputFileName
: FileNameType;
var CopiesRequested : Integer);
{*********************************************************************
*
200 GET USER INPUT
*
*********************************************************************}
Begin {GetUserInput}
WriteLn ('Please
enter the name of the input file in the form');
WriteLn (' "X:\PATH\FILENAME.TYP"
');
ReadLn (InputFileName);
WriteLn;
WriteLn ('How
many copies would you like to print? ');
ReadLn (CopiesRequested);
If CopiesRequested
= 0 then
Begin
WriteLn ('Invalid input, assuming 1 copy');
CopiesRequested := 1
End;
If CopiesRequested
> 50 then
WriteLn ('That is a high number, but I am your willing slave');
End {GetUserInput};
Procedure ProcessInputFile (var InputFileName
: FileNameType;
var InputFileRecCtr : Integer;
var CarriageCntlChar : Char;
var AbendFlag : Boolean;
var CarriageCntlError : Boolean);
{*******************************************************************
*
300 PROCESS INPUT FILE
*
*******************************************************************}
Var
InputBuffer
: String[133];
InputFile
: Text;
FileError
: Boolean;
CarriageCntlString
: String;
ValidCarriageCntl
: Boolean;
CarriageCntlByte
: String[1];
Procedure InterpretCarriageCntl (var
CarriageCntlString : String;
var CarriageCntlChar : Char;
var AbendFlag : Boolean;
var CarriageCntlError : Boolean);
{*****************************************************************
*
600 INTERPRET CARRIAGE CONTROL
*
*****************************************************************}
Begin {InterpretCarriageCntl}
ValidCarriageCntl
:= False;
CarriageCntlByte
:= '$';
If Length(CarriageCntlString)
= 1 then
CarriageCntlByte := Copy (CarriageCntlString,1,1);
If CarriageCntlByte
= '1' Then
Begin
Write (Lst, #12);
ValidCarriageCntl := True;
End;
If CarriageCntlByte
= '+' Then
Begin
Write (Lst, #13);
ValidCarriageCntl := True;
End;
If CarriageCntlByte
= ' ' Then
Begin
Write (Lst, #10, #13);
ValidCarriageCntl := True;
End;
If CarriageCntlByte
= '-' Then
Begin
Write (Lst, #10, #10, #13);
ValidCarriageCntl := True;
End;
If CarriageCntlByte
= '0' Then
Begin
Write (Lst, #10, #10, #10, #13);
ValidCarriageCntl := True;
End;
If not ValidCarriageCntl
then
Begin
Writeln ('Invalid carriage control character!');
Writeln ('Carriage control = ', CarriageCntlString);
CarriageCntlError := True;
AbendFlag := True
End;
End {InterpretCarriageCntl};
{*******************************************************************
* 300 PROCESS INPUT
FILE main body
*
*******************************************************************}
{$I-}
Begin {ProcessInputFile}
Assign (InputFile,
InputFileName);
FileError := False;
CarriageCntlError
:= False;
AbendFlag := False;
InputFileRecCtr
:= 0;
Reset (InputFile);
If IOResult >
0 Then
FileError := True;
If not FileError
then
Begin
Writeln (Lst, #12);
While not EOF(InputFile) and
not AbendFlag do
Begin
ReadLn(InputFile,InputBuffer);
InputFileRecCtr := InputFileRecCtr + 1;
CarriageCntlString := Copy (InputBuffer,1,1);
InterpretCarriageCntl (CarriageCntlString,
CarriageCntlChar,
AbendFlag,
CarriageCntlError);
If not AbendFlag then
begin
Delete (InputBuffer,1,1);
Write (Lst, InputBuffer);
end;
End;
End;
If FileError then
Begin
Writeln ('abending on file error');
AbendFlag := True
End;
End;{ProcessInputFile}
{$I+}
Procedure Abend (var InputFileRecCtr
: Integer;
CarriageCntlError : Boolean);
{*********************************************************************
* 800 ABEND
*
*********************************************************************}
Begin {abend}
Writeln ('Program is abending');
If CarriageCntlError then
Begin
WriteLn ('On an invalid input carriage control byte');
WriteLn ('In record number ', InputFileRecCtr);
End;
End {abend};
Procedure GracefulShutdown (var InputFileRecCtr
: Integer;
CopiesRequested : Integer);
{********************************************************************
*
900 GRACEFUL SHUTDOWN
*
********************************************************************}
Begin {gracefulShutdown}
WriteLn;
WriteLn ('Program is ending normally...');
WriteLn ('Number of copies printed
= ', CopiesRequested);
WriteLn ('Number of input records
= ', InputFileRecCtr);
WriteLn;
End {GracefulShutdown};
{***************************************************************************
* PROGRAM
main body
*
***************************************************************************}
Begin {main program}
TalkToUser;
GetUserInput (InputFileName, CopiesRequested);
CurrentCopyNumber := 0;
While CurrentCopyNumber < CopiesRequested do
Begin
CurrentCopyNumber
:= CurrentCopyNumber + 1;
WriteLn ('Starting
copy number ', CurrentCopyNumber);
ProcessInputFile
(InputFileName, InputFileRecCtr,
CarriageCntlChar, AbendFlag, CarriageCntlError);
End;
If AbendFlag then
Abend (InputFileRecCtr, CarriageCntlError)
Else
GracefulShutdown (InputFileRecCtr, CopiesRequested);
End.