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:
  1. H BNDDIR('QC2LE') ActGrp(*New) DftActGrp(*No) Option(*SrcStmt)          
  2.                                                                         
  3. D atof            PR             8F   Extproc('atof')                   
  4. D  string_in                      *   Value Options(*String)            
  5.                                                                         
  6. D isDigit_IBM     PR            10I 0 Extproc(*CWIDEN: 'isdigit')       
  7. D  char_in                       1    Value                             
  8.                                                                         
  9. D isDigit         PR              N   ExtProc('my_isDigit')             
  10. D  char_in                       1    Value                             
  11.                                                                         
  12. D buildList       PR            10I 0 ExtProc('buildList')              
  13. D  values                       80    Const                             
  14.                                                                         
  15. D myString        C                   'L=19.3000A=19.43M=21.7700LS=19.9+
  16. D                                      3AS=19.93CB=19.1600'             
  17.                                                                         
  18.   // Name/Value Pairs (nvp)                                             
  19. D nvp             DS                  Qualified Dim(26)                 
  20.       // Cannot be more than 26 elements, since each element            
  21.       // needs at least 1 character, and max String length is 80.       
  22.       // Adjust as necessary if max length of String differs.           
  23. D   name                         5    Varying                           
  24. D   value                       15  9             
  25.                                                   
  26. D nbrEnts         S             10I 0             
  27. D message         S             52                
  28.                                                   
  29.  /Free                                            
  30.                                                   
  31.   nbrEnts = buildList(myString) ;                 
  32.   message = %Char(nbrEnts) + ' entries' ;         
  33.   dsply message ;                                 
  34.   message = 'Last is ' + nvp(nbrEnts).name        
  35.                        + ' ('                     
  36.                        + %Char(nvp(nbrEnts).value)
  37.                        + ').' ;                   
  38.   dsply message ;                                 
  39.   *INLR = *On ;                                   
  40.   Return ;                                        
  41.                                                   
  42.  /End-free                                        
  43.                                                   
  44.                                                   
  45.                                                   
  46. P buildList       B                               
  47. D buildList       PI            10I 0                               
  48. D  values                       80    Const                         
  49.                                                                     
  50. D pEnd            S             10I 0 Inz(*Zero)                    
  51. D pBeg            S                   Like(pEnd)                    
  52. D entNbr          S             10I 0 Inz(*Zero)                    
  53.                                                                     
  54.  /Free                                                              
  55.                                                                     
  56.   DoU pEnd < 1 ;                                                    
  57.      pEnd = %Scan('=': values: pEnd+1) ;                            
  58.      If pEnd < 1 ;                                                  
  59.         Leave ;                                                     
  60.      EndIF ;                                                        
  61.      pBeg = pEnd - 1 ;  // Last position before =                   
  62.      If pBeg < 1 ;      // Should never happen, but...              
  63.         Leave ;         // Leave with no entry built                
  64.      EndIF ;                                                        
  65.      DoW pBeg>1 And Not isDigit(%Subst(values: pBeg-1: 1)) ;        
  66.         pBeg -= 1 ;                                                 
  67.      EndDO ;            // pBeg points to the first non-numeric char
  68.      entNbr += 1 ;                                                  
  69.      nvp(entNbr).name = %Subst(values: pBeg: pEnd - pBeg) ;         
  70.      nvp(entNbr).value = atof(%Subst(values: pEnd+1)) ; 
  71.   EndDO ;                                               
  72.   Return entNbr ;                                       
  73.                                                         
  74.  /End-free                                              
  75.                                                         
  76. P buildList       E                                     
  77.                                                         
  78.                                                         
  79.                                                         
  80. P isDigit         B                                     
  81.   // IBM's isdigit() function returns an integer value. 
  82.   // That's the world standard, but to make it more     
  83.   // RPG-friendly, I've put it under the wrappers of    
  84.   // my own isDigit function                            
  85. D isDigit         PI              N                     
  86. D  char_in                       1    Value             
  87.                                                         
  88.  /Free                                                  
  89.                                                         
  90.   Return (isdigit_IBM(char_in) <> *Zero) ;              
  91.                                                         
  92.  /End-free                                              
  93.                     
  94. P isDigit         E 
  95.  
© 2004-2019 by midrange.com generated in 0.014s valid xhtml & css