home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / fortran / library / comline / fortck.for < prev    next >
Text File  |  1991-07-01  |  14KB  |  394 lines
  1. c=======================================================================
  2. c
  3. c   PROGRAM FILE:  FORTCK.FOR
  4. c
  5. c   DATE:  August 17, 1990
  6. c
  7. c   VERSION:  4.05                      REVISION DATE: July 1, 1991
  8. c
  9. c   AUTHOR:  Scott D. Heavner 
  10. c
  11. c   LANGUAGE: MicroSoft FORTRAN 4.01
  12. c
  13. c   COPYRIGHT:  1991, Scott D. Heavner
  14. c
  15. c=======================================================================
  16. c
  17. c   DESCRIPTION:  FORTCK will check a program for anything that is not a
  18. c                 FORTRAN readable character (ASCII [32 - 126] + CR/LF).
  19. c                           !"#$%&'()*+,-./0123456789:;<=>?@
  20. c                           ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`
  21. c                           abcdefghijklmnopqrstuvwxyz{|}~   and SPACE
  22. c                 It is designed to indicate embedded control 
  23. c                 characters and also to detect a broken
  24. c                 carriage return/line feed sequence, which my editor
  25. c                 occasionally slips in.
  26. c
  27. c  COMMAND LINE OPTIONS: (none are case sensitive and they may
  28. c                         begin with '-' or '/'):
  29. c        /s###  : Skip ASCII value
  30. c                 Where ### is a number corresponding to an ASCII character
  31. c                 code.  The number may be up to 3 characters long.  If the
  32. c                 last character is an 'H' then the number is assumed to be
  33. c                 hexadecimal.  If more than one number is specified, they
  34. c                 must be 3 characters long (the leading zeroes must be 
  35. c                 entered).  If you only include one number, it may be from
  36. c                 one to three characters.  This option may be called
  37. c                 repeatedly.
  38. c                 If the character specified is in the "legal" range of this
  39. c                 program (SPACE to ~), the character is marked as bad and
  40. c                 any occurrences of the character are displayed.  If a CR
  41. c                 is specified, the CR/LF sequence check is not completed.
  42. c       /a$     : Skip ASCII character
  43. c                 Where $ is an ASCII character.  The characters are typed
  44. c                 directly you may include up to MAXSKIP characters.  This
  45. c                 option may be called repeatedly.
  46. c                 This option may also be used to mark bad characters bad.
  47. c       /f      : Fix on (+)
  48. c                 The program will delete any bad characters (and fix
  49. c                 any broken CR/LF sequence).  This is done in the file:
  50. c                 FIXED.TXT, your original file is left intact.
  51. c       /? /h   : Print help summary screen
  52. c
  53. c   CONTENTS:    Fortck - Main program
  54. c                call INICOM(ffile, cfile, iskip, maxskip, skip, ichk, chk,
  55. c                            fchk, fix, fcr)
  56. c                       - Initializes flags/options from command line
  57. c
  58. c
  59. c   APPRECIATION:  If you find this program instructive or helpful, a 
  60. c                small (or large) donation would be greatly appreciated.
  61. c
  62. c                Send them to:    Scott Heavner
  63. c                                 19 Pine Woods Drive
  64. c                                 North Tonawanda, NY 14120
  65. c
  66. c   COMMENTS:   Send EMAIL to sdh@po.cwru.edu
  67. c
  68. c=======================================================================
  69.       Program fortck
  70. c
  71.       integer      maxskip, chkfil, fixfil
  72.       parameter    (maxskip = 10)
  73.       parameter    (chkfile = 10)
  74.       parameter    (fixfile = 11)
  75. c
  76.       integer      icount, i, iskip, ichk
  77.       character*1  skip(maxskip), chk(maxskip)
  78.       character*50 cfile
  79.       logical      ffile, fix, fcr, fchk
  80. c
  81.       integer      inp
  82.       character*1  cinp
  83.       equivalence  (cinp, inp)
  84. c
  85.       data cfile / '                                                  '/
  86. c
  87. c   Check Command Line for options
  88. c
  89.       call INICOM(ffile, cfile, iskip, maxskip, skip, ichk, chk,
  90.      +                  fchk, fix, fcr)
  91. c
  92. c   Check if filename given, if not then prompt user
  93. c
  94.       if (.NOT.ffile) then
  95.           write(*,*) 'File name may also be entered as a command line ',
  96.      +               'option . . .'
  97.           write(*,*)
  98.           write(*,*) 'Enter filename to be checked  (Include .FOR)'
  99. 100       format(A)
  100.           read(*,100) cfile
  101.         endif
  102. c
  103. c  Open file
  104. c
  105. 101   format (1X,'Checking File: ',A)
  106.       write(*,101) cfile
  107.       write(*,*)
  108.       open (unit=chkfile, file=cfile, form='BINARY',
  109.      +      status='OLD', err=98)
  110.       if (fix) open (unit=fixfile, file='FIXED.TXT',
  111.      +      form='BINARY', err=98)
  112. c
  113. c  Checking loop
  114. c
  115. 10    read(chkfile,END=99) cinp
  116.       icount = icount + 1
  117. 20    if ((inp.GT.126).OR.(inp.LT.32)) then
  118.           if (fcr.AND.(inp.EQ.13)) then
  119.               icount = icount + 1
  120.               if (fix) write(fixfile) char(13), char(10)
  121.               read (chkfile,END=99) cinp
  122.               if (inp.NE.10) then
  123. 103               format(' CR/LF not in sequence : Position =',I10)
  124.                   write(*,103) icount
  125.                   goto 20
  126.                 else
  127.                   goto 10
  128.                 endif
  129.             endif
  130. c
  131. c         Check if should skip character
  132. c
  133.           i = 0
  134. 30        i = i + 1
  135.           if (cinp.EQ.skip(i)) then 
  136.               if (fix) write(fixfile) cinp
  137.               goto 10
  138.             endif
  139.           if (i.LT.iskip) goto 30
  140. 104       format (' Char(',I3,') at position',I10)
  141.           write(*,104) inp, icount
  142.         else
  143. c
  144. c         Check for characters marked bad
  145. c
  146.           if (fchk) then
  147.               i = 0
  148. 40            i = i + 1
  149.               if (cinp.EQ.chk(i)) then
  150.                   write(*,104) inp, icount
  151.                   goto 10
  152.                 endif
  153.               if (i.LT.ichk) goto 40
  154.             endif
  155.           if (fix) write(fixfile) cinp
  156.         endif
  157.       goto 10
  158. c
  159. c  Exit program
  160. c
  161. 99    close (chkfile)
  162.       if (fix) close (fixfile)
  163.       stop ''
  164. 98    stop 'Cannot open file.'      
  165.       end
  166. c----------------------------------------------------------------------
  167.       Subroutine INICOM(ffile, cfile, iskip, maxskip, skip, ichk, chk,
  168.      +                  fchk, fix, fcr)
  169. c----------------------------------------------------------------------
  170.       logical       ffile, fchk, fix, fcr
  171.       integer       iskip, maxskip, ichk
  172.       character*1   cfile(50), skip(*), chk(*)
  173. c      
  174.       integer       i, ii, j, k, kk, length, num
  175.       character*1   c, s, ch, cnum(3)
  176.       character*128 CIN
  177. c      
  178. 100   format (1x,
  179.      +'FORTCK  -- A Textfile check/fix program                    ')
  180. 101   format (1x,
  181.      +'           Copyright 1991,  Scott D. Heavner               ')
  182. 102   format (1x,
  183.      +'Options -- Toggle with +/- (shown are defaults)            ')     
  184. 103   format (1x,
  185.      +'         /a@@@@@@@@ = Skip over ASCII characters (@= char) ')
  186. 104   format (1x,
  187.      +'         /s###      = Skip over ASCII values  (# = number) ')
  188. 105   format (1x,
  189.      +'         /f-        = Set Fix Flag               (+ = Fix) ')
  190. 106   format (1x,
  191.      +'         /h or /?   = Print this Screen                    ')
  192. 107   format (1x,
  193.      +'If you appreciate this program, a monetary donation is the ')
  194. 108   format (1x,
  195.      +'best way to show appreciation to a poor college student.   ')     
  196. 109   format (1x,
  197.      +'Mail any amount to Scott Heavner, 19 Pine Woods Drive,     ')
  198. 110   format (1x,
  199.      +'North Tonawanda, NY 14120                                  ')
  200. c
  201. c  Initialize variables
  202. c
  203.       iskip = 0
  204.       ichk = 0
  205.       fchk  = .FALSE.
  206.       ffile = .FALSE.
  207.       fix   = .FALSE.
  208.       fcr   = .TRUE.
  209.       do 900 j = 1, maxskip
  210.          skip(j) = ' '
  211.          chk(j)  = ' ' 
  212. 900      continue
  213. c
  214. c  Get Command line string + check length
  215. c
  216.       call cline(CIN)
  217.       length = ICHAR(CIN(1:1)) + 1
  218.       if (length.EQ.1) return
  219.       i = 1
  220. c
  221. c  Loop to check string for desired input
  222. c
  223. 910   i = i + 1
  224.       if (i.LE.length) then
  225.          c = CIN(i:i)
  226.          if (c.EQ.' ') goto 910
  227.          if (c.EQ.char(13)) goto 999
  228. c
  229. c          Check for Dash/minus character
  230. c        
  231.          if ((c.EQ.'-').OR.(c.EQ.'/')) then
  232.             i = i + 1
  233.             if (i.GT.length) goto 999
  234.             c = CIN(i:i)
  235. c
  236. c           Check Characters after dash
  237. c
  238. c                     Check for characters to skip or mark as bad
  239. c
  240. c                     Checks for ASCII characters
  241. c
  242.             if ((c.EQ.'a').OR.(c.EQ.'A')) then
  243.                 j = i
  244. 930             j = j + 1
  245.                 if ((j.LE.length)) then
  246.                     s = CIN(j:j)
  247.                     if ((s.EQ.' ').OR.(s.EQ.char(13))) goto 940
  248.                     if ((s.LE.'~').AND.(s.GE.' ')) then
  249.                         if (ichk.LT.maxskip) then
  250.                             ichk = ichk + 1
  251.                             chk(ichk) = s
  252.                             fchk = .TRUE.
  253.                           endif
  254.                       else
  255.                         continue
  256.                         if (iskip.LT.maxskip) then
  257.                             iskip = iskip + 1
  258.                             skip(iskip) = s
  259.                           endif
  260.                       endif
  261.                     goto 930
  262.                   endif
  263. 940             i = j
  264.                 if (s.EQ.char(13)) goto 999
  265. c
  266. c                    Checks for ASCII values in hex or decimal
  267. c
  268.               elseif ((c.EQ.'s').OR.(c.EQ.'S')) then
  269.                 j = i + 1
  270. c
  271. c                    Copy number into string CNUM (up to 3 chars)
  272. c
  273. 949             k = 0
  274.                 num = 0
  275. 950             if ((j.LE.length).AND.(k.LT.3)) then
  276.                     s = CIN(j:j)
  277.                     if ((s.EQ.' ').OR.(s.EQ.char(13))) goto 960
  278.                     k = k + 1
  279.                     j = j + 1
  280.                     cnum(k) = s
  281.                     goto 950
  282.                   endif
  283. 960             i = j
  284.                 if (k.EQ.0) goto 963
  285. c
  286. c                    Convert Hex number
  287. c
  288.                 if ((cnum(k).EQ.'h').OR.(cnum(k).EQ.'H')) then
  289.                    k = k - 1
  290.                    do 961 kk = 1, k
  291.                       ch = cnum(kk)
  292.                       if ((ch.GE.'A').AND.(ch.LE.'F')) then
  293.                           num =num+(ichar(ch)-ichar('A')+10)*16**(k-kk)
  294.                         elseif ((ch.GE.'a').AND.(ch.LE.'f')) then
  295.                           num =num+(ichar(ch)-ichar('a')+10)*16**(k-kk)
  296.                         elseif ((ch.GE.'0').AND.(ch.LE.'9')) then
  297.                           num = num + (ichar(ch)-ichar('0'))*16**(k-kk)
  298.                         endif
  299. 961                   continue
  300. c
  301. c                     Convert decimal number
  302. c
  303.                   else
  304.                    do 962 kk = 1, k
  305.                       num = num+(ichar(cnum(kk))-ichar('0'))*10**(k-kk)
  306. 962                   continue
  307.                   endif
  308. c
  309. c                    Convert number to character and store in skip array
  310. c
  311.                 if ((k.GT.0).AND.(num.GE.0).AND.(num.LE.255)) then
  312.                     if (num.EQ.13) fcr = .FALSE.
  313.                     if ((num.LE.126).AND.(num.GE.32)) then
  314.                         if (ichk.LT.maxskip) then
  315.                             ichk = ichk + 1
  316.                             chk(ichk) = s
  317.                             fchk = .TRUE.
  318.                           endif
  319.                       else
  320.                         continue
  321.                         if (iskip.LT.maxskip) then
  322.                             iskip = iskip + 1
  323.                             skip(iskip) = char(num)
  324.                           endif
  325.                       endif
  326.                   endif
  327. c
  328. c                    Check return conditions
  329. c
  330. 963             if (s.EQ.char(13)) goto 999
  331.                 if (j.GE.length) goto 999
  332.                 if (s.NE.' ') goto 949
  333. c
  334. c                Set Fix flag
  335. c
  336.               elseif ((c.EQ.'f').OR.(c.EQ.'F')) then
  337.                 j = i
  338.                 j = j + 1
  339.                 s = CIN(j:j)
  340.                 if (s.EQ.'+') fix = .TRUE.
  341.                 if (s.EQ.'-') fix = .FALSE.
  342.                 if ((s.EQ.char(13)).OR.(s.EQ.' ')) then
  343.                     fix = .TRUE.
  344.                   else
  345.                     i = j
  346.                   endif
  347. c 
  348. c                Show help screen
  349. c
  350.               elseif ((c.EQ.'H').OR.(c.EQ.'?').OR.(c.EQ.'h')) then
  351.                 write(*,100)
  352.                 write(*,101)
  353.                 write(*,*)
  354.                 write(*,102)
  355.                 write(*,103)
  356.                 write(*,104)
  357.                 write(*,105)
  358.                 write(*,106)
  359.                 write(*,*)
  360.                 write(*,107)
  361.                 write(*,108)
  362.                 write(*,109)
  363.                 write(*,110)
  364.                 write(*,*)
  365.                 stop 'EMAIL any comments to sdh@po.cwru.edu'
  366.               endif
  367. c
  368. c                If not /- assume it's the filename (store in CFILE)
  369. c
  370.            else
  371.              if (.NOT.ffile) then
  372.                  ffile = .TRUE.
  373.                  j = i
  374.                  k = 1
  375. 970              if ((j.LE.length).AND.(k.LE.50)) then
  376.                      s = CIN(j:j)
  377.                      if ((s.EQ.' ').OR.(s.EQ.char(13))) then
  378.                          if (k.EQ.1) ffile = .FALSE.
  379.                          goto 980
  380.                        endif
  381.                      cfile(k) = s
  382.                      j = j + 1
  383.                      k = k + 1
  384.                      goto 970
  385.                    endif
  386. 980              i = j
  387.                  if (s.EQ.char(13)) goto 999
  388.                endif
  389.            endif
  390.           goto 910
  391.         endif
  392. 999   return
  393.       end
  394.