Trigger Sql-updates

[tarkusch]

Hallo,

ich habe mir im Internet folgendes Pgm gefunden, was das aufrufende Programm ermittelt

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?

Mir fällt da nur die Datenstruktur UDS ein.

D MyPGM          UDS

Dank im Voraus für eure Hilfe.

Tarki