program mail_Version_3_2;


var

FLAG3  , IOErr: boolean;
KEY, ONO, CM, RE, RET, YN : char;
REC, E1L, E2L, E3L, E4L, E5L, E6L, E7L : string[60];
MAILFILE2,MAILFILE : file of string[60];
NUM, X, COPY, OPT, OPTION, POPT, NOS, RECNO : integer;

const
 A=#27;     { ESCAPE CODE  }
 B=#112;     { HIGHLIGHT ON }
 C=#113;     { HIGHLIGHT OFF}
 D=#64;     { RESETS PRINTER TO POWER UP STATE }
 E=#71;     { DOUBLESTRIKE MODE }
 F=#8;     { PAPER END DETECTION OVERRIDDEN  }
 G=#15;     { CONDENSED MODE  }
 H=#87 ;     { ENLARGED MODE   }
 I=#01;
 J=#99;     { RESETS PRINTER TO CONTINUOUS SHEET**AMSTRAD PCW8512 }
 K=#79;     { RESETS GAP LENGTH OF PAPER TO 0**AMSTRAD PCW8512}




procedure Menu;
begin
     clrscr;
     writeln('____________________MAILING_LABELS__________________');
     writeln('                                         version 3.2');
     writeln('                                         8th Jan 1987');
     writeln('                               Mailing Label Program');
     writeln; writeln; writeln; writeln; writeln; writeln; writeln; writeln;
     writeln('                                                1986');
     writeln('                                                  by');
     writeln; writeln; writeln;
     writeln('                                     J.FRANCIS & Co.');
     writeln('                                   52 Chester Square');
     writeln('                                   London,   England');
     writeln('                                   SW1W 9EA');
     writeln;
     writeln('                   ',A ,B ,'Hit > RETURN <',A ,C);
     readln(RET);
end;



procedure Dwrite;
begin
     clrscr;
     assign(MAILFILE,'MAILFILE.DAT');
     reset(MAILFILE);
     writeln(A,B,'     Please Wait while Writing to disk........',A,C);
     seek(MAILFILE,Filesize(MAILFILE));
     write(MAILFILE,E1L);
     write(MAILFILE,E2L);
     write(MAILFILE,E3L);
     write(MAILFILE,E4L);
     write(MAILFILE,E5L);
     write(MAILFILE,E6L);
     write(MAILFILE,E7L);
     close(MAILFILE);
 end;


procedure Retr;
begin
     read(MAILFILE,E1L);
     read(MAILFILE,E2L);
     read(MAILFILE,E3L);
     read(MAILFILE,E4L);
     read(MAILFILE,E5L);
     read(MAILFILE,E6L);
     read(MAILFILE,E7L);
end;


procedure Oldfile;
begin
     clrscr;
     gotoxy(10,10);
     writeln('                ',A,B,'READING DATA FROM DISC......',A,C);
     assign(MAILFILE,'MAILFILE.DAT');
     reset(MAILFILE);
     repeat
     retr;
     until eof(MAILFILE);
     close(MAILFILE);
end;


procedure Disp1;
begin
     retr;
     writeln(E1L);
end;


procedure Print;
begin
     writeln(Lst,A,F,A,J,A,K);
     writeln(Lst,E1L);
     writeln(Lst,E2L);
     writeln(Lst,E3L);
     writeln(Lst,E4L);
     writeln(Lst,E5L);
     writeln(Lst,E6L);
     writeln(Lst,E7L);
     writeln(Lst);
end;

procedure Copies;
begin
     writeln;
     write( A,B,'How many copies do you require ?'  ,A,C);Readln(Copy);
     for X:=1 to Copy do
     print;
end;


procedure Display;
begin
     clrscr;
     assign(MAILFILE,'MAILFILE.DAT');
     reset(MAILFILE);
repeat
     Disp1;
until eof(MAILFILE);
     close (MAILFILE);
     writeln;
     writeln('                ',A ,B ,'Hit CARRIAGE RETURN....',A ,C);
     readln(RET);
end;


procedure Printall;
begin
     clrscr;
     writeln('This program will print standard 102mm * 36mm labels ');
     writeln;
     writeln('The  print  out is spaced for a  printer setting  of');
     writeln('6 lines  per  inch and  10 characters per inch. This');
     writeln('is the default setting  of most dot matrix printers.');
     writeln('If  you  wish to  set the  character  spacing  for a');
     writeln('different value or for narrower labels, please leave');
     writeln('a  message  in the bulletin board to Walter  Francis');
     writeln;
     writeln('                ',A,B,'PRESS CARRIAGE RETURN TO CONTINUE ',A ,C);
     readln(RET);
     clrscr;
     gotoxy(12,20);
     writeln(A,B,  '  P R I N T I N G !!!!!!!!',A,C);
     assign(MAILFILE,'MAILFILE.DAT');
     reset(MAILFILE);
repeat
     Retr;
     writeln; writeln;
     print;
until eof(MAILFILE);
     close(MAILFILE);
end;




procedure Quit;
begin
clrscr;
     writeln;
     writeln('           Hit > RETURN < to go Menu,');
     writeln('           Hit >    Q   < to Quit to C/PM,');
     writeln;
     write(A,B,'OPTION >> ',A,C); read(kbd,RET);
end;



procedure Quit2;
begin
     clrscr;
     writeln(lst);
     writeln;
     writeln; writeln; writeln; writeln;
     writeln('              C  return to C/PM');
     writeln('      Any other key to  return to Menu');
     write(A ,B ,'OPTION >> ',A ,C); read(kbd,CM);
     CM:=upcase(CM);
     if CM = 'C' then Quit;
     if CM <> 'C' then
end;


procedure Clear;
begin
     writeln(lst,A ,D, 'Line 1. This is a ');
     writeln(lst,      'Line 2. Test to   ');
     writeln(lst,      'Line 3. Line up '  );
     writeln(lst,      'Line 4. Your paper');
     writeln(lst,      'Line 5. Ready for' );
     writeln(lst,      'Line 6. Your final');
     write(lst,        'Line 7. Printout !!');
end;



procedure Doublestrike;
begin
     clear;
     writeln(lst,A ,E );
     Quit2;
end;

procedure Condensed;
begin
     clear;
     writeln(lst,A ,G );
     Quit2;
end;


procedure Enlarged;
begin
     clear;
     writeln(lst,A ,H ,I);
     Quit2;
end;


procedure Draft;
begin
     clear;
     writeln(lst,A,D);
     Quit2;
end;


procedure Menu4;
begin
     clrscr;
     writeln;
     writeln;
     writeln;
     writeln('                         C = Clear printer buffer');
     writeln('                         X = eXit to C/PM');
     writeln('                         Q = Quit to Main Menu');
     writeln('                         B = douBlestrike');
     writeln('                         O = cOndensed');
     writeln('                         E = Enlarged');
     writeln('                         D = Draft');
     writeln;
     writeln;
     writeln;
     write(A ,B ,'OPTION >> ',A ,C); read(kbd,YN);
     YN := upcase(YN);
        if YN ='C' then Clear;
        if YN ='X' then Quit;
        if YN ='B' then Doublestrike;
        if YN ='O' then Condensed;
        if YN ='E' then Enlarged;
        if YN ='D' then Draft;
        if YN ='Q' then Quit;
end;



procedure Save;
begin
     clrscr;
     writeln(' Only Type ',A,B,'"Y"',A,C,'  to the next question if ');
     writeln('        the data is ',A,B,' CORRECT !!!!!!!',A,C);
     writeln;
     write('             ',A,B,'Save data to disk (Y/N) ?',A,C);
     writeln;writeln;
     write(A ,B ,'OPTION >> ',A ,C); read(kbd,YN);
     YN := upcase(YN);
     if YN = 'Y' then Dwrite;
     begin
     end;
end;


procedure Append;
begin
     clrscr;
     writeln('ENTER NAME AND ADDRESS, LINE BY LINE.');
     writeln('            or            ');
     writeln('TYPE ',A,B,'"END"',A,C,' in First Line  TO FINISH ENTRY');
     writeln; writeln;
     write('Enter First   Line........? '); readln(E1L);
     if (E1L = 'END') or (E1L = 'end' ) then Quit;
     if E1L <> 'END' then begin
     if E1L <> 'end' then begin
     write('Enter Second  Line........? '); readln(E2L);
     write('Enter Third   Line........? '); readln(E3L);
     write('Enter Fourth  Line........? '); readln(E4L);
     write('Enter Fifth   Line........? '); readln(E5L);
     write('Enter Sixth   Line........? '); readln(E6L);
     write('Enter Seventh Line........? '); readln(E7L);
     clrscr;
     writeln; writeln;
     writeln(A,B,'NAME AND ADDRESS IS.....',A,C);
     writeln;
     writeln(E1L);
     writeln(E2L);
     writeln(E3L);
     writeln(E4L);
     writeln(E5L);
     writeln(E6L);
     writeln(E7L);
     writeln;
     writeln(A,B,'IF  NAME  AND  ADDRESS  ARE  CORRECT  PRESS',A,C);
     writeln('                      > RETURN <   To enter ');
     readln(RET);
     save;
     end;
     end;
end;

procedure Erasure;
begin
     clrscr;
     assign(MAILFILE,'MAILFILE.DAT');
     rewrite(MAILFILE);
     close(MAILFILE);
     Append;
end;


procedure Newfile;
begin
     clrscr;
     writeln; writeln; writeln;
     writeln('NN     NN      OOOOOOO      TTTTTTTTTT     EEEEEEEE ');
     writeln('NNN    NN     OOOOOOOOO     TTTTTTTTTT     EEEEEEEE ');
     writeln('NNNN   NN     OO     OO         TT         EE       ');
     writeln('NN NN  NN     OO     OO         TT         EEEEEEEE ');
     writeln('NN  NNNNN     OO     OO         TT         EE       ');
     writeln('NN   NNNN     OOOOOOOOO         TT         EEEEEEEE ');
     writeln('NN    NNN      OOOOOOO          TT         EEEEEEEE ');
     writeln; writeln;
     writeln('THE INITIALISATION OF THE DATA FILE WILL ERASE');
     writeln('           ALL EXISTING DATA');
     writeln;
     writeln; writeln(' DO YOU WISH TO CONTINUE Y/N ?');
     write(A ,B ,'OPTION >> ',A ,C); read(kbd,YN);
     YN := upcase(YN);
     if YN = 'Y' then Erasure;
     if YN <> 'Y' then Menu;
     clrscr;
end;


procedure Menu3;
begin
     clrscr;
     writeln; writeln;
     writeln('THIS PROGRAM IS TO CREATE AND MAINTAIN A NAME AND ');
     writeln;
     writeln('ADDRESS FILE AND TO PRINT THE CONTENTS OF THE FILE');
     writeln;
     writeln('     IN A FORMAT SUITABLE FOR LABELS !   ');
     writeln; writeln; writeln; writeln; writeln;
     writeln('1. DO YOU WISH TO CREATE A NEW FILE       ?');
     writeln;
     writeln('2. DO YOU WISH TO ACCESS AN EXISTING FILE ?');
     writeln; writeln;
     writeln(A,B,'YOU MUST ANSWER AS QUESTION 1 ON YOUR FIRST ATTEMPT !!!!!',A,C);
     writeln;writeln;
     write(A ,B ,'OPTION >> ',A ,C); read(kbd,ONO);
     ONO:=upcase(ONO);
     if ONO = '1' then Newfile;
     if ONO = '2' then Oldfile;
end;


procedure IOError;
begin
    Num:=0;
    IOErr := false;
    Num := IOresult;
    IOErr := (Num <> 0);
    if IOErr then
begin
      write(chr(7));
      clrscr;
      gotoxy(10,10);
      case Num of
      $99: write(REC,'  <:::::',A,B,'I N P U T   D A T A   I S  I N C O R R E C T',A,C);
 end;
      writeln;writeln;
      writeln('          You Are Being Returned To The MAIN MENU !!!!!!!!!!!!!');
      writeln('                 Type any key to continue..........');
      read(kbd,Key);
      assign(MAILFILE,'MAIL.COM');
      execute(MAILFILE);
      end;
end;


procedure Printone;
begin
{$I-}
     assign(MAILFILE,'MAILFILE.DAT');
     reset(MAILFILE);
     clrscr;
repeat
     Disp1;
until eof(MAILFILE);
     close(MAILFILE);
     writeln; writeln;
     writeln(A ,B ,'Input FIRST LINE to Recognize:',A ,C);
     writeln;
     writeln('"FIRST LINE " data MUST be exactly as seen !!!!!');
     writeln('                   ^^^^ ');
     writeln;
     readln(REC);
     assign(MAILFILE,'MAILFILE.DAT');
     reset(MAILFILE);
repeat
IOERROR;
     read(MAILFILE,E1L);
     read(MAILFILE,E2L);
     read(MAILFILE,E3L);
     read(MAILFILE,E4L);
     read(MAILFILE,E5L);
     read(MAILFILE,E6L);
     read(MAILFILE,E7L);
 until REC =E1L;
 clrscr;
     writeln; writeln;
     writeln(A,B,'NAME AND ADDRESS SELECTED:-',A,C);
     writeln; writeln;
     writeln(E1L);
     writeln(E2L);
     writeln(E3L);
     writeln(E4L);
     writeln(E5L);
     writeln(E6L);
     writeln(E7L);
     writeln; writeln;
     writeln('ENTER OPTION REQUIRED');
     writeln;
     writeln('          1.  PRINT LABEL');
     writeln('          2.  SELECT NEW NAME');
     writeln('          3.  RETURN TO MAIN MENU');
     writeln;
     write(A ,B ,'OPTION >> ',A ,C); read(kbd,ONO);
     ONO:= upcase(ONO);
     if ONO = '1' then Copies ;
     if ONO = '2' then Printone;
     if ONO = '3' then
{$I+}
end;


procedure Wrtmail2;
begin
     write(mailfile2,E1L);
     write(mailfile2,E2L);
     write(mailfile2,E3L);
     write(mailfile2,E4L);
     write(mailfile2,E5L);
     write(mailfile2,E6L);
     write(mailfile2,E7L);
end;



procedure Remove;
begin
{$I-}
     flag3:=false;
     assign(MAILFILE,'MAILFILE.DAT');
     reset(MAILFILE);
     clrscr;
repeat
     Disp1;
until eof(MAILFILE);
     close(MAILFILE);
     writeln; writeln;
     writeln(A ,B ,'Input FIRST LINE to Recognize:',A ,C);
     writeln;
     writeln('"FIRST LINE " data MUST be exactly as seen !!!!!');
     writeln('                   ^^^^ ');
     writeln;
     readln(REC);
     assign(MAILFILE,'MAILFILE.DAT');
     reset(MAILFILE);
repeat
     IOError;
     read(MAILFILE,E1L);
     read(MAILFILE,E2L);
     read(MAILFILE,E3L);
     read(MAILFILE,E4L);
     read(MAILFILE,E5L);
     read(MAILFILE,E6L);
     read(MAILFILE,E7L);
until REC = E1L ;
     clrscr;
     writeln; writeln;
     writeln(A,B,'NAME AND ADDRESS SELECTED:-',A,C);
     writeln; writeln;
     writeln(E1L);
     writeln(E2L);
     writeln(E3L);
     writeln(E4L);
     writeln(E5L);
     writeln(E6L);
     writeln(E7L);
     close(MAILFILE);
     writeln; writeln;
     writeln('ENTER OPTION REQUIRED');
     writeln;
     writeln('          1.  DELETE RECORD THIS RECORD ?');
     writeln('          2.  RETURN TO MAIN MENU');
     writeln;
     write(A ,B ,'OPTION >> ',A ,C); read(kbd,ONO);
     ONO:= upcase(ONO);
     if ONO = '1' then flag3 := true;
     if flag3 then
begin
     assign( MAILFILE,'MAILFILE.DAT');
     reset (mailfile);
     assign(mailfile2,'mailfile.tmp');
     rewrite(mailfile2);
repeat
     read(MAILFILE,E1L);
     read(MAILFILE,E2L);
     read(MAILFILE,E3L);
     read(MAILFILE,E4L);
     read(MAILFILE,E5L);
     read(MAILFILE,E6L);
     read(MAILFILE,E7L);
    seek(mailfile2,filesize(mailfile2));
if REC <> E1L then
     Wrtmail2;
    until eof(mailfile);
close(mailfile);
close(mailfile2);
     erase(mailfile);
     rename(mailfile2,'mailfile.dat');
end;
{$I+}
end;


procedure Menu2;
begin
     clrscr;
     writeln('____________________MAILING_LABELS_________________');
     writeln('                                        version 3.2');
     writeln;
     writeln; writeln; writeln; writeln;
     writeln('DO YOU WISH TO ');
     writeln('      1.  INPUT MORE NAMES     ?     ',A ,B ,'EDITORS',A ,C);
     writeln('      2.  PRINT OUT ALL LABELS ?     Walter Francis');
     writeln('      3.  PRINT OUT ONE LABEL  ?     Jules  Francis');
     writeln('      4.  DISPLAY ALL DATA     ?');
     writeln('      5.  CHANGE FONT          ?');
     writeln('      6.  ERASE ALL DATA       ?     ',A ,B ,'PROGRAMMER',A ,C);
     writeln('      7.  EXIT TO C/PM         ?     Jules Francis');
     writeln('      8.  DELETE a RECORD      ?');
     writeln;
     writeln('                                     ',A ,B ,'ENHANCER &',A ,C);
     writeln('                                     ',A ,B ,'DEBUGGER',A ,C);
     writeln('                                     Walter Francis');
     write(A ,B ,'OPTION >> ',A ,C); read(kbd,ONO);
     ONO:=upcase(ONO);
     writeln;
     if ONO = '1' then Append;
     if ONO = '2' then Printall;
     if ONO = '3' then Printone;
     if ONO = '4' then Display;
     if ONO = '5' then Menu4;
     if ONO = '6' then Newfile;
     if ONO = '7' then Quit;
     if ONO = '8' then Remove;
end;



begin
     Menu;
     Menu3;
repeat Menu2;
until upcase(RET) in ['Q'] ;
     clrscr;
    gotoxy(1,15);
     writeln('Exiting.............................................BYE For Now Folks!.');
     writeln(lst,A,D);
end.