home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / TEXT / UTILITY / DFUTIL2.ZIP / FREPLACE.ZIP / FREPLACE.BAS next >
Encoding:
BASIC Source File  |  1990-11-10  |  4.3 KB  |  145 lines
  1. 'FREPLACE replaces strings in files
  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. DIM arg$(10)
  10.      
  11.       inline$ = COMMAND$
  12.       ch = 1: word = 1
  13.       WHILE ch <= LEN(inline$)
  14.              ch$ = MID$(inline$, ch, 1)
  15.              IF ch$ <> " " THEN
  16.                     arg$(word) = arg$(word) + ch$
  17.                     IF ch$ = "<" THEN
  18.                         WHILE NOT ch$ = ">"
  19.                             ch = ch + 1
  20.                             ch$ = MID$(inline$, ch, 1)
  21.                             arg$(word) = arg$(word) + ch$
  22.                         WEND
  23.                     END IF
  24.              ELSE
  25.                     word = word + 1
  26.              END IF
  27.              ch = ch + 1
  28.       WEND
  29.       IF NOT arg$(1) = "" THEN GOTO BEGINNING
  30. HELP:
  31.       PRINT " "
  32.       PRINT "FREPLACE replaces or deletes strings in a file. "
  33.       PRINT "(c) 1990 David A. Wesson"
  34.       PRINT " "
  35.       PRINT "Syntax: FREPLACE  [d:]filename  [Oldstring  Newstring]"
  36.       PRINT " where  filename = original file  [drive optional]      "
  37.       PRINT "       Oldstring = string to be replaced, delimited by < and >"
  38.       PRINT "       Newstring = replacement, delimited by < and > "
  39.       PRINT ""
  40.       PRINT "If Oldstring is missing, you will be prompted for OLD and NEW strings."
  41.       PRINT "If Newstring is missing, the OLD string is deleted."
  42.       PRINT ""
  43.       PRINT "NOTE: Lines may not be longer than 254 characters."
  44.       PRINT "      Because the command line only works in UPPERCASE,"
  45.       PRINT "      if you want to replace a string with a lowercase"
  46.       PRINT "      string, you must use the prompts to enter this text."
  47.       PRINT "      This program makes a backup of the original file"
  48.       PRINT "      named filename.OLD"
  49.       END
  50. BEGINNING:
  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$ = file$ + ".OLD"
  58. ROUTINE:
  59.       COLOR 15: PRINT "FREPLACE "; : COLOR 7: PRINT "Fast string replacer or deleter"
  60. GETSTRINGS:
  61.       oldstring$ = arg$(2)
  62.       newstring$ = arg$(3)
  63.       IF oldstring$ = "" THEN
  64.             INPUT "OLD string: ", oldstring$
  65.             INPUT "NEW string: ", newstring$
  66.       END IF
  67.       IF oldstring$ = newstring$ THEN GOTO badstring
  68.       IF newstring$ = "" THEN newstring$ = "NOTHING"
  69.       PRINT "Replacing "; oldstring$; " with "; newstring$; " in "; infile$; ", creating "; oldfile$
  70.       PRINT "Hit [Ctrl]+[Break] to terminate."
  71.       PRINT "Starting time: "; TIME$
  72.       PRINT "   Processing: ";
  73.       z = 0
  74. cleanstrings:
  75.       IF LEFT$(oldstring$, 1) = "<" THEN oldstring$ = MID$(oldstring$, 2)
  76.       IF RIGHT$(oldstring$, 1) = ">" THEN oldstring$ = LEFT$(oldstring$, LEN(newstring$) - 1)
  77.       IF LEFT$(newstring$, 1) = "<" THEN newstring$ = MID$(newstring$, 2)
  78.       IF RIGHT$(newstring$, 1) = ">" THEN newstring$ = LEFT$(newstring$, LEN(newstring$) - 1)
  79. CYCLE:
  80.       IF EOF(1) THEN GOTO FINISH
  81.       LINE INPUT #1, l$
  82.       z = z + 1
  83.       strt = 1
  84.       LOCATE , 15: PRINT z;
  85. search:
  86.      lfpos = INSTR(strt, UCASE$(l$), UCASE$(oldstring$))
  87.      IF lfpos < 1 THEN GOTO DUMP
  88.      GOTO SPLIT
  89. NEXTLOOK:
  90.      strt = lfpos + LEN(oldstring$): GOTO search
  91. SPLIT:
  92.      lpart$ = LEFT$(l$, lfpos - 1)
  93.      rpos = lfpos + LEN(oldstring$) - 1
  94.      rpart$ = RIGHT$(l$, LEN(l$) - rpos)
  95.      s$ = lpart$ + newstring$ + rpart$
  96. NEWOUT:
  97.       PRINT #2, s$
  98.       GOTO CYCLE
  99. DUMP:
  100.       PRINT #2, l$
  101.       GOTO CYCLE
  102. FINISH:
  103.       CLOSE
  104.       IF exists(oldfile$) = YES THEN KILL oldfile$
  105. NOOLD:
  106.       NAME infile$ AS oldfile$
  107.       NAME outfile$ AS infile$
  108.       PRINT ""
  109.       PRINT "  Finish time: "; TIME$
  110.       END
  111. '******************************** GENERAL SUBROUTINES *************************
  112. nofind:
  113.       PRINT "ERROR: No file by that name found."
  114.       GOTO HELP
  115. badstring:
  116.       PRINT "ERROR: NEWSTRING cannot be the same as OLDSTRING."
  117.       GOTO HELP
  118. filename:                                         'splits infile$ into
  119.           period = INSTR(infile$, ".")              'file$ and ext$
  120.           IF period = 0 THEN
  121.                     file$ = infile$
  122.                     ext$ = ""
  123.                     ELSE
  124.                           file$ = LEFT$(infile$, period - 1)
  125.                           ext$ = MID$(infile$, period + 1)
  126.           END IF
  127.           RETURN
  128.  
  129. FUNCTION exists (search$)
  130.      savefile$ = search$
  131.      inregs.ax = &H4E00
  132.      inregs.cx = 1     '3 for hidden
  133.      search$ = search$ + CHR$(0)
  134.      inregs.dx = SADD(search$)
  135.      inregs.ds = -1
  136.      CALL INTERRUPTX(&H21, inregs, outregs)
  137.      IF (outregs.flags AND 1) = 1 THEN
  138.             exists = NO
  139.      ELSE
  140.             exists = YES
  141.      END IF
  142.      search$ = savefile$
  143. END FUNCTION
  144.  
  145.