Scot,
That worked perfectly. You are a life saver man!
One last piece of help required. I need to promote this utility to
production over the course of the weekend. Note the initial set-up was
provided to us by a third party. The binding directory piece of this is
again relatively new territory to me, hence why I need some more advice.
What I think I need to do is as follows - please tell me where I may be
going wrong ...
To begin with I have 3 sources I need to promote ...
My PROTOUTIL RPGLE source - see attached (note yet to be updated to
reflect the CONST 2nd parameter change)
BND source member named UTILITY - also attached
The UTIL001A RPGLE as sent earlier
So to re-create them from scratch I would ...
1. Use CRTRPGMOD to create the UTIL001A RPGLE
2. Create the service program UTILITY - CRTSRVPGM SRVPGM(NEWLIB/UTILITY)
MODULE(UTIL001A) SRCFILE(NEWLIB/QSRVSRC) SRCMBR(*SRVPGM)
TEXT('Utilities')
3. Create binding directory UTILITY - CRTBNDDIR BNDDIR(NEWLIB/UTILITY)
4. Add the service program to the binding directory - ADDBNDDIRE
BNDDIR(NEWLIB/UTILITY) OBJ((NEWLIB/UTIL001A))
5. Finally compile my RPG program which uses the UTILITY
Is this the correct approach?
Regards,
John.
-----Original Message-----
From: rpg400-l-bounces@xxxxxxxxxxxx
[mailto:rpg400-l-bounces@xxxxxxxxxxxx] On Behalf Of Scott Klement
Sent: 19 February 2010 20:31
To: RPG programming on the IBM i / System i
Subject: Re: Help with Service Programming
Hi again,
On 2/19/2010 2:06 PM, Scott Klement wrote:
I'm going to go over your code and fix it up, and post my results.
Give
me a few minutes to do that...
Okay, here's the code posted by John Kelly with only some minor
revisions... this should solve the problem, and make it run slightly
faster as well:
h noMain bndDir('QC2LE') option(*srcstmt: *noDebugIO)
/include protoUtil
d getToken pr * extProc('strtok')
d pString * value options(*string)
d pDelimiters * value options(*string)
d delimiters s 2a inz('; ')
p get_eMail_Addresses...
p B export
d PI
d forSplit 1000a const
d numEmails 5i 0
d emails 75a dim(13)
d pToken s *
d split s 1000a varying
d emailIs s like(emails)
/free
split = %trim(forSplit);
pToken = getToken(split: delimiters);
numEMails = 0;
doW (pToken <> *null);
emailIs = %str(pToken);
if (emailIs <> *blanks);
numEmails += 1;
if (numEmails <= %elem(emails));
emails(numEmails) = emailIs;
endIf;
endIf;
pToken = getToken(*null: delimiters);
endDo;
return;
/end-Free
p E
p set_eMail_Addresses...
p B export
d PI
d forSplit 1000a
d emails 75a dim(13) const
d i s 5i 0
d split s 1000a varying inz('')
/free
for i = 1 to %elem(emails);
if (emails(i) <> *blanks);
if (%len(split) > 0);
split = split + ';';
endIf;
split = split + %trim(emails(i));
endIf;
endFor;
forSplit = split;
return;
/end-Free
P E
Here are the important points of what I changed:
1) I changed 'split' to a VARYING variable, and trimmed the blanks from
the end. It just seemed pointless to ask strtok() to find all of
those blanks at the end.
2) (the crucial one) I changed getToken(%addr(split): %addr(delimiters))
to be simply getToken(split: delimiters) and also changed
getToken(*null: %addr(delimiters)) to getToken(*null: delimiters)
This is the important change. Passing the strings directly lets RPG
null-terminate the properly, and therefore they don't go off into
random memory locations that follow the string, reading garbage
from memory.
3) I added CONST to the 2nd parameter of set_eMail_Addresses()...
another minor change, but it bugged me, so I changed it. You'll
need to make that change in your protoUtil copy book as well.
#2 was the big one.. that's what was causing the extra array elements
with garbage in them.
0000.01
0000.02
0001.00 d get_eMail_Addresses...
0003.00 d Pr extProc('get_eMail_Addresses')
0004.00 d forSplit 1000a const
0005.00 d numEmails 5i 0
0006.00 d emails 75a dim(13)
0007.00
0008.00 d set_eMail_Addresses...
0009.00 d Pr extProc('set_eMail_Addresses')
0010.00 d forSplit 1000a
0012.00 d emails 75a dim(13) 0000.01 STRPGMEXP PGMLVL(*CURRENT) SIGNATURE('0000000000000001')
0000.02 /********************************************************************/
0000.03 /* *MODULE UTIL001A PTTEMP 04/02/10 12:12:40 */
0000.04 /********************************************************************/
0000.05 EXPORT SYMBOL("get_eMail_Addresses")
0000.06 EXPORT SYMBOL("set_eMail_Addresses")
0000.07 ENDPGMEXP
midrange.com
