d*===================================================================== d* PROGRAMA....: SCHFLDR d* DESCRIPCION.: Buscar campo en miembro fuente. d* AUTOR.......: Diego M. ACEVEDO -Buenos Aires- Argentina d* d* d* Compilar con los siguientes parámetros DFTACTGRP(*NO) ACTGRP(*NEW) d* d*===================================================================== d* Comando di sistema. d*----------------------------------------------------- d qcmdexc pr ExtPgm('QCMDEXC') d 128a Const d 15p 5 d*----------------------------------------------------- d* Re-send program message API d*----------------------------------------------------- d qmhrsnem Pr ExtPgm('QMHRSNEM') d 4a Const d snercod Like(ErrCod) d 32766a Options(*varsize:*nopass) d 10i 0 Const Options(*nopass) d 8a Const Options(*nopass) d * Const Options(*nopass) d 10i 0 Const Options(*nopass) d*----------------------------------------------------- d* List of members . d*----------------------------------------------------- d Quslmbr pr extpgm('QUSLMBR') d 20a d 8a d 20a d 10a d 1a d mbrerr like(errcod) d*----------------------------------------------------- d* Create user space . d*----------------------------------------------------- d quscrtus pr extpgm('QUSCRTUS') d 20a d 10a d 10i 0 d 1a d 10a d 50a d 10a d spcerr like(errcod) d*----------------------------------------------------- d* Retrieve user space . d*----------------------------------------------------- d qusrtvus pr extpgm('QUSRTVUS') d 20a d 10i 0 d 10i 0 d 100a d rtverr like(errcod) d*----------------------------------------------------- d* Send Program Message API. . d*----------------------------------------------------- d qmhsndpm Pr ExtPgm('QMHSNDPM') d 7a Const d 20a Const d 32767a Options(*Varsize) d 10i 0 d 10a Const d 10a Const d 10i 0 d 4a Const d mhserr Like(ErrCod) d*------------------------------------------------------ d* Structure for QMHRSNEM API in RSNM0100 format d*------------------------------------------------------ d dsRS Ds d 10i 0 Inz(2) d 20a Inz('*NONE *NONE') d 10i 0 Inz(7) d 7a Inz('*') d*------------------------------------------------------ d* Error code data structure . d*------------------------------------------------------ d ErrCod Ds Inz d bytprv 1 4b 0 Inz(256) d bytava 5 8b 0 Inz(0) d errid 9 15a d œœreserv 16 16a d msgdta 17 256a d*----------------------------------------------------- d* File name . d*----------------------------------------------------- d Qualnm Ds d Filenm 10a Overlay(Qualnm) d Libl 10a Overlay(Qualnm:11) d*---------------------------------------------------------- d rcvvar Ds d offset 10i 0 Overlay(rcvvar) d nbrent 10i 0 Overlay(rcvvar:9) d filler 88a Overlay(rcvvar:13) d*---------------------------------------------------------- d MbrL0200 Ds Inz d MbrNam 10a Overlay(MbrL0200) d SrcTyp 10a Overlay(MbrL0200:11) d CrtDat 13a Overlay(MbrL0200:21) d ChgDat 13a Overlay(MbrL0200:34) d Text 50a Overlay(MbrL0200:47) d CCSID 10i 0 Overlay(MbrL0200:97) d*---------------------------------------------------------- d* Campos stand-alone . d*---------------------------------------------------------- d X s 10i 0 Inz d USsize s 10i 0 Inz(32767) d ldsofs s 10i 0 Inz(125) d ldelen s 10i 0 Inz(%size(rcvvar)) d MsgLen s 10i 0 Inz(%len(msgdta)) d Stack s 10i 0 Inz(2) d CmdLen s 15p 5 Inz d CmdStr s 128a Inz d UStext s 50a Inz(*allX'40') d rtvtxt s 50a Inz d User_Space s 20a Inz('TEMP QTEMP ') d MsgF s 20a Inz('QCPFMSG *LIBL ') d MBRfmt s 10a Inz('MBRL0200') d Format s 10a Inz d USexta s 10a Inz(*allX'40') d USauth s 10a Inz('*LIBCRTAUT') d USrplc s 10a Inz('*NO') d MsgTyp s 10a Inz('*STATUS') d PgmQ s 10a Inz('*EXT') d MsgID s 7a Inz('CPF9898') d MsgKey s 4a Inz d Ovrprc s 1a Inz('0') d USinit s 1a Inz(X'00') d*---------------------------------------------------------- d* Parámetros de entrada. . d*---------------------------------------------------------- d Parm1 Ds d NbrPrm1 5i 0 Overlay(Parm1) d Filenam 10a Overlay(Parm1:3) d Library 10a Overlay(Parm1:13) d Member 10a Overlay(Parm1:23) d* d Parm5 Ds d OutFile 10a Overlay(Parm5) d OutLibl 10a Overlay(Parm5:11) d* d Parm6 Ds d NbrPrm6 5i 0 Overlay(Parm6) d OutMbr 10a Overlay(Parm6:3) d OutOpt 8a Overlay(Parm6:13) d*---------------------------------------------------------- c* Definición de parámetros de entrada. c *Entry Plist c Parm Parm1 c Parm Parm2 14 c Parm Parm3 7 c Parm Parm4 8 c Parm Parm5 c Parm Parm6 c* c*========================================================== c* c* M A I N P R O G R A M c* c*========================================================== c* c Do nbrent X <-------------+ c* | c* Recupera Nombre de miembro. | c Callp QUSRTVUS(User_Space:offset:ldelen:MbrL0200: | c Errcod) | c* | c If %Scan('RPGLE':SrcTyp) > *Zeros <------------+| c* || c Reset ErrCod || c Eval msgdta = 'Buscando en miembro '+%Trim(mbrnam) || c CallP qmhsndpm(MsgID:MsgF:msgdta:MsgLen:MsgTyp:PgmQ || c :Stack:MsgKey:ErrCod) || c* || c* || c Eval Member = Mbrnam || c* || c Call 'SCHFLD2R' || c Parm '*NEW' Option 4 || c Parm Parm1 || c Parm Parm2 || c Parm Parm3 || c Parm Parm4 || c Parm Parm5 || c Parm Parm6 || c Parm Text || c EndIf >------------+| c* | c Eval offset = offset+ldelen | c EndDo >-------------+ c* c* Visualizar miembros encontrados. c Call 'SCHFLD2R' c Parm '*DSP' Option 4 c Parm Parm1 c Parm Parm2 c Parm Parm3 c Parm Parm4 c Parm Parm5 c Parm Parm6 c* c SetOn LR c Return c* c*========================================================== c* S U B R U T I N A S c*========================================================== c*---------------------------------------------------------- c* SUBRUTINA: *INZSR c* PROPOSITO: Inicialización c*---------------------------------------------------------- c *InzSr BegSr c* c* Crea User Space. c Callp QUSCRTUS(User_Space:USexta:USsize:USinit: c USauth:UStext:USrplc:errcod) c* c* Lista los miembros fuente. c Eval Filenm = FileNam c Eval Libl = Library c* c Callp QUSLMBR(User_Space:MBRfmt:Qualnm:Member: c Ovrprc:Errcod) c* c* Recupera cantidad de registros encontrados. c Callp QUSRTVUS(User_Space:ldsofs:ldelen:rcvvar: c Errcod) c* c* Posicionamiento en el primer elemento. c Eval offset = offset+1 c* c* Crea archivo de salida si seleccionó OUTPUT(*OUTFILE) c If Parm4 = '*OUTFILE' <-------------+ c* | c* Verifica si ya existe el archivo especificado. | c Eval CmdStr = 'ChkObj ' + %Trim(OutLibl) + '/' + | c %Trim(OutFile) + ' *file' | c Eval CmdLen = %Len(%Trim(CmdStr)) | c CallP(E) qcmdexc(CmdStr:CmdLen) | c* | c* Si no existe, crea el archivo. | c If %Error <------------+| c Eval CmdStr = 'Crtpf ' + %Trim(OutLibl) + '/' + || c %Trim(OutFile) + ' srcfile(qgpl/qddssrc) ' + || c 'srcmbr(schfldpf)' || c Eval CmdLen = %Len(%Trim(CmdStr)) || c CallP(E) qcmdexc(CmdStr:CmdLen) || c* || c If %Error <-----------+|| c CallP qmhrsnem(*Blanks:ErrCod:dsRS:%size(dsRS): ||| c 'RSNM0100':*NULL:*Zeros) ||| c EndIf >-----------+|| c* || c* Si existe, limpia archivo si es *REPLACE. || c ElseIf OutOpt = '*REPLACE' }------------|| c Eval CmdStr = 'ClrPfm ' + %Trim(OutLibl) + '/' + || c %Trim(OutFile) || c Eval CmdLen = %Len(%Trim(CmdStr)) || c CallP(E) qcmdexc(CmdStr:CmdLen) || c* || c If %Error <-----------+|| c CallP qmhrsnem(*Blanks:ErrCod:dsRS:%size(dsRS): ||| c 'RSNM0100':*NULL:*Zeros) ||| c EndIf >-----------+|| c EndIf >------------+| c* | c* | c Eval CmdStr = 'OvrDbf FileOut ' + %Trim(OutLibl) + | c '/' + %Trim(OutFile) | c Eval CmdLen = %Len(%Trim(CmdStr)) | c CallP(E) qcmdexc(CmdStr:CmdLen) | c EndIf >-------------+ c* c EndSr