-
Versuch mal den hier.
PHP-Code:
h DftActGrp(*NO)
*
* Prozedurenprototyp für Prozedur 'QMHSNDPM'
*
dQMHSNDPM PR ExtPgm('QMHSNDPM')
d 7A Const --> Message identifier
d 20A Const --> Qualified message file name
d 32767A Const Options(*VarSize) --> Message data
d 10I 0 Const --> Length of message data
d 10A Const --> Message type
d 256A Const --> Call stack entry
d 10I 0 Const --> Call stack counter
d 4A <-- Message key
d 32767A Options(*VarSize) <-> Error code
d 10I 0 Const Options(*NoPass) --> Length of call stack entry
d 20A Const Options(*NoPass) --> Call stack entry qualification
d 10I 0 Const Options(*NoPass) --> Display program messages SWT
d 10A Const Options(*NoPass) --> Call stack entry data type
d 10I 0 Const Options(*NoPass) --> Coded character set identifier
*
* Datenstruktur für Format 'ERRC0100' für Fehlercode
*
dERRC0100 DS
d ERRCBytePrv 10I 0 Inz(272) --> Bytes provided
d ERRCByteAvl 10I 0 <-- Bytes available
d ERRCExcId 7A <-- Exeption-Id.
d ERRCRsrvd 1A <-- Reserved
d ERRCExcDta 256A <-- Exeption data
*
* Sonstige Felddeklarationen
*
dITMsgKey S 4A Nachrichtenschlüssel
*
* Nachricht in die Programmnachrichtenwarteschlange senden
*
c Reset ERRC0100
c CallP QMHSNDPM('CPF9897' : --> Message identifier
c 'QCPFMSG *LIBL' : --> Qualified message file name
c 'Hello World' : --> Message data
c 11 : --> Length of message data
c '*INFO' : --> Message type
c '*' : --> Call stack entry
c 2 : --> Call stack counter
c ITMsgKey : <-- Message key
c ERRC0100 : <-> Error code
c 1 : --> Length of call stack entry
c '*NONE *NONE' : --> Call stack entry qualification
c 0)
*
* Programmende
*
c Eval *INLR = *On
Frank Hildebrandt
-
vielen Dank für Eure Hilfe,
- leider bringt *PGMBDY nichts
- auch mit der Prozedur von Frank gab's kein Erfolg...
- muss man vielleicht was in der Aktivierungsgruppe einstellen (ACTGROUP *NEW ...) ?
....
anbei die komplette Source:
Code:
H DECEDIT('0,') DATEDIT(*DMY.)
H DFTACTGRP(*NO) OPTION(*NODEBUGIO)
H* ***************************************************************
*
//-----------------------------------
// Prototypenbeschreibung für Module
// und Serviceprogramme einbinden
//-----------------------------------
D/COPY QSYSINC/QRPGLESRC,QUSROBJD
*
//-----------------------------------------
// Prozeduren für Exterene Programmaufrufe
//-----------------------------------------
D USROBJD PR EXTPGM('QUSROBJD')
D R_RTN 527A
D R_LEN 4B 0
D R_FMT 8A
D R_OBJ 20A
D R_OBJT 10A
*
//-----------------------------------------
// übersicht interne Prozeduren/Funktionen
//-----------------------------------------
D GET_SIZE PR
D V_OBJ 10A VALUE
D V_LIBL 10A VALUE
D V_SIZE 9S 0 OPTIONS(*NOPASS)
D V_OK N OPTIONS(*NOPASS)
*
* Prozedurenprototyp für Prozedur 'QMHSNDPM'
*
dQMHSNDPM PR ExtPgm('QMHSNDPM')
d 7A Const
d 20A Const
d 32767A Const Options(*VarSize)
d 10I 0 Const
d 10A Const
d 256A Const
d 10I 0 Const
d 4A
d 32767A Options(*VarSize)
d 10I 0 Const Options(*NoPass)
d 20A Const Options(*NoPass)
d 10I 0 Const Options(*NoPass)
d 10A Const Options(*NoPass)
d 10I 0 Const Options(*NoPass)
*
* Datenstruktur für Format 'ERRC0100' für Fehlercode
*
dERRC0100 DS
d ERRCBytePrv 10I 0 Inz(272)
d ERRCByteAvl 10I 0
d ERRCExcId 7A
d ERRCRsrvd 1A
d ERRCExcDta 256A
*
//------------------------------------------
// Variablendeklaration
//------------------------------------------
*
D OK S N Inz(*Off)
d ITMsgKey S 4A
D P_MsgData S 32767A
D P_DataLength S 10I 0
D SIZE S 9S 0
*
‚*-------------------------------------------------------------------
‚* PARAMETER
‚*-------------------------------------------------------------------
C *ENTRY PLIST
C PARM PAFILE 10
C PARM PALIBL 10
*
C*‚********************************************************************
C*š* MAIN-PROGRAM *
C*‚********************************************************************
*
* // Größe der Datei ermitteln
C CALLP(E) GET_SIZE(PAFILE:PALIBL:SIZE:OK)
*
C EXSR SND_MSG
*
*š // Programmende einleiten
C MOVE *ON *INLR
C*
*=====================================================================
*= SND_MSG - Nachricht in die Messagesubfile schreiben
*=====================================================================
C SND_MSG BEGSR
*
* // Vorhergehende Verarbeitung ok ?
C IF OK
C EVAL P_MsgData = 'Datei: ' + %TRIM(PAFILE) +
C ' - Größe: ' +
C %TRIM(%EDITC(SIZE:'K')) + ' Byte'
C ELSE
C EVAL P_MsgData = 'Datei wurde nicht gefunden...'
C ENDIF
*
C EVAL P_DataLength = %SIZE(P_MsgData)
*
* //Nachricht in die Messagesubfile senden
c Reset ERRC0100
c CallP QMHSNDPM('CPF9897' :
c 'QCPFMSG *LIBL' :
c P_MsgData :
c P_DataLength :
c '*INFO' :
c '*' :
c 2 :
c ITMsgKey :
c ERRC0100 :
c 1 :
c '*NONE *NONE' :
c 0)
*
C ENDSR
*
//--------------------------------------------------------------------
// Funktion GET_SIZE : Dateigröße ermitteln
//--------------------------------------------------------------------
P GET_SIZE B
D GET_SIZE PI
D V_OBJ 10A VALUE
D V_LIBL 10A VALUE
D V_SIZE 9S 0 OPTIONS(*NOPASS)
D V_OK N OPTIONS(*NOPASS)
//------------------
// Lokale Variablen
//------------------
D L_LEN S 4B 0 INZ
D L_FMT S 8A INZ
D L_OBJ S 20A INZ
D L_OBJT S 10A INZ
D L_TEST S 527A INZ
//--------------------------------------------------------------------
C CLEAR QUSD0400
*
C IF V_LIBL = *BLANKS
C EVAL L_OBJ = V_OBJ + '*LIBL'
C ELSE
C EVAL L_OBJ = V_OBJ + '' + %TRIM(V_LIBL)
C ENDIF
*
C EVAL L_OBJT = '*FILE'
C EVAL L_LEN = %SIZE(QUSD0400)
C EVAL L_FMT = 'OBJD0400'
C CALLP(E) USROBJD(L_TEST:L_LEN:L_FMT:L_OBJ:L_OBJT)
C EVAL QUSD0400 = L_TEST
C IF NOT %ERROR()
C EVAL V_SIZE = QUSOBJS00
C EVAL V_OK = *ON
C ELSE
C EVAL V_OK = *OFF
C ENDIF
*
C RETURN
*
//--------------------------------------------------------------------
P GET_SIZE E
Gruß
Bratmaxxe
-
Ich gehe jetzt mal von folgendem Fall bei Dir aus. Der Befehl ruft ein ILE-CL auf. Das ILE-CL ruft dann das ILE-RPG auf. Die Nachricht soll dann in der Nachrichtenzeile angezeigt werden, von wo aus der Befehl aufgerufen wird. Dann musst Du den Parameter 'Call stack counter' auf 4 setzen. Wenn der Wert auf 0 steht, dann wird die Nachricht in die Nachrichtenwarteschlange des ILE-RPG gesendet. Wenn der Wert auf 1 steht, dann wird die Nachricht in die Nachrichtenwarteschlange der Program-Entry-Prozedure des ILE-RPG gesendet. Wenn der Wert auf 2 steht, dann wird die Nachricht in die Nachrichtenwarteschlange des ILE-CL gesendet. Wenn der Wert auf 3 steht, dann wird die Nachricht in die Nachrichtenwarteschlange der Program-Entry-Prozedure des ILE-CL gesendet. Wenn der Wert auf 4 steht, dann wird die Nachricht in die Nachrichtenwarteschlange des Programms gesendet, welches den Befehl abgesetzt hat.
Frank Hildebrandt
-
Da lag der Hund begraben  *lach*
Wert 4 für StackEntry....
Lieben Dank nochmal Frank !!!
Gruß
Bratmaxxe
 Zitat von Frank Hildebrandt
Ich gehe jetzt mal von folgendem Fall bei Dir aus. Der Befehl ruft ein ILE-CL auf. Das ILE-CL ruft dann das ILE-RPG auf. Die Nachricht soll dann in der Nachrichtenzeile angezeigt werden, von wo aus der Befehl aufgerufen wird. Dann musst Du den Parameter 'Call stack counter' auf 4 setzen. Wenn der Wert auf 0 steht, dann wird die Nachricht in die Nachrichtenwarteschlange des ILE-RPG gesendet. Wenn der Wert auf 1 steht, dann wird die Nachricht in die Nachrichtenwarteschlange der Program-Entry-Prozedure des ILE-RPG gesendet. Wenn der Wert auf 2 steht, dann wird die Nachricht in die Nachrichtenwarteschlange des ILE-CL gesendet. Wenn der Wert auf 3 steht, dann wird die Nachricht in die Nachrichtenwarteschlange der Program-Entry-Prozedure des ILE-CL gesendet. Wenn der Wert auf 4 steht, dann wird die Nachricht in die Nachrichtenwarteschlange des Programms gesendet, welches den Befehl abgesetzt hat.
-
@bratmaxxe
Warum so "umständlich" als RPGLE und nicht als CLP ?
Also RTVOBJD und anschließend SNDPGMMSG ??
Gruß
DVE
Similar Threads
-
By cc in forum IBM i Hauptforum
Antworten: 3
Letzter Beitrag: 25-01-07, 09:29
-
By QSECOFR-1 in forum IBM i Hauptforum
Antworten: 1
Letzter Beitrag: 03-08-06, 18:06
-
By Rico in forum NEWSboard Programmierung
Antworten: 3
Letzter Beitrag: 06-07-06, 16:25
-
By becama in forum IBM i Hauptforum
Antworten: 4
Letzter Beitrag: 12-05-06, 19:46
-
By JonnyRico in forum NEWSboard Programmierung
Antworten: 14
Letzter Beitrag: 30-03-06, 12:33
Berechtigungen
- Neue Themen erstellen: Nein
- Themen beantworten: Nein
- You may not post attachments
- You may not edit your posts
-
Foren-Regeln
|
Erweiterte Foren Suche
Google Foren Suche
Forum & Artikel
Update eMail
AS/400 / IBM i
Server Expert Gruppen
Unternehmens IT
|
Kategorien online Artikel
- Big Data, Analytics, BI, MIS
- Cloud, Social Media, Devices
- DMS, Archivierung, Druck
- ERP + Add-ons, Business Software
- Hochverfügbarkeit
- Human Resources, Personal
- IBM Announcements
- IT-Karikaturen
- Leitartikel
- Load`n`go
- Messen, Veranstaltungen
- NEWSolutions Dossiers
- Programmierung
- Security
- Software Development + Change Mgmt.
- Solutions & Provider
- Speicher – Storage
- Strategische Berichte
- Systemmanagement
- Tools, Hot-Tips
Auf dem Laufenden bleiben
|
![[NEWSboard IBMi Forum]](images/duke/nblogo.gif)
[professional_User]
Mit Zitat antworten
Bookmarks