home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / DATABASE / MAIL20.ARK / MINIT.INC < prev    next >
Text File  |  1986-09-25  |  8KB  |  234 lines
  1. { File = MINIT.INC -- Include file for Reliance Mailing List
  2.     Copyright (c) 1986 William Meacham, All Rights Reserved
  3.     Revised: 3/9/86 }
  4.  
  5. { ----------------------------------------------------------- }
  6.  
  7. overlay procedure reset_disks ;
  8.   var
  9.     ch : char ;
  10.   begin
  11.     clrscr ;
  12.     write_str ('CHANGE DATA DISKETTE',30,2) ;
  13.     write_str ('Put in the new data diskette,',25,5) ;
  14.     write_str ('THEN press the space-bar . . . ',25,6) ;
  15.     repeat
  16.         read(kbd,ch)
  17.     until ch in [' ',#$1B] ;
  18.     if ch = ' ' then
  19.       begin
  20. { ******** COMMENT OUT THE NEXT LINE FOR MS/PC-DOS ******** }
  21.         bdos($0D) ;
  22. { ******** INCLUDE THE PREVIOUS LINE FOR CP/M ************* }
  23.         if not files_exist then
  24.           begin
  25.             show_msg ('DATA FILES NOT FOUND') ;
  26.             halt
  27.           end ;
  28.         read_scr
  29.       end ;
  30.     fld := 1
  31.   end ; { proc reset_disks }
  32.  
  33. { ----------------------------------------------------------- }
  34.  
  35. overlay procedure initialize ;
  36.   { Do initialization housekeeping when program starts }
  37.     var
  38.         n   : integer ;
  39.         yes : boolean ;
  40.  
  41.   { + + + + + + + + + + + + + + + + + + + + }
  42.  
  43. procedure create_files ;
  44.   { This is called if files are not found on the selected drive.
  45.     It creates the four files and initializes the SCR. }
  46.  
  47.     procedure bomb (filename : str14) ;
  48.       begin
  49.         show_msg (concat('CANNOT CREATE ',filename,'!')) ;
  50.         halt
  51.       end ;
  52.  
  53.     var
  54.         i,
  55.         result  : integer ;
  56.  
  57.     begin
  58.         write_str ('CREATING FILES -- PLEASE WAIT', 21,24) ;
  59.  
  60.         with scr do                         { initialize SCR }
  61.           begin
  62.             num_k := 0 ;
  63.             max_rec := 0 ;
  64.             num_recs := 0 ;
  65.             prt_init := chr(15) ; { for Epson & compatible printers }
  66.             prt_rset := chr(18) ; { " }
  67.             for i := 2 to 4 do
  68.               begin
  69.                 prt_init[i] := chr(0) ;
  70.                 prt_rset[i] := chr(0)
  71.               end ;
  72.             for i := 1 to 8 do
  73.                 cat_name[i] := ''
  74.           end ; { with }
  75.  
  76. { ******** COMMENT OUT THE NEXT LINE FOR MS/PC-DOS ******** }
  77.         bdos($0D) ;
  78. { ******** INCLUDE THE PREVIOUS LINE FOR CP/M ************* }
  79.  
  80.         {$i-} rewrite(scr_file) ; {$i+}      { create files }
  81.         result := ioresult ;
  82.         if not (result = 0) then
  83.           begin
  84.             write_str('IORESULT = ',16,20) ;
  85.             write    (result) ;
  86.             bomb(scr_fname)
  87.           end
  88.         else
  89.           begin
  90.             write(scr_file,scr) ;
  91.             close(scr_file)
  92.           end ;
  93.  
  94.         makefile (mf_file,mf_fname,sizeof(master)) ;
  95.         if not OK then bomb (mf_fname) ;
  96.         makeindex (ix1_file,ix1_fname,sizeof(key1),dups_ok) ;
  97.         if not OK then bomb (ix1_fname) ;
  98.         makeindex (ix2_file,ix2_fname,sizeof(key2),dups_ok) ;
  99.         if not OK then bomb (ix2_fname) ;
  100.  
  101.         clear_master ;                       { the following kludge is }
  102.         master.last_name := 'ZZZZZ' ;        { necessary per Borland }
  103.         master.zip := '999999999' ;
  104.         addrec (mf_file,rec_num,master) ;
  105.         deleterec (mf_file,rec_num) ;
  106.         close_database    
  107.     end ; { --- Procedure create_files --- }
  108.  
  109.   { + + + + + + + + + + + + + + + + + + + + }
  110.  
  111.     begin  { proc initialize }
  112.                   { Display cover screen }
  113.         clrscr ;
  114.         write_str ('RELIANCE SOFTWARE SERVICES',26,4) ;
  115.         write_str ('--------------------',29,7) ;
  116.         write_str ('      RELIANCE',29,9) ;
  117.         write_str ('    MAILING LIST',29,10) ;
  118.         write_str ('    Version 2.0',29,12) ;
  119.         write_str ('--------------------',29,14) ;
  120.         write_str ('    Reliance Software Services',22,18) ;
  121.         write_str ('1004 Elm Street, Austin, Tx  78703',22,19) ;
  122.         write_str ('Copyright (c) 1986, Wm Meacham',24,21) ;
  123.         fld := 1 ;
  124.         hard_pause ;
  125.         if fld = maxint then halt ;
  126.  
  127.         initindex ;
  128.         clrscr ;
  129.         write_str ('Please enter today''s date:',16,5) ;
  130.         write_str ('On which drive do you keep your data files?',16,7) ;
  131.         cur_proc_dt := null_date ;
  132.         drive := '' ;
  133.         scr.ID := '' ;
  134.         fld := 1 ;
  135.         repeat
  136.             case fld of
  137.              1: begin                                { get current date }
  138.                   read_date (cur_proc_dt,43,5) ;
  139.                   if fld = maxint then halt ;
  140.                   if equal_date (cur_proc_dt,null_date) then
  141.                     begin
  142.                       beep ;
  143.                       fld := 1
  144.                     end
  145.                   else if fld > 2 then
  146.                       fld := 2
  147.                 end ; { 1 }
  148.              2: begin                                { get data file drive }
  149.                   read_str (drive,1,60,7) ;
  150.                   drive[1] := upcase(drive[1]) ;
  151.                   write_str (drive,60,7) ;
  152.                   if fld = maxint then halt ;
  153.                   if (fld > 2) then
  154.                     begin
  155.                       if length(drive) < 1 then
  156.                           fld := 2
  157.                       else if not (drive[1] in ['A'..'P']) then
  158.                         begin
  159.                           drive := '' ;
  160.                           fld := 2
  161.                         end
  162.                       else { drive spec ok }
  163.                         begin
  164.                           n := pos(':',scr_fname) ;
  165.                           if not(n = 0) then
  166.                               delete (scr_fname,1,n) ;
  167.                           n := pos(':',mf_fname) ;
  168.                           if not(n = 0) then
  169.                               delete (mf_fname,1,n) ;
  170.                           n := pos(':',ix1_fname) ;
  171.                           if not(n = 0) then
  172.                               delete (ix1_fname,1,n) ;
  173.                           n := pos(':',ix2_fname) ;
  174.                           if not(n = 0) then
  175.                               delete (ix2_fname,1,n) ;
  176.  
  177.                           scr_fname := concat (drive,':',scr_fname) ;
  178.                           mf_fname  := concat (drive,':',mf_fname) ;
  179.                           ix1_fname := concat (drive,':',ix1_fname) ;
  180.                           ix2_fname := concat (drive,':',ix2_fname) ;
  181.  
  182.                           assign (scr_file,scr_fname)
  183.                         end { else drive spec ok }
  184.                     end ; { if fld > 2 }
  185.                   if fld > 3 then fld := 3
  186.                 end ; { 2 }
  187.              3: if files_exist then
  188.                     fld := 5
  189.                 else
  190.                   begin
  191.                     yes := false ;
  192.                     write_str('DATA FILES DO NOT NOT EXIST ON DRIVE ',16,9) ;
  193.                     write    (drive) ;
  194.                     beep ;
  195.                     write_str('Do you wish to create them? (Y/N)',16,10) ;
  196.                     read_bool(yes,50,10) ;
  197.                     if fld < 3 then
  198.                       begin
  199.                         clrline (16,9) ;
  200.                         clrline (16,10)
  201.                       end
  202.                     else if (not yes) or (fld = maxint) then
  203.                         halt
  204.                     else
  205.                         fld := 4
  206.                   end ; { else, not files_exist }
  207.              4: begin
  208.                   write_str ('Please enter a descriptive ID for these data files:',16,12) ;
  209.                   read_str (scr.ID,30,16,13) ;
  210.                   if fld < 4 then
  211.                     begin
  212.                       clrline (16,12) ;
  213.                       clrline (16,13) ;
  214.                       fld := 3
  215.                     end
  216.                   else if fld = maxint then
  217.                       halt
  218.                   else
  219.                       create_files
  220.                 end { 4 }
  221.             end ; { case }
  222.             if fld = maxint then halt
  223.             else if fld < 1 then fld := 1
  224.         until fld > 4 ;
  225.         read_scr
  226.  
  227.     end ; { --- Procedure initialize --- }
  228.  
  229. {---- EOF FILE MINIT.INC ------------------------------------- }
  230. 
  231.                       end
  232.                     else if (not yes) or (fld = maxint) then
  233.                         halt
  234.