Tweet
Code:
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' 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]http://www.powerbasic.com/support/forums/smile.gif[/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)
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
FUNCTION ReplaceAll(BYVAL txt AS STRING, BYVAL s AS STRING, BYVAL r AS STRING, _
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 x AS LONG, x2 AS LONG
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
BeginReplace:
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
BeginSearch:
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
NEXT
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
NEXT
IF CountOnly THEN 'if CountOnly flag was set
txt2 = FORMAT$(fnd) 'return count both as string and in fnd variable
ELSE
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..
END FUNCTION
May 17, did some minor cosmetic adjustments to code and comments.
[This message has been edited by Borje Hagsten (edited May 16, 2001).]