midrange.com code scratchpad |
Name:
Build Name/Value Pair list from unformatted string
|
Scriptlanguage:
Plain Text
|
Tabwidth:
4
|
Date:
09/12/2012 12:05:51 pm
|
IP:
Logged
|
|
Description:
Build Name/Value Pair list from unformatted string
Dennis Lovelady (September, 2012)
|
Code:
- H BNDDIR('QC2LE') ActGrp(*New) DftActGrp(*No) Option(*SrcStmt)
-
- D atof PR 8F Extproc('atof')
- D string_in * Value Options(*String)
-
- D isDigit_IBM PR 10I 0 Extproc(*CWIDEN: 'isdigit')
- D char_in 1 Value
-
- D isDigit PR N ExtProc('my_isDigit')
- D char_in 1 Value
-
- D buildList PR 10I 0 ExtProc('buildList')
- D values 80 Const
-
- D myString C 'L=19.3000A=19.43M=21.7700LS=19.9+
- D 3AS=19.93CB=19.1600'
-
- // Name/Value Pairs (nvp)
- D nvp DS Qualified Dim(26)
- // Cannot be more than 26 elements, since each element
- // needs at least 1 character, and max String length is 80.
- // Adjust as necessary if max length of String differs.
- D name 5 Varying
- D value 15 9
-
- D nbrEnts S 10I 0
- D message S 52
-
- /Free
-
- nbrEnts = buildList(myString) ;
- message = %Char(nbrEnts) + ' entries' ;
- dsply message ;
- message = 'Last is ' + nvp(nbrEnts).name
- + ' ('
- + %Char(nvp(nbrEnts).value)
- + ').' ;
- dsply message ;
- *INLR = *On ;
- Return ;
-
- /End-free
-
-
-
- P buildList B
- D buildList PI 10I 0
- D values 80 Const
-
- D pEnd S 10I 0 Inz(*Zero)
- D pBeg S Like(pEnd)
- D entNbr S 10I 0 Inz(*Zero)
-
- /Free
-
- DoU pEnd < 1 ;
- pEnd = %Scan('=': values: pEnd+1) ;
- If pEnd < 1 ;
- Leave ;
- EndIF ;
- pBeg = pEnd - 1 ; // Last position before =
- If pBeg < 1 ; // Should never happen, but...
- Leave ; // Leave with no entry built
- EndIF ;
- DoW pBeg>1 And Not isDigit(%Subst(values: pBeg-1: 1)) ;
- pBeg -= 1 ;
- EndDO ; // pBeg points to the first non-numeric char
- entNbr += 1 ;
- nvp(entNbr).name = %Subst(values: pBeg: pEnd - pBeg) ;
- nvp(entNbr).value = atof(%Subst(values: pEnd+1)) ;
- EndDO ;
- Return entNbr ;
-
- /End-free
-
- P buildList E
-
-
-
- P isDigit B
- // IBM's isdigit() function returns an integer value.
- // That's the world standard, but to make it more
- // RPG-friendly, I've put it under the wrappers of
- // my own isDigit function
- D isDigit PI N
- D char_in 1 Value
-
- /Free
-
- Return (isdigit_IBM(char_in) <> *Zero) ;
-
- /End-free
-
- P isDigit E
-
|
|
|