ILE RPG:使用 QMHSNDPM,找不到调用堆栈条目
ILE RPG: Using QMHSNDPM, call stack entry not found
我正在尝试涉足 RPG ILE 的 MVC 池。所以我有两个模块 VIEW 和 MODEL,它们绑定到我的主程序 CNTRL。我通过调用 MODEL 模块来验证在我的 VIEW 模块中输入的信息,然后将任何错误传回给 View。当我尝试使用 QHNSNDPM api 时,我在作业日志中看到错误,然后是 CALL STACK ENTRY NOT FOUND。我试图在调用堆栈上找到 VIEW 模块,但它不在那里。在 DDS 和 ILE 方面不是很强大,我不确定 how/what 可以解决这个错误。任何建议将不胜感激!
DCL-F 显示器工作台;在VIEW模块中。
现在从 VIEW 模块获取一些代码....
dcl-pr SendMsg Extpgm('QMHSNDPM');
MsgID char(7) const;
MsgF char(20) const;
MsgData char(30) const;
MsgDataLen int(10) const;
MsgType char(10) const;
CallStackEnt char(10) const;
CallStackCtr int(10) const;
MsgKey char(4) const;
Error like(ErrorDS);
end-pr;
*******************************************************************
dcl-proc VIEW_SetError EXPORT;
dcl-pi *n;
Msg int(3);
MSGQ char(10);
end-pi ;
// The MSGQ parameter is from the PSDS *PROC
// I tried having this defined in the view where the DDS file
// is defined, and I have tried with it defined in the main CNTRL program
Dcl-s MsgTxt char(30);
if Msg=1;
MsgTxt='Invalid Facility';
AT1FAC=setAttr(*omit:'RI');
elseif Msg=2;
MsgTxt='Status must be O, C, or A!';
AT1STAT=setAttr(*omit:'RI');
elseif Msg=3;
MsgTxt='Invalid Order Number';
AT1ITEM=setAttr(*omit:'RI');
elseif Msg=4;
MsgTxt='Invalid Vendor Number';
AT1VEND=setAttr(*omit:'RI');
elseif Msg=5;
MsgTxt='Invalid Pallet Number';
AT1PLT=setAttr(*omit:'RI');
endif;
callp SendMsg (*blanks: *blanks :
MsgTxt : %size(MsgTxt):
'*INFO': '*':
0: *blanks: ErrorDS);
// I have tried setting the CallStackEnt to * and C
// And the CallStackCtr to 0,1,2
write msgctl;
end-proc ;
和用于显示的 DDS....
A DSPSIZ(24 80 *DS3)
A CHGINPDFT(UL FE)
A PRINT
A HELP
A ALTHELP(CA01)
A* ALTPAGEUP(CF07)
A* ALTPAGEDWN(CF08)
A CF03(03)
A CF04(04)
A CF06(06)
A CF12(12)
*------------------------------------------------------------------*
* Screen 1 - Filter Criteria
*------------------------------------------------------------------*
A R SCREEN1
A OVERLAY
A BLINK
A RTNCSRLOC(&REC1 &FLD1)
A CSRLOC(XROW1 XCOL1)
A XROW1 3S 0H
A XCOL1 3S 0H
A REC1 10A H
A FLD1 10A H
A 1 2'SCN200-01'
A COLOR(BLU)
A COMPANY 40A O 1 20DSPATR(HI)
A WSID 10A O 1 62
A 1 73DATE
A EDTCDE(Y)
A 2 2SYSNAME
A 2 23'Pallet Maintenance'
A COLOR(BLU)
A 2 62USER
A 2 73TIME
A 5 4'Enter Facility to Search'
A COLOR(BLU)
A 7 7'Facility:'
A DFAC1 2 B 7 21
A DSPATR(&AT1FAC)
A AT1FAC 1A P
A 7 24'+'
A 8 2'Pallet Status:'
A DSTAT 1 B 8 21
A DSPATR(&AT1STAT)
A AT1STAT 1A P
A 8 24'(O=Open, C=Closed, or A=All)'
A 10 4'Search by Item and/or Vendor:'
A COLOR(BLU)
A 11 11'Item:'
A DITM1 15A B 11 21
A DSPATR(&AT1ITEM)
A AT1ITEM 1A P
A 11 37'+ (Blank=All)'
A 12 9'Vendor:'
A DVND1 5S 0B 12 21
A DSPATR(&AT1VEND)
A AT1VEND 1A P
A 12 28'+ (Blank=All)'
A 15 7'Or By Pallet ID:'
A COLOR(BLU)
A 16 9'Pallet:'
A DPLT1 11A B 16 21
A DSPATR(&AT1PLT)
A AT1PLT 1A P
A 18 4'IF ALL SEARCH FIELDS LEFT BLANK, +
A ALL FACILITY RECORDS'
A COLOR(BLU)
A 19 6 'DISPLAYED IN PALLET ID ORDER.'
A COLOR(BLU)
A 23 2'F3=Exit'
A COLOR(BLU)
*------------------------------------------------------------------*
* Message Subfile
*------------------------------------------------------------------*
A R MSGRCD TEXT('MSG SFL RECORD')
A SFL SFLMSGRCD(24)
A MSGKEY SFLMSGKEY
A PGMSGQ SFLPGMQ
*------------------------------------------------------------------*
* Message Subfile Control
*------------------------------------------------------------------*
A R MSGCTL TEXT('MSG SFL CONTROL')
A OVERLAY SFLCTL(MSGRCD) SFLSIZ(10)
A SFLPAG(1) SFLDSPCTL SFLDSP SFLINZ
A N98 SFLEND
A PGMSGQ SFLPGMQ
这是启动该过程的 CL...它非常基本,但我们在遗留代码中使用了很多覆盖,所以我认为从 CL 开始会有所帮助...
PGM
DCL VAR(&COMPANY) TYPE(*CHAR) LEN(40) VALUE('BROWNFOX')
CALL PGM(CNTRL) PARM(&Company)
ENDPGM
顺便说一句,公司位是我测试的遗物。我在服务程序中添加了公司检索。
还有 CNTRL RPGLE...
ctl-opt dftactgrp(*no) BNDDIR('MVC');
*------------------------------------------------------------------*
* Mainline processing
*------------------------------------------------------------------*
/define MODEL_PalletMaintenance
/copy TEMPLATE/QCPYSRC,MODEL
/undefine MODEL_PalletMaintenance
/define VIEW_GetParms
/copy TEMPLATE/QCPYSRC,VIEW
/undefine VIEW_GetParms
dcl-ds *N PSDS;
PGMSGQ *PROC;
WSID CHAR(10) Pos(244);
USER CHAR(10) Pos(254);
end-ds;
//dcl-s Exit ind;
//dcl-s ErrorField char(30);
dcl-s ErrorText char(30);
dcl-s ErrorID int(3);
//dcl-ds Screen1DS likeDS(Screen1);
dcl-s CurrentStep int(5);
dcl-c StepExit 0;
dcl-c StepPrep 1;
dcl-c StepShowScreen1 2;
dcl-c StepValidateScreen1 3;
//dcl-c StepShowScreen2 0;
dcl-pr cntrl EXTPGM ;
END-PR;
//dcl-PROC cntrl;
dcl-pi *n;
END-PI;
CurrentStep=StepPrep;
DoU CurrentStep=StepExit;
select;
When CurrentStep=StepPrep;
VIEW_Prep(Screen1DS);
MODEL_Prep(Screen1DS);
CurrentStep=StepShowScreen1;
When CurrentStep=StepShowScreen1;
if (VIEW_GetParms(Screen1DS));
CurrentStep=StepValidateScreen1;
else;
CurrentStep=StepExit;
ENDIF;
When CurrentStep=StepValidateScreen1;
ErrorID=MODEL_ValidateScreen1(Screen1DS);
if (ErrorID<>0);
VIEW_SetError(ErrorID:PGMSGQ);
CurrentStep=StepShowScreen1;
else;
CurrentStep=StepExit;
ENDIF;
ENDSL;
enddo;
*INLR=*on;
Return;
而且我想如果我已经做到了这一点,我不妨加入副本成员
模型复制
/if defined(MODEL_PalletMaintenance)
dcl-ds Screen1DS qualified;
Company char(40);
Facility char(2);
Status char(1);
Item char(35);
Vendor zoned(5:0);
Pallet char(11);
END-DS;
DCL-PR MODEL_Prep;
*n likeds(Screen1DS);
END-PR;
DCL-PR MODEL_ValidateScreen1 int(3);
*n likeds(Screen1DS);
END-PR;
/endif
并查看....
/if defined(VIEW_GetParms)
dcl-ds VScreen1DS qualified;
Company char(40);
Facility char(2);
Status char(1);
Item char(35);
Vendor zoned(5:0);
Pallet char(11);
END-DS;
DCL-PR VIEW_Prep;
*n likeds(VScreen1DS);
END-PR;
DCL-PR VIEW_GetParms Ind;
*n likeds(VScreen1DS);
END-PR;
DCL-PR screen1ResetIndicators;
END-PR;
DCL-PR ClearScreen1;
END-PR;
DCL-PR VIEW_SetError;
*n int(3);
*n char(10);
END-PR;
/endif
跟踪当前堆栈级别可能很棘手。
请记住,当您在过程内部时,堆栈级别会增加 1。因此,如果您当前的堆栈级别为 1 并且您调用了一个过程,则该过程内部的堆栈级别为 2。
在我的应用程序中,我声明了一个初始化为 1 的全局变量。在进入过程时,我将该变量加 1,在退出时,我减去 1。该变量被传递给 QMHSNDPM API。
顺便说一句,调用子程序不会将堆栈加 1。
希望这对您有所帮助。
// The MSGQ parameter is from the PSDS *PROC
// I tried having this defined in the view where the DDS file
// is defined, and I have tried with it defined in the main CNTRL program
所以在程序栈上,每一个栈入口都有一个消息队列。您声明用于初始化消息子文件的消息队列来自 PSDS *PROC
。所以你需要将你的消息发送到同一个堆栈条目。我这样做的方法是用相同的变量填充 StackEntry 和 PGMMSGQ,并使 Stack Counter 为 0。
这是我发送消息到消息子文件的程序(我保存在服务程序中):
// ----------------------------------------
// SndDspfMsgText - sends an *INFO message to the
// message subfile in a display file.
//
// Parameters:
// StackEntry - The program call stack entry to which the message is sent.
// Usually the program name. This must be the same value that
// is placed in the SFLPGMQ variable in the message subfile
// control format.
// MsgText - Text of the messqage to be sent.
// MsgTextLen - The length of the message text provided above.
// ----------------------------------------
dcl-proc SndDspfMsgText Export;
dcl-pi *n;
StkEnt Char(10) Const;
MsgText Char(512) Const Options(*VarSize);
MsgTextLen Int(10) Const;
end-pi;
dcl-ds MsgFile LikeDs(QualName_t) Inz(*LikeDs);
dcl-ds ErrorCd LikeDs(ErrorCdType1_t) Inz(*LikeDs);
dcl-s pmMsgId Char(7) Inz('CPF9898');
dcl-s pmMsgText Char(512) Inz('');
dcl-s pmMsgTextLen Int(10) Inz(0);
dcl-s pmMsgTyp Char(10) Inz('*INFO');
dcl-s pmStkCnt Int(10) Inz(0);
dcl-s pmMsgKey Char(4) Inz('');
// if Message Data is provided,
if MsgTextLen > 0;
pmMsgTextLen = min(%size(MsgText): MsgTextLen);
pmMsgText = %subst(MsgText: 1: pmMsgTextLen);
endif;
MsgFile.Name = 'QCPFMSG';
qmhsndpm(pmMsgId: MsgFile: pmMsgText: pmMsgTextLen:
pmMsgTyp: StkEnt: pmStkCnt: pmMsgKey:
ErrorCd);
end-proc;
这里有几个模板,您将需要这些模板才能完全理解上述过程:
// Standard Error Code Format
dcl-ds ErrorCdType1_t Qualified Template Inz;
BytesProv Int(10) Inz(%size(ErrorCdType1_t));
BytesAvail Int(10);
MsgId Char(7);
Data Char(1024) Pos(17);
end-ds;
// Qualified Name
dcl-s Name_t Char(10) Template Inz('');
dcl-ds QualName_t Qualified Template Inz;
Name Like(Name_t) Inz('');
Lib Like(Name_t) Inz('*LIBL');
end-ds;
// Call Stack Qualifier - used by message handling APIs
dcl-ds CallStackQual_t Qualified Template Inz;
Module Like(Name_t) Inz('*NONE');
Program Like(Name_t) Inz('*NONE');
end-ds;
// Send Program Message
dcl-pr qmhsndpm ExtPgm('QMHSNDPM');
MessageId Char(7) Const;
MessageFile LikeDs(QualName_t) Const;
MessageDta Char(512) Const Options(*Varsize);
MessageLen Int(10) Const;
MessageType Char(10) Const;
StackEntry Char(4102) Const Options(*Varsize);
StackCounter Int(10) Const;
MessageKey Char(4);
Error LikeDs(ErrorCdType1_t);
StackEntryLen Int(10) Const Options(*NoPass);
StackEntryQual LikeDs(CallStackQual_t)
Const Options(*NoPass);
ScreenWaitTime Int(10) Const Options(*NoPass);
StackEntryType Char(10) Const Options(*NoPass);
Ccsid Int(10) Const Options(*NoPass);
end-pr;
QMHSNDPM 疑难解答:在调用 QMHRMVPM 之前和调用 QMHSNDPM 之后查看交互式作业的消息(系统请求 3,然后选项 10,然后 f10,然后 f18)如果您没有看到消息,则程序有问题发送消息。如果您确实看到消息,请按 f1 并将光标放在消息上,然后按 F9 以查看消息的发送位置。
您的程序可能需要 2 或 3 的 msgCallStack,如果您希望在命令行返回消息,则需要 4 或 5。
我输入旧学校格式以查看变量名称。
call 'QMHSNDPM'
parm msgIdIN
parm msgLoc
parm msgRplDta
parm msgRplDtaLen
parm msgType
parm msgQueue
parm 3 msgCallStack
parm msgKey
parm msgErr
这应该将消息从模型中的过程发送回视图。
对于 RPG 交互中的 MVC 风格程序,您从视图开始,然后向下调用模型,该模型将消息发射回视图。也许你有一个调用视图的控制器。
我正在尝试涉足 RPG ILE 的 MVC 池。所以我有两个模块 VIEW 和 MODEL,它们绑定到我的主程序 CNTRL。我通过调用 MODEL 模块来验证在我的 VIEW 模块中输入的信息,然后将任何错误传回给 View。当我尝试使用 QHNSNDPM api 时,我在作业日志中看到错误,然后是 CALL STACK ENTRY NOT FOUND。我试图在调用堆栈上找到 VIEW 模块,但它不在那里。在 DDS 和 ILE 方面不是很强大,我不确定 how/what 可以解决这个错误。任何建议将不胜感激!
DCL-F 显示器工作台;在VIEW模块中。
现在从 VIEW 模块获取一些代码....
dcl-pr SendMsg Extpgm('QMHSNDPM');
MsgID char(7) const;
MsgF char(20) const;
MsgData char(30) const;
MsgDataLen int(10) const;
MsgType char(10) const;
CallStackEnt char(10) const;
CallStackCtr int(10) const;
MsgKey char(4) const;
Error like(ErrorDS);
end-pr;
*******************************************************************
dcl-proc VIEW_SetError EXPORT;
dcl-pi *n;
Msg int(3);
MSGQ char(10);
end-pi ;
// The MSGQ parameter is from the PSDS *PROC
// I tried having this defined in the view where the DDS file
// is defined, and I have tried with it defined in the main CNTRL program
Dcl-s MsgTxt char(30);
if Msg=1;
MsgTxt='Invalid Facility';
AT1FAC=setAttr(*omit:'RI');
elseif Msg=2;
MsgTxt='Status must be O, C, or A!';
AT1STAT=setAttr(*omit:'RI');
elseif Msg=3;
MsgTxt='Invalid Order Number';
AT1ITEM=setAttr(*omit:'RI');
elseif Msg=4;
MsgTxt='Invalid Vendor Number';
AT1VEND=setAttr(*omit:'RI');
elseif Msg=5;
MsgTxt='Invalid Pallet Number';
AT1PLT=setAttr(*omit:'RI');
endif;
callp SendMsg (*blanks: *blanks :
MsgTxt : %size(MsgTxt):
'*INFO': '*':
0: *blanks: ErrorDS);
// I have tried setting the CallStackEnt to * and C
// And the CallStackCtr to 0,1,2
write msgctl;
end-proc ;
和用于显示的 DDS....
A DSPSIZ(24 80 *DS3)
A CHGINPDFT(UL FE)
A PRINT
A HELP
A ALTHELP(CA01)
A* ALTPAGEUP(CF07)
A* ALTPAGEDWN(CF08)
A CF03(03)
A CF04(04)
A CF06(06)
A CF12(12)
*------------------------------------------------------------------*
* Screen 1 - Filter Criteria
*------------------------------------------------------------------*
A R SCREEN1
A OVERLAY
A BLINK
A RTNCSRLOC(&REC1 &FLD1)
A CSRLOC(XROW1 XCOL1)
A XROW1 3S 0H
A XCOL1 3S 0H
A REC1 10A H
A FLD1 10A H
A 1 2'SCN200-01'
A COLOR(BLU)
A COMPANY 40A O 1 20DSPATR(HI)
A WSID 10A O 1 62
A 1 73DATE
A EDTCDE(Y)
A 2 2SYSNAME
A 2 23'Pallet Maintenance'
A COLOR(BLU)
A 2 62USER
A 2 73TIME
A 5 4'Enter Facility to Search'
A COLOR(BLU)
A 7 7'Facility:'
A DFAC1 2 B 7 21
A DSPATR(&AT1FAC)
A AT1FAC 1A P
A 7 24'+'
A 8 2'Pallet Status:'
A DSTAT 1 B 8 21
A DSPATR(&AT1STAT)
A AT1STAT 1A P
A 8 24'(O=Open, C=Closed, or A=All)'
A 10 4'Search by Item and/or Vendor:'
A COLOR(BLU)
A 11 11'Item:'
A DITM1 15A B 11 21
A DSPATR(&AT1ITEM)
A AT1ITEM 1A P
A 11 37'+ (Blank=All)'
A 12 9'Vendor:'
A DVND1 5S 0B 12 21
A DSPATR(&AT1VEND)
A AT1VEND 1A P
A 12 28'+ (Blank=All)'
A 15 7'Or By Pallet ID:'
A COLOR(BLU)
A 16 9'Pallet:'
A DPLT1 11A B 16 21
A DSPATR(&AT1PLT)
A AT1PLT 1A P
A 18 4'IF ALL SEARCH FIELDS LEFT BLANK, +
A ALL FACILITY RECORDS'
A COLOR(BLU)
A 19 6 'DISPLAYED IN PALLET ID ORDER.'
A COLOR(BLU)
A 23 2'F3=Exit'
A COLOR(BLU)
*------------------------------------------------------------------*
* Message Subfile
*------------------------------------------------------------------*
A R MSGRCD TEXT('MSG SFL RECORD')
A SFL SFLMSGRCD(24)
A MSGKEY SFLMSGKEY
A PGMSGQ SFLPGMQ
*------------------------------------------------------------------*
* Message Subfile Control
*------------------------------------------------------------------*
A R MSGCTL TEXT('MSG SFL CONTROL')
A OVERLAY SFLCTL(MSGRCD) SFLSIZ(10)
A SFLPAG(1) SFLDSPCTL SFLDSP SFLINZ
A N98 SFLEND
A PGMSGQ SFLPGMQ
这是启动该过程的 CL...它非常基本,但我们在遗留代码中使用了很多覆盖,所以我认为从 CL 开始会有所帮助...
PGM
DCL VAR(&COMPANY) TYPE(*CHAR) LEN(40) VALUE('BROWNFOX')
CALL PGM(CNTRL) PARM(&Company)
ENDPGM
顺便说一句,公司位是我测试的遗物。我在服务程序中添加了公司检索。
还有 CNTRL RPGLE...
ctl-opt dftactgrp(*no) BNDDIR('MVC');
*------------------------------------------------------------------*
* Mainline processing
*------------------------------------------------------------------*
/define MODEL_PalletMaintenance
/copy TEMPLATE/QCPYSRC,MODEL
/undefine MODEL_PalletMaintenance
/define VIEW_GetParms
/copy TEMPLATE/QCPYSRC,VIEW
/undefine VIEW_GetParms
dcl-ds *N PSDS;
PGMSGQ *PROC;
WSID CHAR(10) Pos(244);
USER CHAR(10) Pos(254);
end-ds;
//dcl-s Exit ind;
//dcl-s ErrorField char(30);
dcl-s ErrorText char(30);
dcl-s ErrorID int(3);
//dcl-ds Screen1DS likeDS(Screen1);
dcl-s CurrentStep int(5);
dcl-c StepExit 0;
dcl-c StepPrep 1;
dcl-c StepShowScreen1 2;
dcl-c StepValidateScreen1 3;
//dcl-c StepShowScreen2 0;
dcl-pr cntrl EXTPGM ;
END-PR;
//dcl-PROC cntrl;
dcl-pi *n;
END-PI;
CurrentStep=StepPrep;
DoU CurrentStep=StepExit;
select;
When CurrentStep=StepPrep;
VIEW_Prep(Screen1DS);
MODEL_Prep(Screen1DS);
CurrentStep=StepShowScreen1;
When CurrentStep=StepShowScreen1;
if (VIEW_GetParms(Screen1DS));
CurrentStep=StepValidateScreen1;
else;
CurrentStep=StepExit;
ENDIF;
When CurrentStep=StepValidateScreen1;
ErrorID=MODEL_ValidateScreen1(Screen1DS);
if (ErrorID<>0);
VIEW_SetError(ErrorID:PGMSGQ);
CurrentStep=StepShowScreen1;
else;
CurrentStep=StepExit;
ENDIF;
ENDSL;
enddo;
*INLR=*on;
Return;
而且我想如果我已经做到了这一点,我不妨加入副本成员
模型复制
/if defined(MODEL_PalletMaintenance)
dcl-ds Screen1DS qualified;
Company char(40);
Facility char(2);
Status char(1);
Item char(35);
Vendor zoned(5:0);
Pallet char(11);
END-DS;
DCL-PR MODEL_Prep;
*n likeds(Screen1DS);
END-PR;
DCL-PR MODEL_ValidateScreen1 int(3);
*n likeds(Screen1DS);
END-PR;
/endif
并查看....
/if defined(VIEW_GetParms)
dcl-ds VScreen1DS qualified;
Company char(40);
Facility char(2);
Status char(1);
Item char(35);
Vendor zoned(5:0);
Pallet char(11);
END-DS;
DCL-PR VIEW_Prep;
*n likeds(VScreen1DS);
END-PR;
DCL-PR VIEW_GetParms Ind;
*n likeds(VScreen1DS);
END-PR;
DCL-PR screen1ResetIndicators;
END-PR;
DCL-PR ClearScreen1;
END-PR;
DCL-PR VIEW_SetError;
*n int(3);
*n char(10);
END-PR;
/endif
跟踪当前堆栈级别可能很棘手。
请记住,当您在过程内部时,堆栈级别会增加 1。因此,如果您当前的堆栈级别为 1 并且您调用了一个过程,则该过程内部的堆栈级别为 2。
在我的应用程序中,我声明了一个初始化为 1 的全局变量。在进入过程时,我将该变量加 1,在退出时,我减去 1。该变量被传递给 QMHSNDPM API。
顺便说一句,调用子程序不会将堆栈加 1。
希望这对您有所帮助。
// The MSGQ parameter is from the PSDS *PROC
// I tried having this defined in the view where the DDS file
// is defined, and I have tried with it defined in the main CNTRL program
所以在程序栈上,每一个栈入口都有一个消息队列。您声明用于初始化消息子文件的消息队列来自 PSDS *PROC
。所以你需要将你的消息发送到同一个堆栈条目。我这样做的方法是用相同的变量填充 StackEntry 和 PGMMSGQ,并使 Stack Counter 为 0。
这是我发送消息到消息子文件的程序(我保存在服务程序中):
// ----------------------------------------
// SndDspfMsgText - sends an *INFO message to the
// message subfile in a display file.
//
// Parameters:
// StackEntry - The program call stack entry to which the message is sent.
// Usually the program name. This must be the same value that
// is placed in the SFLPGMQ variable in the message subfile
// control format.
// MsgText - Text of the messqage to be sent.
// MsgTextLen - The length of the message text provided above.
// ----------------------------------------
dcl-proc SndDspfMsgText Export;
dcl-pi *n;
StkEnt Char(10) Const;
MsgText Char(512) Const Options(*VarSize);
MsgTextLen Int(10) Const;
end-pi;
dcl-ds MsgFile LikeDs(QualName_t) Inz(*LikeDs);
dcl-ds ErrorCd LikeDs(ErrorCdType1_t) Inz(*LikeDs);
dcl-s pmMsgId Char(7) Inz('CPF9898');
dcl-s pmMsgText Char(512) Inz('');
dcl-s pmMsgTextLen Int(10) Inz(0);
dcl-s pmMsgTyp Char(10) Inz('*INFO');
dcl-s pmStkCnt Int(10) Inz(0);
dcl-s pmMsgKey Char(4) Inz('');
// if Message Data is provided,
if MsgTextLen > 0;
pmMsgTextLen = min(%size(MsgText): MsgTextLen);
pmMsgText = %subst(MsgText: 1: pmMsgTextLen);
endif;
MsgFile.Name = 'QCPFMSG';
qmhsndpm(pmMsgId: MsgFile: pmMsgText: pmMsgTextLen:
pmMsgTyp: StkEnt: pmStkCnt: pmMsgKey:
ErrorCd);
end-proc;
这里有几个模板,您将需要这些模板才能完全理解上述过程:
// Standard Error Code Format
dcl-ds ErrorCdType1_t Qualified Template Inz;
BytesProv Int(10) Inz(%size(ErrorCdType1_t));
BytesAvail Int(10);
MsgId Char(7);
Data Char(1024) Pos(17);
end-ds;
// Qualified Name
dcl-s Name_t Char(10) Template Inz('');
dcl-ds QualName_t Qualified Template Inz;
Name Like(Name_t) Inz('');
Lib Like(Name_t) Inz('*LIBL');
end-ds;
// Call Stack Qualifier - used by message handling APIs
dcl-ds CallStackQual_t Qualified Template Inz;
Module Like(Name_t) Inz('*NONE');
Program Like(Name_t) Inz('*NONE');
end-ds;
// Send Program Message
dcl-pr qmhsndpm ExtPgm('QMHSNDPM');
MessageId Char(7) Const;
MessageFile LikeDs(QualName_t) Const;
MessageDta Char(512) Const Options(*Varsize);
MessageLen Int(10) Const;
MessageType Char(10) Const;
StackEntry Char(4102) Const Options(*Varsize);
StackCounter Int(10) Const;
MessageKey Char(4);
Error LikeDs(ErrorCdType1_t);
StackEntryLen Int(10) Const Options(*NoPass);
StackEntryQual LikeDs(CallStackQual_t)
Const Options(*NoPass);
ScreenWaitTime Int(10) Const Options(*NoPass);
StackEntryType Char(10) Const Options(*NoPass);
Ccsid Int(10) Const Options(*NoPass);
end-pr;
QMHSNDPM 疑难解答:在调用 QMHRMVPM 之前和调用 QMHSNDPM 之后查看交互式作业的消息(系统请求 3,然后选项 10,然后 f10,然后 f18)如果您没有看到消息,则程序有问题发送消息。如果您确实看到消息,请按 f1 并将光标放在消息上,然后按 F9 以查看消息的发送位置。
您的程序可能需要 2 或 3 的 msgCallStack,如果您希望在命令行返回消息,则需要 4 或 5。
我输入旧学校格式以查看变量名称。
call 'QMHSNDPM'
parm msgIdIN
parm msgLoc
parm msgRplDta
parm msgRplDtaLen
parm msgType
parm msgQueue
parm 3 msgCallStack
parm msgKey
parm msgErr
这应该将消息从模型中的过程发送回视图。
对于 RPG 交互中的 MVC 风格程序,您从视图开始,然后向下调用模型,该模型将消息发射回视图。也许你有一个调用视图的控制器。