home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / TEXT / UTILITY / DFUTIL1.ZIP / STRIPPER.ZIP / STRIPPER.BAS next >
Encoding:
BASIC Source File  |  1990-11-10  |  7.5 KB  |  242 lines
  1. 'STRIPPER cleans blank lines, extra spaces or selected columns out of a file  
  2. '
  3. ' $INCLUDE: 'qb.bi'
  4.  
  5. DECLARE FUNCTION exists (filename$)
  6.  
  7. DIM SHARED inregs AS RegTypeX, outregs AS RegTypeX
  8. CONST YES = 1, NO = 0
  9.      
  10.       com$ = UCASE$(COMMAND$)
  11.       length = LEN(com$)
  12.       max = 10
  13.       DIM arg$(max)
  14.       true = -1: false = 0: i = 1: num = 1: inword = true
  15.       WHILE i <= length
  16.              ch$ = MID$(com$, i, 1)
  17.              IF ch$ <> " " THEN
  18.                     IF NOT inword THEN inword = true
  19.                     arg$(num) = arg$(num) + ch$
  20.              ELSEIF inword THEN
  21.                     num = num + 1
  22.                     inword = false
  23.              END IF
  24.              i = i + 1
  25.       WEND
  26.       y = 1
  27.       GOTO FRONTEND
  28. help:
  29.       PRINT " "
  30.       PRINT "STRIPPER strips columns, extra spaces or blank lines in a file."
  31.       PRINT "(c) 1990 David A. Wesson"
  32.       PRINT " "
  33.       PRINT "Syntax: STRIPPER  [d:]filename  [option]"
  34.       PRINT " where  filename = original file  [drive optional]"
  35.       PRINT "          option = B  for strip BLANK LINES"
  36.       PRINT "                   S  for strip EXTRA SPACES"
  37.       PRINT "                   C  #1  #2  for stripping COLUMNS starting"
  38.       PRINT "                              in column #1 and ending in #2."
  39.       PRINT "                              If #1 = #2 or #2 is omitted then"
  40.       PRINT "                              only one column is stripped."
  41.       PRINT ""
  42.       PRINT "        If option is omitted, then the program will prompt you."
  43.       PRINT "        "
  44.       PRINT "NOTE: This program makes a backup of the file named filename.OLD"
  45.       END
  46.  
  47. FRONTEND:
  48.       IF arg$(1) = "" THEN
  49.             GOTO help
  50.       ELSE
  51.             infile$ = UCASE$(arg$(1))
  52.             IF exists(infile$) = NO THEN GOTO nofind
  53.             OPEN infile$ FOR INPUT AS #1
  54.             outfile$ = "temp"
  55.             OPEN outfile$ FOR OUTPUT AS #2
  56.             GOSUB filename
  57.             oldfile$ = UCASE$(file$) + ".OLD"
  58.       END IF
  59.      
  60.       SELECT CASE ag$(2)
  61.             CASE "": GOTO LONGFORM
  62.             CASE "B": GOTO BLANKLINE
  63.             CASE "S": GOTO EXTRASPACE
  64.             CASE "C": GOTO COLUMNS
  65.             CASE ELSE: GOTO help
  66.       END SELECT
  67. '***************************** BLANKLINE STRIPPER ***************************
  68. BLANKLINE:
  69.       CLS : COLOR 15: PRINT "STRIPPER "; : COLOR 7
  70.       PRINT "stripping BLANKLINES from "; infile$; ", creating "; oldfile$
  71.       PRINT "Hit [Ctrl] + [Break] to terminate run."
  72.       PRINT "Starting time: "; TIME$
  73.       PRINT " Process line: "
  74. BLANKCYCLE:
  75.       IF EOF(1) THEN GOTO FINISH
  76.              LINE INPUT #1, inline$
  77.                     l = LEN(inline$)
  78.                     x = x + 1: blank = 0
  79. CUTBLANK:
  80.       IF l = 0 OR LEFT$(inline$, 1) = CHR$(13) OR LEFT$(inline$, 1) = CHR$(10) THEN GOTO BLANKCYCLE
  81.       FOR col = 1 TO LEN(inline$)
  82.             IF MID$(inline$, col, 1) = CHR$(32) THEN
  83.                   blank = 1
  84.                   ELSE GOTO OUTBLANK
  85.             END IF
  86.       NEXT
  87.       IF blank = 1 THEN GOTO BLANKCYCLE
  88. OUTBLANK:
  89.              PRINT #2, inline$
  90.              y = y + 1
  91.              LOCATE 4, 15: PRINT y
  92.              GOTO BLANKCYCLE
  93. '*************************** EXTRA SPACE STRIPPER ****************************
  94. EXTRASPACE:
  95.       CLS : COLOR 15: PRINT "STRIPPER "; : COLOR 7
  96.       PRINT "stripping EXTRA SPACES from "; infile$; ", creating "; oldfile$
  97.       PRINT "Hit [Ctrl] + [Break] to terminate run."
  98.       PRINT "Starting time: "; TIME$
  99.       PRINT " Process line: "
  100. SPACECYCLE:
  101.       WHILE NOT EOF(1)
  102.              LINE INPUT #1, inline$
  103.                     l = LEN(inline$)
  104. CUTSPACE:
  105.       WHILE RIGHT$(inline$, 1) = CHR$(32)
  106.              inline$ = LEFT$(inline$, l - 1)
  107.              l = l - 1
  108.       WEND
  109.  IF INSTR(inline$, CHR$(32)) = 0 THEN GOTO OUTSPACE
  110.       FOR x = 1 TO l - 1
  111.   char$ = MID$(inline$, x, 1): next$ = MID$(inline$, x + 1, 1)
  112.   IF char$ = CHR$(32) AND next$ = CHR$(32) THEN
  113.     inline$ = LEFT$(inline$, x) + RIGHT$(inline$, l - x - 1)
  114.     l = l - 1: x = x - 1
  115.              END IF
  116.       NEXT
  117. OUTSPACE:
  118.              PRINT #2, inline$
  119.              y = y + 1
  120.              LOCATE 4, 15: PRINT y
  121.         WEND
  122.         GOTO FINISH
  123. '*********************** COLUMNS STRIPPER ************************************
  124. COLUMNS:
  125.       a = VAL(arg$(3))
  126.       b = VAL(arg$(4))
  127.              IF a = 0 THEN GOTO MISSCOL
  128.              IF b = 0 THEN b = a
  129.              IF a > b THEN GOTO BADCOL
  130.       CLS : COLOR 15: PRINT "STRIPPER "; : COLOR 7
  131.       PRINT "stripping COLUMNS"; a; "to"; b; "from "; infile$; ", creating "; oldfile$
  132.       PRINT "Hit [Ctrl] + [Break] to terminate run."
  133.       PRINT "Starting time: "; TIME$
  134.       PRINT " Process line: "
  135.       a = a - 1: b = b + 1
  136. CUTCOL:
  137.       IF EOF(1) THEN GOTO FINISH
  138.              LINE INPUT #1, inline$
  139.                     a$ = LEFT$(inline$, a)
  140.                     b$ = MID$(inline$, b)
  141.                     outline$ = a$ + b$
  142. OUTCOL:
  143.              PRINT #2, outline$
  144.              y = y + 1
  145.              LOCATE 4, 15: PRINT y
  146.              GOTO CUTCOL
  147. '************************** PROMPT FOR INPUT FORMAT ***************************
  148. LONGFORM:
  149.       CLS
  150.       GOSUB DRAWFRAME
  151.       LOCATE 1, 33: PRINT "[ STRIPPER ]"
  152.       LOCATE 3, 31: COLOR 15: PRINT "[ INTRODUCTION ]": COLOR 7
  153.       LOCATE 6, 10: PRINT "STRIPPER is a utility package for manipulating ASCII text files."
  154.       LOCATE 7, 10: PRINT "  "
  155.       LOCATE 8, 10: PRINT "There are three functions you can call:"
  156.       LOCATE 10, 10: PRINT "       [1]  Strip all BLANK LINES from file"
  157.       LOCATE 12, 10: PRINT "       [2]  Strip all EXTRA SPACES from file"
  158.       LOCATE 14, 10: PRINT "       [3]  Strip selected COLUMNS from file"
  159.       LOCATE 18, 17: PRINT "(c) 1990 David A. Wesson"
  160.       LOCATE 19, 17: PRINT "Type STRIPPER for instructions to bypass this menu."
  161. SELECTONE:
  162.       LOCATE 22, 20: COLOR 15: PRINT "Select a NUMBER or [Esc] key to EXIT.": COLOR 7
  163.       GOSUB in
  164.       SELECT CASE in$
  165.             CASE CHR$(27):
  166.                  CLS
  167.                  COLOR 15
  168.                  PRINT "OK, thanks for visiting STRIPPER."
  169.                  COLOR 7
  170.                  END
  171.             CASE "1": GOTO BLANKLINE
  172.             CASE "2": GOTO EXTRASPACE
  173.             CASE "3": GOTO LONGPROMPT
  174.             CASE ELSE: GOTO SELECTONE
  175.       END SELECT
  176. LONGPROMPT:
  177.       GOSUB CLEAR22
  178.       GOSUB CLEARALL
  179.       LOCATE 10, 15: INPUT "Input column to START stripping: ", arg$(3)
  180.       LOCATE 15, 15: PRINT "hit [Return] for FINISH."
  181.       LOCATE 14, 15: PRINT "To strip just one column,"
  182.       LOCATE 12, 15: INPUT "Input column to FINISH stripping: ", arg$(4)
  183.       GOTO COLUMNS
  184. '*************************** GENERAL SUBROUTINES ******************************
  185. DRAWFRAME:
  186.       LOCATE 1, 1, 0, 8: PRINT CHR$(201); STRING$(77, 205); CHR$(187)
  187.       FOR x = 2 TO 22: LOCATE x, 79: PRINT CHR$(186): NEXT
  188.       FOR x = 22 TO 2 STEP -1: LOCATE x, 1: PRINT CHR$(186): NEXT
  189.       LOCATE 23, 1: PRINT CHR$(200); STRING$(77, 205); CHR$(188)
  190.       LOCATE 3: PRINT CHR$(199); STRING$(77, 196); CHR$(182)
  191.       LOCATE 21: PRINT CHR$(199); STRING$(77, 196); CHR$(182)
  192.       RETURN
  193. CLEARALL:
  194.       FOR x = 20 TO 4 STEP -1: LOCATE x, 2: PRINT STRING$(77, 0): NEXT: RETURN
  195. CLEAR22:
  196.       LOCATE 22, 2: PRINT STRING$(77, 0): RETURN
  197. in:
  198.       in$ = INKEY$: IF in$ = "" THEN GOTO in ELSE RETURN
  199. filename:                                         'splits infile$ into
  200.           period = INSTR(infile$, ".")              'file$ and ext$
  201.           IF period = 0 THEN
  202.                     file$ = infile$
  203.                     ext$ = ""
  204.                     ELSE
  205.                           file$ = LEFT$(infile$, period - 1)
  206.                           ext$ = MID$(infile$, period + 1)
  207.           END IF
  208.           RETURN
  209. nofind:
  210.       PRINT "ERROR: No file by that name found."
  211.       GOTO help
  212. MISSCOL:
  213.       PRINT "ERROR: Missing column specifier."
  214.       GOTO help
  215. BADCOL:
  216.       PRINT "ERROR: ENDCOL must be equal to or larger than STARTCOL."
  217.       GOTO help
  218. FINISH:
  219.       CLOSE
  220.       IF exists(oldfile$) THEN KILL oldfile$
  221.       NAME infile$ AS oldfile$
  222.       NAME outfile$ AS infile$
  223.       PRINT "Finish time  : "; TIME$
  224.       END
  225.  
  226. FUNCTION exists (search$)
  227.      savefile$ = search$
  228.      inregs.ax = &H4E00
  229.      inregs.cx = 1     '3 for hidden
  230.      search$ = search$ + CHR$(0)
  231.      inregs.dx = SADD(search$)
  232.      inregs.ds = -1
  233.      CALL INTERRUPTX(&H21, inregs, outregs)
  234.      IF (outregs.flags AND 1) = 1 THEN
  235.             exists = NO
  236.      ELSE
  237.             exists = YES
  238.      END IF
  239.      search$ = savefile$
  240. END FUNCTION
  241.  
  242.