home *** CD-ROM | disk | FTP | other *** search
/ Software Du Jour / SoftwareDuJour.iso / BUSINESS / DBASE / DBREP.ARC / REP.PRG < prev    next >
Encoding:
Text File  |  1985-10-31  |  4.5 KB  |  152 lines
  1. * REP.PRG   GLOBAL SEARCH AND REPLACE SUBSTRING IN FIELD
  2. SET TALK OFF
  3. DO WHILE .T.
  4. ACCEPT "FIELD TO SEARCH:  " TO MFIELD
  5. IF LEN("&MFIELD") = 0
  6.   RETURN
  7. ENDIF
  8. STORE 'Y' TO MREPEAT,MVERIFY
  9. * PER FIELD LOOP
  10. DO WHILE MREPEAT = 'Y'
  11.   MCOUNT = 0
  12.   ACCEPT 'REPLACE WHAT:  ' TO MTEXT
  13.   LMTEXT = LEN(MTEXT)
  14.   * CHECK FOR RESTRICTIONS TO SEARCH STRING
  15.   IF LMTEXT = 0
  16.     EXIT
  17.   ENDIF
  18.   IF '"'$MTEXT .AND. "'"$MTEXT
  19.     ? "Unable to search for character strings containing both single and double quotes."
  20.     WAIT 'Please press <RETURN>.  '
  21.     LOOP
  22.   ENDIF
  23.   ACCEPT 'REPLACE WITH:  ' TO NTEXT
  24.   LNTEXT = LEN(NTEXT)
  25.   CLEAR
  26.   ? 'FIELD:    ',MFIELD
  27.   ? 'REPLACE:  ',MTEXT,' WITH ',NTEXT
  28.   @ 03,00 SAY '----------------------------------------'
  29.   @ 03,40 SAY '----------------------------------------'
  30.   @ 04,00 SAY '(Searching . . . )'
  31. * LOCATE NEXT OCCURRENCE OF SUBSTRING (FROM PRESENT RECORD)
  32.   IF '"'$&MFIELD
  33.     LOCATE NEXT 50000 FOR '&MTEXT'$&MFIELD
  34.   ELSE
  35.     LOCATE NEXT 50000 FOR "&MTEXT"$&MFIELD
  36.   ENDIF
  37. * REPLACEMENT LOOP
  38.   DO WHILE .T.
  39.     IF EOF()
  40.       GO TOP
  41.       EXIT
  42.     ENDIF
  43.   * CONDITION FOR VERIFIED REPLACEMENT
  44.   IF MVERIFY = 'Y'
  45.     @ 04,00 SAY 'RECORD: '
  46.     @ 04,08 SAY RECNO()
  47.     @ 05,00 SAY '&MFIELD:  ' GET &MFIELD
  48.     * DISPLAY REPLACEMENT OPTIONS
  49.     @ 18,00 SAY '----------------------------------------'
  50.     @ 18,40 SAY '----------------------------------------'
  51.  @ 19,0 SAY 'Replace - R     Continue - C    Edit - E         Quit - <RETURN>'
  52.  @ 20,0 SAY 'Replace all (unverified) - X    Replace w/ other text - O'
  53.     * CHECK IF REPLACEMENT WILL CAUSE TEXT TO EXCEED FIELD LENGTH
  54.     IF LNTEXT > LMTEXT
  55.       LTEXT1 = LEN(&MFIELD)
  56.       LTEXT2 = LEN(TRIM(&MFIELD))
  57.       IF (LNTEXT - LMTEXT) > (LTEXT1 - LTEXT2)
  58.       * (i.e., NET INCREASE OF SUBSTRING > REMAINING SPACES IN FIELD)
  59.         MLOSS = (LNTEXT - LMTEXT) - (LTEXT1 - LTEXT2)
  60.         NLOSS = SUBSTR(STR(MLOSS),8,3)
  61.         ? 'WARNING - LAST',NLOSS,'CHARACTERS WILL BE LOST.'
  62.       ENDIF
  63.     ENDIF
  64.     * ACCEPT SELECTION AND DO APPLICABLE CASE
  65.     WAIT 'ENTER YOUR SELECTION HERE: ' TO MREPLACE
  66.     MREPLACE = UPPER('&MREPLACE')
  67.     IF LEN(MREPLACE) = 0
  68.        EXIT
  69.     ENDIF
  70.     DO CASE
  71.       CASE MREPLACE = 'R'
  72.         DO REPSUB
  73.         @ 05,00 CLEAR
  74.         @ 05,00 SAY '&MFIELD:  ' GET &MFIELD
  75.         @ 18,00 SAY '----------------------------------------'
  76.         @ 18,40 SAY '----------------------------------------'
  77.         @ 20,00 SAY 'ITEM REPLACED.'
  78.         WAIT 'Find next one?  (Y/N)  ' TO MNEXT
  79.         DO CASE
  80.           CASE UPPER("&MNEXT") = 'N'
  81.             EXIT
  82.           CASE LEN("&MNEXT") = 0
  83.             RETURN
  84.           OTHERWISE
  85.             * CONTINUE
  86.         ENDCASE
  87.       CASE MREPLACE = 'C'
  88.         * CONTINUE
  89.       CASE MREPLACE = 'E'
  90.         READ
  91.         WAIT
  92.       CASE MREPLACE = 'X'
  93.         DO REPSUB
  94.         MVERIFY = 'N'
  95.       CASE MREPLACE = 'O'
  96.         NTEXTBAK = NTEXT
  97.         ACCEPT 'Replace with:  ' TO NTEXT
  98.         DO REPSUB
  99.         NTEXT = NTEXTBAK
  100.         @ 05,00 CLEAR
  101.         @ 05,00 SAY '&MFIELD:  ' GET &MFIELD
  102.         @ 18,00 SAY '----------------------------------------'
  103.         @ 18,40 SAY '----------------------------------------'
  104.         @ 20,00 SAY 'ITEM REPLACED.'
  105.         WAIT 'Find next one?  (Y/N)  ' TO MNEXT
  106.         DO CASE
  107.           CASE UPPER("&MNEXT") = 'N'
  108.             EXIT
  109.           CASE LEN("&MNEXT") = 0
  110.             RETURN
  111.           OTHERWISE
  112.             * CONTINUE
  113.         ENDCASE
  114.       OTHERWISE
  115.         WAIT "INVALID SELECTION.  TYPE ANY KEY TO TRY AGAIN.  "
  116.     @ 21,00 CLEAR
  117.         LOOP
  118.     ENDCASE * Replacement/edit options
  119.   ELSE
  120.     * CONDITION FOR UNVERIFIED REPLACEMENT
  121.     @ 04,00 CLEAR
  122.     @ 04,00 SAY '(Replacing       )          '
  123.     MRECORD = substr(str(RECNO()),6,5)
  124.     @ 04,12 SAY MRECORD
  125.     DO REPSUB
  126.   ENDIF * VERIFIED/UNVERIFIED REPLACEMENT
  127.   *  LOCATE NEXT OCCURRENCE OF STRING
  128.   @ 04,00 CLEAR
  129.   @ 04,00 SAY '(Searching . . . )          '
  130.   * CHECK IF MTEXT IS A SUBSTRING OF NTEXT
  131.   * (IF NOT, SEARCH SAME RECORD FOR ANOTHER OCCURRENCE OF MTEXT.)
  132.   IF .NOT. MTEXT$NTEXT .AND. MREPLACE <> 'C' .AND. .NOT. BOF()
  133.     SKIP -1
  134.   ENDIF
  135.   CONTINUE
  136. ENDDO *** REPLACEMENT LOOP (DO WHILE .T.)
  137. ? 'NUMBER OF REPLACEMENTS:',MCOUNT
  138. ?
  139. WAIT 'ANOTHER CHANGE, SAME FIELD? (Y/N)  ' TO MREPEAT
  140. MREPEAT = UPPER('&MREPEAT')
  141. DO CASE
  142.   CASE MREPEAT = 'Y'
  143.     MVERIFY = 'Y'
  144.     @ 02,00 CLEAR
  145.   CASE MREPEAT = 'N'
  146.     EXIT
  147.   OTHERWISE
  148.     RETURN
  149. ENDCASE
  150. ENDDO ** FIELD LOOP
  151. ENDDO 
  152.