home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / MISC / MISCFOR.ZIP / TOKEN.FOR next >
Encoding:
Text File  |  1992-06-23  |  2.2 KB  |  75 lines
  1.       program TOKEN
  2.       character*80 StrTok$, P$, Delimiters$, Token$
  3.  
  4.       read (unit=*,fmt='(a)') p$
  5.       print *, p$
  6.  
  7.       Delimiters$ = ' ,;:().?' // CHAR(9) // CHAR(34)
  8.       Token$ = StrTok$(P$, Delimiters$)
  9.       DO WHILE (Token$ .ne. char(0))
  10.           PRINT *, Token$
  11.           Token$ = StrTok$(char(0), Delimiters$)
  12.       ENDDO
  13.       end
  14.  
  15.       Character*80 FUNCTION StrTok$ (Srce$, Delim$)
  16.       Character*80 Srce$, Delim$, SaveStr$                
  17. c     Tokenize a string in a similar manner to C.  The usage is
  18. c     very similar to the C function.
  19. c
  20. c     Input:  Srce$     =   SouRCE string to tokenize. (see usage note)
  21. c             Delim$    =   DELIMiter string.  Used to determine the
  22. c                           beginning/end of each token in a string.
  23. c
  24. c     Output: StrTok$   =   STRing TOKen.  
  25. c     Usage:  a) First Call StrTok$ with the string to tokenize
  26. c                as Srce$, and the delimiter string used to tokenize
  27. c                Scre$ is in Delim$, as follows
  28. c
  29. c     CHARACTER*80 StrTok$,SOURCE$,DELIM$,C$
  30. c          .
  31. c          .
  32. c         
  33. c     SOURCE$='This is a test. I hope that it Works! "eh" '
  34. c     DELIM$=' ,.;:"{}()!@#$%^&*'
  35. c     C$=StrTok$(SOURCE$,DELIM$)
  36. c     PRINT *,C$,' is the first token'
  37. c     DO WHILE (C$ .ne. char(0))
  38. c         PRINT *, C$
  39. c         C$ = StrTok$(char(0), DELIM$)
  40. c     ENDDO
  41. c       
  42. c
  43. c
  44.       integer Start_, Ln_, BegPos_, EndPos_
  45.       common /strtk/ Start_, SaveStr$
  46.  
  47.       IF (Srce$(1:1) .ne. char(0)) THEN
  48.           Start_ = 1
  49.           SaveStr$ = Srce$
  50.       ENDIF
  51.  
  52.       BegPos_ = Start_
  53.       Ln_ = LEN(SaveStr$)
  54. 5     continue
  55.       if ( (BegPos_ .le. Ln_) .AND. 
  56.      &( index(Delim$,SaveStr$(BegPos_:BegPos_)) .ne. 0)) then
  57.           BegPos_ = BegPos_ + 1
  58.           goto 5
  59.       endif
  60.       IF (BegPos_ .gt. Ln_) THEN
  61.           StrTok$ = char(0)
  62.           return
  63.       ENDIF
  64.       EndPos_ = BegPos_
  65. 10    continue
  66.       if ((EndPos_ .le. Ln_) .AND.
  67.      &   (index(Delim$,SaveStr$(EndPos_:EndPos_)) .eq. 0)) then
  68.           EndPos_ = EndPos_ + 1
  69.           goto 10
  70.       endif
  71.       StrTok$ = SaveStr$(BegPos_:EndPos_)
  72.       Start_ = EndPos_ 
  73.       END 
  74.  
  75.