|
Thanks *Jonathan Mason* * * * *ur idea was the best, i was troubled with reverse way thanks for all who contributed to this thread hoping that i get an opportunity to return courtesy On 4/6/06, Jonathan Mason <jonathan.mason@xxxxxxxxxxxxxxxx> wrote: > > Terry > > >> You can populate an array with the positions of a > >> search argument with a string using the SCAN op code. > > Thanks for that, in 20+ years of programming RPG I had never noticed that > - > just goes to show you never stop learning. > > Stiju, > > Using the SCAN op code as Terry suggests, the following sub-procedure > seems > to do what I think you want: > > H DFTACTGRP(*NO) > > D ParseIt pr 255a Varying > D iString 1024a Value > D iSep 1a Value Options(*NoPass) > > D wResult s 32a > > * Expect *NULL as only two words in string... > C Eval wResult=ParseIt('The_Cat') > C wResult Dsply > > * Expect "The" as only three words in string... > C Eval wResult=ParseIt('The_Cat_Sat') > C wResult Dsply > > * Expect "Cat" as third last word in string... > C Eval wResult=ParseIt('The_Cat_Sat_On') > C wResult Dsply > > * Expect *NULL as only two words in string... > C Eval wResult=ParseIt('_Cat_Sat') > C wResult Dsply > > * Expect *NULL as third last word is missing... > C Eval wResult=ParseIt('The__Cat_Sat') > C wResult Dsply > > * Expect "The" as third last word in string... > C Eval wResult=ParseIt('The-Cat-Sat':'-') > C wResult Dsply > > C Eval *InLr = *On > > p ParseIt b > > D ParseIt pi 255a Varying > D iString 1024a Value > D iSep 1a Value Options(*NoPass) > > D Pos s 5 0 Dim(1024) > D Ix s 5 0 > > D wSep s 1a > D Error c Const('*ERROR') > D Null c Const('*NULL') > D Pos1 s 5 0 > D Pos2 s 5 0 > D Pos3 s 5 0 > D wPos s 5 0 > > * Check the number of parameters passed... > > C Select > C When %Parms = 1 > C Eval wSep = '_' > C When %Parms = 2 > C Eval wSep = iSep > C Other > C Return Error > C EndSl > > * Scan the string for all occurrences of the separator > * character. The first element of the Pos array will hold > * the first occurrence, the second the second, etc. All > * elements after the last occurrence of the separator character > * will be zero... > > C wSep Scan iString Pos > > > * There need to be at least two separator characters from the > * end of the string. If there are three or more then we need > * return the value between the 3rd and 2nd separators, but if > * there are only two and the second starts in position 2 or > * later then the word we want starts in position 1... > > C Eval Pos1 = 0 > C Eval Pos2 = 0 > C Eval Pos3 = 0 > > * First we need to find the last occurrence of the separator > * character... > > C Eval Ix = 1 > C *Zero > Lookup Pos(Ix) 91 > > * ...and then Determine the last three occurrences of > * the separator character in the string, Pos1 being the > * last occurrence... > > C If Ix > 1 > C Eval Pos1 = Pos(Ix-1) > C EndIf > > C If Ix > 2 > C Eval Pos2 = Pos(Ix-2) > C EndIf > > C If Ix > 3 > C Eval Pos3 = Pos(Ix-3) > C EndIf > > * Return a value depending on the contents of Pos3 and Pos2... > > C Select > C When Pos3 = 0 and Pos2 = 0 > C Return Null > C When Pos3 = 0 and Pos2 > 1 > C Return %Subst(iString:1:Pos2 - 1) > C When Pos3 > 1 and Pos2 = Pos3 + 1 > C Return Null > C When Pos3 > 1 and Pos2 > Pos3 + 1 > C Return %Subst(iString:Pos3+1:Pos2-Pos3-1) > C Other > C Return Null > C EndSl > > p ParseIt e > > It returns the third last delimited "word" from the string and allows you > to > specify the delimiter. If no delimiter is specified then "_" is used. If > there are fewer than three delimited "words" in the string then "*ERROR" > is > returned. > > All the best > > Jonathan > > > > > -- > This is the RPG programming on the AS400 / iSeries (RPG400-L) mailing list > To post a message email: RPG400-L@xxxxxxxxxxxx > To subscribe, unsubscribe, or change list options, > visit: http://lists.midrange.com/mailman/listinfo/rpg400-l > or email: RPG400-L-request@xxxxxxxxxxxx > Before posting, please take a moment to review the archives > at http://archive.midrange.com/rpg400-l. > >
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.