Solved

Can we retrieve the DSPF source form that Corresponding Object?

Posted on 2006-06-22
13
2,997 Views
Last Modified: 2008-03-03
Can we retrieve the DSPF source form that Corresponding Object?
TIA
MW
0
Comment
Question by:midwestexp
  • 6
  • 4
  • 3
13 Comments
 
LVL 14

Accepted Solution

by:
daveslater earned 250 total points
ID: 16961025
Here is some source I found years ago written  by Michael Sansoterra

===============
command RTVDDSSRC.
================

/*---------------------------------------------------------------*/
/* RTVDDSSRC - Retrieve DDS Source                               */
/*                                                               */
/* Michael Sansoterra, 01/20/03                                  */
/*                                                               */
/*                                                               */
/* Compile to call program: RTVDDSSRCC                           */
/*                                                               */
/* CRTCMD CMD(XXX/RTVDDSSRC) PGM(*LIBL/RTVDDSSRCC)               */
/*        SRCFILE(XXX/QCMDSRC)                                   */
/*                                                               */
/*---------------------------------------------------------------*/
CMD PROMPT('Retrieve DDS Source')

/* File Name Prompt */
PARM KWD(FILE) TYPE(FILEPMT) PROMPT('File Name')

/* Source File Name Prompt */
PARM KWD(SRCFILE) TYPE(SRCFILE) PROMPT('Source File Name')

/* Member Name */
PARM KWD(SRCMBR) TYPE(*NAME) LEN(10) DFT(*FILE) +
                 SPCVAL((*FILE)) PROMPT('Source Member')

/* Replace Existing Member */
PARM KWD(REPLACE) TYPE(*CHAR) LEN(4) RSTD(*YES) +
                  DFT(*YES) VALUES(*YES *NO) +
                  PROMPT('Replace existing member')


FILEPMT:     QUAL TYPE(*NAME) LEN(10)
             QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
                 SPCVAL((*LIBL) (*CURLIB)) PROMPT('Library')

SRCFILE:     QUAL TYPE(*NAME) LEN(10) DFT(QDDSSRC) +
                 SPCVAL((QDDSSRC))
             QUAL TYPE(*NAME) LEN(10) DFT(*CURLIB) +
                 SPCVAL((*LIBL) (*CURLIB)) PROMPT('Library')

0
 
LVL 14

Expert Comment

by:daveslater
ID: 16961031
CL program to process command

/*-------------------------------------------------------------------*/
/* RTVDDSSRCC - Retrieve DDS Source                                  */
/*                                                                   */
/* Michael Sansoterra, 01/20/03                                      */
/*                                                                   */
/* Compile Instructions:                                             */
/* CRTCLPGM PGM(XXX/RTVDDSSRCC) SRCFILE(XXX/QCLSRC)                  */
/*                                                                   */
/*-------------------------------------------------------------------*/
PGM PARM(&QONAME &QSNAME &MBRNAM &REPLACE)

DCL &QONAME  *CHAR 20  /* Qualified Object (file) name    */
DCL &QSNAME  *CHAR 20  /* Qualified Source File name      */
DCL &MBRNAM  *CHAR 10  /* Member Name                     */
DCL &REPLACE *CHAR 4   /* Replace Existing Member         */

DCL &FILE    *CHAR 10  /* File Name to Retrieve */
DCL &FILEL   *CHAR 10  /* File Library          */
DCL &SRCF    *CHAR 10  /* Source File Name      */
DCL &SRCFL   *CHAR 10  /* Source Library        */
DCL &TEXT    *CHAR 50  /* Object Text           */
DCL &ATR     *CHAR 10  /* Object Attr           */

DCL &NBRRCD *DEC LEN(10 0)  /* Number of Current Records */

/* Global Message Monitor */
MONMSG MSGID(CPF0000 MCH0000) EXEC(GOTO CMDLBL(ERROR))

/* Display Status Message */
SNDPGMMSG  MSGID(CPF9897) MSGF(QCPFMSG) +
           MSGDTA('Retrieving Source Member....') +
           TOPGMQ(*EXT) MSGTYPE(*STATUS)


/* Split Qualified Object name into Object and Library Names */
CHGVAR VAR(&FILE)  VALUE(%SST(&QONAME 1 10))
CHGVAR VAR(&FILEL) VALUE(%SST(&QONAME 11 10))

/* Split Qualified Source name into Object and Library Names */
CHGVAR VAR(&SRCF)  VALUE(%SST(&QSNAME 1 10))
CHGVAR VAR(&SRCFL) VALUE(%SST(&QSNAME 11 10))

/* Default Mbr Name to File Name, if Necessary */
IF COND(&MBRNAM='*FILE') THEN(CHGVAR &MBRNAM &FILE)

/* Check if source file exists               */
CHKOBJ &SRCFL/&SRCF *FILE
MONMSG CPF0000 EXEC(DO)
    SNDPGMMSG MSG('Source File '||&SRCF|>'not found.') MSGTYPE(*COMP)
    GOTO END
ENDDO


/* Retrieve Object Text for Heading Purposes */
RTVOBJD OBJ(&FILEL/&FILE) OBJTYPE(*FILE) OBJATR(&ATR) TEXT(&TEXT)
MONMSG CPF0000 EXEC(DO)
    SNDPGMMSG MSG('File ' || &FILE |> 'not found.') MSGTYPE(*COMP)
    GOTO END
ENDDO

/* Remove QTEMP Work Files */
DLTF QTEMP/QADSPFFD
MONMSG CPF0000

DLTF QTEMP/QAFDACCP
MONMSG CPF0000

DLTF QTEMP/QAFDSELO
MONMSG CPF0000

DLTF QTEMP/QAFDJOIN
MONMSG CPF0000

DLTF QTEMP/QAFDRFMT
MONMSG CPF0000

/* Assume Member Doesn't Exist in Specified File  */
ADDPFM FILE(&SRCFL/&SRCF) MBR(&MBRNAM) SRCTYPE(&ATR) TEXT(&TEXT)
MONMSG CPF0000

/* Retrieve number of records in member           */
RTVMBRD FILE(&SRCFL/&SRCF) MBR(&MBRNAM) NBRCURRCD(&NBRRCD)
IF COND(&NBRRCD *NE 0) THEN(DO)
    IF COND(&REPLACE='*NO') THEN(DO)
        SNDPGMMSG  MSG('Specified Member is not empty.  Clear +
                        the specified member before continuing.')
        GOTO END
    ENDDO
    /* Replace Existing Source Member */
    ELSE (DO)
        CLRPFM &SRCFL/&SRCF MBR(&MBRNAM)
        CHGPFM &SRCFL/&SRCF MBR(&MBRNAM) SRCTYPE(&ATR) TEXT(&TEXT)
    ENDDO
ENDDO


/* Output File Field Description */
DSPFFD FILE(&FILEL/&FILE) OUTPUT(*OUTFILE) +
                          OUTFILE(QTEMP/QADSPFFD)

IF (&ATR='PF' *OR &ATR='LF') THEN(DO)
    /* Output Access Path Info      */
    DSPFD  FILE(&FILEL/&FILE) TYPE(*ACCPTH) OUTPUT(*OUTFILE) +
           OUTFILE(QTEMP/QAFDACCP)
    /* Output Select/Omit,JOIN and Record Format Info  */
    IF (&ATR='LF') THEN(DO)
        DSPFD FILE(&FILEL/&FILE) TYPE(*JOIN)   OUTPUT(*OUTFILE) +
              OUTFILE(QTEMP/QAFDJOIN)
        DSPFD FILE(&FILEL/&FILE) TYPE(*SELECT) OUTPUT(*OUTFILE) +
              OUTFILE(QTEMP/QAFDSELO)
        DSPFD FILE(&FILEL/&FILE) TYPE(*RCDFMT) OUTPUT(*OUTFILE) +
              OUTFILE(QTEMP/QAFDRFMT)
    ENDDO
ENDDO


/* Override system file names to work files in QTEMP */
OVRDBF QADSPFFD QTEMP/QADSPFFD
OVRDBF QAFDACCP QTEMP/QAFDACCP
OVRDBF QAFDSELO QTEMP/QAFDSELO
OVRDBF QAFDJOIN QTEMP/QAFDJOIN
OVRDBF QAFDRFMT QTEMP/QAFDRFMT

/* Point RPG program to desired source member */
OVRDBF FILE(QDDSSRC) TOFILE(&SRCFL/&SRCF) MBR(&MBRNAM)

/* Retrieve DDS Spec RPG Program */
CALL RTVDDSSRCR PARM(&TEXT &MBRNAM &ATR)
MONMSG CPF4131 EXEC(DO)    /* Monitor for level check */
    SNDPGMMSG  MSG('A level check error occured.  This is +
                    most likely due to an O/S upgrade.  +
                    Please recompile the program.') +
                    MSGTYPE(*COMP)
    GOTO END
ENDDO

SNDPGMMSG  MSG('Source Member has been retrieved.') MSGTYPE(*COMP)

GOTO END

ERROR:
SNDPGMMSG  MSG('The Program Encountered Errors.  Check Job Log for +
                 Details.') MSGTYPE(*COMP)
DMPCLPGM

END:
DLTOVR *ALL
RCLRSC
ENDPGM
0
 
LVL 13

Expert Comment

by:_b_h
ID: 16961037
Hi, mw
Has the source been lost? You might look around for a compile listing, or an old save that would have the source.
I will look for other tools in the meantime.
Barry
0
 
LVL 14

Expert Comment

by:daveslater
ID: 16961038
RPG program called from CL Program

      *================================================================
      *
      *  RTVDDSSRCR  Build DDS Spec from file
      *              ILE Version
      *
      *
      *  Michael Sansoterra, 01/20/03
      *
      * Notes:
      * -JDFTVAL, JDUPSEQ(*DESCEND) and CONCAT keywords aren't supported
      * -For logical files, all fields will be listed
      * -Ref fields are only supported for PFs
      * -Attributes (EDTCDE, etc.) are included for Ref fields even
      *  when inherited from a REF file
      * -SQL data types including UDTs, BLOBs, Datalinks don't have DDS
      *  equivalents
      * -Certain ALIAS names created by an SQL app may be invalid in DDS
      * -Libraries that don't exist on the system will be replaced with
      *  *LIBL in the PFILE and JFILE keywords
      * -Compile time keywords such as RECOVER() and FRCACCPTH() will have
      *  to be gleaned from the existing object.
      * -Select/Omit values are limited to 32 characters
      * -Number of Select/Omit entries is limited to 32
      * -A VIEW's WHERE clause doesn't count as a Select/Omit
      *
      * Compile Options:
      * ===============================================
      * CRTBNDRPG PGM(XXXX/RTVDDSSRCR) SRCFILE(XXXX/QRPGLESRC)
      *
      *================================================================
     H DFTACTGRP(*NO) ACTGRP(*CALLER)
      *
      *  File Field Information
      *
     FQADspFFD  IF   E             Disk
      *
      *  Access Path Information
      *
     FQAfdAccP  IF   E             Disk    Usropn
      *
      *  Select/Omit Information
      *
     FQAfdSelO  IF   E             Disk    Usropn
      *
      *  Join Info Information
      *
     FQAfdJoin  IF   E             Disk    Usropn
      *
      *  Record Format Information
      *
     FQAfdRFmt  IF   E             Disk    Usropn
      *
      *  Source Member
      *  Member should be overridden and cleared before calling program
      *
     FQDDSSrc   O  A F   92        Disk
      *=====================================================================
      * Variables
      *=====================================================================
     D aSrcData        S              1    Dim(80)
     D aHeadings       S             80    Dim(13) CTData PerRcd(1)
     D aNumFields      S             10    Dim(500)
      *
     D Len             S              3  0
     D KeyWord         S            512
     D TempKW          S             36
     D FldLength       S              5  0
     D FldLengthA      S              5
     D NoDecPos        S              2
     D Count           S              5  0
     D NumFields       S              5  0
     D MaxKeyN         S                   Like(APKeyN)
     D MaxIBO          S                   Like(WHIBO)
      *
     D PrvHierFile     S             10
     D PrvHierLib      S             10
     D SavRfID         S                   Like(RFID)
     D RfCount         S              3  0
      *
     D Join            S            512
     D PrvJoinFile     S             10
     D PrvJoinLib      S             10
     D PrvJoinNo       S              3  0
     D PrvRcdName      S             10
     D PrvPos          S              3  0
     D I               S              3  0
      *
     D KeyFlag         S              1
     D JoinFlag        S              1
     D HierFlag        S              1
     D SelOmitFlag     S              1
      *
     D SrcSeq          S              6  0
     D SrcDat          S              6  0
     D SrcDta          S             80
      *
      * Entry Parms
      *
     D pFileText       S             50
     D pFileName       S             10
     D pFileAtr        S             10
      *=====================================================================
      * Constants
      *=====================================================================
     D cBlue           C                   Const(x'3A')
     D cNoHeadings     C                   Const(%Elem(aHeadings))
     D cOpt            C                   Const('COMPILE OPTION:')
     D cImmed          C                   Const('MAINT(*IMMED)')
     D cDelay          C                   Const('MAINT(*DLY)')
     D cRebuild        C                   Const('MAINT(*REBLD)')
      *=====================================================================
      * System Data Structure
      *=====================================================================
     D                SDS
     D  sdsPgm                 1     10
     D  sdsUser              254    263
      *=====================================================================
      * Prototype Definitions
      *=====================================================================
     D ReplaceQt       PR           100    Varying
     D   pText                       50    Value
      *
     D ChkLib          PR            10    Varying
     D   pLibrary                    10    Value
      *
     D QCmdExc         PR                  ExtPgm('QCMDEXC')
     D   pCmd                       256    Const
     D   pLen                        15  5 Const
      *
     D Cmd             S            100
      *
      *
      * FILE LEVEL KeyWords
      * -------------------
      *
      * Read Access Path Info and write related information
      *
     C                   Open(E)   QAfdAccP
     C                   If        Not %Error
     C                   Read      QAfdAccP
     C                   If            Not %Eof
     C                             And APNkyF>*Zero
      * Key (Access path) information info exists
     C                   Eval      KeyFlag='Y'
      * Write Comment for Access Path Maintenance
     C                   Eval      aSrcData(7)='*'
     C                   MoveA     cOpt          aSrcData(9)
     C                   Select
     C                   When      apmant='I'
     C                   MoveA     cImmed        aSrcData(25)
     C                   When      apmant='R'
     C                   MoveA     cRebuild      aSrcData(25)
     C                   When      apmant='D'
     C                   MoveA     cDelay        aSrcData(25)
     C                   EndSl
     C                   ExSr      WriteRec
      *
      * APUNIQ          Keys must be unique: N=No, Y=Yes
      *
     C                   If        APUniq='Y'
     C                   Eval      KeyWord='UNIQUE'
     C                   ExSr      WriteKeyWord
     C                   Else
      *
      * APKEYO          L=LIFO, F=FIFO, C=FCFO, N=No specific key order
      *
     C                   Select
     C                   When      APKeyO='L'
     C                   Eval      KeyWord='LIFO'
     C                   ExSr      WriteKeyWord
     C                   When      APKeyO='F'
     C                   Eval      KeyWord='FIFO'
     C                   ExSr      WriteKeyWord
     C                   When      APKeyO='C'
     C                   Eval      KeyWord='FCFO'
     C                   ExSr      WriteKeyWord
     C                   EndSl
     C                   EndIf
      *
     C                   EndIf
      *
      * Test if this is a special "hierarchical" logical file where a
      * single record format shares multiple PFs.
      *
     C                   If        APJoin='N' And APNSCo>1
     C                   Open(E)   QAfdRFmt
     C                   If        Not %Error
     C                   Read      QAfdRFmt
     C                   Dow       Not %EOF
     C                   If        RfID<>SavRFID
     C                   Eval      RfCount=RfCount+1
     C                   Eval      SavRFID=RfID
     C                   EndIf
     C                   Read      QAfdRFmt
     C                   EndDo
     C                   EndIf
      * If the number of distinct formats is < total formats then
      * we have a hierarchical logical file
     C                   If        RfCount<RfTotF
     C                   Eval      HierFlag='Y'
      * Save all PFiles by logical file format name
     C                   EndIf
     C                   EndIf
     C                   EndIf
      *
      * Test if Select/Omit data file exists and has data.
      * Write related file level key words.
      *
     C                   Open(E)   QAfdSelO
     C                   If        Not %Error
     C                   Read      QAfdSelO
     C                   If            Not %Eof
     C                             And SONRul>*Zero
     C                   Eval      SelOmitFlag='Y'
     C                   EndIf
      *
      * Write Dynamic Select Keyword, if present
      *
     C                   If        SODynS='Y'
     C                   Eval      KeyWord='DYNSLT'
     C                   ExSr      WriteKeyWord
     C                   EndIf
     C                   EndIf
      *
      * Read Field Names
      *
     C                   Read      QADspFFD
      *
     C                   Dow       Not %Eof
      *
      * RECORD LEVEL KeyWords
      * ---------------------
      *
      * Check for new record format
      *
     C                   If        WHName<>PrvRcdName
     C                   Eval      MaxIBO=*Zero
     C                   If        PrvRcdName<>*Blanks
     C                   ExSr      KeyFields
     C                   ExSr      SelectOmit
     C                   MoveA     *All' '       aNumFields
     C                   Eval      NumFields=*Zero
     C                   EndIf
      *
     C                   Eval      PrvRcdName=WHName
     C                   Eval      aSrcData(17)='R'
     C                   MoveA     WHName        aSrcData(19)
      *
      * Fill Data Array with Record Format Text Info, if text exists
      * format TEXT key word
      *
     C                   If        WHText<>*Blanks
     C                   Eval      KeyWord='TEXT('''+ReplaceQt(WHText)+''')'
     C                   ExSr      WriteKeyWord
     C                   Else
     C                   ExSr      WriteRec
     C                   EndIf
      *
      * If this file is a logical, write JFILE or PFILE KeyWord
      *
     C                   ExSr      JoinSpec
     C                   ExSr      HierSpec
     C                   If        JoinFlag<>'Y'
     C                             And HierFlag<>'Y'
      *
      * If a physical file is specified, write PFILE KeyWord
      *
     C                   If        APBof<>*Blanks
     C                   ExSr      GetPF
     C                   Eval      KeyWord='PFILE('+ChkLib(APBol)+'/'+
     C                                     %Trim(APBof)+')'
     C                   ExSr      WriteKeyWord
     C                   EndIf
     C                   EndIf
      *
     C                   EndIf
      *
      * FIELD LEVEL KeyWords
      * --------------------
      *
      * Fill Data Array with A-Spec Field Info Data
      *
      * Position  6='A'
      * Position 17=Record Indicator
      * Position 19=Field Name
      * Position 29=Ref Indicator
      * Position 30=Field Len
      * Position 35=Data Type
      * Position 36=No Decimal Places
      * Position 45=DDS KeyWords
      *
     C                   If        WHIBO>MaxIBO
     C                   Eval      MaxIBO=WHIBO
     C                   If        WHFldE<>*Blanks
     C                   MoveA     WHFldE        aSrcData(19)
     C                   MoveA     WHFldT        aSrcData(35)
      *
      * If this field is numeric, record it in the array of numeric fields
      * which will be used later when writing out key information.
      *
     C                   If        WHFldD>*Zero
     C                   Eval      NumFields=NumFields+1
     C                   If        NumFields<=%Elem(aNumFields)
     C                   Eval      aNumFields(NumFields)=WHFldE
     C                   EndIf
     C                   EndIf
      *
      * If Not a ref field, output Field Type info
      *
     C                   If            WHRFil<>*Blanks
     C                             And pFileAtr<>'LF'
     C                   Eval      aSrcData(29)='R'
     C                   Eval      aSrcData(35)=' '
     C                   Else
      *
      * Write Data Type and adjust field length, if necessary
      * (For packed, binary & float fields, use actual number digits for
      *  field length rather than number of bytes.)
      *
     C                   Eval      FldLength=*Zero
     C                   Select
      * Packed/Binary/Float
     C                   When         WHFldT='P'
     C                             Or WHFldT='B'
     C                             Or WHFldT='F'
     C                   Eval      FldLength=WHFldd
     C                   When      WHFldT='G'
     C                   Div       2             WHFldB
     C                   Eval      FldLength=WHFldB
      * Date/Time/Timestamp - No Field Length Needed
     C                   When         WHFldT='L'
     C                             Or WHFldT='T'
     C                             Or WHFldT='Z'
     C                   Eval      FldLength=*Zero
      * Varchar
     C                   When          WHFldT='A'
     C                             And WHVarL='Y'
      * For varchar fields, subtract 2 from total # bytes
     C                   Sub       2             WHFldB
     C                   Eval      FldLength=WHFldB
      * Other Data Types, use # bytes
     C                   Other
     C                   Eval      FldLength=WHFldB
     C                   EndSl
      *
     C                   Move      FldLength     FldLengthA
     C                   Eval      FldLengthA=%EditC(FldLength:'Z')
      *
     C                   MoveA     FldLengthA    aSrcData(30)
      *
      * Fill in decimal positions for numeric columns
      *
     C                   If        WHFldD>*Zero
     C                   If        WHFldP=*Zero
     C                   Eval      aSrcData(37)='0'
     C                   Else
     C                   Eval      NoDecPos=%EditC(WHFldP:'Z')
     C                   MoveA     NoDecPos      aSrcData(36)
     C                   EndIf
     C                   EndIf
     C                   EndIf
      *
      * Substring KeyWord
      *
     C                   If        WHMap='Y'
     C                   Eval      KeyWord='SST('+%Trim(WHFldi)+' '+
     C                                     %Trim(%EditC(WHMaps:'Z'))+' '+
     C                                     %Trim(%EditC(WHMapl:'Z'))+')'
     C                   MoveA     KeyWord       aSrcData(45)
     C                   EndIf
      *
      * Write I/O Attribute
      *
     C                   If           (pFileAtr<>'PF' And pFileAtr<>'LF')
     C                             Or WHFiob<>'B'
     C                   Eval      aSrcData(38)=WHFiob
     C                   EndIf
     C                   ExSr      WriteRec
      *
      * Fill Data Array with Field Text Info, if text exists
      * Format TEXT KeyWord
      *
     C                   If        WHFTxt<>*Blanks
     C                   Eval      KeyWord='TEXT('''+ReplaceQt(WHFTxt)+''')'
     C                   ExSr      WriteKeyWord
     C                   EndIf
      *
      * Fill Data Array with VARLEN KeyWord, if Varying length field
      *
     C                   If        WHVarL='Y'
     C                   Eval      KeyWord='VARLEN'
      *
      * Include Allocated Length, if exists
      *
     C                   If        WHAllc<>*Zero
     C                   Eval      KeyWord=%Trim(KeyWord)+
     C                             '('+%Trim(%EditC(whallc:'Z'))+')'
     C                   EndIf
     C                   ExSr      WriteKeyWord
     C                   EndIf
      *
      * Fill Data Array with ALIAS KeyWord, if ALIAS name exists
      *
     C                   If        WHAlis<>*Blanks
     C                   Eval      KeyWord='ALIAS('+%TrimR(WHAlis)+')  '
     C                   ExSr      WriteKeyWord
     C                   EndIf
      *
      * Write Allow Null KeyWord, if field allows nulls
      *
     C                   If        WHNull='Y'
     C                   Eval      KeyWord='ALWNULL'
     C                   ExSr      WriteKeyWord
     C                   EndIf
      *
      * Write CCSID if Alpha and CCSID<>37 (USA)
      *
     C                   If            WHFldT='A'
     C                             And WHCsid<>37
     C                             And WHCsid<>*Zero
     C                             And pFileAtr<>'LF'
     C                   Eval      KeyWord='CCSID('+
     C                                     %Trim(%EditC(WHCsid:'Z'))+')'
     C                   ExSr      WriteKeyWord
     C                   EndIf
      *
      * Write Date/Time Format & Separator
      *
     C                   If        WHFmt<>*Blanks
     C                   Select
     C                   When      WHFldT='L'
     C                   Eval      KeyWord='DATFMT('+whFmt+')'
     C                   ExSr      WriteKeyWord
     C                   When      WHFldT='T'
     C                   Eval      KeyWord='TIMFMT('+whFmt+')'
     C                   ExSr      WriteKeyWord
     C                   EndSl
     C                   EndIf
      *
      * Add Date/Time Separator KeyWords
      *
     C                   If        WHSep<>*Blanks
     C                   Select
     C                   When      WHFldT='L'
     C                   Eval      KeyWord='DATSEP('''+whSep+''')'
     C                   ExSr      WriteKeyWord
     C                   When      WHFldT='T'
     C                   Eval      KeyWord='TIMSEP('''+WHSep+''')'
     C                   ExSr      WriteKeyWord
     C                   EndSl
     C                   EndIf
      *
      * Write Edit Code or Edit Word
      *
     C                   If            WHECde<>*Blanks
     C                             And WHEWrd=*Blanks
      *
      * Edit code field contains a code and optionally a symbol
      *
     C                   Eval      KeyWord='EDTCDE(' + %Trim(
     C                                      %Subst(WHECde:1:1)+' '+
     C                                      %Subst(WHECde:2:1))+')'
     C                   ExSr      WriteKeyWord
     C                   EndIf
      *
     C                   If        WHEWrd<>*Blanks
     C                   Eval      KeyWord='EDTWRD('+%Trim(WHEWrd)+')'
     C                   ExSr      WriteKeyWord
     C                   EndIf
      *
      * Write Default Value KeyWord if exists
      *
     C                   If            WHDftL>*Zero
     C                             And pFileAtr<>'LF'
     C                   Eval      KeyWord='DFT('+%Subst(WHDft:1:WHDftL)+')'
     C                   ExSr      WriteKeyWord
     C                   EndIf
      *
      * Write Reference KeyWord
      *
     C                   If            WHRFil<>*Blanks
     C                             And pFileAtr<>'LF'
     C                   Eval      KeyWord='REFFLD(' +
     C                                     %Trim(WHRFmt)+'/'+%Trim(WHRFld)+
     C                                     ' ' +
     C                                     ChkLib(WHRLib)+'/'+%Trim(WHRFil)+
     C                                     ')'
     C                   ExSr      WriteKeyWord
     C                   EndIf
      *
      * Write Column Heading KeyWord
      *
     C                   If        WHCHd1+WHCHd2+WHCHd3<>*Blanks
     C                   Eval      KeyWord='COLHDG('''
      * Heading 1
     C                   If        WHCHd1=*Blanks
     C                   Eval      KeyWord=%Trim(KeyWord)+' '''
     C                   Else
     C                   Eval      KeyWord=
     C                             %Trim(KeyWord)+ReplaceQt(WHCHd1)+''''
     C                   EndIf
      * Heading 2
     C                   If        WHCHd2<>*Blanks or WHCHd3<>*Blanks
     C                   If        WHCHd2=*Blanks
     C                   Eval      KeyWord=%Trim(KeyWord)+' '' '''
     C                   Else
     C                   Eval      KeyWord=%Trim(KeyWord)+' '''+
     C                                     ReplaceQt(WHCHd2)+''''
     C                   EndIf
     C                   EndIf
      * Heading 3
     C                   If        WHCHd3<>*Blanks
     C                   Eval      KeyWord=%Trim(KeyWord)+' '''+
     C                                     ReplaceQt(WHCHd3)+''''
     C                   EndIf
     C                   Eval      KeyWord=%Trim(KeyWord)+')'
     C                   ExSr      WriteKeyWord
     C                   EndIf
      *
      * Write Floating Precision key word if FLOAT type is DOUBLE (8 bytes)
      *
     C                   If        WHFldT='F' And WHFldB=8
     C                   Eval      KeyWord='FLTPCN(*DOUBLE)'
     C                   ExSr      WriteKeyWord
     C                   EndIf
      *
      * Write RENAME KeyWord
      *
     C                   If            WHFldI<>WHFldE
     C                             And WHMap<>'Y'
     C                   Eval      KeyWord='RENAME('+%Trim(WHFldI)+')'
     C                   ExSr      WriteKeyWord
     C                   EndIf
      *
      * Write JREF KeyWord
      *
     C                   If        WHJRef<>*Zeros
     C                   Eval      KeyWord='JREF('+%Trim(%EditC(WHJRef:'Z'))+')'
     C                   ExSr      WriteKeyWord
     C                   EndIf
     C                   EndIf
      *
     C                   EndIf
      *
      * Read Next Field
      *
     C                   Read      QADspFFD
     C                   EndDo
      *
      * Write Key Field entries
      *
     C                   ExSr      KeyFields
      *
      * Write Select/Omit Field entries
      *
     C                   ExSr      SelectOmit
      *
     C                   Eval      *INLR=*On
     C                   Return
      *================================================================
      * End Mainline
      *================================================================
      *
      * Get PF Name for Select Logical File Record Format
      *
     C     GetPF         BegSr
     C                   If        KeyFlag='Y'
     C     1             Setll     QAfdAccP
     C                   Read      QAfdAccP
     C                   Dow       Not %Eof
     C                   If           APBolF<>PrvRcdName
     C                             Or pFileAtr='PF'
     C                   Eval      APBof=*Blanks
     C                   Else
     C                   Leave
     C                   EndIf
      *
     C                   Read      QAfdAccP
     C                   EndDo
     C                   EndIf
     C                   EndSr
      *================================================================
      * Write Key Field key words for Current LF Record Format or PF
      *================================================================
     C     KeyFields     BegSr
     C                   If        KeyFlag='Y'
      *
     C                   Eval      MaxKeyN=*Zero
     C     1             Setll     QAfdAccP
     C                   Read      QAfdAccP
     C                   Dow       Not %Eof
     C                   If           APBolF=PrvRcdName
     C                             Or pFileAtr='PF'
      *
      * The check to see if the key sequence# repeats is used to
      * weed out duplicate key names in hierarchical logicals
      *
     C                   If        APKeyN>MaxKeyN
     C                   Eval      MaxKeyN=APKeyN
     C                   Eval      aSrcData(17)='K'
     C                   MoveA     APKeyF        aSrcData(19)
      *
      * Descending Key Sequence
      *
     C                   If        APKSeq='D'
     C                   MoveA(P)  'DESCEND'     aSrcData(45)
     C                   EndIf
     C                   ExSr      WriteRec
      *
      * Make sure this field is numeric, before writing numeric keywords
      *
     C     APKeyF        Lookup    aNumFields                             10
     C                   If        %Equal
      *
      * Key Sign
      *
     C                   Select
     C                   When      APKSin='A'
     C                   Eval      KeyWord='ABSVAL'
     C                   When      APKSin='N'
     C                   Eval      KeyWord='UNSIGNED'
     C                   When      APKSin='S'
     C                   Eval      KeyWord='SIGNED'
     C                   EndSl
     C                   ExSr      WriteKeyWord
      *
      * Key Zone/Digit
      *
     C                   Select
     C                   When      APKzd='Z'
     C                   Eval      KeyWord='ZONE'
     C                   ExSr      WriteKeyWord
     C                   When      APKzd='D'
     C                   Eval      KeyWord='DIGIT'
     C                   ExSr      WriteKeyWord
     C                   EndSl
     C                   EndIf
     C                   EndIf
     C                   EndIf
      *
     C                   Read      QAfdAccP
     C                   EndDo
     C                   EndIf
     C                   EndSr
      *================================================================
      * Write Select/Omit key words for current LF record format
      *================================================================
     C     SelectOmit    BegSr
      *
     C                   If        SelOmitFlag='Y'
     C     1             Setll     QAfdSelO
     C                   Read      QAfdSelO
     C                   Dow       Not %Eof And Not %Error
     C                   If        SORFmt=PrvRcdName
      *
     C                   If        SORule='A'
     C                   Eval      SORule=*Blanks
     C                   EndIf
      *
      * Determine Select/Omit comparison type (RANGE KeyWord is
      * replace by a COMP GE and a COMP LE)
      *
     C                   Select
     C                   When      SOComp='AL'
     C                   Eval      KeyWord='ALL'
     C                   When      SOComp='VA'
     C                   Eval      KeyWord='VALUES('
     C                   Other
     C                   Eval      KeyWord='COMP('+%TrimR(SOComp)
     C                   EndSl
      *
     C                   Move      SORule        aSrcData(17)
     C                   MoveA     SOFld         aSrcData(19)
      *
      * Write Comparison Values
      * Select/Omit Comparison Values > 31 characters are truncated
      *
     C                   If        SONVal>*Zero
     C                   Do        SONVal        Count
      *
      * Write ValueS or COMP Values
      *
     C                   Eval      KeyWord=%Trim(KeyWord)+' '+SOValu
      *
      * Loop to read additional Values, if ValueS KeyWord specified
      *
     C                   If        Count<SONVal
     C                   Read      QAfdSelO
     C                   EndIf
     C                   EndDo
     C                   EndIf
      *
      * Close Parenthesis After Value or COMP List
      *
     C                   If           SOComp='VA'
     C                             Or SOComp<>'AL'
     C                   Eval      KeyWord=%TrimR(KeyWord)+')'
     C                   EndIf
     C                   ExSr      WriteKeyWord
      *
      * Bail out of loop early, if this record format has no more
      * rules.  This is to protect duplication of rules for
      * special hierarchical logical files.
      *
     C                   If        SONVal=*Zero
     C                   Leave
     C                   EndIf
     C                   EndIf
      *
     C                   Read(E)   QAfdSelO
     C                   EndDo
     C                   EndIf
     C                   EndSr
      *================================================================
      * Write Special Hierarchical PFile Spec
      *================================================================
     C     HierSpec      BegSr
     C                   If        HierFlag='Y'
     C                   Eval      KeyWord=*Blanks
     C                   Eval      PrvHierFile=*Blanks
     C                   Eval      PrvHierLib=*Blanks
     C     1             Setll     QAfdAccP
     C                   Read      QAfdAccP
     C                   Dow       Not %Eof
      * WHName is current record format
     C                   If        WHName=APBolF
     C                   If           PrvHierFile<>APBOF
     C                             Or PrvHierLib<>APBOL
     C                   Eval      KeyWord=%TrimR(KeyWord)+' '+ChkLib(APBOL)+
     C                                     '/'+%Trim(APBOF)
      *
     C                   Eval      PrvHierFile=APBOF
     C                   Eval      PrvHierLib=APBOL
      *
     C                   EndIf
     C                   EndIf
     C                   Read      QAfdAccP
     C                   EndDo
     C                   Eval      KeyWord='PFILE('+%Trim(KeyWord)+')'
     C                   ExSr      WriteKeyWord
     C                   EndIf
     C                   EndSr
      *================================================================
      * Write Join Spec if this is a Join File
      *================================================================
     C     JoinSpec      BegSr
      *
      * open JOIN info File
      *
     C                   Open(E)   QAfdJoin
     C                   If        Not %Error
     C                   Read      QAfdJoin
      *
      * Test if this is a join file
      *
     C                   If        JNNSpc>*Zero
      *
      * Find Join File Names
      *
      *
     C                   Eval      JoinFlag='Y'
     C                   Eval      KeyWord=*Blanks
      *
      * Loop through all records pulling out each JFILE name
      *
     C                   Dow       Not %Eof
     C                   If           PrvJoinFile<>JndNam
     C                             Or PrvJoinLib<>Jndlnm
     C                             Or PrvJoinNo<>Jndial
     C                   Eval      KeyWord=%TrimR(KeyWord)+' '+ChkLib(Jndlnm)+
     C                                     '/'+%Trim(JndNam)
      *
     C                   Eval      PrvJoinFile=JndNam
     C                   Eval      PrvJoinLib=Jndlnm
     C                   Eval      PrvJoinNo=Jndial
      *
     C                   EndIf
     C                   Read(E)   QAfdJoin
     C                   EndDo
     C                   If           PrvJoinFile<>JndNam
     C                             Or PrvJoinLib<>Jndlnm
     C                             Or PrvJoinNo<>Jndial
     C                   Eval      KeyWord=%TrimR(KeyWord)+' '+ChkLib(Jndlnm)+
     C                                     '/'+%Trim(JndNam)
     C                   EndIf
     C                   Eval      KeyWord='JFILE('+%Trim(KeyWord)+')'
     C                   ExSr      WriteKeyWord
      *
      * Reset File Pointer at 2nd record (1st record isn't useful here)
      *
     C     2             Setll     QAfdJoin
     C                   Read      QAfdJoin
     C                   Eval      aSrcData(17)='J'
      *
      * Write JFLD & JOIN KeyWords
      *
     C                   Eval      PrvPos=Jndial
     C                   Dow       Not %Eof
     C                   If        Jndial<>PrvPos
      * Write JOIN and JDFTSEQ KeyWords for prior join
     C                   If        Join<>*Blanks
     C                   Eval      KeyWord=Join
     C                   ExSr      WriteKeyWord
      * Setup J Reference
     C                   Eval      aSrcData(17)='J'
     C                   EndIf
     C                   Eval      PrvPos=Jndial
     C                   EndIf
      * Join Duplicate Sequence KeyWord
     C                   If        JNJdSq<>*Blanks
     C                   Eval      KeyWord='JDUPSEQ('+%TrimR(JNJdSq)+')'
     C                   ExSr      WriteKeyWord
     C                   Else
      *
      * Write JFLD KeyWord
      *
     C                   Eval      KeyWord='JFLD('+%TrimR(JNJFd1)+' '+
     C                                             %TrimR(JNJFd2)+')'
     C                   ExSr      WriteKeyWord
      * construct JOIN(fromfile:tofile) KeyWord (for use later)
     C                   Eval      Join='JOIN('+%Trim(%EditC(JNJFrm:'Z'))+' '+
     C                                          %Trim(%EditC(JNJTo:'Z'))+')'
     C                   EndIf
      *
     C                   Read(E)   QAfdJoin
     C                   EndDo
      * Write FINAL JOIN and JDFTSEQ KeyWords for prior join
     C                   If        Join<>*Blanks
     C                   Eval      KeyWord=Join
     C                   ExSr      WriteKeyWord
     C                   EndIf
      *
     C                   EndIf
     C                   EndIf
     C                   EndSr
      *=====================================================================
      * Write Record (Data to be written should be in array aSrcData)
      *=====================================================================
     C     WriteRec      BegSr
      *
     C                   Eval      aSrcData(6)='A'
      *
      * For unsupported data types, comment line out
      * 1-BLOB/CLOB, 3-DBCLOB, 4-Datalink
      *
     C                   If            WHFldT>='1'
     C                             And WHFldT<='4'
     C                             And aSrcData(17)<>'R'
     C                   MoveA     '*Unsupp'     aSrcData(7)
     C                   EndIf
      *
      * Move, Write and clear source data line
      *
     C                   MoveA     aSrcData      SrcDta
     C                   Except
     C                   Clear                   SrcDta
     C                   Clear                   aSrcData
      * Increment Seq#
     C                   If        SrcSeq<999999
     C                   Eval      SrcSeq=SrcSeq+1
     C                   EndIf
      *
     C                   EndSr
      *=====================================================================
      * Write KeyWord Record(s)
      *=====================================================================
     C     WriteKeyWord  BegSr
      *
      *
      * Determine Length of KeyWord Field Being Passed
      * The DDS KeyWord space is limited to 36 characters.  Therefore,
      * if the size of a KeyWord exceeds 36 characters then write 35
      * characters at a time along with a line extender (-) until
      * the KeyWord has completed.
      *
     C                   Eval      Len=%Len(%Trim(KeyWord))
     C                   Dow       Len>*Zero
      *
      * Move portion of KeyWord to DDS line
      *
     C                   Eval      TempKW=KeyWord
     C                   If        Len>36
     C                   Move      '-'           TempKW
     C                   Eval      KeyWord=%Subst(Keyword:36)
     C                   Else
     C                   Eval      TempKW=KeyWord
     C                   Eval      KeyWord=*Blanks
     C                   EndIf
      *
     C                   MoveA     TempKW        aSrcData(45)
      *
     C                   ExSr      WriteRec
     C                   Eval      Len=%Len(%Trim(KeyWord))
     C                   EndDo
      *
     C                   EndSr
      *=====================================================================
      * Write Heading Comments / Program ID Section
      *=====================================================================
     C     WriteHdg      BegSr
      *
      * Replace Special Values in Headings
      *
     C                   Eval      %Subst(aHeadings(2):20:50)=pFileText
     C                   Eval      %Subst(aHeadings(4):20:10)=pFileName
     C                   Eval      %Subst(aHeadings(6):20:10)=sdsUser
     C                   Eval      %Subst(aHeadings(8):20:8)=
     C                                                %EditC(udate:'Y')
      *
     C                   Do        cNoHeadings   I
      * Write output to File
     C                   MoveA     aHeadings(I)  aSrcData
     C                   Eval      aSrcData(1)=cBlue
     C                   ExSr      WriteRec
      *
     C                   EndDo
      *
     C                   EndSr
      *=====================================================================
      *
      * Initialization Subroutine
      *
      * Parms:
      * pFileText - Text description from file object
      * pFileName - Name of file object being rebuilt
      * pFileAtr  - Attribute of file being rebuilt
      *
      *=====================================================================
     C     *InzSr        BegSr
     C     *Entry        Plist
     C                   Parm                    pFileText
     C                   Parm                    pFileName
     C                   Parm                    pFileAtr
      *
      * Init Variables
      *
     C                   Eval      SrcSeq=1
     C     10000.01      Mult      UDate         SrcDat
      *
      * Write Heading Text to Member
      *
     C                   ExSr      WriteHdg
      *
     C                   EndSr
      *=====================================================================
      * Source File Record
      *=====================================================================
     OQDDSSrc   EAdd
     O                       SrcSeq               6
     O                       SrcDat              12
     O                       SrcDta              92
      *=====================================================================
      * Replace Quote (')
      *
      * Replace all single quotes with two single quotes so that
      * constants like TEXT & COLHDG which may contain a single
      * quote will compile correctly.
      *
      *=====================================================================
     P ReplaceQt       B
      *
     D ReplaceQt       PI           100    Varying
     D   pText                       50    Value
      *
     D WrkText         S            100    Varying
     D Str             S              3  0
     D pos             S              3  0
      *
     C                   Eval      WrkText=pText
     C                   Eval      Str=1
     C                   Eval      Pos=%Scan('''':WrkText)
     C                   Dow       Pos<>*Zero
     C                   Eval      WrkText=%Subst(WrkText:1:Pos)+''''+
     C                                     %Subst(WrkText:Pos+1)
     C                   Eval      Str=pos+2
     C                   Eval      Pos=%Scan('''':WrkText:Str)
     C                   EndDo
      *
     C                   Eval      WrkText=%TrimR(WrkText)
     C                   Return    WrkText
      *
     P ReplaceQt       E
      *=====================================================================
      * Check Library Name
      *
      * Verify that library name is on the system.  If ref PF library
      * is not on system, then replace library name with *LIBL.
      *
      *=====================================================================
     P ChkLib          B
      *
     D ChkLib          PI            10    Varying
     D   pLibrary                    10    Value
      *
     D RtnLibrary      S             10    Varying
     D SavLibrary      S             10    Static
     D MissingFlg      S              1    Static
      *
      *
     C                   If        savLibrary<>pLibrary
     C                   Eval      savLibrary=pLibrary
     C                   Eval      MissingFlg='N'
      *
     C                   Eval      cmd='CHKOBJ '+%Trim(pLibrary)+' *LIB'
     C                   CallP(E)  QCmdExc(Cmd:64)
     C                   If        %Error
     C                   Eval      MissingFlg='Y'
     C                   EndIf
     C                   EndIf
      *
     C                   If        MissingFlg='Y'
     C                   Eval      pLibrary='*LIBL'
     C                   EndIf
      *
     C                   Eval      RtnLibrary=%Trim(pLibrary)
      *
     C                   Return    RtnLibrary
      *
     P ChkLib          E
**
      *****************************************************************
      *      Desc: XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *
      *                                                               *
      * File Name: XXXXXXXXXX                                         *
      *                                                               *
      *      User: XXXXXXXXXX                                         *
      *                                                               *
      *      Date: XX/XX/XX                                           *
      *                                                               *
      * This source file was constructed using the RTVDDSSRC          *
      * command.                                                      *
      *                                                               *
      *****************************************************************
0
 
LVL 14

Expert Comment

by:daveslater
ID: 16961062
The easiest way to do this is to

1) cut and paste the code into notepad then save it
2) FTP the saved file into QCLSRC, QCMDSRC, and QRPGLESRC.

The objects I have used are

Cmd : REVDDSSRC
CL  : RTVDDSSRCC
RPG : RTVDDSSRCR

Good luck
Dave
0
 

Author Comment

by:midwestexp
ID: 16961084
Hi Barry , it was Compiled 5 years back , noe i am not findin the Source.

THANKS
MW
0
Why You Should Analyze Threat Actor TTPs

After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

 

Author Comment

by:midwestexp
ID: 16961296
Thanks Dave,
this One is working fine for the Physical File,
But my problem is I have to retrieve the Source for Display File .
0
 
LVL 13

Assisted Solution

by:_b_h
_b_h earned 100 total points
ID: 16961622
For DSSPF, RTVDDSSRC retrieves the fields but not screen positions, edits, etc.
How complicated is this display file? Does it use subfiles?  It might not be too difficult to reverse engineer.
Barry
0
 

Author Comment

by:midwestexp
ID: 16961939
Dave,
this is Working fine , the Only Problem is like Barry says that it is not giving you the Screen Position , Edit Word, Attributes But I can live with that because I have the Object , sine I have the Partial source I will re create the Source.
THANKS Dave/Barry.
MW

0
 
LVL 13

Expert Comment

by:_b_h
ID: 16962013
Use DSPFFD and DSPFD to check out the display file as well. There is additional help there for some attributes.
Good luck!
0
 
LVL 14

Expert Comment

by:daveslater
ID: 16962112
Barry
Can we use the DMPOBJ command to get the missing attributes?

Dave
0
 
LVL 13

Expert Comment

by:_b_h
ID: 16976527
Hi, Dave/MW
I have never done that before, but it might be worth a shot.
Can we get a copy of the object, MW?
Barry
0
 
LVL 14

Expert Comment

by:daveslater
ID: 16982109
Barry
I have dumped a simple display file,
all the details look like they are there but with-out some documentation it looks virtually impossible to decode.

Dave
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Suggested Solutions

A Short Story about the Best File Recovery Software – Acronis True Image 2017
Use of TCL script on Cisco devices:  - create file and merge it with running configuration to apply configuration changes
In this seventh video of the Xpdf series, we discuss and demonstrate the PDFfonts utility, which lists all the fonts used in a PDF file. It does this via a command line interface, making it suitable for use in programs, scripts, batch files — any pl…
This video shows how to remove a single email address from the Outlook 2010 Auto Suggestion memory. NOTE: For Outlook 2016 and 2013 perform the exact same steps. Open a new email: Click the New email button in Outlook. Start typing the address: …

746 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

8 Experts available now in Live!

Get 1:1 Help Now