最初のページに戻ります。

 総合の目次があるページに戻ります。

よく使うマニュアルです

 Wiki

updated on 2004.06.23

9.36.自分を呼び出したプログラム名を知る

[ Previous ] [ HOME ] [ Upper ] [ Next ]

iSUCのリクワイアメントで、CLPやRPGを呼び出したプログラム名を判定する方法を知りたい、と言うのがありました。まあ、一つの解決方法として、プログラムメッセージを利用する方法が有るので、以下はそのプログラムです。

プログラムは、CALL01C→CALL01R→CALL02C→CALL02R→CALL03Cという感じで、呼び出しています。尚、各々のプログラムの相違点は、呼び出すプログラム名だけです。

基本的なロジック

CLPの場合

  1. プログラムメッセージ待ち行列*PRVに、なにかメッセージを送る。

  2. 同じプログラムメッセージ待ち行列*PRVから、メッセージキーを使ってメッセージを受け取る。この時、RCVMSGのSENDERキーワードが重要となる（SENDERFMT=*SHORT）。

  3. SENDERの27-38にメッセージを送ったプログラム（つまり、自分自身の名前）と、56-65にメッセージ送信先のプログラム名が、入ってきます。これを、情報として利用しています。

RPGの場合

  1. 上記CLPをAPIで実行。外部サブルーチンにしてしまうと、その外部サブルーチン自体のプログラムスタックが出来るため、期待した結果にならない（はず。試してはいない）ので、APIをつかった。

  2. 内容は、SNDPPGMSG+RCVMSGでCLPの場合と同じ事をしている。

詳しくテストを繰り返したわけではないけれど、ここに出ているプログラムでは正しい結果になっていました。こんな感じでどうでしょうか。

CALL01C

PGM

     DCL &KEYVAR  *CHAR 4
     DCL &MSG     *CHAR 100
     DCL &SENDER  *CHAR 80
     DCL &CALLER  *CHAR 10
     DCL &MYNAME  *CHAR 12

   SNDPGMMSG  MSG('T') TOPGMQ(*PRV) KEYVAR(&KEYVAR)
   RCVMSG  PGMQ(*PRV) MSGKEY(&KEYVAR) SENDER(&SENDER) SENDERFMT(*SHORT)
   CHGVAR &MYNAME %SST(&SENDER  27 10)
   CHGVAR &CALLER %SST(&SENDER  56 10)

   CHGVAR &MSG (&MYNAME |>'IS CALLED FROM' |> &CALLER)
             SNDPGMMSG  MSG(&MSG) TOPGMQ(*EXT)

   CALL CALL01R

RETURN
ENDPGM

CALL01R

     H            Y/                                    1
     I******************************************************
     I*     D E F I N E    D A T A  - S T R U C T U R E    *
     I******************************************************
     IMSGF       IDS
     I                                        1  10 MSGFIL
     I                                       11  20 MSGFLB
     I*
     I           IDS
     I                                    B   1   40MSGLEN
     I                                    B   5   80TOPGCT
     I                                    B   9  120MSGCNT
     I                                    B  13  160WAIT
     IQMHB4      IDS
     I                                       82  93 QMHB4Q
     I                                      111 120 QMHB4V
     IPBERR       DS
     I I            116                   B   1   40BYTPRV
     I I            0                     B   5   80BYTAVA
     I                                        9  15 ERRID
     I                                       16  16 ERR###
     I                                       17 116 ERRDTA
     I******************************************************
     I*     D E F I N E    C O N S T A N T                 *
     I******************************************************
     I              'IS CALLED FROM'      C         #CALL
     C******************************************************
     C*             M A I N -  R O U T I N E               :
     C******************************************************
     C                     EXSR @SNDPM                     :
     C                     EXSR @RCVMG                     :
     C*                                                    :
     C           QMHB4Q    CAT  #CALL:1   W1DATA 30        :
     C                     CAT  QMHB4V:1  W1DATA           :
     C                     DSPLY          W1DATA           :
     C*                                                    :
     C                     CALL 'CALL02C'                  :
     C*                                                    :
     C                     MOVE *ON       *INLR            :
     C                     RETRN                           :
     C******************************************************
     C*             S U B   -  R O U T I N E               :
     C******************************************************
     C*----------------------------------------------------*
     C           @SNDPM    BEGSR                           :
     C*----------------------------------------------------*
     C                     CALL 'QMHSNDPM'                 :
     C                     PARM           MSGID   7        :
     C                     PARM           MSGF             :
     C                     PARM 'T'       MSG     1        :
     C                     PARM 1         MSGLEN           :
     C                     PARM '*INFO'   MSGTYP 10        :
     C                     PARM '*'       TOPGMQ 10        :
     C                     PARM 1         TOPGCT           :
     C                     PARM           KEYVAR  4        :
     C                     PARM           PBERR            :
     C*                                                    :
     C                     ENDSR                           :
     C*----------------------------------------------------*
     C           @RCVMG    BEGSR                           :
     C*----------------------------------------------------*
     C                     CALL 'QMHRCVPM'                 :
     C                     PARM           QMHB4            :
     C                     PARM 120       MSGLEN           :
     C                     PARM 'RCVM0200'MSGFMT  8        :
     C                     PARM '*'       MSGST  10        :
     C                     PARM 1         MSGCNT           :
     C                     PARM '*ANY'    MSGTYP 10        :
     C                     PARM           KEYVAR  4        :
     C                     PARM 0         WAIT             :
     C                     PARM '*REMOVE' MSGHDL 10        :
     C                     PARM           PBERR            :
     C*                                                    :
     C                     ENDSR                           :

CALL02C

PGM

     DCL &KEYVAR  *CHAR 4
     DCL &MSG     *CHAR 100
     DCL &SENDER  *CHAR 80
     DCL &CALLER  *CHAR 10
     DCL &MYNAME  *CHAR 12

   SNDPGMMSG  MSG('T') TOPGMQ(*PRV) KEYVAR(&KEYVAR)
   RCVMSG  PGMQ(*PRV) MSGKEY(&KEYVAR) SENDER(&SENDER) SENDERFMT(*SHORT)
   CHGVAR &MYNAME %SST(&SENDER  27 10)
   CHGVAR &CALLER %SST(&SENDER  56 10)

   CHGVAR &MSG (&MYNAME |>'IS CALLED FROM' |> &CALLER)
             SNDPGMMSG  MSG(&MSG) TOPGMQ(*EXT)

   CALL CALL02R

RETURN
ENDPGM

CALL02R

     H            Y/                                    1
     I******************************************************
     I*     D E F I N E    D A T A  - S T R U C T U R E    *
     I******************************************************
     IMSGF       IDS
     I                                        1  10 MSGFIL
     I                                       11  20 MSGFLB
     I*
     I           IDS
     I                                    B   1   40MSGLEN
     I                                    B   5   80TOPGCT
     I                                    B   9  120MSGCNT
     I                                    B  13  160WAIT
     IQMHB4      IDS
     I                                       82  93 QMHB4Q
     I                                      111 120 QMHB4V
     IPBERR       DS
     I I            116                   B   1   40BYTPRV
     I I            0                     B   5   80BYTAVA
     I                                        9  15 ERRID
     I                                       16  16 ERR###
     I                                       17 116 ERRDTA
     I******************************************************
     I*     D E F I N E    C O N S T A N T                 *
     I******************************************************
     I              'IS CALLED FROM'      C         #CALL
     C******************************************************
     C*             M A I N -  R O U T I N E               :
     C******************************************************
     C                     EXSR @SNDPM                     :
     C                     EXSR @RCVMG                     :
     C*                                                    :
     C           QMHB4Q    CAT  #CALL:1   W1DATA 30        :
     C                     CAT  QMHB4V:1  W1DATA           :
     C                     DSPLY          W1DATA           :
     C*                                                    :
     C                     CALL 'CALL03C'                  :
     C*                                                    :
     C                     MOVE *ON       *INLR            :
     C                     RETRN                           :
     C******************************************************
     C*             S U B   -  R O U T I N E               :
     C******************************************************
     C*----------------------------------------------------*
     C           @SNDPM    BEGSR                           :
     C*----------------------------------------------------*
     C                     CALL 'QMHSNDPM'                 :
     C                     PARM           MSGID   7        :
     C                     PARM           MSGF             :
     C                     PARM 'T'       MSG     1        :
     C                     PARM 1         MSGLEN           :
     C                     PARM '*INFO'   MSGTYP 10        :
     C                     PARM '*'       TOPGMQ 10        :
     C                     PARM 1         TOPGCT           :
     C                     PARM           KEYVAR  4        :
     C                     PARM           PBERR            :
     C*                                                    :
     C                     ENDSR                           :
     C*----------------------------------------------------*
     C           @RCVMG    BEGSR                           :
     C*----------------------------------------------------*
     C                     CALL 'QMHRCVPM'                 :
     C                     PARM           QMHB4            :
     C                     PARM 120       MSGLEN           :
     C                     PARM 'RCVM0200'MSGFMT  8        :
     C                     PARM '*'       MSGST  10        :
     C                     PARM 1         MSGCNT           :
     C                     PARM '*ANY'    MSGTYP 10        :
     C                     PARM           KEYVAR  4        :
     C                     PARM 0         WAIT             :
     C                     PARM '*REMOVE' MSGHDL 10        :
     C                     PARM           PBERR            :
     C*                                                    :
     C                     ENDSR                           :

CALL03C

PGM

     DCL &KEYVAR  *CHAR 4
     DCL &MSG     *CHAR 100
     DCL &SENDER  *CHAR 80
     DCL &CALLER  *CHAR 10
     DCL &MYNAME  *CHAR 12

   SNDPGMMSG  MSG('T') TOPGMQ(*PRV) KEYVAR(&KEYVAR)
   RCVMSG  PGMQ(*PRV) MSGKEY(&KEYVAR) SENDER(&SENDER) SENDERFMT(*SHORT)
   CHGVAR &MYNAME %SST(&SENDER  27 10)
   CHGVAR &CALLER %SST(&SENDER  56 10)

   CHGVAR &MSG (&MYNAME |>'IS CALLED FROM' |> &CALLER)
             SNDPGMMSG  MSG(&MSG) TOPGMQ(*EXT)


RETURN
ENDPGM

AS/400 CL(制御言語)解説書 バージョン3より1.6.147 RCVMSG(メッセージ受取り)コマンド

SENDER

*SHORT: 送信側情報が短形式で戻されます。短形式は80文字であり、最後の9文字はブランクに設定されます。以下の情報が返されます。

最初の26文字は、送出し側のジョブを識別します。
- ジョブ名(10)
- ユーザー名(10)
- ジョブ番号(6)

次の16文字は、送出し側のプログラムを識別します。
- プログラム名 (12) (ILE プロシージャーの場合は、バインド済みプログラム名)。送信側タイプが 3 の場合、このフィールドの最初の 3文字は、プログラム名の最後の 9 文字が後に付いた、記号 (<<<) よりも短くなります。
- 命令数(4) (ILEプロシージャーの場合は、このフィールドはブランクに設定される)

次の13文字は日時です。
- 日付(7) (0yymmdd形式)
- 時刻(6) (hhmmss形式)

次の14文字は、メッセージが呼び出しメッセージ待ち行列に送信される場合は、送信先呼び出しスタック項目を識別します。
- プログラム名(10)　(ILEプロシージャーの場合は、バインド済みプログラム名)
- 命令数(4) (ILEプロシージャーの場合は、このフィールドはブランクに設定される)

次の1文字は送信側のタイプを識別します。
- "0" 送信側が、12 文字またはそれ未満のOPM プログラムまたは SLICプログラムの場合。
- "1" 送信側が、ILE プロシージャーで、その名前が 256 文字またはそれ未満の場合。
- "2" 送信側が、ILE プロシージャーで、その名前が 256 文字以上の場合。
- "3" 送信側が、12 文字以上の SLIC プログラムの場合。

最後の1文字は送信先タイプを指定します。
- "0" 受信側が OPM プログラムの場合。
- "1" 受信側が ILE プロシージャーで、その名前が 256 文字またはそれ未満の場合。
- "2" 受信側が ILE プロシージャーで、その名前が 256 文字以上の場合。

1998/11/29

[ Previous ] [ HOME ] [ Upper ] [ Next ]

You are at K's tips-n-kicks of AS/400

　

SEO [PR] 爆速!無料ブログ 無料ホームページ開設 無料ライブ放送