These are the source files for the USESPCIAL2/3 and DIRREADER2 programs dicsussed in the May 2010 edition of IBM i Extra
|
|
SPECIAL File Program DIRREADER2
H DftActGrp(*No) BndDir('QC2LE')
H Option(*NoDebugIO : *SrcStmt)
// DirReader2
// - Used as SPECIAL file to read entries in a specified directory
// - Actual directory to open given by the fifth (extra) parm
// - 80 character INFDS passed as sixth (extra) parm
/Copy EXTRASRC,IFSDIRPROT
D template_INFDS DS Template
/Copy EXTRASRC,ShortINFDS
D* directoryData E DS ExtName(DIRENTRIES) Qualified
// Prototype for CEEUTCO API - Obtains current time zone offset
D CEEUTCO PR
D Hours 10I 0
D Mins 10I 0
D Secs 8F
D fc 12A options(*omit)
// Prototype to keep the compiler happy
D DirReader2 Pr ExtPGM('DIRREADER2')
D requestedAction...
D 1a
D statusFlag 1a
D errorCode 5s 0
D recordData 1a
D directoryToOpen...
D 640a Varying
D INFDS LikeDS(template_INFDS)
// Procedure Interface used instead of *Entry PList
D DirReader2 PI
// First four are the standard parameter definitions
// passed for SPECIAL files from the RPG program
D action 1a
D status 1a
D error 5s 0
// Length of data will actually be determined by which record
// layout we map to - the length here is irrelevant
D recordData 1a
// These are the extra parameters specified within the RPG program
// They are the name of the directory to open and the INFDS
D dirName 640a Varying
D INFDS LikeDS(template_INFDS)
// Definitions for directory entry, record layouts etc.
D entryName S 640a Varying
D LongEntry E DS ExtName(LONGDIRE) Based(p_data)
D Qualified
D ShortEntry E DS Extname(SHORTDIRE) Based(p_data)
D Qualified
D p_data S *
* Constants for SPECIAL file operation requests
D OPEN C 'O'
D READ C 'R'
D CLOSE C 'C'
D EOF C '1'
D ERR C '2'
D OK C '0'
D pdir S *
D message S 52a
// Definitions for time zone offset calculations
D hours S 10i 0
D minutes S 10i 0
D offsetSeconds S 8f
D epoch c z'1970-01-01-00.00.00'
D adjustedEpoch s z
/FREE
p_data = %Addr(recordData); // Set record basing pointerr
Select;
When action = READ;
p_dirEnt = ReadDir( pdir );
If p_dirEnt <> *Null; // If pointer is valid we have a record
entryName = %Subst( dE_name: 1: dE_nameLen );
If Stat( entryName: p_statDS ) < 0;
dirName = 'File: ' + entryName; // Identify failing file name
ExSr ReportError;
Else;
// Create required entries in the record buffer depending on
// the record type
If INFDS.RECORD = 'LONGREC';
longEntry.type = st_objtype;
longEntry.name = entryName;
longEntry.created = adjustedEpoch + %seconds( st_ctime );
longEntry.accessed = adjustedEpoch + %seconds( st_atime );
longEntry.modified = adjustedEpoch + %seconds( st_mtime );
Else;
shortEntry.type = st_objtype;
shortEntry.name = entryName;
EndIf;
EndIf;
Else; // otherwise we're at the end of the "File"
status = EOF;
Endif;
When action = OPEN;
pdir = OpenDir( dirName );
If pdir = *Null; // If pointer is null then open failed
ExSr ReportError; // Obtains error details and reports failure
EndIf;
When action = CLOSE;
CloseDir( pdir );
EndSl;
Return;
BegSr ReportError;
// Obtains errno and sets it into the file's feedback area
status = ERR;
p_errno = GetPtr_errno();
error = errno;
// Form basic error message
If action = OPEN;
message = 'Open error: ' + %Str( strError(errno));
Else;
message = 'Read error: ' + %Str( strError(errno));
EndIf;
Dsply message;
EndSr;
// Routine calculates an epoch timestamp adjusted to account for
// the current time zone offset. This is then used to produce
// correct timestamps for dates in the directory entries.
BegSr *InzSr;
// Call CEEUTCO to obtain current time zone offset in seconds
CEEUTCO( hours: minutes: offsetSeconds: *omit );
// Then add them to the base date to form adjusted epoch
adjustedEpoch = epoch + %seconds( %int( offsetSeconds ) );
EndSr;
Program USESPCIAL2 - sample program that uses the DIRREADER2 special file
FDirEntriesIF E SPECIAL PgmName('DIRREADER2')
F PList(DirReaderParm)
F UsrOpn
F INFDS(INFDS)
FQPrint O F 132 PRINTER
D INFDS DS QUALIFIED
/Copy ExtraSrc,ShortINFDS
D directoryName S 640a Varying
D Inz('/Partner400')
D message S 52a
D shortName S 34a
/Free
Open(E) DirEntries;
If %Error;
message = 'Directory: ' + directoryName; // Report error and quit
Dsply message;
*InLR = *On;
Return;
EndIf;
Dou %EOF(DirEntries);
Read(E) LongRec;
If ( not %Error ) AND ( not %EOF(DirEntries) );
shortName = name;
except main;
ElseIf %Error;
message = directoryName; // Report (truncated) file name and quit
Dsply message;
Leave; // Exit read loop
EndIf;
EndDo;
*InLR = *On;
/End-free
// SPECIAL files need a PList for extra parms. Sadly we
// have to code that in fixed form but we hide it down here!
C PListDummy BegSr
C DirReaderParm PList
C Parm directoryName
C Parm INFDS
C EndSr
OQPrint E main
O type 12
O created 40
O accessed 68
O modified 96
O shortName 132
Program USESPCIAL3 - Alternate version of USESPCIAL2 that uses the short directory entry format
FShortDirE IF E SPECIAL PgmName('DIRREADER2')
F PList(DirReaderParm)
F UsrOpn
F INFDS(INFDS)
FQPrint O F 132 PRINTER
D INFDS DS QUALIFIED
/Copy ExtraSrc,ShortINFDS
D directoryName S 640a Varying
D Inz('/Partner400')
D message S 52a
D shortName S 118a
/Free
Open(E) ShortDirE;
If %Error;
message = 'Directory: ' + directoryName; // Report error and quit
Dsply message;
*InLR = *On;
Return;
EndIf;
Dou %EOF(ShortDirE);
Read(E) ShortRec;
If ( not %Error ) AND ( not %EOF(ShortDirE) );
shortName = name;
except main;
ElseIf %Error;
message = directoryName; // Report (truncated) file name and quit
Dsply message;
Leave; // Exit read loop
EndIf;
EndDo;
*InLR = *On;
/End-free
// SPECIAL files need a PList for extra parms. Sadly we
// have to code that in fixed form but we hide it down here!
C PListDummy BegSr
C DirReaderParm PList
C Parm directoryName
C Parm INFDS
C EndSr
OQPrint E main
O type 12
O shortName 132
Source IFSDIRPROT - prototypes for IFS routines
// IFSDIRPROT - Prototypes for IFS directory processing
// - Includes DS definitions for directory entry and
// stat() data
D OpenDir Pr * ExtProc('opendir')
D
D ppath * Value Options(*String)
D ReadDir Pr * ExtProc('readdir')
D pdirectory * Value
D CloseDir Pr 10I 0 ExtProc('closedir')
D pdirectory * Value
D Stat Pr 10I 0 ExtProc('stat')
D * Value Options(*String)
D * Value
// Function and data definitions for obtaining current errno value and string
D GetPtr_errno Pr * ExtProc('__errno')
D
D p_errno S *
D p_errnoTxt S *
D errno S 10I 0 Based(p_errno)
D strerror Pr * extproc('strerror')
D errno 10I 0 value
// RPG Translation of C member STAT from file SYS in library QSYSINC
D p_statDS S * Inz(%addr(statDS))
D statDS DS
D st_mode 10U 0
D st_ino 10U 0
D st_nlink 5U 0
D st_pad 2A
D st_uid 10U 0
D st_gid 10U 0
D st_size 10I 0
D st_atime 10I 0
D st_mtime 10I 0
D st_ctime 10I 0
D st_dev 10U 0
D st_blksize 10U 0
D st_allocsize 10U 0
D st_objtype 12A
D st_codepage 5U 0
D st_reserved1 62A
D st_ino_gen_id 10U 0
// DS for directory entry information retrieved by readdir
D dirEnt DS Based(p_dirEnt)
D dE_res1 16a
D dE_genId 10u 0
D dE_fileNo 10u 0
D dE_recLen 10u 0
D dE_res3 10i 0
D dE_res4 6a
D dE_res5 2a
D dE_NLSinfo
D dE_CCSID 10i 0 Overlay(dE_NLSInfo)
D dE_country 2a Overlay(dE_NLSInfo: *Next)
D dE_language 3a Overlay(dE_NLSInfo: *Next)
D dE_res6 3a Overlay(dE_NLSInfo: *Next)
D dE_nameLen 10u 0
D dE_name 640a
// End of source IFSDIRPROT
Source SHORTINFDS - RPG controlled portion of full INFDS
// Modified version of source generated by RDP D-Spec generator.
// I hate From/To notation but since all the IBM examples use it ...
// Only the RPG supplied information is present as SPECIAL files do
// not supply all of the normal I/O and Open feedback information
// No actual DS name entry provided to allow you to supply
// your own name and/or have multiples in the program etc.
// File information feedback DS for file feedback
D FILE 1 8a * file name
D OPEN_IND 9 9n * file open?
D EOF_IND 10 10n * file at eof?
D FILESTATUS 11 15s 0 * Status code
D OPCODE 16 21a * Last opcode
D ROUTINE 22 29a * RPG Routine
D LIST_NUM 30 37a * Listing line
D SPCL_STAT 38 42s 0 * SPECIAL status
D RECORD 38 45a * Record name
D MSGID 46 52 * Error MSGID
D 53 66a * Unused
D SCREEN 67 70s 0 * Screen size
D NLS_IN 71 72s 0 * NLS Input?
D NLS_OUT 73 74s 0 * NLS Output?
D NLS_MODE 75 76s 0 * NLS Mode?
D LIST_NUM_SRC 77 78i 0
Source for LONGDIRE and SHORTDIRE Files used by USESPCIAL2 and 3
File LONGDIRE
A* Long Directory entry file layout used by DIRREADER2
A R LONGREC
A TYPE 12A
A NAME 640A VARLEN
A CREATED Z
A ACCESSED Z
A MODIFIED Z
File SHORTDIRE
A* Short Directory entry file layout used by DIRREADER2
A R SHORTREC
A TYPE 12A
A NAME 640A VARLEN
Want
more information?
Got a question or comment about the site?
Please feel free to Contact
Us at any time.}