Recently, a reader asked if it was possible to change an object's source file information. He had several files that were created from a source in a library that no longer existed. The original source had been moved to several different libraries and source files. The fact that the object descriptions still showed the original source file information confused developers.
Fortunately, API QliCObjD (Change Object Description) lets you change certain parts of an object's attributes, one of which is the source file information.
I've created command ChgObjSrc (Change Object Source Info), which you can use to change an object's source file information. The utility has three components:
* Command ChgObjSrc
* Command processing program ChgObjSrcC
* Validity checking program ChgObjSrcV
To use the utility, simply compile CL programs ChgObjSrcC and ChgObjSrcV, then compile command ChgObjSrc using the compile instructions found in its comments.
Command ChgObjSrc:
/* =============================================================== */
/* = Command....... ChgObjSrc = */
/* = CPP........... ChgObjSrcC = */
/* = Description... Change Object Source File = */
/* = Change source file attributes of an object = */
/* = = */
/* = CrtCmd Cmd( ChgObjSrc ) = */
/* = Pgm( ChgObjSrcC ) = */
/* = SrcFile( YourSourceFile ) = */
/* = VldCkr( ChgObjSrcV ) = */
/* =============================================================== */
Cmd Prompt( 'Change Object Source Info' )
Parm Kwd( Obj ) +
Type( QObj ) +
Min( 1 ) +
Prompt( 'Object' )
Parm Kwd( ObjType ) +
Type( *Char ) +
Len( 10 ) +
Rstd( *Yes ) +
Values( +
*Cmd +
*File +
*Module +
*Pgm +
*PnlGrp +
*QMForm +
*QMQry +
*Tbl +
) +
Min( 1 ) +
Expr( *Yes ) +
Prompt( 'Object type' )
Parm Kwd( SrcFile ) +
Type( QSrcFile ) +
Min( 1 ) +
Prompt( 'Source file' )
Parm Kwd( SrcMbr ) +
Type( *Char ) +
Len( 10 ) +
Dft( *Obj ) +
SpcVal( +
( *Obj ) +
) +
Expr( *Yes ) +
Prompt( 'Source member' )
QObj: Qual Type( *Name ) +
Len( 10 ) +
Min( 1 ) +
Expr( *Yes )
Qual Type( *Name ) +
Len( 10 ) +
Min( 1 ) +
SpcVal( +
( *LibL ) +
( *CurLib ) +
) +
Expr( *Yes ) +
Prompt( 'Library' )
QSrcFile: Qual Type( *Name ) +
Len( 10 ) +
Min( 1 ) +
Expr( *Yes )
Qual Type( *Name ) +
Len( 10 ) +
Min( 1 ) +
Expr( *Yes ) +
Prompt( 'Library' )
Program: ChgObjSrcC
/* =============================================================== */
/* = Program....... ChgObjSrcC = */
/* = Description... Change object's source file information = */
/* =============================================================== */
Pgm ( +
&QObj +
&ObjType +
&QSrcFile +
&SrcMbr +
)
/* =============================================================== */
/* = Declarations = */
/* =============================================================== */
Dcl &QObj *Char ( 20 )
Dcl &ObjType *Char ( 10 )
Dcl &QSrcFile *Char ( 20 )
Dcl &SrcMbr *Char ( 10 )
Dcl &RtnLib *Char ( 10 )
Dcl &SrcF *Char ( 10 )
Dcl &SrcFLib *Char ( 10 )
Dcl &ChgObjInfo *Char ( 42 )
Dcl &ChgObjNbr *Char ( 4 )
Dcl &ChgObjKey *Char ( 4 )
Dcl &ChgObjLen *Char ( 4 )
Dcl &APIError *Char ( 272 )
Dcl &BytesProv *Char ( 4 )
Dcl &BytesAvail *Char ( 4 )
Dcl &MsgID *Char ( 7 )
Dcl &MsgDta *Char ( 256 )
Dcl &MsgF *Char ( 10 )
Dcl &MsgFLib *Char ( 10 )
/* =============================================================== */
/* = Global error monitor = */
/* =============================================================== */
MonMsg ( CPF0000 MCH0000 ) Exec( +
GoTo Error )
/* =============================================================== */
/* = Check for source file member existence = */
/* =============================================================== */
ChgVar ( &SrcF ) ( %Sst( &QSrcFile 1 10 ) )
ChgVar ( &SrcFLib ) ( %Sst( &QSrcFile 11 10 ) )
If ( &SrcMbr *Eq '*OBJ' ) +
ChgVar ( &SrcMbr ) ( %Sst( &QObj 1 10 ) )
ChkObj Obj( &SrcFLib/&SrcF ) +
ObjType( *File ) +
Mbr( &SrcMbr )
/* =============================================================== */
/* = Initialize variables = */
/* =============================================================== */
ChgVar ( %Bin( &ChgObjNbr ) ) ( 1 )
ChgVar ( %Bin( &ChgObjKey ) ) ( 1 )
ChgVar ( %Bin( &ChgObjLen ) ) ( 30 )
ChgVar ( %Sst( &ChgObjInfo 1 4 ) ) ( &ChgObjNbr )
ChgVar ( %Sst( &ChgObjInfo 5 4 ) ) ( &ChgObjKey )
ChgVar ( %Sst( &ChgObjInfo 9 4 ) ) ( &ChgObjLen )
ChgVar ( %Sst( &ChgObjInfo 13 20 ) ) ( &QSrcFile )
ChgVar ( %Sst( &ChgObjInfo 33 10 ) ) ( &SrcMbr )
ChgVar ( %Bin( &BytesProv ) ) ( 272 )
ChgVar ( %Bin( &BytesAvail ) ) ( 0 )
ChgVar ( %Sst( &APIError 1 4 ) ) ( &BytesProv )
ChgVar ( %Sst( &APIError 5 4 ) ) ( &BytesAvail )
/* =============================================================== */
/* = Change object's source file information = */
/* =============================================================== */
Call QLiCObjD +
( +
&RtnLib +
&QObj +
&ObjType +
&ChgObjInfo +
&APIError +
)
/* --------------------------------------------------------------- */
/* - Check for error and percolate if one exists - */
/* --------------------------------------------------------------- */
ChgVar ( &BytesAvail ) ( %Sst( &APIError 5 4 ) )
If ( %Bin( &BytesAvail ) *NE 0 ) +
Do
ChgVar ( &MsgID ) ( %Sst( &APIError 9 7 ) )
ChgVar ( &MsgDta ) ( %Sst( &APIError 17 256 ) )
ChgVar ( &MsgF ) ( 'QCPFMSG' )
ChgVar ( &MsgFLib ) ( 'QSYS' )
GoTo SndMsg
EndDo
/* =============================================================== */
/* = Exit program = */
/* =============================================================== */
Return
/* =============================================================== */
/* = Error routine = */
/* =============================================================== */
Error:
RcvMsg MsgType( *Excp ) +
MsgDta( &MsgDta ) +
MsgID( &MsgID ) +
MsgF( &MsgF ) +
MsgFLib( &MsgFLib )
MonMsg ( CPF0000 MCH0000 )
SndMsg:
SndPgmMsg MsgID( &MsgID ) +
MsgF( &MsgFLib/&MsgF ) +
MsgDta( &MsgDta ) +
MsgType( *Escape )
MonMsg ( CPF0000 MCH0000 )
/* =============================================================== */
/* = End of program = */
/* =============================================================== */
EndPgm
Program ChgObjSrcV:
/* =============================================================== */
/* = Program....... ChgObjSrcV = */
/* = Description... Validity checking program for ChgObjSrc = */
/* =============================================================== */
Pgm ( +
&QObj +
&ObjType +
&QSrcFile +
&SrcMbr +
)
/* =============================================================== */
/* = Declarations = */
/* =============================================================== */
Dcl &QObj *Char ( 20 )
Dcl &Obj *Char ( 10 )
Dcl &ObjLib *Char ( 10 )
Dcl &ObjType *Char ( 10 )
Dcl &QSrcFile *Char ( 20 )
Dcl &SrcMbr *Char ( 10 )
Dcl &SrcF *Char ( 10 )
Dcl &SrcFLib *Char ( 10 )
Dcl &Msg *Char ( 80 )
/* =============================================================== */
/* = Global error monitor = */
/* =============================================================== */
MonMsg ( CPF0000 MCH0000 ) Exec( +
GoTo Error )
/* =============================================================== */
/* = Check for object existence as well as validate object type = */
/* =============================================================== */
ChgVar ( &Obj ) ( %Sst( &QObj 1 10 ) )
ChgVar ( &ObjLib ) ( %Sst( &QObj 11 10 ) )
ChkObj Obj( &ObjLib/&Obj ) +
ObjType( &ObjType )
/* =============================================================== */
/* = Check for source file member existence = */
/* =============================================================== */
ChgVar ( &SrcF ) ( %Sst( &QSrcFile 1 10 ) )
ChgVar ( &SrcFLib ) ( %Sst( &QSrcFile 11 10 ) )
If ( &SrcMbr *Eq '*OBJ' ) +
ChgVar ( &SrcMbr ) ( %Sst( &QObj 1 10 ) )
ChkObj Obj( &SrcFLib/&SrcF ) +
ObjType( *File ) +
Mbr( &SrcMbr )
/* =============================================================== */
/* = Exit program = */
/* =============================================================== */
Return
/* =============================================================== */
/* = Error routine = */
/* =============================================================== */
Error:
RcvMsg MsgType( *Excp ) +
Msg( &Msg )
MonMsg ( CPF0000 MCH0000 )
SndPgmMsg MsgID( CPD0006 ) +
MsgF( QSYS/QCPFMSG ) +
MsgDta( '0000' *Cat &Msg ) +
MsgType( *Diag )
MonMsg ( CPF0000 MCH0000 )
SndPgmMsg MsgID( CPF0002 ) +
MsgF( QSYS/QCPFMSG ) +
MsgType( *Escape )
MonMsg ( CPF0000 MCH0000 )
/* =============================================================== */
/* = End of program = */
/* =============================================================== */
EndPgm