www.pudn.com > ZMODEM code.zip > SCANFILS.FOR
*----------------------------------------------------------------------*
* *
* SCANFILS *
* ~~~~~~~~ *
* This routine checks the date/time of files in the RAM disk, and *
* copies back to floppy disk all files for which the date/time has *
* been changed in dBase2. A summary report of actions is output to *
* a text file. *
* *
*----------------------------------------------------------------------*
program scanfils
implicit integer (a-z)
character*24 cpyfmt
character*8 olname(50),nuname(50),dename(50),udname(50),
. oldate(50),nudate(50),fname
character*6 oltime(50),nutime(50)
character*4 olextn(50),nuextn(50),deextn(50),udextn(50)
character*2 tmpfmt(12),nurch
character tmpnam(8)
data oldir,nudir,report,savefi /2,3,4,8/
data uc,dc /0,0/
data tmpfmt /'(''','co','py',' e',':''','A8',',1','H.','A4',
. ',''','b:',''')'/
open (6,file='prn')
open (oldir,file='e:old.dir')
open (nudir,file='e:new.dir')
open (report,file='e:report.txt',status='new')
open (savefi,file='a:savefils.bat',status='new')
10 format(A8,1XA4,10XA8,2XA6)
20 format(' Number of files deleted: ',I2)
30 format(5XA8,1H.A4)
40 format(' Number of files added: ',I2)
50 format(' Number of files changed: ',I2)
60 format('copy e:'A8,1H.A4,'b:')
70 format(///)
* Get past the trash --------------------------------------------------
read (oldir,70)
read (nudir,70)
* Load in the old and new directories ----------------------------------
do 100 k=1,50
read (oldir,10,end=110) olname(k),olextn(k),oldate(k),oltime(k)
if (oltime(k) .eq. ' free ') go to 110
100 continue
110 lasol = k-1
olname(k) = ' '
olextn(k) = ' '
oldate(k) = ' '
oltime(k) = ' '
do 120 k=1,50
read (nudir,10,end=130) nuname(k),nuextn(k),nudate(k),nutime(k)
if (nutime(k) .eq. ' free ') go to 130
120 continue
130 lasnu = k-1
nuname(k) = ' '
nuextn(k) = ' '
nudate(k) = ' '
nutime(k) = ' '
* Match-up file names -------------------------------------------------
do 250 o=1,lasol
do 200 n=1,lasnu
if (olname(o) .eq. nuname(n) .and. olextn(o) .eq. nuextn(n))
. go to 210
200 continue
go to 240
* We have matchup! Check to see if date/time has been changed, ---------
210 if (oldate(o) .eq. nudate(n) .and. oltime(o) .eq. nutime(n))
. go to 220
* and, if so, save the filename and write its name to savefils.bat.
uc = uc + 1
udname(uc) = nuname(n)
udextn(uc) = nuextn(n)
* Before writing to savefils, however, got to squeeze out spaces
write (fname,'(A8)') nuname(n)
read (fname,'(8A1)') (tmpnam(j),j=1,8)
do 211 k=1,8
if (tmpnam(k) .eq. ' ') go to 213
211 continue
213 length = k-1
write (nurch,'(''A'',I1)') length
read (nurch,'(A2)') tmpfmt(6)
write (cpyfmt,'(12A2)') tmpfmt
write (savefi,cpyfmt) nuname(n),nuextn(n)
* Pack nudir arrays ------------------------
220 do 230 k=n,lasnu
m = k+1
nuname(k) = nuname(m)
nuextn(k) = nuextn(m)
nudate(k) = nudate(m)
nutime(k) = nutime(m)
230 continue
lasnu = lasnu-1
go to 250
* Save list of deleted files. ----------------
240 dc = dc+1
dename(dc) = olname(o)
deextn(dc) = olextn(o)
250 continue
* WRAP-UP --------------------------------------------------------------
* Check to see if any files were created in ram disk, and if so copy
* them to drive b:. Since the nuname array was packed after each
* match-up, it will now be empty unless a new file has been created.
if (lasnu .eq. 0) go to 310
do 300 k=1,lasnu
write (fname,'(A8)') nuname(k)
read (fname,'(8A1)') (tmpnam(j),j=1,8)
do 270 i=1,8
if (tmpnam(i) .eq. ' ') go to 280
270 continue
280 length = i-1
write (nurch,'(''A'',I1)') length
read (nurch,'(A2)') tmpfmt(6)
write (cpyfmt,'(12A2)') tmpfmt
write (savefi,cpyfmt) nuname(k),nuextn(k)
300 continue
310 write (report,20) dc
do 320 k=1,dc
write (report,30) dename(k),deextn(k)
320 continue
write (report,40) lasnu
do 330 k=1,lasnu
write (report,30) nuname(k), nuextn(k)
330 continue
write (report,50) uc
do 340 k=1,uc
write (report,30) udname(k),udextn(k)
340 continue
close (report)
close (savefi)
stop
end