|
Give this a whirl. It's the infamous sendemail program. It has code that seems pretty straight forward with dealing with the IFS. I've been meaning to take a look at it and understand it! -----Original Message----- From: Hatzenbeler, Tim [mailto:thatzenbeler@xxxxxxxxxxxxx] Sent: Friday, June 27, 2003 2:49 PM To: 'RPG programming on the AS400 / iSeries' Subject: rpg <-> ifs sample... Does anybody have a sample rpg program or url, that has the basic ifs functions? Does a file exist? Create/Append/Overwite exisiting file, write a few lines of data, and then close the file... And of course, a way to iter through an ifs directory (recursive sublevel wouldn't be needed), so i can retrieve the filenames, so I could use them to open and read an ifs file would be very helpful also... Any help would be greatly appreciated,
midrange.com
* ------------------------------------------------------------------ *
* *
* This program will send an MIME e-mail with optional attachments *
* *
* To create this program, issue the following: *
* *
* CRTPGM PGM(*LIBL/SENDEMAIL) + *
* MODULE(*LIBL/SENDEMAIL) + *
* BNDSRVPGM(QTCP/QTMMSNDM) *
* *
* ------------------------------------------------------------------ *
h optimize( *basic )
* ------------------------------------------------------------------ *
* IFS Prototypes *
* ------------------------------------------------------------------ *
* Open an IFS file
d open pr 10i 0 extproc( 'open' )
d filename * value
d openflags 10i 0 value
d mode 10u 0 value options( *nopass )
d codepage 10u 0 value options( *nopass )
* Read an IFS file
d read pr 10i 0 extproc( 'read' )
d filehandle 10i 0 value
d datareceived * value
d nbytes 10u 0 value
* Write to an IFS file
d write pr 10i 0 extproc( 'write' )
d filehhndle 10i 0 value
d datatowrite * value
d nbytes 10u 0 value
* Close an IFS file
d close pr 10i 0 extproc( 'close' )
d filehandle 10i 0 value
* ------------------------------------------------------------------ *
* Standalones *
* ------------------------------------------------------------------ *
* File Access Modes for open()
d o_rdonly s 10i 0 inz( 1 )
d o_wronly s 10i 0 inz( 2 )
d o_rdwr s 10i 0 inz( 4 )
* Oflag values for open()
d o_creat s 10i 0 inz( 8 )
d o_excl s 10i 0 inz( 16 )
d o_trunc s 10i 0 inz( 64 )
* File status flags for opent() and fcntl()
d o_nonblock s 10i 0 inz( 128 )
d o_append s 10i 0 inz( 256 )
* Oflag share mode values for open()
d o_share_none s 10i 0 inz( 2000000 )
d o_share_rdonly s 10i 0 inz( 0200000 )
d o_share_rdwr s 10i 0 inz( 1000000 )
d o_share_wronly s 10i 0 inz( 0400000 )
* File permissions
d s_irusr s 10i 0 inz( 256 )
d s_iwusr s 10i 0 inz( 128 )
d s_ixusr s 10i 0 inz( 64 )
d s_irwxu s 10i 0 inz( 448 )
d s_irgrp s 10i 0 inz( 32 )
d s_iwgrp s 10i 0 inz( 16 )
d s_ixgrp s 10i 0 inz( 8 )
d s_irwxg s 10i 0 inz( 56 )
d s_iroth s 10i 0 inz( 4 )
d s_iwoth s 10i 0 inz( 2 )
d s_ixoth s 10i 0 inz( 1 )
d s_irwxo s 10i 0 inz( 7 )
* Misc
d o_textdata s 10i 0 inz( 16777216 )
d o_codepage s 10i 0 inz( 8388608 )
* ------------------------------------------------------------------ *
* Data Definitions *
* ------------------------------------------------------------------ *
* Miscellaneous data declarations
d filename s 256a
d filelen s 9b 0
d originator s 256a
d originname s 80a
d originlen s 9b 0
d cpfnumber s like( cpfid )
d subject s 256a
d message s 512a
d attachname s 256a
d asciicodepage s 10u 0 inz(819)
d addressee s like( address )
d addresseename s like( address )
d totalrecp s 9b 0
d filedesc s 10i 0
d byteswrt s 10i 0
d data s 9999a
d attachdesc s 10i 0
d bytesread s 10i 0
d dataread s 9899a
d eor s 2a inz( x'0D25' )
d null s 1a inz( x'00' )
d fullname s 512a
d returnint s 10i 0
d pos s 5u 0
d savepos s like( pos )
* Data structure of recipient info.
d recipient ds
d offset 1 4b 0
d addrlen 5 8b 0
d format 9 16
d distrtype 17 20b 0
d reserved 21 24b 0
d address 25 280
* MIME header fields
d msender s 256a
d mdatetime s 256a
d mfrom s 256a
d mmimever s 256a
d mto s 256a
d msubject s 256a
d mboundary s 256a inz( '--PART.BOUNDARY.1' )
d returnpt s 6a
* Array of file attachments
d attachment ds
d nbrfiles 1 2b 0
d attachfile 256a dim( 30 )
* Program Status
d sds
d error *status
d pgmname 1 10
d user 254 263
* API error info
d apierror ds
d apibytes 1 4b 0
d cpfid 9 15
* Constants
d dto c const( 0 )
d dcc c const( 1 )
d dbcc c const( 2 )
d msgsize c const( %len( message ))
d z s 5 0
**********************************************************************
»* M a i n l i n e C a l c u l a t i o n s *·
**********************************************************************
* Entry Parms
c *entry plist
c parm filename
c address parm addressee
c parm originator
c parm addresseename
c parm originname
c parm attachment
c parm subject
c parm message
* Initialize error structure
c eval apibytes = 11
* Initialize values
c eval filelen = %len( %trimr( filename ))
c eval %subst( filename : filelen +1 : 2 ) = x'0000'
c eval originlen = %len( %trimr( originator ))
c eval format = 'ADDR0100'
c eval distrtype = dto
c eval reserved = 0
c eval addrlen = %len( %trimr( address ))
c eval offset = 0
c eval totalrecp = 1
* Write MIME file
c exsr writehdr
* Call API to send e-mail
c callb 'QtmmSendMail'
c parm filename
c parm filelen
c parm originator
c parm originlen
c parm recipient
c parm totalrecp
c parm apierror
* Return to caller
c exit tag
c return
* ------------------------------------------------------------------ *
* Write header portion of file *
* ------------------------------------------------------------------ *
csr writehdr begsr
* Open file
c eval fullName = %trimr( fileName ) + null
c eval fileDesc = open( %addr( fullName )
c : o_creat + o_wronly + o_trunc +
c o_codePage
c : s_irwxu + s_iroth
c : asciiCodePage )
c eval returnInt = close( fileDesc )
c eval fileDesc = open( %addr( fullName )
c : o_textdata + o_rdwr )
* Build MIME header fields
c eval mSender =
c 'Sender: ' + originator
c eval mDateTime =
c 'Date: '
c eval mFrom =
c 'From: ' +
c %trimr( originName ) + ' <' +
c %trimr( originator ) + '>'
c eval mMimeVer =
c 'MIME-Version: 1.0'
c if addresseeName > *blanks
c eval mTo =
c 'To: ' + %trimr( addresseeName ) +
c ' <' + %trimr( address ) + '>'
c else
c eval mTo =
c 'To: ' + %trimr( address )
c endif
c if subject > *blanks
c eval mSubject =
c 'Subject: ' + subject
c else
c eval mSubject =
c 'Subject: '
c endif
c eval data = %trimr( mSender ) +
c eor +
c %trimr( mDateTime ) +
c eor +
c %trimr( mFrom) +
c eor +
c %trimr( mMimeVer) +
c eor +
c %trimr( mTo ) +
c eor +
c %trimr( mSubject ) +
c eor +
c 'Content-Type: multipart/mixed; boundary=' +
c '"' + %trimr( mBoundary ) + '"' +
c eor +
c eor +
c 'This is a multi-part message in MIME ' +
c 'format.' + eor + eor +
c '--' + %trimr( mboundary ) +
c eor +
c 'Content-Type: text/plain; charset=us-ascii'+
c eor +
c 'Content-Transfer-Encoding: 7bit' +
c eor + eor +
c %trimr( message ) +
c eor + eor + eor + eor +
c '--' + %trimr( mBoundary )
* Add attachment file(s) if requested
c if nbrfiles > *zero
c and attachfile(1) <> '*NONE'
c exsr writefile
c do nbrfiles z
c clear savepos
c eval pos = %scan('/':attachfile(z):1)
c dow pos > *zero
c eval savepos = pos
c eval pos = %scan('/':attachfile(z):pos+1)
c enddo
c if savepos <> *zero
c eval attachname = %subst(attachfile(z):savepos+1)
c else
c eval attachname = attachfile(z)
c endif
c eval data = eor +
c 'Content-Type: application/octet' +
c '-stream; name="' +
c %trimr(attachname) + '"' +
c eor +
c 'Content-Transfer-Encoding: 7bit' +
c eor +
c 'Content-Disposition: inline; filename="' +
c %trimr(attachname) + '"' +
c eor + eor
c exsr writefile
* Open file
c eval fullname = %trimr(attachfile(z)) + null
c eval attachdesc = open(%addr(fullname)
c : o_rdonly + o_textdata)
* Read from file and write to MIME file
c eval bytesread = read(attachdesc
c : %addr(dataread)
c : %size(dataread))
c dow bytesread > 0
c eval data = %subst(dataread:1:bytesread)
c eval byteswrt = write(filedesc
c : %addr(data)
c : %len(%trimr(data)))
c eval bytesread = read(attachdesc
c : %addr(dataread)
c : %size(dataread))
c enddo
* Close attachment file and write to MIME
c eval returnint = close(attachdesc)
c if z >= nbrfiles
c eval data = eor +
c '--' + %trimr(mboundary) + '--' +
c eor + eor
c else
c eval data = eor +
c '--' + %trimr(mboundary)
c endif
c exsr writefile
c enddo
c else
* Write end of MIME file for e-mail w/ no attachment
c eval data = %trimr(data) + '--' + eor + eor
c exsr writefile
c endif
* Close file
c eval returnint = close(filedesc)
csr endsr
* ------------------------------------------------------------------ *
* Write to file *
* ------------------------------------------------------------------ *
csr writefile begsr
c eval byteswrt = write(filedesc
c : %addr(data)
c : %len(%trimr(data)))
csr endsr
* ------------------------------------------------------------------ *
* Subroutine - @PSSR *
* Description - Error trapping subroutine. *
* ------------------------------------------------------------------ *
csr *pssr begsr
c if error = 202
c**************** move '*DETLC' ReturnPt
c**************** else
c move '*CANCL' returnpt
c endif
csr endsr returnpt
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2025 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.
