Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Replace all / Count all function..

  • Filter
  • Time
  • Show
Clear All
new posts

  • Replace all / Count all function..

    ' Combined Replace all/Count all function.
    ' Public Domain by Borje Hagsten, May 2001
    ' Only a function call this time, but very fast and quite useful in many
    ' situations. A piece of power PB code that may save someone a bit of time .   [img][/img]
    ' PB's REPLACE command is quite fast and sometimes even useful, but in many
    ' cases one need better control over things, to avoid replacing parts of words,
    ' etc. Following is useful in such cases and actually almost as fast, in spite
    ' the added functionality. The function combines ability to Replace all, and/or
    ' Count all, occurrences of search text. Handles Whole Words Only and/or Match Case.
    ' Good for easy use in a Replace all dialog, etc.
    ' Explanations:
    ' txt = original text
    ' s   = text to search for
    ' r   = text to replace with
    ' mc  = Match Case:      0 = ignore, 1 = match case
    ' wo  = WholeWords Only: 0 = ignore, 1 = whole words only
    ' fnd returns found occurrences
    ' CountOnly decides action: 0 = Replace all, 1 = Count all
    ' Example call for replace: Result = ReplaceAll(Maintxt, Searchtext, Replacetext, 0, 0, Found, 0)
    ' (Result is resulting string - count is returned in Found variable)
    ' Same call for count only: Result = ReplaceAll(Maintxt, Searchtext, Replacetext, 0, 0, Found, 1)
    ' (count is returned in both Result string and Found variable)
                        BYVAL mc AS LONG, BYVAL wo AS LONG, fnd AS LONG, CountOnly AS LONG) AS STRING
      IF LEN(s) = 0 OR LEN(txt) < LEN(s) THEN EXIT FUNCTION    'no point in continuing..
      LOCAL Letter AS BYTE PTR, Letter2 AS BYTE PTR, Letter3 AS BYTE PTR, ckLet AS BYTE PTR, OldLetter AS BYTE PTR
      LOCAL oldx AS LONG, Flag AS LONG, sln AS LONG, tmpCountOnly AS LONG, dif AS LONG, rln AS LONG, oln AS LONG
      LOCAL fLet AS BYTE, txt2 AS STRING, txt3 AS STRING
      IF CountOnly = 0 THEN txt3 = txt                         'replace wanted, so keep a copy of original text
      oln = LEN(txt)                                           'get whole text's length
      sln = LEN(s)                                             'get search text's length
      tmpCountOnly = 1                                         'set tmp flag so we can get count first
      IF mc = 0 THEN                                           'if not MATCH CASE
         CALL CharUpperBuff(BYVAL STRPTR(txt), oln)           'compare both search and text as UCASE strings
         CALL CharUpperBuff(BYVAL STRPTR(s), sln)
      END IF
      GOTO BeginSearch                                         'ignore replace at this point
      tmpCountOnly = 0                                         'now we have count, so reset this one
      rln = LEN(r)                                             'get replace text's length
      dif = fnd * (rln - sln)                                  'calculate occurrences and caclculate needed space
      txt2 = SPACE$(oln + dif)                                 'allocate space enough for replacements
      Letter2 = STRPTR(txt2)                                   'set pointer to resulting text
      Letter3 = STRPTR(txt3)                                   'set pointer to original text
      Letter  = STRPTR(txt)                                    'set pointer to text
      fLet    = ASC(s)                                         'get first letter in search text
      FOR  x = 1 TO oln
         IF @Letter = fLet THEN                                'if first letter matches
            flag = 1                                           'set found flag
            IF wo THEN                                         'if whole words only
               IF x > 1 THEN                                   'if position is > 1
                  ckLet = Letter - 1                           'check letter before
                  flag = (IsCharAlphaNumeric(@ckLet) = 0)      'flag becomes zero if not ok
               END IF
               IF Flag THEN                                    'if still in business
                  IF x < oln - sln THEN                        'if position is < len(txt) - len(search)
                     ckLet = Letter + sln                      'check letter after
                     flag = (IsCharAlphaNumeric(@ckLet) = 0)   'flag becomes zero if not ok
                  END IF
               END IF
            END IF
            IF Flag THEN                                       'if still in business
               OldLetter = Letter : oldx = x                   'store positions
               FOR x2 = 2 TO sln                               'check against rest of search string
                  INCR Letter : INCR x                         'increase pointers
                  IF @Letter <> ASC(s, x2) THEN                'if anything different
                     Letter = OldLetter : x = oldx             'reset positions
                     flag = 0 : EXIT FOR                       'reset flag and move on
                  END IF
            END IF
         END IF
         IF tmpCountOnly THEN                  'if initial count
            IF flag THEN                       'match, so increase counter and reset flag
               INCR fnd : flag = 0
            END IF
         ELSE                                  'else, if replace action
            IF flag = 0 THEN                   'no match
               ckLet = Letter3 + x - 1         'set pointer in original string
               @Letter2 = @ckLet               'just copy bytes from original string
            ELSE                               'else perfect match, so
               POKE$ Letter2, r                'poke replace string into place
               Letter2 = Letter2 + rln - 1     'increase pointers in resulting string
               flag = 0                        'and reset flag
            END IF
            INCR Letter2
         END IF
         INCR Letter                           'next letter
      IF CountOnly THEN                        'if CountOnly flag was set
         txt2 = FORMAT$(fnd)                   'return count both as string and in fnd variable
         IF fnd AND tmpCountOnly THEN GOTO BeginReplace ' else jump to label and replace found occurrences
      END IF                                            '(Function will then return resulting text in txt2)
                                                        '(fnd will still return count..)
      FUNCTION = txt2                                   'return result - or count, on Count all..
    May 17, did some minor cosmetic adjustments to code and comments.

    [This message has been edited by Borje Hagsten (edited May 16, 2001).]