c c EMAIL.FOR c c author: Russell C. Zaccari, Jr. c Primerica c MS: BSP03C c 300 St Paul Place c Baltimore, MD 21202 c c purpose: This program totals the number of allin1 documents for a given C user. c c format: email username [/FULL /MATCH /EXTRA /BRIEF] c c flags are mutually exclusive c c full gives detailed information c match gives you brief information beginning with your pattern c (i.e. email */match will give all users; c email z*/match gives you all users beginning c with z) c extra gives you all document names, folders, numbers, etc... c brief is default and gives a short summary of information c c full looks like this: c NAME EMAIL WPS S2020 Dist Other Archv TOTAL c ALLIN1 c CREATED 0 0 0 0 0 0 0 c READ 0 0 0 0 0 0 0 c SENT 19 0 0 0 0 0 19 c WASTEBASKET 2 0 0 0 0 0 2 c FILED 7 0 0 0 2 0 9 c TOTAL 28 0 0 0 2 0 30 c c brief looks like this: c NAME EMAIL WPS S2020 Dist Other Archv TOTAL c ALLIN1 28 0 0 0 2 0 30 C c c Due to our legal department's requirements I must include the c following disclaimer. Because of this I must recommend that you c examine the program's source code and compile and link each on your c own. Therefore I have included everything that you will need for c each of these utilities. c c These programs are provided AS IS. Primerica makes no statements c or promises regarding the use or operations of these programs. c There is no promised or intended warranty for any loss caused c either directly or indirectly by any of these programs. c c Summary: If you use it and lose it, don't call us. c c For you information, most of these utilities use read-only shared c access to your files. Many ignore locks from other programs. c PROGRAM EMAIL IMPLICIT NONE INCLUDE 'PROFILE_REC_v23.INC' !oa$data:profile.dat record definition INCLUDE 'docdb_REC.INC' !document database record format INTEGER*4 NAME_LEN, !returned form sys$idtoasc 1 str$trim,str$upcase, ! trim trailing blanks routine 1 STATUS, ! return status 1 Lib$get_foreign, Lib$stop INTEGER*2 DIR_SIZ, 1 email_count(6), 1 wps_count(6), 1 s2020_count(6), 1 dist_count(6), 1 other_count(6), 1 arch_count(6), 1 total(6), 1 i INTEGER*2 qual_pos !store the location of '/' character*80 inline character*12 user1 CHARACTER*80 DOCDB_FILENAME logical extra, 1 full, 1 match, 1 first_time External Ignore_locks !rms hack to allow reading locked !records first_time = .true. C ******************* O P E N F I L E S **************** OPEN (useropen=ignore_locks, 1 UNIT=10, 1 err=7000, 1 FORM='UNFORMATTED', 1 STATUS='OLD', 1 ACCESS='KEYED', 1 shared, 1 readonly, 1 FILE='oa$data:profile.dat') C ****************** M A I N L O O P ************************ status = lib$get_foreign(inline) if (.not. status) call lib$stop(%val(status)) if (inline(:12) .eq. ' ') then write (6,110) READ (5,120,end=9000) inline endif STATUS = STR$UPCASE(inline,inline) qual_pos = index(inline,'/') full = .false. match = .false. extra = .false. if (qual_pos .eq. 0) then user1 = inline(1:12) else user1 = inline(1:qual_pos-1) if (inline(qual_pos+1:qual_pos+4) .eq. 'FULL') then full = .true. else if(inline(qual_pos+1:qual_pos+5) .eq. 'MATCH') then match = .true. else if(inline(qual_pos+1:qual_pos+5) .eq. 'EXTRA') then full = .true. extra = .true. else if(inline(qual_pos+1:qual_pos+5) .ne. 'BRIEF') then write (6,204) endif endif 10 CONTINUe C ********* read a profile record *********** if (match) then if (first_time) then write (6, 130) if (user1(:1) .eq. '*') then READ (UNIT=10,ERR=6000) profile else READ (UNIT=10,KEY=USER1,ERR=6000) profile endif first_time = .false. else READ (UNIT=10,ERR=6000) profile endif else READ (UNIT=10,KEY=USER1,ERR=6000) profile endif if (extra) then write (6, 133) 'DOCDB Dump for: ', profile.vms_usr else if (.not. match) then write (6, 130) endif do i=1,6 email_count(i) = 0 wps_count(i) = 0 s2020_count(i) = 0 dist_count(i) = 0 other_count(i) = 0 arch_count(i) = 0 total(i) = 0 end do C ********* get the size of the "stripped" A1 directory name status = str$trim(profile.direct,profile.direct,dir_siz) if (dir_siz .eq. 0) goto 10 docdb_filename = profile.direct(:dir_siz)//'docdb.dat' c ******** open docdb.dat file for the user in "profile" record OPEN (useropen=ignore_locks, 1 UNIT=12, 1 err=5000, 1 FORM='UNFORMATTED', 1 STATUS='OLD', 1 ACCESS='KEYED', 1 shared, 1 readonly, 1 FILE=docdb_filename) 20 continue read(unit=12,end=29) document d print *, document.type if (document.folder(:7) .eq. 'CREATED') then i = 1 elseif (document.folder(:4) .eq. 'READ') then i = 2 elseif (document.folder(:6) .eq. 'OUTBOX') then i = 3 elseif (document.folder(:8) .eq. 'WASTEBAS') then i = 4 else i = 5 endif if (document.type(:4) .eq. 'MAIL') then email_count(i) = email_count(i) + 1 else if (document.type(:5) .eq. 'S2020') then s2020_count(i) = s2020_count(i) + 1 else if (document.type(:8) .eq. 'DOCUMENT') then wps_count(i) = wps_count(i) + 1 else if (document.type(:12) .eq. 'DISTRIB LIST') then dist_count(i) = dist_count(i) + 1 else if (document.type(:8) .eq. 'ARCHIVE') then arch_count(i) = arch_count(i) + 1 else other_count(i) = other_count(i) + 1 endif total(i) = total(i) + 1 if (extra) then WRITE (6, 25) document.folder(:20), 1 document.title(:20), 1 document.document_number, 1 document.author(:20), 1 document.filename(:40) endif 25 format( ' ', a20, ' ', a20, ' ', a6, ' ', a20, ' ', a40) goto 20 29 continue close (12) 110 Format ('$ Enter the Username/[Brief (d), Full] :') 120 Format (a18) 130 format (//,' NAME EMAIL WPS S2020 ' 1 'Dist Other Archv TOTAL') 131 format (' ',A14) 132 format (' ',A14,' ',7(' ',i5)) 133 format (' ',A14,' ', A60) 200 format (' Trouble in paradise!! -- Can''t file profile.dat') 202 format (' %EMAIL-W-NOSUCHUSER, No such user') 204 format (' %EMAIL-I-ILLQUAL, invalid qualifier IGNORED') do i=1,5 email_count(6) = email_count(6) + email_count(i) wps_count(6) = wps_count(6) + wps_count(i) s2020_count(6) = s2020_count(6) + s2020_count(i) dist_count(6) = dist_count(6) + dist_count(i) other_count(6) = other_count(6) + other_count(i) arch_count(6) = arch_count(6) + arch_count(i) total(6) = total(6) + total(i) enddo if (extra) then write (6,130) endif if (full) then write (6,131) profile.vms_usr write (6,132) 'CREATED ', 1 email_count(1), wps_count(1), s2020_count(1), 1 dist_count(1), other_count(1), arch_count(1), total(1) write (6,132) 'READ ', 1 email_count(2), wps_count(2), s2020_count(2), 1 dist_count(2), other_count(2), arch_count(2), total(2) write (6,132) 'SENT ', 1 email_count(3), wps_count(3), s2020_count(3), 1 dist_count(3), other_count(3), arch_count(3), total(3) write (6,132) 'WASTEBASKET ', 1 email_count(4), wps_count(4), s2020_count(4), 1 dist_count(4), other_count(4), arch_count(4), total(4) write (6,132) 'FILED ', 1 email_count(5), wps_count(5), s2020_count(5), 1 dist_count(5), other_count(5), arch_count(5), total(5) write (6,132) ' TOTAL', 1 email_count(6), wps_count(6), s2020_count(6), 1 dist_count(6), other_count(6), arch_count(6), total(6) else write (6,132) profile.vms_usr, 1 email_count(6), wps_count(6), s2020_count(6), 1 dist_count(6), other_count(6), arch_count(6), total(6) endif if (match) goto 10 goto 9000 5000 continue write (6,133) profile.vms_usr, 'No DOCDB found...' if (match) goto 10 goto 9000 6000 write (6,202) goto 9000 7000 write (6,200) goto 9500 9000 CONTINUE CLOSE (10) 9500 continue END