Schoenen Nachmittag.
Jetzt braeuchte ich eure Hilfe mal denn ich sehe den Wald vor lauter Baeume nicht mehr.
Ich bin gerade dabei mein ersten Programm in **FREE zu schrieben. Es soll ein Dialogprogramm werden welches die Fehler per QMHSNDPM an das Messagesubfile schicken soll. In meinen vorherigen pseudo-free Programmen hat dies immer wunderbar geklappt.
Daher habe ich die Prozeduren einfach aus den "alten" pseudo-free ile rpg uebernommen bzw ins free uebersetzt. Genau so den CallStackEntry 0 sowie PgmQueue 'MAIN' (wie bei mir halt immer). Ich habs aber auch schon mit '*' statt 'MAIN' probiert. Leider wird im Subfile nichts angezeigt sondern nur im Joblog.
Im Dsplayfile wie gehabt:
Code:
DSPSIZ(24 80 *DS4) PRINT
ALTHELP(CA01) HELP
MSGLOC(24) ERRSFL
R AUFAU7ZS SFL
SFLMSGRCD(24)
MESSAGEKEY SFLMSGKEY
PGMQUEUE SFLPGMQ
R AUFAU7ZC SFLCTL(AUFAU7ZS)
CF01
KEEP
OVERLAY
PUTRETAIN
SFLDSP
SFLDSPCTL
SFLINZ
N88 SFLEND
SFLSIZ(2)
SFLPAG(1)
PGMQUEUE SFLPGMQ
Das Displayfile ist folgendermaßen definiert:
Code:
DCL-F AUFAU7DF WORKSTN INFDS(WSDS) ALIAS USROPN;
Die beiden Felder fuer den Stack sowie PgmQ:
Code:
DCL-C MESSAGEFILE 'XXMSGF *LIBL';
DCL-S PgmQueue CHAR(10) INZ('MAIN');
DCL-S CallStack INT(10) INZ(0);
Der Prozeduraufruf für das API
Code:
DCL-PR API_QMHSNDPM EXTPGM('QMHSNDPM');
MessageID CHAR(7) CONST;
MessageFile CHAR(20) CONST;
MessageData CHAR(128) CONST;
MessageDataLenght INT(10) CONST;
MessageType CHAR(10) CONST;
CallStackEntry CHAR(10) CONST;
CallStackLevel INT(10) CONST;
MessageKey CHAR(4) CONST;
ErrorDS LIKEDS(API_ErrorDS);
END-PR;
Dieses wird eben aus folgender Prozedur aufgerufen:
Code:
DCL-PROC SndPgmMsgPrc;
DCL-PI SndPgmMsgPrc;
pMessageID CHAR(7) CONST;
pMessageFile CHAR(20) CONST;
pMessageData CHAR(128) CONST;
pMessageProgramQueue CHAR(10) CONST;
pMessageCallStack INT(10) CONST;
END-PI;
/INCLUDE GHP3MOD/QRPGLECPY,QMHSNDPM
DCL-S MessageKey CHAR(4) INZ;
//------------------------------------------------------------------------
API_QMHSNDPM ( pMessageID :
pMessageFile :
pMessageData :
%Size(pMessageData) :
'*INFO' :
pMessageProgramQueue :
pMessageCallStack :
MessageKey :
API_ErrorDS );
END-PROC;
Das DSPF wird in einer eigenen Prozedur ausgegeben:
Code:
DCL-PROC LoopFM_A;
Clear AUFAU7A0;
InitFM_A();
DoW ( PictureControl = FM_A );
Write AUFAU7A0;
Write AUFAU7ZC;
ExFmt AUFAU7A0;
ClrMsgPrc(PgmQueue :CallStack);
Select;
When ( WSDS.KeyPressed = KeyF03 );
PictureControl = FM_End;
When ( WSDS.KeyPressed = KeyF04 );
PromptFM_A();
When ( WSDS.KeyPressed = KeyEnter );
If CheckFM_A();
EndIf;
EndSl;
EndDo;
END-PROC;
Und folgendermaßen wird dann die Nachricht in der Prozedur CheckFM_A gesendet:
Code:
SndPgmMsgPrc('F000033' :MESSAGEFILE :Feld :PgmQueue :CallStack);
Lt. Joblog wird die Nachricht brav an die MAIN geschickt (wie bei den vorherigen ebenfalls)
Code:
Von Programm . . . . . . . . . : AUFAU7RG
Von Bibliothek . . . . . . . : TESTLIB
Von Modul . . . . . . . . . : AUFAU7RG
Von Prozedur . . . . . . . . : SNDPGMMSGPRC
Von Anweisung . . . . . . . : 550
An Programm . . . . . . . . . : AUFAU7RG
An Bibliothek . . . . . . . : TESTLIB
An Modul . . . . . . . . . . : AUFAU7RG
An Prozedur . . . . . . . . : MAIN
An Anweisung . . . . . . . . : 248
Wie gesagt, ich habs mittlerweile schon mit MAIN und * sowie CallStackEntry 0 sowie 1 (wo dann die Nachricht an die PEP geschickt wird) probiert. Weiters hab ich das Feld PGMQUEUE geteilt. Einmal im Subfile PGMQNAME mit 'MAIN' und die Nachricht hab ich an '*' geschickt. Gleicher "Erfolg".
Wie oben erwähnt, ich sehe den Wald vor lauter Bäume nicht mehr denn das Prinzip hat bei meinen vorherigen Programme (ohne totally free aber sonst gleichem Aufbau) tadellos funktioniert.
Und natürlich habe ich ein altes DSPF mit dem jetzigen verglichen sowie die Felder im Programm selbst. Vielleicht hat hier jemand eine Idee woran ich hier jetzt soooo gigantisch scheitere :-)
Dankeschön und Lg
Bookmarks