1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173
| H DFTACTGRP(*NO)
D RtvDspFD PR extpgm('QDFRTVFD')
D RcvVar 1 options(*varsize)
D LenRcvVar 10i 0 const
D Format 8 const
D QualDspF 20 const
D ErrCde LIKEDS(QUSEC)
D CvtHex PR 3 0
D 1 const
D QualDspF DS
D DspFName 10
D DspFLib 10 inz('*LIBL')
D I S 10i 0
D J S 10i 0
D K S 10i 0
D L S 10i 0
D BasePtr S *
D BaseInfo DS LIKEDS(QDFFBASE) BASED(BasePtr)
D InfoPtr S *
D InfoInfo DS LIKEDS(QDFFINFO) BASED(InfoPtr)
D RftePtr S *
D RfteInfo DS LIKEDS(QDFARFTE) BASED(RftePtr)
D RinfPtr S *
D RinfInfo DS LIKEDS(QDFFRINF) BASED(RinfPtr)
D RdpdPtr S *
D RdpdInfo DS LIKEDS(QDFFRDPD) BASED(RdpdPtr)
D RctbPtr S *
D RctbInfo DS LIKEDS(QDFFRCTB) BASED(RctbPtr)
D FleiPtr S *
D FleiInfo DS LIKEDS(QDFWFLEI) BASED(FleiPtr)
D NtblPtr S *
D NtblInfo DS LIKEDS(QDFFNTBL) BASED(NtblPtr)
D RcdiPtr S *
D RcdiInfo DS LIKEDS(QDFWRCDI) BASED(RcdiPtr)
D FldiPtr S *
D FldiInfo DS LIKEDS(QDFWFLDI) BASED(FldiPtr)
D RctePtr S *
D RcteInfo DS LIKEDS(QDFFRCTE) BASED(RctePtr)
D NamePtr S *
D NameInfo S 10 BASED(NamePtr)
D InlRcvVar DS QUALIFIED
D BytRtn 10i 0
D BytAvl 10i 0
/copy QSYSINC/QRPGLESRC,QDFRTVFD
/copy QSYSINC/QRPGLESRC,QUSEC
C *ENTRY PLIST
C PARM DspFile 10
C PARM DspFrmt 10
C PARM DspField 10
C PARM Row 3 0
C PARM Col 3 0
/free
DspFName = DspFile;
Row = 0;
Col = 0;
// Lit la structure du fichier
RtvDspFD( InlRcvVar : %size(InlRcvVar) : 'DSPF0100' : QualDspF : QUSEC );
BasePtr = %alloc( InlRcvVar.BytAvl );
RtvDspFD( BaseInfo : InlRcvVar.BytAvl : 'DSPF0100' : QualDspF : QUSEC );
InfoPtr = BasePtr + BaseInfo.QDFFINOF; // File Header Section
RftePtr = InfoPtr + InfoInfo.QDFFDFLO; // Record Format Table
// Recherche l'index du format demandé
FOR I = 1 TO BaseInfo.QDFFFRCS;
IF RfteInfo.QDFARFNM <> DspFrmt;
RftePtr += %size( RfteInfo ); // Format suivant
ELSE;
RinfPtr = InfoPtr + RfteInfo.QDFARFOF; // Record Header Section
RdpdPtr = RinfPtr + RinfInfo.QDFFRAOF; // Display-Record-Level Device Section
RctbPtr = RinfPtr + RdpdInfo.QDFFDRCO; // Row-Column Table
FleiPtr = InfoPtr + InfoInfo.QDFFWUOF; // Where Used File Information
NtblPtr = FleiPtr + FleiInfo.QDFWNTBO; // Field Name table pointer
NamePtr = NtblPtr + %size( NtblInfo.QDFFFNMS );
// Recherche l'index du champ demandé
FOR J = 1 TO NtblInfo.QDFFFNMS;
IF NameInfo <> DspField ;
NamePtr += 10; // Champ suivant
ELSE;
// Accède aux données du format et du champ
RcdiPtr = FleiPtr + FleiInfo.QDFWXLEN; // Where-Used Record Information Struct.
FOR K = 1 TO BaseInfo.QDFFFRCS;
IF K <> I;
RcdiPtr += RcdiInfo.QDFWNXTR;
ELSE;
FldiPtr = RcdiPtr + RcdiInfo.QDFWRLEN; // Where-Used Field Information Structure
FOR L = 1 TO RinfInfo.QDFFFFLD;
IF FldiInfo.QDFWNMEI <> J;
FldiPtr += FldiInfo.QDFWFLDL;
ELSE;
RctePtr = RctbPtr + %size( RctbInfo );
RctePtr = RctePtr + (( FldiInfo.QDFWRRDX - 1 ) * 2 );
Row = CvtHex( RcteInfo.QDFFSROW );
Col = CvtHex( RcteInfo.QDFFSCOL ) + 1;
IF Row = 255;
Row = 0;
ENDIF;
IF Col = 256;
Col = 0;
ENDIF;
LEAVE;
ENDIF;
ENDFOR;
LEAVE;
ENDIF;
ENDFOR;
LEAVE;
ENDIF;
ENDFOR;
LEAVE;
ENDIF;
ENDFOR;
DEALLOC BasePtr;
*INLR = *ON;
RETURN;
/end-free
P CvtHex B
D CvtHex PI 3 0
D Character 1A CONST
D DS
D DSNum 5I 0 INZ( 0 )
D DSChar 1A OVERLAY( DSNum : 2 )
C EVAL DSChar = Character
C RETURN DSNum
P CvtHex E |
Partager