Add SQL RPG Skeleton
This commit is contained in:
SJLennon
parent
2acc1ccec5
commit
2a5a0c661d
175
SQL_SKELETON/sql_skel.sqlrpgle
Normal file
175
SQL_SKELETON/sql_skel.sqlrpgle
Normal file
@ -0,0 +1,175 @@
|
||||
**free
|
||||
// Sample Skeleton SQL RPG program. This is a linear main program
|
||||
// so there is no RPG cycle logic included. There is no RPG file
|
||||
// IO. Data is read with SQL. It uses an SQL Cursor, but this is
|
||||
// just one way to retrieve data with SQL.
|
||||
//
|
||||
// After //executable// SQL statements I check for the SQL States
|
||||
// that I expect. Any unexpected state causes the program to dump
|
||||
// and crash, because this requires investigation.
|
||||
// Common states are defined below in SQL State Constants.
|
||||
//
|
||||
// Your shop error handling standards may be different and you
|
||||
// may want to rewrite the SQLProblem procedure.
|
||||
|
||||
// Program reads table QIWS/QCUSTCDT which is on all(?) machines.
|
||||
// Pass a two character State parameter, e.g. PARM('NY').
|
||||
|
||||
ctl-opt option(*nodebugio:*srcstmt) dftactgrp(*no) actgrp(*caller)
|
||||
main(sql_skel);
|
||||
|
||||
//=== Prototypes ======================================
|
||||
dcl-pr QMHSNDPM extpgm('QMHSNDPM');
|
||||
*n char(7) const; // MsgId
|
||||
*n char(20) const; // MsgFile
|
||||
*n char(1024) const options(*varsize); // MsgData
|
||||
*n int(10) const; // MsgDataLgth
|
||||
*n char(10) const; // MsgType
|
||||
*n char(10) const; // CallStk
|
||||
*n int(10) const; // RelCallStk
|
||||
*n char(4); //RtnMsgKey
|
||||
*n char(17); // apiErrorDS
|
||||
end-pr;
|
||||
|
||||
//=== SQL State Constants =============================
|
||||
dcl-c SQLSuccess '00000';
|
||||
dcl-c SQLNoData '02000';
|
||||
dcl-c SQLNoMoreData '02000';
|
||||
dcl-c SQLDupRecd '23505';
|
||||
dcl-c SQLRowLocked '57033';
|
||||
|
||||
//=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
|
||||
// Main Program =
|
||||
//=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
|
||||
dcl-proc SQL_SKEL;
|
||||
dcl-pi *n;
|
||||
piState char(2);
|
||||
end-pi;
|
||||
|
||||
//=== Program (Global) Variables ======================
|
||||
dcl-ds InTbl extname('QIWS/QCUSTCDT') template end-ds;
|
||||
|
||||
dcl-s MyCusnum like(cusnum);
|
||||
dcl-s MyLstNam like(lstnam);
|
||||
dcl-s MyInit like(init);
|
||||
dcl-s MyState like(state);
|
||||
dcl-s MyBalDue like(baldue);
|
||||
dcl-s RecordsRead packed(7) inz(0);
|
||||
|
||||
//=== Set SQL Options ===============================
|
||||
// Note: Compile time only. Not executable.
|
||||
exec sql set option datfmt=*iso,
|
||||
closqlcsr=*endmod,
|
||||
commit=*none;
|
||||
//=== Cursor ========================================
|
||||
exec sql declare DemoCursor cursor for
|
||||
select
|
||||
CUSNUM,
|
||||
LSTNAM,
|
||||
INIT,
|
||||
STATE,
|
||||
BALDUE
|
||||
from QIWS/QCUSTCDT
|
||||
where STATE = :piState
|
||||
order by BALDUE desc
|
||||
;
|
||||
//=== Initialization ================================
|
||||
exec sql open DemoCursor;
|
||||
if SQLSTT <> SQLSuccess;
|
||||
SQLProblem('open DemoCursor');
|
||||
endif;
|
||||
//=== Main Logic ====================================
|
||||
exsr FetchCur;
|
||||
dow SQLSTT = SQLSuccess;
|
||||
RecordsRead += 1;
|
||||
// Real program logic goes here <<<<<<<<<<
|
||||
exsr FetchCur;
|
||||
enddo;
|
||||
//=== Termination ===================================
|
||||
dsply ('Records read: ' + %char(RecordsRead) );
|
||||
exec sql close DemoCursor;
|
||||
if SQLSTT <> SQLSuccess;
|
||||
SQLProblem('close DemoCursor');
|
||||
endif;
|
||||
*inlr = *on;
|
||||
|
||||
//=== Subroutines ===================================
|
||||
|
||||
//--- FetchCur --------------------------------------
|
||||
// Get the next row from the cursor
|
||||
// Returns: SQLSUCCESS, with data
|
||||
// SQLNoMoreData, no data returned
|
||||
begsr FetchCur;
|
||||
exec sql fetch DemoCursor into
|
||||
:MyCusNum,
|
||||
:MyLstNam,
|
||||
:MyInit,
|
||||
:MyState,
|
||||
:MyBalDue
|
||||
;
|
||||
if SQLSTT <> SQLSuccess
|
||||
and SQLSTT <> SQLNoMoreData;
|
||||
SQLProblem('fetch DemoCursor');
|
||||
endif;
|
||||
endsr;
|
||||
|
||||
end-proc;
|
||||
//=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
|
||||
// End of Main Program =
|
||||
//=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
|
||||
|
||||
//=== Procedures ======================================
|
||||
|
||||
//=== SQLProblem ======================================
|
||||
// For those "Never should happen" SQL errors.
|
||||
// Issues DUMP(A) to dump memory, then ends program by
|
||||
// sending an *ESCAPE message of the supplied debugging text.
|
||||
dcl-proc SQLProblem;
|
||||
dcl-pi SQLProblem;
|
||||
piSQLDebug varchar(1024) value;
|
||||
end-pi;
|
||||
|
||||
//--- Local Variables ---------------------------------
|
||||
dcl-s wkSQLDebug varchar(1024);
|
||||
|
||||
wkSQLDebug = 'Unexpected SQL error in: ' + piSQLDebug;
|
||||
dump(a);
|
||||
SndEscMsg(wkSqlDebug);
|
||||
return;
|
||||
end-proc;
|
||||
|
||||
//=== SndEscMsg =======================================
|
||||
// Sends CPF9898 Escape message of the provided text.
|
||||
dcl-proc SndEscMsg export ;
|
||||
|
||||
dcl-pi SndEscMsg extProc(*dclcase) ;
|
||||
piMsg varchar(1024) const;
|
||||
end-pi;
|
||||
|
||||
//--- Parameters for QMHSNDPM -------------------------
|
||||
dcl-c MsgId const('CPF9898');
|
||||
dcl-c MsgF const('QCPFMSG *LIBL ');
|
||||
dcl-c MsgType const('*ESCAPE ');
|
||||
dcl-c PgmQue const('* ');
|
||||
dcl-c InvCount const(2);
|
||||
dcl-s ApiError char(17) inz(x'00');
|
||||
dcl-s RetMsgKey char(4);
|
||||
dcl-s DataLen int(10);
|
||||
|
||||
//--- Local Variables ---------------------------------
|
||||
dcl-s MsgData char(1024);
|
||||
|
||||
DataLen = %len(PiMSG);
|
||||
MsgData = piMsg;
|
||||
QMHSNDPM(
|
||||
MsgId :
|
||||
MsgF :
|
||||
MsgData :
|
||||
DataLen :
|
||||
MsgType :
|
||||
PgmQue :
|
||||
InvCount :
|
||||
RetMsgKey :
|
||||
APIError);
|
||||
return ;
|
||||
end-proc;
|
||||
187
SQL_SKELETON/sql_skelnf.sqlrpgle
Normal file
187
SQL_SKELETON/sql_skelnf.sqlrpgle
Normal file
@ -0,0 +1,187 @@
|
||||
* Sample Skeleton SQL RPG program. This is a linear main program
|
||||
* so there is no RPG cycle logic included. There is no RPG file
|
||||
* IO. Data is read with SQL. It uses an SQL Cursor, but this is
|
||||
* just one way to retrieve data with SQL.
|
||||
*
|
||||
* After *executable* SQL statements I check for the SQL States
|
||||
* that I expect. Any unexpected state causes the program to dump
|
||||
* and crash, because this requires investigation.
|
||||
* Common states are defined below in SQL State Constants.
|
||||
*
|
||||
* Your shop error handling standards may be different and you
|
||||
* may want to rewrite the SQLProblem procedure.
|
||||
|
||||
* Program reads table QIWS/QCUSTCDT which is on all(?) machines.
|
||||
* Pass a two character State parameter, e.g. PARM('NY').
|
||||
|
||||
h Option(*NODEBUGIO:*SRCSTMT)
|
||||
h DftActGrp(*no) ActGrp(*caller)
|
||||
h main(SQL_SKEL)
|
||||
|
||||
*=== Prototypes ======================================
|
||||
d SQL_SKEL pr extpgm('SQL_SKELM')
|
||||
d 2a
|
||||
|
||||
d SQLProblem pr
|
||||
d piSQLDebug 1024 varying value
|
||||
|
||||
D SndEscMsg pr
|
||||
D piMsg 1024a Const Varying
|
||||
|
||||
D QMHSNDPM pr ExtPgm('QMHSNDPM')
|
||||
D piMsgId 7a Const
|
||||
D piMsgFile 20a Const
|
||||
D piMsgData 1024a Const OPTIONS(*varsize)
|
||||
D piMsgDataLgth 10i 0 Const
|
||||
D piMsgType 10a Const
|
||||
D piCallStk 10a Const
|
||||
D piRelCallStk 10i 0 Const
|
||||
D piRtnMsgKey 4a
|
||||
D apiErrorDS 17a
|
||||
|
||||
*=== SQL State Constants =============================
|
||||
d SQLSuccess c '00000'
|
||||
d SQLNoData c '02000'
|
||||
d SQLNoMoreData c '02000'
|
||||
d SQLDupRecd c '23505'
|
||||
d SQLRowLocked c '57033'
|
||||
/free
|
||||
|
||||
*=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
|
||||
* Main Program =
|
||||
*=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
|
||||
p SQL_SKEL B
|
||||
d PI
|
||||
d piState 2a
|
||||
|
||||
*=== Program (Global) Variables ======================
|
||||
d InTbl e ds EXTNAME('QIWS/QCUSTCDT') template
|
||||
|
||||
d MyCusnum s like(cusnum)
|
||||
d MyLstNam s like(lstnam)
|
||||
d MyInit s like(init)
|
||||
d MyState s like(state)
|
||||
d MyBalDue s like(baldue)
|
||||
d RecordsRead s 7p 0 Inz(0)
|
||||
|
||||
*=== Set SQL Options ===============================
|
||||
* Note: Compile time only. Not executable.
|
||||
exec sql set option datfmt=*iso,
|
||||
closqlcsr=*endmod,
|
||||
commit=*none;
|
||||
*=== Cursor ========================================
|
||||
exec sql declare DemoCursor cursor for
|
||||
select
|
||||
CUSNUM,
|
||||
LSTNAM,
|
||||
INIT,
|
||||
STATE,
|
||||
BALDUE
|
||||
from QIWS/QCUSTCDT
|
||||
where STATE = :piState
|
||||
order by BALDUE desc
|
||||
;
|
||||
*=== Initialization ================================
|
||||
exec sql open DemoCursor;
|
||||
if SQLSTT <> SQLSuccess;
|
||||
SQLProblem('open DemoCursor');
|
||||
endif;
|
||||
*=== Main Logic ====================================
|
||||
exsr FetchCur;
|
||||
dow SQLSTT = SQLSuccess;
|
||||
RecordsRead += 1;
|
||||
// Real program logic goes here <<<<<<<<<<
|
||||
exsr FetchCur;
|
||||
enddo;
|
||||
*=== Termination ===================================
|
||||
dsply ('Records read: ' + %char(RecordsRead) );
|
||||
exec sql close DemoCursor;
|
||||
if SQLSTT <> SQLSuccess;
|
||||
SQLProblem('close DemoCursor');
|
||||
endif;
|
||||
*inlr = *on;
|
||||
|
||||
*=== Subroutines ===================================
|
||||
|
||||
*--- FetchCur --------------------------------------
|
||||
* Get the next row from the cursor
|
||||
* Returns: SQLSUCCESS, with data
|
||||
* SQLNoMoreData, no data returned
|
||||
begsr FetchCur;
|
||||
exec sql fetch DemoCursor into
|
||||
:MyCusNum,
|
||||
:MyLstNam,
|
||||
:MyInit,
|
||||
:MyState,
|
||||
:MyBalDue
|
||||
;
|
||||
if SQLSTT <> SQLSuccess
|
||||
and SQLSTT <> SQLNoMoreData;
|
||||
SQLProblem('fetch DemoCursor');
|
||||
endif;
|
||||
endsr;
|
||||
|
||||
/end-free
|
||||
p SQL_SKEL e
|
||||
*=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
|
||||
* End of Main Program =
|
||||
*=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
|
||||
|
||||
*=== Procedures ======================================
|
||||
|
||||
*=== SQLProblem ======================================
|
||||
* For those "Never should happen" SQL errors.
|
||||
* Issues DUMP(A) to dump memory, then ends program by
|
||||
* sending an *ESCAPE message of the supplied debugging text.
|
||||
p SQLProblem B
|
||||
d SQLProblem PI
|
||||
d piSQLDebug 1024 varying value
|
||||
|
||||
*--- Local Variables ---------------------------------
|
||||
d wkSQLDebug s 1024 varying
|
||||
|
||||
/free
|
||||
wkSQLDebug = 'Unexpected SQL error in: ' + piSQLDebug;
|
||||
dump(a);
|
||||
SndEscMsg(wkSqlDebug);
|
||||
return;
|
||||
/end-free
|
||||
p SQLProblem E
|
||||
|
||||
*=== SndEscMsg =======================================
|
||||
* Sends CPF9898 Escape message of the provided text.
|
||||
P SndEscMsg B Export
|
||||
|
||||
D SndEscMsg PI
|
||||
D piMsg 1024a Const Varying
|
||||
|
||||
*--- Parameters for QMHSNDPM -------------------------
|
||||
D MsgId c const('CPF9898')
|
||||
d MsgF c const('QCPFMSG *LIBL ')
|
||||
d MsgType c const('*ESCAPE ')
|
||||
d PgmQue c const('* ')
|
||||
d InvCount c const(2)
|
||||
d ApiError s 17a inz(X'00')
|
||||
d RetMsgKey s 4a
|
||||
D DataLen s 10i 0
|
||||
|
||||
*--- Local Variables ---------------------------------
|
||||
D MsgData s 1024a
|
||||
|
||||
/FREE
|
||||
DataLen = %len(PiMSG);
|
||||
MsgData = piMsg;
|
||||
QMHSNDPM(
|
||||
MsgId :
|
||||
MsgF :
|
||||
MsgData :
|
||||
DataLen :
|
||||
MsgType :
|
||||
PgmQue :
|
||||
InvCount :
|
||||
RetMsgKey :
|
||||
APIError);
|
||||
return ;
|
||||
/end-free
|
||||
P SndEscMsg E
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user