|
Scott, I have already taken the 1st bottle...was working to the 2nd one. Thanks for you help. Michael -----Original Message----- From: rpg400-l-bounces@xxxxxxxxxxxx [mailto:rpg400-l-bounces@xxxxxxxxxxxx] On Behalf Of Scott Klement Sent: Wednesday, March 01, 2006 2:03 PM To: RPG programming on the AS400 / iSeries Subject: RE: QDFRTVFD 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 is the RPG programming on the AS400 / iSeries (RPG400-L) mailing list To post a message email: RPG400-L@xxxxxxxxxxxx To subscribe, unsubscribe, or change list options, visit: http://lists.midrange.com/mailman/listinfo/rpg400-l or email: RPG400-L-request@xxxxxxxxxxxx Before posting, please take a moment to review the archives at http://archive.midrange.com/rpg400-l. ------------------------------------------------------------------------------ This message contains information from Certegy, Inc which may be confidential and privileged. If you are not an intended recipient, please refrain from any disclosure, copying, distribution or use of this information and note that such actions are prohibited. If you have received this transmission in error, please notify by e:mail postmaster@xxxxxxxxxxxx ==============================================================================
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 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].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
midrange.com
