Our find/replace function (FNDRPL) finds all occurrences of a given string and replaces them with another string. Youve probably seen this function in word processors; now your AS/400 can use it, too.
Lets say you have a sales order database with a few thousand open orders. A customer, who yesterday placed 37 orders, frantically calls you to change the shipping instructions from Ground to Next Day Air. Or suppose you hired a temporary data entry clerk who, being spelling-challenged, entered an unknown number of names into the contacts database as Jhon.
If you were using a word processor such as Microsoft Word, you could simply open the document, press Ctrl-H (Cmd-H on Macintosh), type the wrong string (Jhon) and the right string (John), and click on the Replace All button. Each instance of the wrong string would then be corrected by replacing it with the right string. AS/400 application programs and databases arent so conveniently designed, however, and you may not have a program that finds the wrong string and replaces it with the right one. So I wrote a function, FNDRPL, that takes care of that.
The Service Program
Figure 1 shows module FNDRPL, which is to be the sole module in a service program of the same name. If you prefer, you can include this module into an existing service program. Figure 2 shows a /COPY module to define the procedure prototype, and Figure 3 illustrates a typical use of the function.
As coded, the FNDRPL function uses seven parameters:
The base string. If youre changing shipping instructions, the base string would be the shipping instructions field. This field can have any length between 1 and 32,767 bytes.
The length of the base string field, expressed as a 15-digit, 0-decimal, packed decimal field. Enter zero if you want FNDRPL to calculate it for you.
The string to be found, which can have up to 32,767 bytes. Enter Ground to change shipping instructions from Ground to Next Day Air.
The length of the string to be found. Again, you can enter zero to have FNDRPL calculate it for you. You should enter it yourself if the string you want to find contains trailing blanks.
The replacement string, with another 32,767 bytes as maximum. Enter Next Day Air to change it from Ground in the shipping instructions.
The length of the replacement string. Either zero (automatic calculation) or given. Give the length yourself if the replacement string contains trailing blanks.
Whether to ignore case when performing the find/replace. Enter Y to ignore case or N to recognize it. If you choose to ignore case, the string to be found can be either uppercase or lowercase, and will be found regardless of its case.
FNDRPL returns an updated version of the base string, with all replacements already made. The returned string can have up to 32,767 bytes.
Using FNDRPL
In Figure 3, I use FNDSTR to replace both Es in my first name with asterisks. Notice that FNDRPL accepts literals as parameters (all seven parameters are given thus) and that the receiving field (named out in this example) doesnt have to be 32,767 bytes long. Also, I have given all three lengths as zero; the first length will be calculated as 5, and the other two as 1.
*=================================================================
* To compile:
*
* CRTRPGMOD MODULE(XXX/FNDRPL) SRCFILE(XXX/QRPGLESRC) +
* TEXT(Find/Replace function)
* CRTSRVPGM SRVPGM(XXX/FNDRPL) MODULE(XXX/FNDRPL) +
* EXPORT(*ALL) TEXT(Service program for +
* FNDRPL() function) ACTGRP(*CALLER)
*
*=================================================================
H NOMAIN
**********************************************************************
D i S 15P 0
D lc C CONST(abcdefghijklmnopqrstuvwxyz)
D outstr S 32767A
D pos S 15P 0
D uc C CONST(ABCDEFGHIJKLMNOPQRSTUVWXYZ)
D wfndstr S 32767A
D woutstr S 32767A
*=====================================================================
/COPY FNDRPLCPY
**********************************************************************
**********************************************************************
* Function Find/Replace (FNDRPL).
*
* It searches all occurrences of a given string and replaces them
* with a different string.
*
P fndrpl B EXPORT
*=====================================================================
* Procedure interface for function FNDRPL.
*
* Input parameters:
* BASSTR 32767A Base string.
* BASSTRLEN 15P0 Length of base string.
* Calculate it if given as zero.
* FNDSTR 32767A String to be found.
* FNDSTRLEN 15P0 Length of string to be found.
* Calculate it if given as zero.
* RPLSTR 32767A Replacement string.
* RPLSTRLEN 15P0 Length of replacement string.
* Calculate it if given as zero.
* IGNCAS 1A Ignore case when finding FNDSTR in BASSTR.
* Y = Ignore case.
* N = Do not ignore case.
*
* Return value:
* Updated string (max = 32767 bytes).
*
D fndrpl PI 32767A
D basstr 32767A VALUE
D basstrlen 15P 0 VALUE
D fndstr 32767A VALUE
D fndstrlen 15P 0 VALUE
D rplstr 32767A VALUE
D rplstrlen 15P 0 VALUE
D igncas 1A VALUE
*=====================================================================
* Calculate lengths if required.
C IF basstrlen = 0
C CHECKR basstr basstrlen
C ENDIF
C IF fndstrlen = 0
C CHECKR fndstr fndstrlen
C ENDIF
C IF rplstrlen = 0
C CHECKR rplstr rplstrlen
C ENDIF
* Initialize function variables.
*
C EVAL i = 1
C EVAL outstr = %SUBST(basstr:1:basstrlen)
* Repeat until base string is done.
C DOW i <= basstrlen + fndstrlen - 1
* If asked to ignore case, use uppercase versions of both
* the base string and the find string.
C IF igncas = Y
C lc:uc XLATE outstr woutstr
C lc:uc XLATE fndstr wfndstr
C ELSE
* Otherwise, use originals (case sensitive).
C EVAL woutstr = outstr
C EVAL wfndstr = fndstr
C ENDIF
* Find the string.
C EVAL pos = %SCAN(%SUBST(wfndstr:1:fndstrlen):
C % SUBST(woutstr:1:basstrlen): i)
* If string found, rebuild output string, replacing the
* characters found by those given as replacement values.
* Then increase starting position and repeat loop.
C IF pos > 0
C EVAL outstr = %SUBST(outstr:1:pos-1) +
C % SUBST(rplstr:1:rplstrlen) +
C % SUBST(outstr:pos+fndstrlen)
C EVAL i = pos + rplstrlen
C ELSE
* Otherwise, exit loop prematurely.
C LEAVE
C ENDIF
C ENDDO
C RETURN outstr
*=====================================================================
P fndrpl E
D fndrpl PR 32767A
Figure 1: RPG IV service program FNDRPL
D basstr 32767A VALUE
D basstrlen 15P 0 VALUE
D fndstr 32767A VALUE
D fndstrlen 15P 0 VALUE
D rplstr 32767A VALUE
D rplstrlen 15P 0 VALUE
D igncas 1A VALUE
*=================================================================
* To compile:
*
* CRTRPGMOD MODULE(XXX/FNDRPLTST) SRCFILE(XXX/QRPGLESRC) +
* TEXT(Test program using FNDRPL() function)
* CRTPGM PGM(XXX/FNDRPLTST) MODULE(XXX/FNDRPLTST) +
* TEXT(Test program for FNDRPL() +
* function) BNDSRVPGM(XXX/FNDRPL) +
* ACTGRP(*CALLER)
*
*=================================================================
/COPY FNDRPLCPY
D out S 32A
D answer S 1A
C EVAL out = fndrpl(Ernie:0:e:0:*:0:Y)
C out DSPLY answer
C EVAL *INLR = *ON
LATEST COMMENTS
MC Press Online