Tweet
Don't ask ... just cobbled this nasty code together for another site.
call passing library to search (all PF will be processed in this library)
& field you are searching for.
at LR the datastructure MYFILES will contain the files that the field was found in..
** Also if you are Birgitta you would just do something like this & be done!
This is an ugly piece of crap :
call passing library to search (all PF will be processed in this library)
& field you are searching for.
PHP Code:
call lstfiles parm('PRODLIB' 'IZSHELO')
** Also if you are Birgitta you would just do something like this & be done!
PHP Code:
select tbname from COLUMNS where name = 'IZSHELO' and dbname = 'PRODLIB'
This is an ugly piece of crap :
PHP Code:
H OPTION(*NODEBUGIO) ACTGRP(*NEW)
? ************************************************************************* ?
? * TO COMPILE: ?
? *
? ************************************************************************* ?
*
* *entry plist
*
d LSTFILES pr
d PassedLibrary 10 const
d PassedField 10 const
d LSTFILES pi
d PassedLibrary 10 const
d PassedField 10 const
? * ?
? * Stand Alone variables ?
? * ?
d AllText s 10 Inz('*ALL')
d Count s 4 0
d Count2 s 4 0
d EntryFmt s 10 inz('*FIRST')
d Fds# s 10i 0
d FFds# s 10i 0
d FileLib s 20
d Format s 8
d GenLen s 8
d Header s 2000
d I s 15 0
d Infile s 10
d InLibrary s 10
d InType s 10
d MyFiles s 10 dim(1000)
d MyFilesFound s 10 dim(1000)
d ObjectLib s 20
d ReceiveVr2 s 100
d RelRecNbr s 4 0
d RelRecHi# s 4 0
d SpaceVal s 1 inz(*BLANKS)
d SpaceAuth s 10 inz('*CHANGE')
d SpaceText s 50 inz(*BLANKS)
d SpaceRepl s 10 inz('*YES')
d SpaceAttr s 10 inz(*BLANKS)
d UserSpaceOut s 20
d Worktype s 10 inz('*FILE')
? * ?
? * Data structures ?
d GENDS2 ds qualified
d Filler1 116
d OffsetHdr 10i 0
d SizeHeader 10i 0
d OffsetList 10i 0
d Filler2 4
d NbrInList 10i 0
d SizeEntry 10i 0
d HeaderDs ds
d OutFileNam 10 overlay(HeaderDS:1)
d OutLibName 10 overlay(HeaderDS:11)
d OutType 5 overlay(HeaderDS:21)
d OutFormat 10 overlay(HeaderDS:31)
d RecordLen 10i 0 overlay(HeaderDS:41)
d ListDs ds Qualified
d FieldName 10 overlay(ListDS:1)
d FieldType 1 overlay(ListDS:11)
d BufferOut 10i 0 overlay(ListDS:13)
d FieldLen 10i 0 overlay(ListDS:21)
d Digits 10i 0 overlay(ListDS:25)
d Decimals 10i 0 overlay(ListDS:29)
d FieldDesc 50 overlay(ListDS:33)
d APIErrorDS ds Qualified
d BytesP 10I 0 inz(%size(apiErrorDS))
d BytesA 10I 0 inz(0)
d Messageid 7
d Reserved 1
d messagedta 128
d ds
d StartPosit 10i 0
d StartLen 10i 0
d SpaceLen 10i 0
d ReceiveLen 10i 0
d MessageKey 10i 0
d MsgDtaLen 10i 0
d MsgQueNbr 10i 0
*
dGenSpcPtr *
dLstSpcPtr *
dHdrPtr *
d $GetFields pr ExtPgm('QUSLFLD')
d 20
d 8 const
d 20
d 10
d 1 const
db like(ApiErrorDS)
*
d GENDS ds
d OffsetHdr 10i 0 overlay(GENDS:1)
d NbrInList 10i 0 overlay(GENDS:9)
d SizeEntry 10i 0 overlay(GENDS:13)
*
* Date structure for retriving userspace info
*
d InputDs DS
d UserSpace 1 20
d SpaceName 1 10
d SpaceLib 11 20
d InpFileLib 29 48
d InpFFilNam 29 38
d InpFFilLib 39 48
d InpRcdFmt 49 58
*
d ObjectDs ds qualified
d Object 10
d Library 10
d ObjectType 10
d InfoStatus 1
d ExtObjAttrib 10
d Description 50
**-- Retrieve object description: -------------------------------
d RtvObjD Pr ExtPgm( 'QUSROBJD' )
d RoRcvVar 32767a Options( *VarSize )
d RoRcvVarLen 10i 0 Const
d RoFmtNam 8a Const
d RoObjNamQ 20a Const
d RoObjTyp 10a Const
d RoError 32767a Options( *VarSize )
**-- List objects: ---------------------------------------------
d $ListObjects Pr ExtPgm( 'QUSLOBJ' )
d userspace 20a Const
d format 8a Const
d objectlib 20a Const
d type 10a Const
**-- Userspace pointer: ------------------------------------------
d $Userspace Pr ExtPgm( 'QUSRTVUS' )
d userspace 20a Const
d start 10i 0 Const
d Length 10i 0 Const
d Returned 32767a Options( *VarSize )
**-- Create Space: ---------------------------------------------
d $CreateSpace Pr ExtPgm( 'QUSCRTUS' )
d UserSpaceOut 20a Const
d SpaceAttr 10 Const
d SpaceLen 10i 0 Const
d SpaceVal 1a Const
d SpaceAuth 10a Const
d SpaceText 50a Const
d SpaceRepl 10a Const
d APIErrorDs 32767a Options( *VarSize )
? *--------------------------------------------------------------- ?
? * M A I N L I N E ?
? *--------------------------------------------------------------- ?
? * ?
/free
// find all files in the passed in Library
Spacename = 'LISTFILES';
exsr $QUSCRTUS;
ObjectLib = '*ALL ' + %trim(PassedLibrary);
//
// List all the outqueues to the user space
//
Format = 'OBJL0200';
$ListObjects( Userspace : Format : ObjectLib : WorkType);
//
// Retrive header entry and process the user space
//
StartPosit = 125;
StartLen = 16;
$UserSpace( Userspace : StartPosit : StartLen : GENDS);
StartPosit = OffsetHdr + 1;
StartLen = %size(ObjectDS);
//
? // Do for number of outqueues in the userspace ?
//
B1 for count = 1 to NbrInList;
$UserSpace( Userspace : StartPosit : StartLen : ObjectDs);
StartPosit += SizeEntry;
if OBJECTDS.EXTOBJATTRIB = 'PF';
FFds#+=1;
MyFilesFound(ffds#) = Objectds.Object;
endif;
endfor;
clear Myfiles;
reset Fds#;
clear MyFiles;
reset fds#;
for count = 1 to FFds#;
exsr $IsFieldHere;
endfor;
*inlr = *on;
//--------------------------------------------------------
// $IsFieldHere - search for field in passed in file
//--------------------------------------------------------
begsr $IsFieldHere;
FileLib = MyFilesFound(count) + PassedLibrary;
Spacename = 'FIELDSPC';
exsr $QUSCRTUS;
? // List fields to user space
$getFields(UserSpace:'FLDL0100':FileLib:EntryFmt:
'1':APIErrorDS);
StartPosit = 1;
StartLen = 140;
$UserSpace( Userspace : StartPosit : StartLen : GENDS2);
StartPosit = Gends2.OffsetHdr + 1;
StartLen = GenDS2.SizeHeader;
$UserSpace( Userspace : StartPosit : StartLen : HeaderDS);
SpaceLib = 'QTEMP';
Spacename = 'FIELDSPC';
StartPosit = GenDS2.OffsetList + 1;
StartLen = GenDS2.SizeEntry;
? // Do for number of fields
B1 for count2 = 1 to GENDS2.NBRINLIST;
$UserSpace( Userspace : StartPosit : StartLen : ListDS);
if PassedField = listds.FIELDNAME;
fds#+=1;
MyFiles(fds#) = MyFilesFound(count);
leave;
endif;
StartPosit += GenDS2.SizeEntry;
E1 endfor;
? ?
endsr;
//--------------------------------------------------------
// $QUSCRTUS - create userspace
//--------------------------------------------------------
begsr $QUSCRTUS;
APIErrorDS.BytesP = 116;
SpaceLib = 'QTEMP';
//
// Create the user space
//
$CreateSpace( Userspace : SpaceAttr : 4096 :
SpaceVal : SpaceAuth : SpaceText : SpaceRepl:
APIErrorDs);
endsr;