** This thread discusses the article: Cool Things: The Select STMF Utility **

h dftactgrp(*no) BNDDIR('QC2LE')
h option(*nodebugio:*srcstmt:*seclvl)

fslctstmffmcf e workstn infds(displayINFDS)
f sfile(slctstmsfl :sflrrn)

dSELECTSTMF PR
d StartPath 640A CONST
d RestrictPath 1A CONST
d FileSelected 640A

dSELECTSTMF PI
d inpStartPath 640A CONST
d inpRestrictPath...
d 1A CONST
d outFileSelected...
d 640A

// Program Constants
d SFL_PAGE c const(7)
d PARENT_DIRECTORY...
d c CONST('[parent folder]')
d COLOR_BLUE c CONST(x'3a')
d F00 c const(x'00')
d F03 c const(x'33')
d F05 c const(x'35')
d F12 c const(x'3c')
d F13 c const(x'b1')
d ENTER c const(x'F1')
d PAGEUP c const(x'f4')
d PAGEDN c const(x'f5')

// Display INFDS
ddisplayINFDS ds
d screenOpen 9 9
d key 369 369
d sflFirstRRN 378 379I 0
d sflTotalRcds 380 381I 0

dptrDirHdlr s *
dwkFileName s 640A
dwkStartPath s 640A
dwkPrevPath s 640A dim(299)
dwlPathLevel s 3 0 inz(0)
dwkErrorText s 10a
dwkEPOCH s z
dwkPathChkFlg s 1a
dwkModifiedDate s z
dwkPath s 16384a varying
dwkPath2 s 5000a
dwkAction s 10a
dwkCtlChanged s 1n
dwkCurrentRecd s 5 0
dwkEndRead s 1n
dwkEOF s 1n
dwkErrStr s 10a
dwkMatch s 1n
dwkModDate s z
dwkOldPath s 640a dim(299)
dwkPathCheck s 1a
dwkPathLevel s 3 0 inz(1)
dwkRecordCount s 5 0
dwkSelected s 1n
dwkValid s 1n
dwkCmdStr s 5000a varying
dwkCmdLen s 15p 5
dwkReload s 1n

// Data Structures
dEntryDS ds likeds(DirectoryEntry)
d based(ptrEntry)
dInfoDS ds likeds(statds64)
dPath s 16384a varying
dOwnerDS ds likeds(Passwd)
d based(ptrOwn)
dGroupDS ds likeds(Group)
d based(ptrGroup)

// Procedure Prototypes

// *opendir(const char *dirname)
dopendir PR * extproc('opendir')
d DirectoryName * value options(*string)

// struct dirent *readdir(DIR *dirp)
dreadDir PR * extproc('readdir')
d ptrDiretory * value

// int closedir(DIR *dirp)
dcloseDir PR 10i 0 extproc('closedir')
d ptrDirectory * value

//--------------------------------------------------------------------
// struct passwd *getpwuid(uid_t uid)
dgetPWUID PR * extproc('getpwuid')
d UID 10u 0 value

//--------------------------------------------------------------------
// int lstat64(const char *path, struct stat64 *buf)
dlstat64 PR 10i 0 extproc('lstat64')
d Path * value options(*string)
d Buffer likeds(statds64)

//-------------------------------------------------------------------
dCommandExecute PR EXTPGM('QCMDEXC')
d 5000a CONST OPTIONS(*VARSIZE)
d 15p 5 CONST

//-------------------------------------------------------------------
// IBM Retrieve System Error Construct
dsys_errno pr * extproc('__errno')

// Error Number
dErrNo s 10i 0 based(ptrErrno)

//************************************************** *******************
// Directory Entry Structure
d DirectoryEntry ds qualified
d based(Template)
d dirRsrved 16a
d dirFileNoGenId...
d 10u 0
d dirFileNo 10u 0
d dirRecdLen 10u 0
d dirRsrv3 10i 0
d dirRsrv4 8a
d dirNLSInfo 12a
d dirNLSCCSID 10i 0 overlay(dirNLSInfo:1)
d dirNLSCntry 2a overlay(dirNLSInfo:5)
d dirNLSLang 3a overlay(dirNLSInfo:7)
d dirNameLength 10u 0
d dirName 640a

//************************************************** *******************
// File Information Structure, Large File Enabled (stat64)
dstatds64 ds qualified
d based(Template)
d stsMode 10u 0
d stsIno 10u 0
d stsUID 10u 0
d stsGid 10u 0
d stsSize 20i 0
d stsATime 10i 0
d stsMTime 10i 0
d stsCTime 10i 0
d stsDev 10u 0
d stsBlksize 10u 0
d stsNlink 5u 0
d stsCodepage 5u 0
d stsAllocsize 20u 0
d stsIno_gen_id 10u 0
d stsObjtype 11a
d stsReserved2 5a
d stsRdev 10u 0
d stsRdev64 20u 0
d stsDev64 20u 0
d stsNlink32 10u 0
d stsReserved1 26a
d stsCCSID 5u 0

// User Information Structure (passwd)
dpasswd ds qualified
d based(Template)
d pwdName *
d pwdUID 10u 0
d pwdGID 10u 0
d pwdDIR *
d pwdShell *

//--------------------------------------------------------------------
// Group Information Structure (group)
dGroup ds qualified
d based(template)
d grpName *
d grpGID 10u 0
d grpMEM * dim(256)

d ptrIndicators s * Inz(%addr(*in))
d indicatorDS ds 99 Based(ptrIndicators)
d Indicator 1 99a dim(99)
d DispSflCtl 41 41n
d DispSfl 42 42n
d ClearSfl 43 43n
d EndOfSfl 44 44n
d PositionSflCsr...
d 51 51n

/free
wkEpoch = z'1970-01-01-00.00.00.000000';
wkPath = inpStartPath;
wkPathCheck = %subst(wkPath:%Len(%Trim(wkPath)):1);
if wkPathCheck = '/';
wkPath = %subst(wkPath:1:%Len(%Trim(wkPath))-1);
endif;
wkStartPath = wkPath;

ptrDirHdlr = opendir(%trim(wkPath));
if (ptrDirHdlr = *null);
outFileSelected = '';
else;
exsr initScreen;
exsr LoadSFLRecd;

//---------------------------------------------------------------------
// Main processing loop runs forever until Cmd Key leaves loop.

dow 1=1;
// Write Message Subfile
write slctstmwin ;
// Exfmt Subfile Control and Subfile
exfmt slctstmctl ;
wkAction = '';

//*************************
// Command Key Processing
select;
when key = ENTER;
// Reset to current RRN just in case Page Up was keyed.
ctlCurPage = 1;

// - Exit command key
when key = F03;
wkAction = 'EXIT';
// - Reload key
when key = F05;
ctlObjWld = '';
ctlModDate = %date('01/01/0001': *USA);
ctlFileTyp = '';
exsr ResetSFL;
exsr LoadSFLRecd;
wkAction = 'LOOP';
when key = F12;
if wkPathLevel > 0;
wkPath = wkOldPath(wkPathLevel);
wkOldPath(wkPathLevel) = '';
wkPathLevel -= 1;
ctlObjWld = '';
ctlModDate = %date('01/01/0001': *USA);
ctlFileTyp = '';
exsr ResetSFL;
exsr ReloadCTL;
exsr LoadSFLRecd;
wkAction = 'LOOP';
else;
wkAction = 'EXIT';
endif;
when key = PAGEDN;
exsr LoadSFLRecd;
wkAction = 'LOOP';
other;
ctlCurPage = 1;
if sflFirstRRN 0;
ctlCurPage = sflFirstRRN;
endif;
endsl;
select;
when wkAction = 'EXIT';
leave;
when wkAction = 'LOOP';
iter;
other;
endsl;

//*************************
// Check if positioning fields changed
if ctlFileTyp savFileTyp or savObjWld ctlObjWld or
savModDate ctlModDate;
exsr ReloadCTL;

endif;

if wkCtlChanged = *on;
iter;
endif;

//*************************
// Check subfile records.
wkSelected = *off;
wkReload = *off;

if ctlLastRRN > 0;
readc slctstmsfl ;
dow not %eof;

wkValid = *off;
//
select;

// Subfile change with nothing selected.
// (Probably an "Invalid selection" was wiped out.)
when sflsel = ' ';

wkValid = *on;

// Select record
when sflsel = '1';
if sflfiletyp = 'DIR' or sflfiletyp = 'DDIR' or
sflfiletyp = 'FLR';
if %subst(sflShrtLnk:2:%SIZE(PARENT_DIRECTORY)) =
PARENT_DIRECTORY;
wkOldPath(wkPathLevel) = '';
wkPathLevel -= 1;
else;
wkPathLevel += 1;
wkOldPath(wkPathLevel) = wkPath;
endif;
wkPath = sflFullLnk;
ctlObjWld = '';
ctlModDate = %date('01/01/0001': *USA);
ctlFileTyp = '';
wkReload = *on;
wkValid = *on;
leave;
else;
wkValid = *on;
wkSelected = *on;
endif;
when sflsel = '5';
exsr DisplayDetails;
if wkAction = 'EXIT';
leave;
else;
wkValid = *on;
wkReload = *on;
endif;
endsl;

//** Update Subfile Display fields with new values just prior to
//** returning to the subfile display panel.
if wkValid = *off;
DispSflCtl = *on;
ctlCurPage = sflrrn;
else;
DispSflCtl = *off;
sflsel = ' ';
endif;

update slctstmsfl ;

if wkValid = *off;
leave;
endif;

readc slctstmsfl ;
enddo;

// If necessary reload the data
if wkReload = *on and wkSelected = *off;
exsr ResetSFL;
exsr ReloadCTL;
exsr LoadSFLRecd;
endif;
// Exit the loop if requested
if wkAction = 'EXIT';
leave;
endif;
endif;
if wkSelected = *on;
outFileSelected = sflFullLnk;
leave;
endif;
enddo;
endif;
// --------------------------------------------------------------------

closedir(ptrDirHdlr);

*inlr = *on;
return;

//************************************************** *******************
// Screen Initialization Subroutine

begsr InitScreen;

clear outFileSelected;

sflRRN = 0;

// Load Message Program Queue used by Message Subfile.
msgpgmq = 'SELECTSTMF ';

wkPath2 = wkPath;
ctlPath1=%subst(wkPath2:1:64);
ctlPath2=%subst(wkPath2:65:70);
ctlPath3=%subst(wkPath2:135:70);
ctlPath = wkPath;

endsr;


//************************************************** *******************
// Load Subfile Record

begsr LoadSflRecd;

wkCurrentRecd = 1;
wkEOF = *off;

dow wkCurrentRecd 45;
%subst(sflShrtLnk:43:3) = '...';
endif;

Path = %trim(sflFullLnk);
if wkFileName = '..' and wkPath=inpStartPath;
clear slctstmsfl;
iter;
endif;

if wkFileName = '..';
sflFullLnk = wkOldPath(wkPathLevel);
sflShrtLnk = COLOR_BLUE + PARENT_DIRECTORY;
endif;
if (LStat64(%trim(sflFullLnk): InfoDS) = -1);
ptrErrNo = sys_errno();
wkErrStr = %char(ErrNo);
wkEOF = *ON;
clear slctstmsfl;
iter;
endif;

sflfiletyp = %subst(%trim(InfoDS.stsObjType):2:7);
wkModDate = wkEpoch + %seconds(InfoDS.stsMTime);
sflModDate = %date(wkModDate);
sflModTstm = wkModDate;
sflCrtTstm = wkEpoch + %seconds(InfoDS.stsCTime);
sflAccTstm = wkEpoch + %seconds(InfoDS.stsATime);
sflCCSID = InfoDS.stsCCSID;
ptrOwn = getpwuid(InfoDS.stsUID);
sflOwner = %str(OwnerDS.pwdName);
sflObjSize = InfoDS.stsSize;

if sflfiletyp = 'DIR' and inpRestrictPath = 'Y';
clear slctstmsfl;
iter;
endif;

if sflFullLnk='';
iter;
endif;
// Examine against selection criteria.
exsr CheckDataMatch;


// Only add to file if matched selection criteria.
if wkMatch = *on;

wkRecordCount += 1;

// Position the cursor on the first line.
if wkRecordCount = 1;
PositionSflCsr = *on;
else;
PositionSflCsr = *off;
endif;

ctlLastRRN += 1;
sflRRN = ctlLastRRN;
write slctstmsfl;
endif;

enddo;

EndOfSFL = *Off;
if wkEOF = *On;
EndOfSFL = *On;
endif;
//---------------------------------------------------------------------

// Setup for Subfile display
if ctlLastRRN > 0;
select;
when key = F00;
ctlCurPage = 1;
when key = PAGEDN;
ctlCurPage = ctlLastRRN;
other;
ctlCurPage = 1;
if sflFirstRRN 0;
ctlCurPage = sflFirstRRN;
endif;
endsl;
DispSflCtl = *on;
DispSfl = *on;
else;
DispSflCtl = *on;
DispSfl = *off;
endif;

endsr;

//************************************************** *******************
//---------------------------------------------------------------------
// Subroutine - CheckDataMatch

begsr CheckDataMatch;

wkMatch = *ON;

if ctlFileTyp '' and ctlFileTyp sflFileTyp;
wkMatch = *OFF;
endif;
if ctlModDate %date('01/01/0001': *USA) and
ctlModDate sflModDate;
wkMatch = *off;
endif;
if ctlOBJWLD '' and ctlOBJWLD
%subst(sflShrtLnk:1:%len(%trim(ctlobjwld)));
wkMatch = *off;
endif;
if 0 = 1
;
wkMatch = *off;
endif;

endsr;

//---------------------------------------------------------------------
// Subroutine - ReloadCtl - Reload subfile control screen

begsr ReloadCtl;

// close and re-open path to allow for new files and/or path change.
closedir(ptrDirHdlr);
ptrDirHdlr = opendir(%trim(wkPath));

ctlpath1=%subst(wkPath:1:64);
ctlpath2=%subst(wkPath:65:70);
ctlpath3=%subst(wkPath:135:70);
ctlpath = wkPath;

savFileTyp = ctlFileTyp;
savObjWld = ctlObjWld;
savModDate = ctlModDate;

if %len(%trim(wkPath))>205;
%subst(ctlpath3:68:3)='...';
endif;
endsr;

//---------------------------------------------------------------------
// Subroutine - ResetSFL

begsr ResetSFL;

ctlCurPage = 0;
ctlLastRRN = 0;
sflRRN = 0;

DispSflCtl = *off;
DispSfl = *off;
ClearSfl = *on;

write slctstmwin;
write slctstmctl;

ClearSfl = *off;

endsr;

//---------------------------------------------------------------------
// Subroutine - DispayDetails

begsr DisplayDetails;

dspObjLink = sflFullLnk;
dspFileTyp = sflFileTyp;
dspModTStm = sflModTStm;
dspCrtTStm = sflCrtTStm;
dspAcctStm = sflAcctStm;
dspCCSID = sflCCSID;
dspOwner = sflOwner;
dspObjSize = sflObjSize;

dow 1=1;
write slctstmdwn;
exfmt slctstmdsp;

// Command Key Processing
select;
// - Exit command key
when key = F03;
wkAction = 'EXIT';
leave;
when key = F13;
wkCmdStr = 'DSPF STMF(''' + %trim(dspObjLink) + ''')';
wkCmdLen = %len(%trim(wkCmdStr));
CommandExecute(%trim(wkCmdStr): wkCmdLen);
other;
wkAction = 'ITER';
leave;
endsl;
enddo;

endsr;

/end-free