Unconfigured Ad Widget

Collapse

Announcement

Collapse
No announcement yet.

Cool Things: The Select STMF Utility

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Cool Things: The Select STMF Utility

    ** 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

Working...
X