/INCLUDE -> COPY_MBRS; Use SQL_SRV service pgm
This commit is contained in:
@@ -39,10 +39,11 @@
|
|||||||
//--------------------------------------------------------------------
|
//--------------------------------------------------------------------
|
||||||
ctl-opt debug option(*nodebugio: *srcstmt)
|
ctl-opt debug option(*nodebugio: *srcstmt)
|
||||||
dftactgrp(*no) actgrp(*caller)
|
dftactgrp(*no) actgrp(*caller)
|
||||||
bnddir('UTIL_BND')
|
bnddir('UTIL_BND':'SQL_BND')
|
||||||
main(Main);
|
main(Main);
|
||||||
//=== Prototypes =====================================================
|
//=== Prototypes =====================================================
|
||||||
/include DEMO,Srv_Msg_P
|
/include copy_mbrs,Srv_Msg_P
|
||||||
|
/include copy_mbrs,Srv_SQL_P
|
||||||
|
|
||||||
// Gets job type entry for this job.
|
// Gets job type entry for this job.
|
||||||
// Returns: JobType has the job type. I=interactive, B=batch, etc.
|
// Returns: JobType has the job type. I=interactive, B=batch, etc.
|
||||||
@@ -241,45 +242,3 @@ dcl-proc fetchNext;
|
|||||||
endif;
|
endif;
|
||||||
end-proc;
|
end-proc;
|
||||||
|
|
||||||
//=== 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 message,
|
|
||||||
// plus whatever SQL diagnostics we can fit into 512 chars.
|
|
||||||
dcl-proc SQLProblem;
|
|
||||||
dcl-pi SQLProblem;
|
|
||||||
piSQLDebug varchar(200) value;
|
|
||||||
end-pi;
|
|
||||||
|
|
||||||
//--- Local Variables ---------------------------------
|
|
||||||
dcl-s myDebugMsg varchar(512); //Max CPF9898 supports
|
|
||||||
dcl-s wkRem int(10);
|
|
||||||
|
|
||||||
// Returned SQL diagnostic info
|
|
||||||
dcl-s mySQLState CHAR(5);
|
|
||||||
dcl-s mySQLMsgTxt varchar(32740);
|
|
||||||
dcl-s mySQLMsgLgth int(5);
|
|
||||||
|
|
||||||
exec sql get diagnostics condition 1
|
|
||||||
:mySQLState = RETURNED_SQLSTATE,
|
|
||||||
:mySQLMsgTxt = MESSAGE_TEXT,
|
|
||||||
:mySQLMsgLgth = MESSAGE_LENGTH
|
|
||||||
;
|
|
||||||
myDebugMsg = piSQLDebug
|
|
||||||
+ ' - Unexpected SQL return: SQLSTATE='
|
|
||||||
+ mySQLState
|
|
||||||
+ '. "';
|
|
||||||
|
|
||||||
// Fit in as much of mySQLMsgTxt as possible.
|
|
||||||
wkRem = (%size(myDebugMsg)-2) - %len(myDebugMsg);
|
|
||||||
if wkRem >= mySQLMsgLgth +1;
|
|
||||||
myDebugMsg += (mySQLMsgTxt +'"');
|
|
||||||
else;
|
|
||||||
myDebugMsg += (%subst(mySQLMsgTxt: 1 :wkRem -5) + ' ..."');
|
|
||||||
endif;
|
|
||||||
|
|
||||||
dump(a);
|
|
||||||
SndEscMsg(myDebugMsg);
|
|
||||||
return;
|
|
||||||
end-proc;
|
|
||||||
|
|
||||||
|
|||||||
@@ -42,6 +42,10 @@ This about 100 lines shorter then the version in [APIs](https://github.com/SJLen
|
|||||||
|
|
||||||
These are simple CL programs to test GETOBJUSR and display the results by sending a message and/or displaying the QTEMP/GETOBJUP file.
|
These are simple CL programs to test GETOBJUSR and display the results by sending a message and/or displaying the QTEMP/GETOBJUP file.
|
||||||
|
|
||||||
|
## T00.CLLE
|
||||||
|
|
||||||
|
Simple CL to test GETOBJUR looking for locks on a file member.
|
||||||
|
|
||||||
## T9xxx.CLLE
|
## T9xxx.CLLE
|
||||||
|
|
||||||
More complex testing:
|
More complex testing:
|
||||||
|
|||||||
@@ -0,0 +1,26 @@
|
|||||||
|
PGM
|
||||||
|
|
||||||
|
/* Basic test, using a library as the object to report on */
|
||||||
|
/* Return both a message and a file */
|
||||||
|
|
||||||
|
DCL VAR(&MSG) TYPE(*CHAR) LEN(200)
|
||||||
|
|
||||||
|
GETOBJUSR OBJECT(lennons1/tgtstkp) TYPE(*file) +
|
||||||
|
MSGFLD(&MSG) RETFILE(*YES) member(Backup)
|
||||||
|
|
||||||
|
SNDMSG MSG(&MSG) TOUSR(*REQUESTER)
|
||||||
|
QRY FILE(QTEMP/GETOBJUP)
|
||||||
|
|
||||||
|
GETOBJUSR OBJECT(lennons1/tgtstkp) TYPE(*file) +
|
||||||
|
MSGFLD(&MSG) RETFILE(*YES) member(TGTSTKP)
|
||||||
|
|
||||||
|
SNDMSG MSG(&MSG) TOUSR(*REQUESTER)
|
||||||
|
QRY FILE(QTEMP/GETOBJUP)
|
||||||
|
|
||||||
|
GETOBJUSR OBJECT(lennons1/tgtstkp) TYPE(*file) +
|
||||||
|
MSGFLD(&MSG) RETFILE(*YES)
|
||||||
|
|
||||||
|
SNDMSG MSG(&MSG) TOUSR(*REQUESTER)
|
||||||
|
QRY FILE(QTEMP/GETOBJUP)
|
||||||
|
|
||||||
|
ENDPGM
|
||||||
Reference in New Issue
Block a user