| 
* Demonstration of creating a text file with O_TEXT_CREAT
* and writing the results in Windows compatible ASCII format
* in the IFS. (Requires V5R2)
*
* Compile me with:
* CRTBNDRPG PGM(program-name) SRCFILE(library/filename)
*
H DFTACTGRP(*NO) BNDDIR('QC2LE')
/copy IFSIO_H
D fatal_error PR
D CRLF c const(x'0d25')
D fd s 10I 0
D data s 1000A varying
D mydir s 1000A varying
/free
// **********************************************************
// Change 'mydir' to a more appropriate directory.
// **********************************************************
mydir = '/tmp';
// **********************************************************
// delete the file if it exists (for our test to work, we
// need to make sure that the open() call creates a new
// file!)
// **********************************************************
unlink(mydir + '/test_text_file.txt');
// **********************************************************
// Use the open() API to create a new file, and set it up so
// that we'll translate from our job's CCSID to ASCII
// **********************************************************
fd = open(mydir + '/test_text_file.txt':
O_CREAT+O_WRONLY+O_CODEPAGE+O_TEXTDATA+O_TEXT_CREAT:
M_RDWR: CP_WINASCII: CP_CURJOB);
if (fd = -1);
fatal_error();
endif;
|
|
// ********************************************************** // write some interesting data to our text file // ********************************************************** data = 'Dear Santa,' +CRLF+ ' Christmas is coming soon and I know that I''ve' +CRLF+ 'been a very good boy. Therefore, you are bound by' +CRLF+ 'your nature to provide me with gifts. Here are the' +CRLF+ 'ones I want:' +CRLF+ CRLF+ 'a) 15 bottles of shampoo. It doesnt matter what' +CRLF+ 'kind, as long as it comes in green bottle.' +CRLF+ CRLF+ 'b) A map of Birmingham, Alabama.' +CRLF+ CRLF+ 'c) A new sofa, this one hurts when you sit on it.' +CRLF+ CRLF+ 'd) My own iSeries/400.' +CRLF+ CRLF+ 'Sincerely,' +CRLF+ ' Harry S. Truman.' +CRLF; // %addr(data) + 2, car la variable est varying et commence par 2 octets binaires que la fonction write ne comprend pas. if (write(fd: %addr(data)+2: %len(data)) < 1); fatal_error(); endif; // ********************************************************** // done! Close the file and end. // ********************************************************** if (close(fd) < 0); fatal_error(); endif; *inlr = *on; /end-free |
|
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* If anything goes wrong, we call this to look up the error
* message, and send it back to the previous entry of our
* call-stack.
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P fatal_error B
D fatal_error PI
** The "send program message" (QMHSNDPM) API
D QMHSNDPM PR ExtPgm('QMHSNDPM')
D MessageID 7A Const
D QualMsgF 20A Const
D MsgData 52A Const
D MsgDtaLen 10I 0 Const
D MsgType 10A Const
D CallStkEnt 10A Const
D CallStkCnt 10I 0 Const
D MessageKey 4A
D ErrorCode 1024A options(*varsize)
D dsEC DS
D dsECBytesP 1 4I 0 inz(0)
D dsECBytesA 5 8I 0 inz(0)
D dsECMsgID 9 15
D dsECReserv 16 16
D MsgKey s 4A
D geterrno PR * extproc('__errno')
D p_errno s *
D errno s 10I 0 based(p_errno)
D MsgID s 7A
D errno4 s 4S 0
c eval p_errno = geterrno
c eval errno4 = errno
c eval MsgID = 'CPE' + %editc(errno4:'X')
c callp QMHSNDPM(MsgID: 'QCPFMSG *LIBL':
c ' ': 0: '*ESCAPE':
c '*': 3: MsgKey: dsEC)
P E
|
