| //================================================================ | |
| Test exit procedure with parameter of: | |
| '1' to cause program to fail | |
| '2' to delay program so you can cancel it | |
| // In both case you get the message 'CleanUp ran' | |
| // | |
| // By Julian Monypenny, 2004 | |
| //================================================================ | |
| h dftactgrp( *no ) actgrp( 'CLEANUP' ) d parameter s 1 d x s 3s 0 d y s 5s 0 d status sds d user 254 263 |
|
| d cleanUp pr | A |
| d runCommand pr extpgm( 'QCMDEXC' ) d command 999 const d length 15p 5 const d textLen c 999 |
|
| d setExitProcedure... d pr extproc( 'CEETRX' ) d procedure * procptr const d token * const options( *omit ) d feedback 12 options( *omit ) |
B |
| c *entry plist c parm parameter /free |
|
| setExitProcedure( %paddr( cleanUp ): *omit: *omit ); | C |
| if parameter = '1'; runCommand( 'sndmsg ''Program will fail'' ' + user: textLen ); y = *hival; x = y; else; runCommand( 'sndmsg ''Cancel the program'' ' + user: textLen ); runCommand( 'dlyjob 30': textLen ); endif; *inlr = '1'; return; /end-free |
|
| p cleanUp b /free monitor; runCommand( 'sndmsg ''CleanUp ran'' ' + user: textLen ); on-error; // Handle error endmon; /end-free p e |
D |