home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
fortran
/
library
/
comline
/
fortck.for
< prev
next >
Wrap
Text File
|
1991-07-01
|
14KB
|
394 lines
c=======================================================================
c
c PROGRAM FILE: FORTCK.FOR
c
c DATE: August 17, 1990
c
c VERSION: 4.05 REVISION DATE: July 1, 1991
c
c AUTHOR: Scott D. Heavner
c
c LANGUAGE: MicroSoft FORTRAN 4.01
c
c COPYRIGHT: 1991, Scott D. Heavner
c
c=======================================================================
c
c DESCRIPTION: FORTCK will check a program for anything that is not a
c FORTRAN readable character (ASCII [32 - 126] + CR/LF).
c !"#$%&'()*+,-./0123456789:;<=>?@
c ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`
c abcdefghijklmnopqrstuvwxyz{|}~ and SPACE
c It is designed to indicate embedded control
c characters and also to detect a broken
c carriage return/line feed sequence, which my editor
c occasionally slips in.
c
c COMMAND LINE OPTIONS: (none are case sensitive and they may
c begin with '-' or '/'):
c /s### : Skip ASCII value
c Where ### is a number corresponding to an ASCII character
c code. The number may be up to 3 characters long. If the
c last character is an 'H' then the number is assumed to be
c hexadecimal. If more than one number is specified, they
c must be 3 characters long (the leading zeroes must be
c entered). If you only include one number, it may be from
c one to three characters. This option may be called
c repeatedly.
c If the character specified is in the "legal" range of this
c program (SPACE to ~), the character is marked as bad and
c any occurrences of the character are displayed. If a CR
c is specified, the CR/LF sequence check is not completed.
c /a$ : Skip ASCII character
c Where $ is an ASCII character. The characters are typed
c directly you may include up to MAXSKIP characters. This
c option may be called repeatedly.
c This option may also be used to mark bad characters bad.
c /f : Fix on (+)
c The program will delete any bad characters (and fix
c any broken CR/LF sequence). This is done in the file:
c FIXED.TXT, your original file is left intact.
c /? /h : Print help summary screen
c
c CONTENTS: Fortck - Main program
c call INICOM(ffile, cfile, iskip, maxskip, skip, ichk, chk,
c fchk, fix, fcr)
c - Initializes flags/options from command line
c
c
c APPRECIATION: If you find this program instructive or helpful, a
c small (or large) donation would be greatly appreciated.
c
c Send them to: Scott Heavner
c 19 Pine Woods Drive
c North Tonawanda, NY 14120
c
c COMMENTS: Send EMAIL to sdh@po.cwru.edu
c
c=======================================================================
Program fortck
c
integer maxskip, chkfil, fixfil
parameter (maxskip = 10)
parameter (chkfile = 10)
parameter (fixfile = 11)
c
integer icount, i, iskip, ichk
character*1 skip(maxskip), chk(maxskip)
character*50 cfile
logical ffile, fix, fcr, fchk
c
integer inp
character*1 cinp
equivalence (cinp, inp)
c
data cfile / ' '/
c
c Check Command Line for options
c
call INICOM(ffile, cfile, iskip, maxskip, skip, ichk, chk,
+ fchk, fix, fcr)
c
c Check if filename given, if not then prompt user
c
if (.NOT.ffile) then
write(*,*) 'File name may also be entered as a command line ',
+ 'option . . .'
write(*,*)
write(*,*) 'Enter filename to be checked (Include .FOR)'
100 format(A)
read(*,100) cfile
endif
c
c Open file
c
101 format (1X,'Checking File: ',A)
write(*,101) cfile
write(*,*)
open (unit=chkfile, file=cfile, form='BINARY',
+ status='OLD', err=98)
if (fix) open (unit=fixfile, file='FIXED.TXT',
+ form='BINARY', err=98)
c
c Checking loop
c
10 read(chkfile,END=99) cinp
icount = icount + 1
20 if ((inp.GT.126).OR.(inp.LT.32)) then
if (fcr.AND.(inp.EQ.13)) then
icount = icount + 1
if (fix) write(fixfile) char(13), char(10)
read (chkfile,END=99) cinp
if (inp.NE.10) then
103 format(' CR/LF not in sequence : Position =',I10)
write(*,103) icount
goto 20
else
goto 10
endif
endif
c
c Check if should skip character
c
i = 0
30 i = i + 1
if (cinp.EQ.skip(i)) then
if (fix) write(fixfile) cinp
goto 10
endif
if (i.LT.iskip) goto 30
104 format (' Char(',I3,') at position',I10)
write(*,104) inp, icount
else
c
c Check for characters marked bad
c
if (fchk) then
i = 0
40 i = i + 1
if (cinp.EQ.chk(i)) then
write(*,104) inp, icount
goto 10
endif
if (i.LT.ichk) goto 40
endif
if (fix) write(fixfile) cinp
endif
goto 10
c
c Exit program
c
99 close (chkfile)
if (fix) close (fixfile)
stop ''
98 stop 'Cannot open file.'
end
c----------------------------------------------------------------------
Subroutine INICOM(ffile, cfile, iskip, maxskip, skip, ichk, chk,
+ fchk, fix, fcr)
c----------------------------------------------------------------------
logical ffile, fchk, fix, fcr
integer iskip, maxskip, ichk
character*1 cfile(50), skip(*), chk(*)
c
integer i, ii, j, k, kk, length, num
character*1 c, s, ch, cnum(3)
character*128 CIN
c
100 format (1x,
+'FORTCK -- A Textfile check/fix program ')
101 format (1x,
+' Copyright 1991, Scott D. Heavner ')
102 format (1x,
+'Options -- Toggle with +/- (shown are defaults) ')
103 format (1x,
+' /a@@@@@@@@ = Skip over ASCII characters (@= char) ')
104 format (1x,
+' /s### = Skip over ASCII values (# = number) ')
105 format (1x,
+' /f- = Set Fix Flag (+ = Fix) ')
106 format (1x,
+' /h or /? = Print this Screen ')
107 format (1x,
+'If you appreciate this program, a monetary donation is the ')
108 format (1x,
+'best way to show appreciation to a poor college student. ')
109 format (1x,
+'Mail any amount to Scott Heavner, 19 Pine Woods Drive, ')
110 format (1x,
+'North Tonawanda, NY 14120 ')
c
c Initialize variables
c
iskip = 0
ichk = 0
fchk = .FALSE.
ffile = .FALSE.
fix = .FALSE.
fcr = .TRUE.
do 900 j = 1, maxskip
skip(j) = ' '
chk(j) = ' '
900 continue
c
c Get Command line string + check length
c
call cline(CIN)
length = ICHAR(CIN(1:1)) + 1
if (length.EQ.1) return
i = 1
c
c Loop to check string for desired input
c
910 i = i + 1
if (i.LE.length) then
c = CIN(i:i)
if (c.EQ.' ') goto 910
if (c.EQ.char(13)) goto 999
c
c Check for Dash/minus character
c
if ((c.EQ.'-').OR.(c.EQ.'/')) then
i = i + 1
if (i.GT.length) goto 999
c = CIN(i:i)
c
c Check Characters after dash
c
c Check for characters to skip or mark as bad
c
c Checks for ASCII characters
c
if ((c.EQ.'a').OR.(c.EQ.'A')) then
j = i
930 j = j + 1
if ((j.LE.length)) then
s = CIN(j:j)
if ((s.EQ.' ').OR.(s.EQ.char(13))) goto 940
if ((s.LE.'~').AND.(s.GE.' ')) then
if (ichk.LT.maxskip) then
ichk = ichk + 1
chk(ichk) = s
fchk = .TRUE.
endif
else
continue
if (iskip.LT.maxskip) then
iskip = iskip + 1
skip(iskip) = s
endif
endif
goto 930
endif
940 i = j
if (s.EQ.char(13)) goto 999
c
c Checks for ASCII values in hex or decimal
c
elseif ((c.EQ.'s').OR.(c.EQ.'S')) then
j = i + 1
c
c Copy number into string CNUM (up to 3 chars)
c
949 k = 0
num = 0
950 if ((j.LE.length).AND.(k.LT.3)) then
s = CIN(j:j)
if ((s.EQ.' ').OR.(s.EQ.char(13))) goto 960
k = k + 1
j = j + 1
cnum(k) = s
goto 950
endif
960 i = j
if (k.EQ.0) goto 963
c
c Convert Hex number
c
if ((cnum(k).EQ.'h').OR.(cnum(k).EQ.'H')) then
k = k - 1
do 961 kk = 1, k
ch = cnum(kk)
if ((ch.GE.'A').AND.(ch.LE.'F')) then
num =num+(ichar(ch)-ichar('A')+10)*16**(k-kk)
elseif ((ch.GE.'a').AND.(ch.LE.'f')) then
num =num+(ichar(ch)-ichar('a')+10)*16**(k-kk)
elseif ((ch.GE.'0').AND.(ch.LE.'9')) then
num = num + (ichar(ch)-ichar('0'))*16**(k-kk)
endif
961 continue
c
c Convert decimal number
c
else
do 962 kk = 1, k
num = num+(ichar(cnum(kk))-ichar('0'))*10**(k-kk)
962 continue
endif
c
c Convert number to character and store in skip array
c
if ((k.GT.0).AND.(num.GE.0).AND.(num.LE.255)) then
if (num.EQ.13) fcr = .FALSE.
if ((num.LE.126).AND.(num.GE.32)) then
if (ichk.LT.maxskip) then
ichk = ichk + 1
chk(ichk) = s
fchk = .TRUE.
endif
else
continue
if (iskip.LT.maxskip) then
iskip = iskip + 1
skip(iskip) = char(num)
endif
endif
endif
c
c Check return conditions
c
963 if (s.EQ.char(13)) goto 999
if (j.GE.length) goto 999
if (s.NE.' ') goto 949
c
c Set Fix flag
c
elseif ((c.EQ.'f').OR.(c.EQ.'F')) then
j = i
j = j + 1
s = CIN(j:j)
if (s.EQ.'+') fix = .TRUE.
if (s.EQ.'-') fix = .FALSE.
if ((s.EQ.char(13)).OR.(s.EQ.' ')) then
fix = .TRUE.
else
i = j
endif
c
c Show help screen
c
elseif ((c.EQ.'H').OR.(c.EQ.'?').OR.(c.EQ.'h')) then
write(*,100)
write(*,101)
write(*,*)
write(*,102)
write(*,103)
write(*,104)
write(*,105)
write(*,106)
write(*,*)
write(*,107)
write(*,108)
write(*,109)
write(*,110)
write(*,*)
stop 'EMAIL any comments to sdh@po.cwru.edu'
endif
c
c If not /- assume it's the filename (store in CFILE)
c
else
if (.NOT.ffile) then
ffile = .TRUE.
j = i
k = 1
970 if ((j.LE.length).AND.(k.LE.50)) then
s = CIN(j:j)
if ((s.EQ.' ').OR.(s.EQ.char(13))) then
if (k.EQ.1) ffile = .FALSE.
goto 980
endif
cfile(k) = s
j = j + 1
k = k + 1
goto 970
endif
980 i = j
if (s.EQ.char(13)) goto 999
endif
endif
goto 910
endif
999 return
end