ich habe mir im Internet folgendes Pgm gefunden, was das aufrufende Programm ermittelt
Code:
Which program fired the trigger
* Prototype for the AppPgmName proceduree
D AppPgmName PR 10
D DummyPrm 1 Options( *Omit )
* Procedure to return the name of the application
* program which fired the trigger
P AppPgmName B Export
D AppPgmName PI 10
D DummyPrm 1 Options( *Omit )
* Prototypess
D SndMsg PR ExtPgm( 'QMHSNDPM')
D MsgId 7 Const
D QlMsgfName 20 Const
D MsgDta 256 Const
D Options( *VarSize )
D LenMsgDta 10I 0 Const
D MsgType 10 Const
D ClStkEntry 10 Const
D ClStkCounter 10I 0 Const
D MsgKey 4
D ApiErr 272
D RcvMsg PR ExtPgm( 'QMHRCVPM' )
D MsgInf 120
D LenMsgIfn 10I 0 Const
D FmtName 8 Const
D ClStkEntry 10 Const
D ClStkCounter 10I 0 Const
D MsgType 10 Const
D MsgKey 4 Const
D WaitTime 10I 0 Const
D MsgAct 10 Const
D ApiErr 272
* Local data
D MsgKey S 4
D ApiErr DS
D AeBytesProv 10I 0 Inz( 272 )
D AeBytesAvl 10I 0
D AeMsgId 7
D 1
D AeMsgDta 256
D MsgInf DS
D MiBytesRetd 1 4B 0
D MiBytesAvl 5 8B 0 Inz( 120 )
D MiPgmName 111 120
D TrgPgmName S 10
D CurrPgmName S 10
D PgmNameChanges S 1P 0
D ClStkCounter S 10I 0
D*
* Send a dummy message to the trigger
C CallP SndMsg( 'CPF9898': 'QCPFMSG QSYS':
C ' ': 1:
C '*INFO': '*PGMBDY':
C 1: MsgKey:
C ApiErr )
C*
* Receive the message back and pick up the trigger program name
C CallP RcvMsg( MsgInf: %Size( MsgInf ):
C 'RCVM0200': '*':
C *Zero: '*INFO':
C MsgKey: 0:
C '*REMOVE': ApiErr )
C*
C Eval TrgPgmName = MiPgmName
C*
* Keep going backward in the call stack until the program name changes
* twice. The second change to the program name will be the name of
* the application which caused the trigger to fire.
C*
C Eval CurrPgmName = TrgPgmName
C Eval PgmNameChanges = *Zero
C Eval ClStkCounter = 2
C DoU PgmNameChanges = 2
C*
C CallP SndMsg( 'CPF9898': 'QCPFMSG QSYS':
C ' ': 1:
C '*INFO': '*PGMBDY':
C ClStkCounter: MsgKey:
C ApiErr )
C*
C CallP RcvMsg( MsgInf: %Size( MsgInf ):
C 'RCVM0200': '*':
C *Zero: '*INFO':
C MsgKey: 0:
C '*REMOVE': ApiErr )
C*
C If MiPgmName <> CurrPgmName
C Eval CurrPgmName = MiPgmName
C Eval PgmNameChanges = PgmNameChanges + 1
C Else
C Eval ClStkCounter = ClStkCounter + 1
C EndIf
C*
C EndDo
C*
C Return CurrPgmName
C*
P AppPgmName E
Das klappt ja auch toll, aber falls updates über Sql-Statements erfolgen wird mir immer QSQRUN3 zurückgeliefert.
Welche Möglichkeiten würden bestehen um trotzdem das aufrunfende Programm zu ermitteln?
2 Möglichkeiten:
a) solange rückwärts im Callstack senden, bis das 1. Programm nicht mit "Q" anfängt.
b) in der DS MsgInf wird auch die Lib übergeben, also prüfen bis Lib <> QSYS
Dabei würde ich allerdings spezielle Programmnamen wie von STRSQL spezifisch behandeln.
* --------------------------------------------------------
* API-Definitionen CALLSTACK
* --------------------------------------------------------
DGetStack pr extpgm('QWVRCSTK')
d 2000
d 10I 0 const
d 8 const
d 56
d 8 const
d 16
dStackInfo ds 2000
d ByteAvail 10I 0 inz(%size(StackInfo))
d ByteReturn 10I 0
d Entries 10I 0
d Offset 10I 0
d Count 10I 0
dApiErr ds
d ErrAvail 10I 0 inz(16)
d ErrReturn 10I 0
d ErrReserv 1
d ErrMsg 7
dStackID ds
d IdInfo 26 inz('*')
d IdInt 16 inz
d IdRes 2 inz(*loval)
d IdThread 10I 0 inz(1)
d IdThId 8 inz(*loval)
dStackPtr s *
dStackEntry ds based(StackPtr)
d EntryLen 10I 0
d EntryDispSt 10I 0
d EntryStmtNo 10I 0
d EntryDispPr 10I 0
d EntryProcLen 10I 0
d EntryReqLvl 10I 0
d EntryPgm 10
d EntryLib 10
d StackAct s 10I 0
d FirstQ s 1
c/free
callp GetStack(StackInfo:%size(StackInfo):'CSTK0100'
:StackId:'JIDF0100':ApiErr);
if ErrReturn = *zero;
StackPtr = %addr(StackInfo) + Offset;
FirstQ = *off;
for StackAct = 0 to Entries - 1;
if FirstQ = *off;
if %subst(EntryPgm:1:1) = 'Q';
FirstQ = *on;
endif;
else;
if %subst(EntryPgm:1:1) <> 'Q'
or EntryLib <> 'QSYS';
LEPROG = EntryPgm; // gefundenes Programm
LEPLIB = EntryLib; // in Lib
leave;
endif;
endif;
StackPtr += EntryLen;
endfor;
/endfree
Eigentlich ist das ziemlich einfach. Das eigentliche Trigger-Programm wird durch eines der beiden QDBPUT (für Input-Trigger) oder QDBUDR (für Undate/Delete/Read-Trigger) aufgerufen. Damit muss man nur das Programm, das im Callstack vor dem entsprechenden Aktivierungsprogramm liegt ermitteln.
Das ist leider nicht ganz richtig.
Bei mir liegt bei COBOL zwischen dem QDBUDR und dem Auslöser noch das QLNRFIDX.
Ich muss also weiter gehen.
Je nach Programmsprache können da schon Unterschiede im Callstack durch Runtime-Programme auftreten.
"Q"-Programme ist auch nicht eindeutig, da durch Programmerstellung und Verschiebung in QRPLOBJ das Objekt dort auch mit "Q" anfängt, deshalb ist hier die Lib auch wieder entscheidend.
Eigentlich ist das ziemlich einfach. Das eigentliche Trigger-Programm wird durch eines der beiden QDBPUT (für Input-Trigger) oder QDBUDR (für Undate/Delete/Read-Trigger) aufgerufen. Damit muss man nur das Programm, das im Callstack vor dem entsprechenden Aktivierungsprogramm liegt ermitteln.
Birgitta
Hallo Birgitta,
im Internet hast du folgendes zu QDBPUT/QDBUDR gepostet.
Mein Problem ist das ich ermitteln muss woher das Update(QDBUDR) kommt.
Habe ein PF-File wo als "Triggerprogramm" ein Cl hinterlegt(JRN050CL) ist, das wiederum andere CL-aufruft.
Das dritte CL ruft ein RPG-Programm auf und schreibt im Endeffekt den geänderten Satz.
Wie ermittle ich nach deiner Methode den Aufruf?
Muss ich im RPG-Programm nach den Wert 'QDBUDR' abfragen und dann das CL-aufrufen.
Wie müsste der Aufruf des CL in einem Rpg-Pgm aussehen?
Dein aufgerufenes Programm ist QDBUDR und das rufende Programm must Du ermitteln.
Also übergibst Du im Parameter CALLED QDBUDR und bekommts in CALLED das Programm, das den Trigger aktiviert hat.
Wir brauchen diese Funktion auch ab und zu.
Dafür haben wir einen Trigger, (der nur angehängt wird wenn wir das brauchen), der mit dem Dateinamen in einer Datei nachsieht ob er protokollieren soll. Wenn ja schreibt er den gesammten Pgm Stack und einige zus. Infos (Datum Zeit, User, ...) in eine Datei mit 30 Programm-Namen Feldern.
Häufig ist nämlich nicht nur das Pgm, sondern auch der Aufruf von Interesse.
Allerdings haben bei uns alle Dateien einer allg. Trigger, der den eigentlichen Trigger aus einer Datei ausliest und per Call ruft.
Das hat den Vorteil, das wir zu jeder Zeit Trigger "runter" / "rauf" schalten können.
Das Notwendige steht über dem technisch machbaren.
(klingt komisch, funktioniert aber!)
Habe es jetzt umgesetzt und bekomme aber einen Fehler.
Mein Rpg-Code
Code:
D PRVPGM PR EXTPGM('PRVPGM')
D CALLER_ 10A Options( *Omit )
D CALLED_ 10A Options( *Omit )
D*
D CALLER_ID S 10A
D CALLED_ID S 10A
:
:
IF CHGPGM = 'QDBUDR';
CALLER_ID = 'QDBUDR';
CALLED_ID = *BLANKS;
CALLP(E) PRVPGM(CALLER_ID : CALLED_ID);
IF CALLED_ID <> *BLANKS AND %ERROR = *OFF;
CHGPGM = CALLED_ID;
ELSE;
IF %ERROR;
CHGPGM = 'ERR:PRVPGM';
ENDIF;
ENDIF;
ENDIF;
Joblog
Code:
Modulquelle anzeigen
Programm: PRVPGM Bibliothek: SRCTST Modul: PRVPGM
14 DCL VAR(&SENDER) TYPE(*CHAR) LEN(80)
15 /* ---------------------------------------------------------------*/
16 SNDPGMMSG MSG('TEST') TOPGMQ(*PRV (&CALLED)) MSGTYPE(*RQ
17
18 RCVMSG PGMQ(*PRV (&CALLED)) MSGKEY(&MSGKEY) SENDER(&S
19
20 CHGVAR VAR(&CALLER) VALUE(%SST(&SENDER 56 10))
21
22 ENDE: ENDPGM
Weitere Nachrichteninformationen
Nachrichten-ID . . . . : CPA0702 Bewertung . . . . . . : 99
Nachrichtenart . . . . : Anfrage
Sendedatum . . . . . . : 17.08.10 Sendezeit . . . . . . : 11:12:50
Nachricht . . . : (C D I R) CPF2469 von Prozedur PRVPGM empfangen.
Ursache . . . . : Die ILE CL-Prozedur PRVPGM in Modul PRVPGM in Programm
PRVPGM in Bibliothek SRCTST stellte einen Fehler bei Anweisungsnummer
0000000116 fest. Der Nachrichtentext für CPF2469 ist: Fehler aufgetreten
beim Senden der Nachricht . Die Taste F10 (falls verfügbar) oder den Befehl
DSPJOBLOG (Jobprotokoll anzeigen) verwenden, um die Nachrichten im
Jobprotokoll aufzulisten und eine ausführlichere Beschreibung der
Fehlerursache zu erhalten. Kann das Problem trotzdem nicht gelöst werden,
den technischen Dienst verständigen.
Fehlerbeseitigung: Diese Abfragenachricht kann vermieden werden, indem die
Prozedur geändert wird. Nachrichten auf den Fehler hin überwachen (Befehl
MONMSG) und den Fehler in der Prozedur beheben. Um fortzufahren, einen
Weitere ...
Eingabetaste --> Weiter
Öffnen von Teildatei ZPG001P in SEQONLY(*NO) geändert.
Abfrageoptionsdatei kann nicht abgerufen werden.
Aufrufstapeleintrag nicht gefunden.
Fehler aufgetreten beim Senden der Nachricht .
Funktionsprüfung. CPF2469 nicht überwacht durch PRVPGM bei Anweisung
0000000116, Instruktion X'0000'.
(C D I R) CPF2469 von Prozedur PRVPGM empfangen.
? I
Teildatei oder Kennsatz in Ausgangsdatei nicht gefunden oder
zurückgestellt.
Wegen eines Fehlers Kopierbefehl beendet.
Abfrageoptionsdatei kann nicht abgerufen werden.
Abfrageoptionsdatei kann nicht abgerufen werden.
1 Sätze aus Teildatei QDEFAULT kopiert.
Was habe ich falsch gemacht?
Feld CHGPGM wird über ein Srv-Pgm befüllt(Stackaufruf).
Halte den Prozess mal auf dem SNDPGMMSG an und schaue dir die CALL-Stack mal genau an.
Wenn das Programm im Stack nicht gefunden wird, gibts was auf die Finger.
![[NEWSboard IBMi Forum]](images/duke/nblogo.gif)
[professional_User]
Zitat von B.Hauser
Mit Zitat antworten
Bookmarks