|
Are you looking at the receiver info or the sender's information? The sender's info will be the name of the proc that calls the APIs. The receiver info is what you want to extract. Scott's code is correct, but in your code I don't see where you extract the receiver information. Do you? -Bob Cozzi www.RPGxTools.com If everything is under control, you are going too slow. - Mario Andretti -----Original Message----- From: rpg400-l-bounces@xxxxxxxxxxxx [mailto:rpg400-l-bounces@xxxxxxxxxxxx] On Behalf Of Jeff Young Sent: Friday, August 19, 2005 1:03 PM To: RPG programming on the AS400 / iSeries Subject: Re: Get name of current procdeure Scott, Just prior to receiving your message, I had attempted to code my own routine to get the name. I used your code to clean up what I created, but when I run my routine, I get the name of the sub procedure doing the send/rcv message. The following is the code that I created: H DftActGrp(*No) D*-------------------------------------------------- D* Procedure name: I_Am_First D* Purpose: D* Returns: D*-------------------------------------------------- D I_Am_First PR D*-------------------------------------------------- D* Procedure name: I_Am_Next D* Purpose: D* Returns: D*-------------------------------------------------- D I_Am_Next PR D*-------------------------------------------------- D* Procedure name: WhoAmI D* Purpose: D* Returns: D*-------------------------------------------------- D WhoAmI PR /Free I_Am_First (); I_Am_Next (); Return; /End-Free P*-------------------------------------------------- P* Procedure name: I_Am_First P* Purpose: P* Returns: P*-------------------------------------------------- P I_Am_First B D I_Am_First PI /FREE WhoAmI (); Return; /END-FREE P I_Am_First E P*-------------------------------------------------- P* Procedure name: I_Am_Next P* Purpose: P* Returns: P*-------------------------------------------------- P I_Am_Next B D I_Am_Next PI /FREE WhoAmI (); Return; /END-FREE P I_Am_Next E P*-------------------------------------------------- P* Procedure name: WhoAmI P* Purpose: P* Returns: P*-------------------------------------------------- P WhoAmI B D WhoAmI PI * Define prototype for Send Program Message (QMHSNDPM) API D Send_Message PR ExtPgm('QMHSNDPM') D Message_Id 7A Const D Message_File_Name... D 20A Const D Message_Data 4A Const Options(*VarSize) D Message_Data_Length... D 10I 0 Const D Message_Type 10A Const D Call_Stack_Entry... D 10A Const D Call_Stack_Counter... D 10I 0 Const D Message_Key 4A D API_Error_Code... D 144A Options(*VarSize) * Define prototype for Receive Program Message (QMHRCVPM) API D Receive_Message... D PR ExtPgm('QMHRCVPM') D Message_Text 1024A Options(*VarSize) D Message_Text_Length... D 10I 0 Const D Format_Name 8A Const D Call_Stack_Names... D 10A Const D Call_Stack_Name_Counter... D 10I 0 Const D Message_Type 10A Const D Message_Key 4A Const D Wait_Time 10I 0 Const D Message_Action... D 10A Const D API_Error_Code... D 144A Options(*VarSize) * General API Error Data Structure D Error_Ds DS D Bytes_Provided... D 10I 0 D Bytes_Available... D 10I 0 D Exception_ID 7A D Reserved 1A D Exception_Data... D 128A * Program fields D Message_Data S 4A Inz('TEST') D Message_Data_Length... D S 10I 0 D Call_Stack_Counter... D S 10I 0 Inz(1) D Message_Key S 4A D API_Error_Code... D S 144A D Message_Text DS 1024 D Procedure_Name... D 256A Overlay(Message_Text : 180) D Format_Name S 8A Inz('RCVM0300') D Wait_Time S 10I 0 D Message_Action... D S 10A Inz('*REMOVE') /Free Message_Data_Length = %Len(%TrimR(Message_Data)); Send_Message ('' : '' : Message_Data : Message_Data_Length : '*RQS' : '*' : Call_Stack_Counter : Message_Key : API_Error_Code); Message_Data_Length = %Len(Message_Text); Receive_Message (Message_Text : Message_Data_Length : Format_Name : '*' : Call_Stack_Counter : '*RQS' : Message_Key : Wait_Time : Message_Action : API_Error_Code); Return; /END-FREE P WhoAmI E What am I doing wrong? Thanks, Scott Klement <rpg400-l@xxxxxxxxxxxxxxxx> wrote: > I have a service program that is processing various types of data input > and returning a formatted string. If the procedure being called > encounters an error, I send back a return code to the caller. I am > enhancing that to send a message to QHIST and the users job log. When you send a message, the system automatically logs which program/module/procedure the message came from. (Do a dspjoblog, select any message, press F1 on that message, and press F9 to get the procedure details.) So, if you send the message directly from the subprocedure in question, there's no need for you to calculate it's name. The system will put it in there for you. However, since there are a lot of parms to the Send Program Message (QMHSNDPM) API, people often will stick it in a subprocedure or a separate CL program to simplify logic in the caller. In that situation, the "sender" that gets logged from the message will be the "message sender" routine rather than the one that called it. In that situation, it might be a good idea to find out the subprocedure name and store it in the message data. > One of the parms I am passing to my generic logging routine is the name > of the procedure the error occured in. Currently, I am hard coding it, > but would like to be able to have a variable that I can pass instead. Your "generic message logging routine" sounds like what I'm describing above. So now you'll need a "generic find out my name" routine :) The way you do that is very similar to the way you log messages. As I said above, the system logs the program/module/procedure name that sends a message. It also logs the same info for the receiver. So, to find out your name, you can send a program message to your subprocedure. Then, read that message back and see who received it. To do that from a separate subprocedure (i.e. a "generic" routine) you'll need to tell it which callstack entry to send the message to so that you get the right subprocedure. You can do that by specifying a "count" from the original. 1=the caller, 2=the caller's caller, etc. Here's some sample code that demonstrates this: H DFTACTGRP(*NO) D GetCaller PR 256A D StackCnt 10I 0 value D Program 10A options(*nopass:*omit) D Module 10A options(*nopass:*omit) D testProc PR D myProc PR c callp testProc c eval *inlr = *on P testProc B D testProc PI c callp myProc P e P MyProc B D MyProc PI D msg s 52A D pgm s 10A D proc s 256A D module s 10A C eval msg = 'I am ' + getCaller(1) c msg dsply c eval proc = getCaller(2:pgm:module) c eval msg = 'Called from ' + %trim(proc) c + ' in ' + %trim(module) c + ' in ' + %trim(pgm) c dsply msg P e *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ * GetCaller(): Get the name of a procedure on the call stack * * StackCnt = (input) Number of call stack entries to skip * when counting. * 1 = Skip the getCaller() subprocedure * 2 = Skip the procedure that called getCaller() * 3 = Skip the procedure before the one that * called getCaller(), etc. * * Program = (output/optional) name of program that received * the message * * Module = (output/optional) name of module that received * the message * * returns the name of the subprocedure *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ P GetCaller B D GetCaller PI 256A D StackCnt 10I 0 value D Program 10A options(*nopass:*omit) D Module 10A options(*nopass:*omit) * * Receive Program Message API * D QMHRCVPM PR ExtPgm('QMHRCVPM') D MsgInfo 32767A options(*varsize) D MsgInfoLen 10I 0 const D Format 8A const D StackEntry 10A const D StackCount 10I 0 const D MsgType 10A const D MsgKey 4A const D WaitTime 10I 0 const D MsgAction 10A const D ErrorCode 8000A options(*varsize) * * Send Program Message API * D QMHSNDPM PR ExtPgm('QMHSNDPM') D MessageID 7A const D QualMsgF 20A const D MsgData 32767A const options(*varsize) D MsgDtaLen 10I 0 const D MsgType 10A const D CallStkEnt 10A const D CallStkCnt 10I 0 const D MessageKey 4A D ErrorCode 8000A options(*varsize) D RCVM0300 DS qualified D Space 32767A D MsgDtaLen 10I 0 overlay(Space:81) D MsgLen 10I 0 overlay(Space:89) D MsgHlpLen 10I 0 overlay(Space:97) D VarStart 1A overlay(Space:112) D SndRcvInfo DS qualified D based(p_SndRcvInfo) D Program 10A overlay(SndRcvInfo:355) D Module 10A overlay(SndRcvInfo:365) D Procedure 256A overlay(SndRcvInfo:375) D ErrorCode ds qualified D BytesProv 10I 0 inz(0) D BytesAvail 10I 0 inz(0) D MsgKey s 4A /free QMHSNDPM( '' : '' : 'TEST' : %len('TEST') : '*RQS' : '*' : StackCnt : MsgKey : ErrorCode ); QMHRCVPM( RCVM0300 : %size(RCVM0300) : 'RCVM0300' : '*' : StackCnt : '*RQS' : MsgKey : 0 : '*REMOVE' : ErrorCode ); p_SndRcvInfo = %addr(RCVM0300.VarStart) + RCVM0300.MsgDtaLen + RCVM0300.MsgLen + RCVM0300.MsgHlpLen; if (%parms>=2 and %addr(Program)<>*NULL); Program = SndRcvInfo.Program; endif; if (%parms>=3 and %addr(Module)<>*NULL); Module = SndRcvInfo.Module; endif; return SndRcvInfo.Procedure; /end-free P E
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.
midrange.com
