home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / database / mail20.ark / MAIL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-09-25  |  4.1 KB  |  140 lines
  1. program mail ;
  2.  
  3.   { RELIANCE MAILING LIST, Version 2.0.
  4.  
  5.     Copyright (c) 1986 William Meacham, All Rights Reserved
  6.  
  7.     William Meacham
  8.     1004 Elm Street
  9.     Austin, Tx  78703
  10.  
  11.     Revised:  3/7/86 }
  12.  
  13. { ----------------------------------------------------------- }
  14.  
  15. {$C-,V-}
  16.  
  17. const copyright : string[69] =
  18.    'RELIANCE MAILING LIST VERSION 2.0 COPYRIGHT (c) 1986 WILLIAM MEACHAM' ;
  19.     version = 2.0 ;
  20.  
  21.   { TURBO ACCESS constants }
  22.     MaxDataRecSize = 216 ;
  23.     MaxKeyLen      = 15 ;
  24.     PageSize       = 24 ;
  25.     Order          = 12 ;
  26.     PageStackSize  = 8 ;
  27.     MaxHeight      = 5 ;
  28.  
  29. {$i a:access.box }
  30. {$i a:getkey.box }
  31. {$i a:addkey.box }
  32. {$i a:delkey.box }
  33. {$i a:io20.inc }
  34. {$i maildate.inc }
  35. {$i mailglob.inc }
  36.  
  37. { ------------------------------------------------------------------------ }
  38. {                      functions and procedures                            }
  39. { ------------------------------------------------------------------------ }
  40.  
  41. function exists (filename : str14) : boolean ;
  42.   { test to see if file exists }
  43. var
  44.     infile : file ;
  45. begin
  46.     assign (infile,filename) ;
  47.     {$i-} reset(infile) {$i+} ;
  48.     exists := (ioresult = 0) ;
  49.     close (infile)
  50. end ; { function exists }
  51.  
  52. {------------------------------------------------------------- }
  53.  
  54. function files_exist : boolean ;
  55. begin
  56.     files_exist := exists(scr_fname) and exists(mf_fname)
  57.                and exists(ix1_fname) and exists(ix2_fname)
  58. end ;  { function files_exist }
  59.  
  60. { ----------------------------------------------------------- }
  61.  
  62. {$i mroot1.inc -- miscellaneous }
  63.  
  64. { ----------------------------------------------------------- }
  65.  
  66. {$i mroot2.inc -- clear_master, display_master, input_master, select }
  67.  
  68. { ---- BEGIN OVERLAY AREA 000 ------------------------------- }
  69.  
  70. {$i minit.inc -- procs initialize and reset_disks }
  71.  
  72. { ----------------------------------------------------------- }
  73.  
  74. {$i msetup.inc -- proc set_up }
  75.  
  76. { ----------------------------------------------------------- }
  77.  
  78. {$i maddetc.inc -- procs add, change, record_contributions, delete_name }
  79.  
  80. { ----------------------------------------------------------- }
  81.  
  82. {$i mprint.inc -- proc print (list, labels) }
  83.  
  84. { ----------------------------------------------------------- }
  85.  
  86. {$i mailmerg.inc -- proc make_mailmerge_file }
  87.  
  88. { ---- END OVERLAY AREA 000 --------------------------------- }
  89.  
  90. begin { -------- MAIN -------- }
  91.  
  92.     initialize ;
  93.     repeat
  94.         paint_screen (0) ;     { Main menu }
  95.         repeat
  96.             fld := 1 ;
  97.             choice := 0 ;
  98.             read_int (choice,1, 31,21) ;
  99.             if fld < 1 then choice := 0 ;
  100.             if fld = maxint then
  101.               begin
  102.                 write_str (' ',31,21) ;
  103.                 write_str ('QUIT NOW? (Y/N)',26,23) ;
  104.                 read_yn (OK,42,23) ; { global, in Access.box }
  105.                 if not OK then
  106.                   begin
  107.                     fld := 1 ;
  108.                     choice := 0 ;
  109.                     clrline (26,23)
  110.                   end
  111.               end ;
  112.         until (choice in [1 .. 9]) or (fld = maxint) ;
  113.         if not (fld = maxint) then
  114.             case choice of
  115.               1: set_up ;
  116.               2: do_name (add) ;
  117.               3: do_name (change) ;
  118.               4: do_name (del_rec) ;
  119.               5: do_name (contribution) ;
  120.               6: print (list) ;
  121.               7: print (labels) ;
  122.               8: make_mailmerge_file ;
  123.               9: reset_disks
  124.             else
  125.                  beep
  126.             end  { case }
  127.     until fld = maxint ;
  128.     clrscr ;
  129.     write_str ('Thank you for using the Reliance Mailing List program.',12,5) ;
  130.     write_str ('Don''t forget to back up your data files! ',12,7) ;
  131.     write_str ('If you find this program useful, please make a contribution',12,10) ;
  132.     write_str ('to encourage me to write some more.  Thanks!',12,11) ;
  133.     write_str ('Bill Meacham',34,13) ;
  134.     write_str ('1004 Elm Street',32,14) ;
  135.     write_str ('Austin, Tx  78703',31,15)
  136. end.
  137.            end
  138.               end ;
  139.         until (choice in [1 .. 9]) or (fld = maxint) ;
  140.         if not (fld = maxi