|
midrange.com
This template code works for me, when I create either an XML, or CSV file...
It's a direct rip-off from Scott's (great/fantastice/enlighting/well
written/nice samples provided) IFS tutorial... I just merged all the pieces
into 1 source file...
I just wish IBM would pay Scott a gazillion dollas to write some of their
technical manual's.
h optimize( *basic )
Hactgrp(*caller) dftactgrp(*no) Option(*SrcStmt)
ha
Hbnddir('QC2LE')
* ------------------------------------------------------------------ *
* Error Trapping Prototypes *
* ------------------------------------------------------------------ *
D die PR 1N
D msg 256A const
D @__errno PR * ExtProc('__errno')
D strerror PR * ExtProc('strerror')
D errnum 10I 0 value
D errno PR 10I 0
D EscErrno PR 1N
D errnum 10i 0 value
* ------------------------------------------------------------------ *
* 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 returnpt s 6a
d filename s 256a
d filelen s 9b 0
d asciicodepage s 10u 0 inz(819)
d filedesc s 10i 0
d byteswrt s 10i 0
d data s 9999a
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 )
D ErrMsg S 250A
* 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
* Open file
c eval filename = '/Timtest/test.csv'
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 )
** Error check the file creation
c if fileDesc < 0
c eval ErrMsg = %str(strerror(errno))+
c %editc(errno:'X')
C callp die('open() for input: ' + ErrMsg)
c endif
** we have created the file, now close it...
c eval returnInt = close( fileDesc )
** we now, re-open the file, and since the file was created
** the PCASCII code page, we don't have to handle the ebcidic
** conversion, the system will handle it for us.
c eval fileDesc = open( %addr( fullName )
c : o_textdata + o_rdwr )
** error check or re-open, and display the error if needed.
c if fileDesc < 0
c eval ErrMsg = %str(strerror(errno))+
c %editc(errno:'X')
C callp die('re-open() for input: ' + ErrMsg)
c endif
* Build a simple csv (excel file)
c eval data = 'Age,"record count","seq",'+
c '"direction","close"'+eor
c exsr writefile
* Build detail
c eval data = '12,234,34,"HI",13'+eor
c exsr writefile
c eval data = '11,4,9,"bye",17'+eor
c exsr writefile
* Close file
c eval returnint = close(filedesc)
c eval *Inlr = *on
* ------------------------------------------------------------------ *
* Write to file *
* ------------------------------------------------------------------ *
csr writefile begsr
** write out the detail
c if write(filedesc
c : %addr(data)
c : %len(%trimr(data))) < 1
** error check the write function.
c eval ErrMsg = %str(strerror(errno))+
c %editc(errno:'X')
c callp close(fileDesc)
c callp die('write(): ' + ErrMsg)
c endif
csr endsr
***************************************************************
** The routines past this point are needed to display error*
** messages... No need to modify *
***************************************************************
P die B
D die PI 1N
D msg 256A const
D QMHSNDPM PR ExtPgm('QMHSNDPM')
D MessageID 7A Const
D QualMsgF 20A Const
D MsgData 256A Const
D MsgDtaLen 10I 0 Const
D MsgType 10A Const
D CallStkEnt 10A Const
D CallStkCnt 10I 0 Const
D MessageKey 4A
D ErrorCode 256A
D dsEC DS
D dsECBytesP 1 4I 0 inz(%size(dsEC))
D dsECBytesA 5 8I 0 inz(0)
D dsECMsgID 9 15
D dsECReserv 16 16
D dsECMsgDta 17 256
D MsgLen S 10I 0
D TheKey S 4A
c ' ' checkr msg MsgLen
c if MsgLen<1
c return *off
c endif
c callp QMHSNDPM('CPF9897': 'QCPFMSG *LIBL':
c Msg: MsgLen: '*ESCAPE':
c '*': 3: TheKey: dsEC)
c return *off
P E
P errno B
D errno PI 10I 0
D p_errno S *
D retval S 10I 0 based(p_errno)
c eval p_errno = @__errno
c return retval
P E
P EscErrno B
D EscErrno PI 1N
D errnum 10i 0 value
D QMHSNDPM PR ExtPgm('QMHSNDPM')
D MessageID 7A Const
D QualMsgF 20A Const
D MsgData 1A Const
D MsgDtaLen 10I 0 Const
D MsgType 10A Const
D CallStkEnt 10A Const
D CallStkCnt 10I 0 Const
D MessageKey 4A
D ErrorCode 256A
D dsEC DS
D dsECBytesP 1 4I 0 inz(%size(dsEC))
D dsECBytesA 5 8I 0 inz(0)
D dsECMsgID 9 15
D dsECReserv 16 16
D dsECMsgDta 17 256
D TheKey S 4A
D MsgID S 7A
C move errnum MsgID
c movel 'CPE' MsgID
c callp QMHSNDPM(MsgID: 'QCPFMSG *LIBL':
c ' ': 0: '*ESCAPE':
c '*': 3: TheKey: dsEC)
c return *off
P E
> -----Original Message-----
> From: Joel Cochran [SMTP:jrc@xxxxxxxxxx]
> Sent: Thursday, July 31, 2003 7:22 AM
> To: midrange-l@xxxxxxxxxxxx
> Subject: CCSID for dummies...
>
> I have an RPGIV program that creates a file in the IFS and writes some
> text to it. Following the examples in the superlative "Who Knew..." I
> have used CodePage 437. The file gets created and I can open it through
> WRKLNK and read it just fine.
>
> When I go through Ops Nav and copy it to my PC, however, the contents
> show as garbage. The file is an XML file so it should be readable by
> any editor. When I let IE open it the contents are displayed correctly,
> but the "View Source" option shows the same garbage.
>
> To experiment, I took another text file from my PC and copied it to the
> directory in my IFS. I confirmed that the CodePage is 437, and I can
> view it on the 400. I then copied that file (again through Ops Nav)
> back to a different directory on my PC and could read it fine.
>
> Does anyone have any idea what could be happening? Am I creating the
> file incorrectly? I can provide code if necessary.
>
> Thanks,
>
> Joel Cochran
> http://www.rpgnext.com
>
>
> _______________________________________________
> This is the Midrange Systems Technical Discussion (MIDRANGE-L) mailing
> list
> To post a message email: MIDRANGE-L@xxxxxxxxxxxx
> To subscribe, unsubscribe, or change list options,
> visit: http://lists.midrange.com/mailman/listinfo/midrange-l
> or email: MIDRANGE-L-request@xxxxxxxxxxxx
> Before posting, please take a moment to review the archives
> at http://archive.midrange.com/midrange-l.
This e-mail message, including any attachments, is for the sole use of the
intended recipient(s) and may contain confidential or privileged
information. Any unauthorized review, use, disclosure or distribution is
prohibited. If you are not the intended recipient, please contact the
sender by reply e-mail and destroy the message.
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 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.
