home *** CD-ROM | disk | FTP | other *** search
/ C/C++ Interactive Guide / c-cplusplus-interactive-guide.iso / c_ref / csource4 / 216_01 / scanfils.for < prev    next >
Encoding:
Text File  |  1979-12-31  |  5.1 KB  |  159 lines
  1. *----------------------------------------------------------------------*
  2. *                                                                      *
  3. *                             SCANFILS                                 *
  4. *                             ~~~~~~~~                                 *
  5. *   This routine checks the date/time of files in the RAM disk, and    *
  6. *   copies back to floppy disk all files for which the date/time has   *
  7. *   been changed in dBase2. A summary report of actions is output to   *
  8. *   a text file.                                                       *
  9. *                                                                      *
  10. *----------------------------------------------------------------------*
  11.  
  12.       program scanfils
  13.       implicit integer (a-z)
  14.       character*24 cpyfmt
  15.       character*8 olname(50),nuname(50),dename(50),udname(50),
  16.      .            oldate(50),nudate(50),fname
  17.       character*6 oltime(50),nutime(50)
  18.       character*4 olextn(50),nuextn(50),deextn(50),udextn(50)
  19.       character*2 tmpfmt(12),nurch
  20.       character   tmpnam(8)
  21.       data oldir,nudir,report,savefi /2,3,4,8/
  22.       data uc,dc /0,0/
  23.       data tmpfmt /'(''','co','py',' e',':''','A8',',1','H.','A4',
  24.      .             ',''','b:',''')'/
  25.       open (6,file='prn')
  26.       open (oldir,file='e:old.dir')
  27.       open (nudir,file='e:new.dir')
  28.       open (report,file='e:report.txt',status='new')
  29.       open (savefi,file='a:savefils.bat',status='new')
  30.  
  31.    10 format(A8,1XA4,10XA8,2XA6)
  32.    20 format(' Number of files deleted: ',I2)
  33.    30 format(5XA8,1H.A4)
  34.    40 format(' Number of files added:   ',I2)
  35.    50 format(' Number of files changed: ',I2)
  36.    60 format('copy e:'A8,1H.A4,'b:')
  37.    70 format(///)
  38.  
  39. * Get past the trash --------------------------------------------------
  40.  
  41.       read  (oldir,70)
  42.       read  (nudir,70)
  43.  
  44. * Load in the old and new directories ----------------------------------
  45.  
  46.       do 100 k=1,50
  47.       read  (oldir,10,end=110) olname(k),olextn(k),oldate(k),oltime(k)
  48.       if (oltime(k) .eq. ' free ') go to 110
  49.   100 continue
  50.   110 lasol = k-1
  51.       olname(k) = '        '
  52.       olextn(k) = '    '
  53.       oldate(k) = '        '
  54.       oltime(k) = '      '
  55.       do 120 k=1,50
  56.       read  (nudir,10,end=130) nuname(k),nuextn(k),nudate(k),nutime(k)
  57.       if (nutime(k) .eq. ' free ') go to 130
  58.   120 continue
  59.   130 lasnu = k-1
  60.       nuname(k) = '        '
  61.       nuextn(k) = '    '
  62.       nudate(k) = '        '
  63.       nutime(k) = '      '
  64.  
  65. * Match-up file names -------------------------------------------------
  66.  
  67.       do 250 o=1,lasol
  68.  
  69.         do 200 n=1,lasnu
  70.           if (olname(o) .eq. nuname(n) .and. olextn(o) .eq. nuextn(n))
  71.      .                                                         go to 210
  72.   200   continue
  73.         go to 240
  74.  
  75. * We have matchup! Check to see if date/time has been changed, ---------
  76.  
  77.   210   if (oldate(o) .eq. nudate(n) .and. oltime(o) .eq. nutime(n))
  78.      .                                                         go to 220
  79.  
  80. * and, if so, save the filename and write its name to savefils.bat.
  81.  
  82.         uc = uc + 1
  83.         udname(uc) = nuname(n)
  84.         udextn(uc) = nuextn(n)
  85.  
  86. * Before writing to savefils, however, got to squeeze out spaces
  87.  
  88.       write (fname,'(A8)') nuname(n)
  89.       read  (fname,'(8A1)') (tmpnam(j),j=1,8)
  90.         do 211 k=1,8
  91.         if (tmpnam(k) .eq. ' ') go to 213
  92.   211   continue
  93.   213 length = k-1
  94.       write (nurch,'(''A'',I1)') length
  95.       read  (nurch,'(A2)') tmpfmt(6)
  96.       write (cpyfmt,'(12A2)') tmpfmt
  97.       write (savefi,cpyfmt) nuname(n),nuextn(n)
  98.  
  99. * Pack nudir arrays ------------------------
  100.  
  101.   220   do 230 k=n,lasnu
  102.         m = k+1
  103.         nuname(k) = nuname(m)
  104.         nuextn(k) = nuextn(m)
  105.         nudate(k) = nudate(m)
  106.         nutime(k) = nutime(m)
  107.   230   continue
  108.  
  109.         lasnu = lasnu-1
  110.         go to 250
  111.  
  112. * Save list of deleted files. ----------------
  113.  
  114.   240   dc = dc+1
  115.         dename(dc) = olname(o)
  116.         deextn(dc) = olextn(o)
  117.   250 continue
  118.  
  119. * WRAP-UP --------------------------------------------------------------
  120. * Check to see if any files were created in ram disk, and if so copy
  121. * them to drive b:. Since the nuname array was packed after each
  122. * match-up, it will now be empty unless a new file has been created.
  123.  
  124.       if (lasnu .eq. 0) go to 310
  125.  
  126.       do 300 k=1,lasnu
  127.       write (fname,'(A8)') nuname(k)
  128.       read  (fname,'(8A1)') (tmpnam(j),j=1,8)
  129.         do 270 i=1,8
  130.         if (tmpnam(i) .eq. ' ') go to 280
  131.   270   continue
  132.   280 length = i-1
  133.       write (nurch,'(''A'',I1)') length
  134.       read  (nurch,'(A2)') tmpfmt(6)
  135.       write (cpyfmt,'(12A2)') tmpfmt
  136.       write (savefi,cpyfmt) nuname(k),nuextn(k)
  137.   300 continue
  138.  
  139.   310 write (report,20) dc
  140.       do 320 k=1,dc
  141.       write (report,30) dename(k),deextn(k)
  142.   320 continue
  143.  
  144.       write (report,40) lasnu
  145.       do 330 k=1,lasnu
  146.       write (report,30) nuname(k), nuextn(k)
  147.   330  continue
  148.  
  149.       write (report,50) uc
  150.       do 340 k=1,uc
  151.       write (report,30) udname(k),udextn(k)
  152.   340 continue
  153.  
  154.       close (report)
  155.       close (savefi)
  156.  
  157.       stop
  158.       end
  159.