Hello Michael,

Not the text that describes the field... The text that is on the screen. On the screen:
Enter the company number...: III(Where III = Input1)

I need to extract the "company".

So you want to extract the text constants that are displayed on the screen, then. You're right, you'll have to use QDFRTVFD for that. Unfortunately, this API is really difficult to use because it has about 10 million data structures, many of them are repeated as arrays, and many of them are variable-length. So, make sure you have a full bottle of aspirin ready to help with the headache that the API will give you.

Here's an example of using that API... This isn't thoroughly tested, but it should work, and will (hopefully) give you the idea.

     FQSYSPRT   O    F   80        PRINTER

     D SCHTEXT         PR                  ExtPgm('SCHTEXT')
     D   schFile                     10A   const
     D   schLib                      10A   const
     D   schString                   32A   const
     D SCHTEXT         PI
     D   schFile                     10A   const
     D   schLib                      10A   const
     D   schString                   32A   const

     D CONSTANT        C                   x'01'
     D DFT             C                   x'01'
     D upper           c                   'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
     D lower           c                   'abcdefghijklmnopqrstuvwxyz'

     D QDFRTVFD        PR                  ExtPgm('QDFRTVFD')
     D   RcvVar                   32767A   options(*varsize)
     D   RcvVarLen                   10I 0 const
     D   Format                       8A   const
     D   QualFile                    20A   const
     D   ErrorCode                 8192A   options(*varsize)

     D ErrorCode       ds
     D   BytesProv                   10I 0 inz(0)
     D   BytesAvail                  10I 0 inz(0)

     D Base            ds                  based(p_Base)
     D                                     qualified
     D   FileHdr                      5U 0 overlay(Base:9)
     D   NbrRecFmts                   5U 0 overlay(Base:*NEXT)

     D FileHdr         ds                  based(p_FileHdr)
     D                                     qualified
     D   RecFmt                      10U 0

     D RecFmt          ds                  based(p_RecFmt)
     D                                     qualified
     D   Name                        10A
     D   MiscRcdCnt                   2A
     D   RecHdr                      10U 0

     D RecHdr          ds                  based(p_RecHdr)
     D                                     qualified
     D   FldInfo                     10U 0
     D   FldIdx                      10U 0
     D   SelTbl                      10U 0
     D   MiscCnt                      4A
     D   NbrFlds                      5U 0
     D                                4A
     D   RespInd                      5U 0
     D                                4A
     D   RecDevDep                    5U 0

     D FldInfo         ds                  based(p_FldInfo)
     D                                     qualified
     D    Len                         5U 0
     D    Attrib                      1A
     D    Flags1                      1A
     D    Flags2                      1A
     D                                1A
     D    FldHdr                      1A

     D ConstHdr        ds                  based(p_ConstHdr)
     D                                     qualified
     D                                2A
     D    FldDevDep                   5U 0

     D FldDevDep       ds                  based(p_FldDevDep)
     D                                     qualified
     D    Flags                       1A
     D    DftAttr                     1A
     D    FldDevDepX                  5U 0
     D    KwdCatDisp                  5U 0

     D KwdCatDisp      ds                  based(p_KwdCatDisp)
     D                                     qualified
     D    Count                       5U 0
     D    Start                       1A

     D KwdCatEnt       ds                  based(p_KwdCatEnt)
     D                                     qualified
     D    CatId                       1A
     D    CatData                     5U 0

     D KwdCat23        ds                  based(p_KwdCat23)
     D                                     qualified
     D    NbrKwd                      5U 0
     D    Parm                        1A

     D KwdParm23       ds                  based(p_KwdParm23)
     D                                     qualified
     D    KwdId                       1A
     D    Type                        1A
     D    SelIdx                      5U 0
     D    DtaLen                      5U 0

     D KwdData         s           3564A   varying based(p_KwdData)

     D temp            s                   like(KwdData)
     D FindStr         s             32A   varying
     D x               s             10I 0
     D c               s             10I 0
     D f               s             10I 0
     D k               s             10I 0
     D len             s             10I 0

      /free

          FindStr = %trim(%xlate(lower:upper:schString));

          p_Base = %alloc(1024 * 1024);

          QDFRTVFD(Base: 1024*1024: 'DSPF0100': schFile + schLib
                  : ErrorCode );

          p_FileHdr   = p_Base + Base.FileHdr;
          p_RecFmt    = p_FileHdr + FileHdr.RecFmt;

          for x = 0 to (Base.NbrRecFmts - 1);
               p_RecFmt  = p_FileHdr + FileHdr.RecFmt + (%size(RecFmt)*x);
               p_RecHdr  = p_FileHdr + RecFmt.RecHdr;
               exsr ProcessRecFmt;
          endfor;

          dealloc p_Base;

          *inlr= *on;

          // *------------------------------------------------
          // * Process a record format.
          // *------------------------------------------------
          begsr ProcessRecFmt;

             for f = 1 to RecHdr.NbrFlds;

                if (f = 1);
                   p_FldInfo = p_RecHdr + RecHdr.FldInfo;
                else;
                   p_FldInfo = p_FldInfo + FldInfo.Len;
                endif;

                if (fldInfo.Attrib = CONSTANT);
                    exsr ProcessCategory;
                endif;

             endfor;

          endsr;

          // *------------------------------------------------
          // * This loops through all keyword categories
          // *  for a constant field (text on the screen.)
          // *------------------------------------------------
          begsr ProcessCategory;

             p_ConstHdr = %addr(FldInfo.FldHdr);
             p_FldDevDep = p_FldInfo + ConstHdr.FldDevDep;

             if (FldDevDep.KwdCatDisp > 0);

                p_KwdCatDisp = p_FldInfo + FldDevDep.KwdCatDisp;

                for c = 0 to (KwdCatDisp.Count - 1);

                    p_KwdCatEnt = %addr(KwdCatDisp.Start)
                                + (c * %size(KwdCatEnt));

                    if (KwdCatEnt.CatId = x'23');
                        p_KwdCat23 = p_FldInfo + KwdCatEnt.CatData;
                        exsr ProcessCat23;
                    endif;

                endfor;

             endif;

          endsr;

          // *------------------------------------------------
          // * This loops through all keywords that fall into
          // *  category 23 (DFT, MSGCON, DFTVAL, HTML)
          // *------------------------------------------------
          begsr ProcessCat23;

               for k = 1 to KwdCat23.NbrKwd;

                   if (k=1);
                      p_KwdParm23 = %addr(KwdCat23.Parm);
                   else;
                      p_KwdParm23 = p_KwdParm23 + %size(KwdParm23);
                   endif;

                   if (KwdParm23.KwdId = DFT);

                      p_KwdData = p_KwdParm23 + %size(KwdParm23) - 2;

                      Temp = %xlate(lower:upper:KwdData);
                      if (%scan(FindStr: Temp) > 0);
                           except print;
                      endif;

                   endif;

               endfor;
          endsr;

      /end-free

     OQSYSPRT   E            Print
     O                       RecFmt.Name


This thread ...


Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2020 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].