ecki/IBM-i-RPG-Free-CLP-Code
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Source on IFS & Local Development

Browse Source
This commit is contained in:
SJLennon
2024-04-10 16:16:48 -04:00
parent 57c4efd0aa
commit a2d8f9c33c
83 changed files with 5807 additions and 4011 deletions
Download Patch File Download Diff File Expand all files Collapse all files
RcdLckDsp/RCDLCKBAD.RPGLE
+58 -66
View File
@@ -1,67 +1,59 @@
*==============================================================
* Program that locks a record and then waits for input from
* the operator.
*
* Call this program in two different sessions to see the effect.
* Second program will typically get a error:
* 'Unable to allocate a record in file' (RNX1218)
* and the end user typically choses an unhelpful response.
*==============================================================
* Note: This is a poor technique because the record remains
* locked to all other users until the transaction is
* completed, which may be in a few seconds or after lunch.
*
*Note: Pgm reads by RRN for convenience. This is not a good
* idea is a production program.
*
*Note: DSPLY is use to simulate a display file interaction
* with the user.
*
*Note: QIWS/QCUSTCDT: believed to be on virtually all systems.
*==============================================================
**free
// ==============================================================
// Program that locks a record and then waits for input from
// the operator.
//
// Call this program in two different sessions to see the effect.
// Second program will typically get a error:
// 'Unable to allocate a record in file' (RNX1218)
// and the end user typically choses an unhelpful response.
// ==============================================================
// Note: This is a poor technique because the record remains
// locked to all other users until the transaction is
// completed, which may be in a few seconds or after lunch.
//
// Note: Pgm reads by RRN for convenience. This is not a good
// idea is a production program.
//
// Note: DSPLY is use to simulate a display file interaction
// with the user.
//
// Note: QIWS/QCUSTCDT: believed to be on virtually all systems.
// ==============================================================
H DEBUG(*YES) OPTION(*NODEBUGIO:*SRCSTMT:*NOUNREF)
H DFTACTGRP(*NO) ACTGRP(*NEW)
FQCUSTCDT UF E DISK USROPN EXTDESC('QIWS/QCUSTCDT')
F RECNO(RRN)
F* INFSR(*PSSR)
D QCmdexc PR EXTPGM('QCMDEXC')
D CMD 512A
D lgth 15P 5 const
D RRN s 10p 0 inz(10)
D reply S 1A inz('*')
D Cmd S 512A
/free
*inlr = *on;
// Set update file to a short wait time. Otherwise the file or
// system default wait time applies.
cmd = ' OVRDBF FILE(QCUSTCDT) TOFILE(QIWS/QCUSTCDT) WAITRCD(1)';
QCMDEXC(cmd:512);
open QCUSTCDT;
chain RRN QCUSTCDT;
if %found(QCUSTCDT);
// Logic to update the record would be here.
dsply 'Read for update' ' ' reply;
else;
// Logic for record not found would be here
dsply 'Record not found' ' ' reply;
endif;
// === End of Program =========================================
// Close file before returning
close QCUSTCDT;
return;
// Often found in old programs. Uncomment INFSR(*PSSR) in the
// F-SPEC to make this active.
BEGSR *PSSR;
dsply 'In the *PSSR' ' ' reply;
dump(a);
ENDSR '*CANCL';
Ctl-Opt DEBUG(*YES) OPTION(*NODEBUGIO:*SRCSTMT:*NOUNREF);
Ctl-Opt DFTACTGRP(*NO) ACTGRP(*NEW);
Dcl-F QCUSTCDT Usage(*Update:*Delete:*Output) USROPN EXTDESC('QIWS/QCUSTCDT') RECNO(RRN)
// INFSR(*PSSR)
;
Dcl-PR QCmdexc EXTPGM('QCMDEXC');
Cmd Char(512);
lgth Packed(15:5) CONST;
End-PR;
Dcl-S RRN Packed(10:0) INZ(10);
Dcl-S reply Char(1) INZ('*');
Dcl-S Cmd Char(512);
*inlr = *on;
// Set update file to a short wait time. Otherwise the file or
// system default wait time applies.
Cmd = ' OVRDBF FILE(QCUSTCDT) TOFILE(QIWS/QCUSTCDT) WAITRCD(1)';
QCmdexc(Cmd:512);
open QCUSTCDT;
chain RRN QCUSTCDT;
if %found(QCUSTCDT);
// Logic to update the record would be here.
dsply 'Read for update' ' ' reply;
else;
// Logic for record not found would be here
dsply 'Record not found' ' ' reply;
endif;
// === End of Program =========================================
// Close file before returning
close QCUSTCDT;
return;
// Often found in old programs. Uncomment INFSR(*PSSR) in the
// F-SPEC to make this active.
BEGSR *PSSR;
dsply 'In the *PSSR' ' ' reply;
dump(a);
ENDSR '*CANCL';