SPL2TIFF program

SPL2TIFF program

SPL2TIFF

       **************************************************************************
      *                                                                    *
      * System....... Utility Management System                            *
      * Program...... SPL2TIFF - Convert Spool File to Tag Image Format File
      * Written by... Sudhakar Ramakrishnan Kunji                          *
      * Date......... September 23rd, 2001                                 *
      *                                                                    *
      *                                                                    *
      *                                                                    *
      *                  Program Description                               *
      *                                                                    *
      *  This program converts Spool file to a Tag Image Format File       *
      *                                                                    *
      * Limitation                                                         *
      *   Cannot handle spool file larger than 16M.                        *
      **************************************************************************
      * Compilation
      *CRTRPGMOD MODULE(PKMANHUSKT/SPL2TIFFRP) SRCFILE(LIBRARY/QRPGLESRC)
      *CRTPGM PGM(LIBRARY/SPL2TIFFRP) BNDSRVPGM(QWPZHPT1) BNDDIR(QC2LE)
      *
      * * * * * * * * *  Maintenance Log * * * * * * * * * * * * * * * * * *
      *                                                                    *
      * Req#.       Date      Programmer     Modification Reason           *
      *                                                                    *
      **************************************************************************
      * User space error code                                              *
      **************************************                               *
     DQUSEC            DS
     D*                                             Qus EC
     D QUSBPRV                 1      4B 0
     D*                                             Bytes Provided
     D QUSBAVL                 5      8B 0
     D*                                             Bytes Available
     D QUSEI                   9     15
     D*                                             Exception Id
     D QUSERVED               16     16
     D*                                             Reserved
     D*QUSED01                17     17
     D*                                      Varying length
     D*
      **************************************                               *
      * Retreive error information ........................................*....
      **************************************                               *
     Dgeterrinfo       PR           128
      **************************************
      * SEND program message with Color                                     ....
      **************************************
      * Host print transform API ...............................................
      **************************************
     Dhpt              PR                  EXTPROC('QwpzHostPrintTransform')
     D                                 *   VALUE
     D                                 *   VALUE
     D                                 *   VALUE
     D                                 *   VALUE
     D                                 *   VALUE
     D                                 *   VALUE
     D                                 *   VALUE
     D                                 *   VALUE
     D                                 *   VALUE
     D                                 *   VALUE
     D                                 *   VALUE
     D                                 *   VALUE
      **************************************
      * Option Specific input/output information
      **************************************
     DQWPPTOSI         DS
     D*                                             Qwpz HPT Opt SpecIn
     D QWPRSV1                 1     16
     D*                                             Reserved 1
     D QWPRSV2                17     26
     D*                                             Reserved 2
     D QWPPDN                 27     36
     D*                                             Printer Device Name
     D QWPRSV3                37     56
     D*                                             Reserved 3
     D QWPRSV4                57     76
     D*                                             Reserved 4
     D QWPRSV5                77     86
     D*                                             Reserved 5
     D QWPRSV6                87     96
     D*                                             Reserved 6
     D QWPIJID                97    112
     D*                                             Int Job ID
     D QWPISID               113    128
     D*                                             Int Splf ID
     D QWPJN                 129    138
     D*                                             Job Name
     D QWPUN                 139    148
     D*                                             Usr Name
     D QWPJNBR               149    154
     D*                                             Job Number
     D QWPSN                 155    164
     D*                                             Splf Name
     D QWPSNBR               165    168B 0
     D*                                             Splf Number
     D QWPRSV7               169    180
     D*                                             Reserved 7
     D QWPRSV8               181    184B 0
     D*                                             Reserved 8
     D QWPRSV9               185    188B 0
     D*                                             Reserved 9
     D QWPRSV10              189    198
     D*                                             Reserved 10
     D QWPRAD                199    199
     D*                                             Return Align Data
     D QWPRSV11              200    204
     D*                                             Reserved 11
     D QWPNBRCP              205    208B 0
     D*                                             Number Complete Pages
     D QWPWCOBJ              209    218
     D*                                             Workstation Cust Object
     D QWPWCOL               219    228
     D*                                             Workstation Cust Object Lib
     D QWPMTM                229    243
     D*                                             Manufacturer Type Model
     D QWPPS1                244    253
     D*                                             Paper Source 1
     D QWPPS2                254    263
     D*                                             Paper Source 2
     D QWPES                 264    273
     D*                                             Envelope Source
     D****************************************************************
     D*Structure for Option specific output information
     D****************************************************************
     DQWPPTOSO         DS
     D*                                             Qwpz HPT Opt SpecOut
     D QWPRSV100               1      4B 0
     D*                                             Reserved 1
     D QWPTFIL                 5      5
     D*                                             Transform File
     D QWPPID                  6      6
     D*                                             Pass Input Data
     D QWPRSV200               7      8
     D*                                             Reserved 2
     D QWPDTFIL                9      9
     D*                                             Done Transforming File
     D QWPRSV300              10     12
     D*                                             Reserved 3
     D QWPVPCO                13     16B 0
     D*                                             Vertical Pos Command Offset
     D QWPVPCL                17     20B 0
     D*                                             Vertical Pos Command Length
     D QWPPDO                 21     24B 0
     D*                                             Print Data Offset
     D QWPPDL                 25     28B 0
     D*                                             Print Data Length
     D QWPCRCO                29     32B 0
     D*                                             Carriage Return Command Offs
     D QWPCRCL                33     36B 0
     D*                                             Carriage Return Command Leng
     D QWPFFCO                37     40B 0
     D*                                             Form Feed Command Offset
     D QWPFFCL                41     44B 0
     D*                                             Form Feed Command Length
      * variables for Host Print Transform API
     Dhptopt           S              9B 0
     Dhptosilen        S              9B 0 INZ(%LEN(QWPPTOSI))
     Dhptsplbuflen     S              9B 0
     Dhptosolen        S              9B 0 INZ(%LEN(QWPPTOSO))
     Dhptosolena       S              9B 0
     Dxbufspc_p        S               *
     Dhptxbuflen       S              9B 0 INZ(200000)
     Dhptxbuflena      S              9B 0
      * Size of user space
     Dspc_size         S              9B 0
      **************************************
      * Stream file APIs .......................................................
      **************************************
     Dunlink           PR             9B 0 EXTPROC('unlink')
     D                                 *   VALUE
      **************************************
     Dopen             PR            10I 0 EXTPROC('open')
      **************************************
     D                                 *   VALUE
     D                               10I 0 VALUE
     D                               10U 0 VALUE OPTIONS(*NOPASS)
     D                               10U 0 VALUE OPTIONS(*NOPASS)
     D O_CREAT         S             10I 0 INZ(8)
     D O_WRONLY        S             10I 0 INZ(2)
     D O_TRUNC         S             10I 0 INZ(64)
     D O_CODEPAGE      S             10I 0 INZ(8388608)
     D S_IRWXU         S             10I 0 INZ(448)
     D S_IROTH         S             10I 0 INZ(4)
      **************************************
     Dwrite            PR            10I 0 EXTPROC('write')
      **************************************
     D                               10I 0 VALUE
     D                                 *   VALUE
     D                               10I 0 VALUE
     Dclose            PR            10I 0 EXTPROC('close')
     D                               10I 0 VALUE
      *
     Dfd               S             10I 0
     Dbytesw           S             10I 0
     DTiff             S            257
      **************************************
      * 'QSPOPNSP/QSPGETSP/QSPCLOSP' spool file APIs variables .................
      **************************************
     Dspl_hdl          S              9B 0
     Dspl_nbr_b        S              9B 0
     Dspl_bufnbr       S              9B 0
      **************************************
      * Get Spooled File Data ..................................................
      **************************************
     D QSPGETSP        C                   'QSPGETSP'
     DQSPSPFRH         DS
     D*                                             Qsp SPFRH
     D QSPUD                   1     64
     D*                                             User Data
     D QSPHS                  65     68B 0
     D*                                             Header Size
     D QSPSL                  69     72
     D*                                             Struc Level
     D QSPSFILL               73     78
     D*                                             Spooled File Level
     D QSPFN                  79     86
     D*                                             Format Name
     D QSPICI                 87     87
     D*                                             Info Complete Ind
     D QSPRSV1                88     88
     D*                                             Reserved1
     D QSPUSU                 89     92B 0
     D*                                             User Space Used
     D QSPOFB                 93     96B 0
     D*                                             Offset First Buffer
     D QSPBR00                97    100B 0
     D*                                             Buffers Requested
     D QSPBRTN01             101    104B 0
     D*                                             Buffers Returned
     D QSPPD300              105    108B 0
     D*                                             Size Print Data300
     D QSPNCP                109    112B 0
     D*                                             Nbr Comp Pages
     D QSPFPN                113    116B 0
     D*                                             First Page Nbr
     D QSPOFP                117    120B 0
     D*                                             Offset First Page
     D QSPRSV200             121    128
     D*                                             Reserved2
     D****************************************************************
     D*Structure for Generic Header Section
     D****************************************************************
     DQSPSPFRB         DS
     D*                                             Qsp SPFRB
     D QSPLBI                  1      4B 0
     D*                                             Length Buffer Info
     D QSPBNBR                 5      8B 0
     D*                                             Buffer Number
     D QSPOGI                  9     12B 0
     D*                                             Offset General Info
     D QSPSGI                 13     16B 0
     D*                                             Size General Info
     D QSPOPD                 17     20B 0
     D*                                             Offset Page Data
     D QSPSPD                 21     24B 0
     D*                                             Size Page Data
     D QSPNBRPE               25     28B 0
     D*                                             Number Page Entries
     D QSPSPE                 29     32B 0
     D*                                             Size Page Entry
     D QSPOPD00               33     36B 0
     D*                                             Offset Print Data
     D QSPSPD00               37     40B 0
     D*                                             Size Print Data
     D****************************************************************
     D*Structure for General Data Section
     D****************************************************************
     DQSPSPFRG         DS
     D*                                             Qsp SPFRG
     D QSPNNL                  1      4B 0
     D*                                             Nbr Nonblank Lines
     D QSPNLP1                 5      8B 0
     D*                                             Nonblank Lines Page1
     D QSPEBNBR                9     12B 0
     D*                                             Error Buffer Number
     D QSPOER                 13     16B 0
     D*                                             Offset Error Recovery
     D QSPPDS                 17     20B 0
     D*                                             Print Data Size
     D QSPSTATE               21     30
     D*                                             State
     D QSPLPC                 31     31
     D*                                             Last Page Continues
     D QSPAPF                 32     32
     D*                                             Advanced Print Func
     D QSPACAIB               33     33
     D*                                             LAC Array in Buffer
     D QSPACIAB               34     34
     D*                                             LAC in Any Buffer
     D QSPACIEI               35     35
     D*                                             LAC in Error Info
     D QSPERI                 36     36
     D*                                             Error Recovery Info
     D QSPZP                  37     37
     D*                                             Zero Pages
     D QSPLF                  38     38
     D*                                             Load Font
     D QSPIPDSD               39     39
     D*                                             IPDS Data
     D QSPERVED01             40     44
     D*                                             Reserved
     D****************************************************************
     D*Structure for Page Data Section
     D****************************************************************
     DQSPSPFRP         DS
     D*                                             Qsp SPFRP
     D QSPTDS                  1      4B 0
     D*                                             Text Data Start
     D QSPADS                  5      8B 0
     D*                                             Any Data Start
     D QSPPO                   9     12B 0
     D*                                             Page Offset
     Dgen_hdr          S            128    BASED(splspc_p)
     Dbuf_inf          S             40    BASED(bufp)
     Dbuf_inf2         S             44    BASED(bufp2)
     Dsplbuf           S           5000    BASED(splbuf_p)
      **************************************
      * Misc ...................................................................
      **************************************
     Dmsg_data         S            256
     DEnd_time         S               Z
     DWrk_Splf         S                   Like(P00_Splf)
     DP01_Message      S             78
     DP01_Color        S              1
      **************************************************************************
      * Main - Main Processing Engine
      *****************************************************************
      *
     C     *Entry        PList
     C                   Parm                    P00_Splf         10        I
     C                   Parm                    P00_Job          26        I
     C                   Parm                    P00_Nbr           4 0      I
     C                   Parm                    P00_TiffP       128        I
     C                   Parm                    P00_FReplace      4        I
      *
      * Initialize
     C                   ExSr      Init
      * Prepare user space
     C                   ExSr      UserSpacePrep
      * Retrieve spool file
     C                   ExSr      GetSpoolFile
      * Create stream file
     C                   ExSr      OpenStreamF
      *
      * Run HTP Engine for converting the spool data to TIFF Data.
      * Start HPT Engine.
      *
     C                   Eval      hptopt = 10
     C                   ExSr      HPTEngine
      * Run HPT Engine to Process file.
     C                   Eval      hptopt = 20
     C                   ExSr      HPTEngine
      *   set pointer to first buffer
     C                   Eval      bufp = splspc_p + QSPOFB
      *   loop thru buffer
     C                   Do        QSPBRTN01
      *     retrieve 'Buffer information'
     C                   Eval      QSPSPFRB = buf_inf
      *     set pointer to 'offset to general information buffer'
     C                   Eval      bufp2 = splspc_p + QSPOGI
      *     retrieve 'General data (information buffer)'
     C                   Eval      QSPSPFRG = buf_inf2
      * Run HPT Engine to Transform Data.
     C                   Eval      hptopt = 30
     C                   ExSr      HPTEngine
      *     increment pointer by 'length of all buffer information'
     C                   Eval      bufp = bufp + QSPLBI
     C                   EndDo
      * Run HPT Engine to End Processing the file.
     C                   Eval      hptopt = 40
     C                   ExSr      HPTEngine
      * Stop HPT Engine.
     C                   Eval      hptopt = 50
     C                   ExSr      HPTEngine
      * Close Stream File
     C                   ExSr      CloseStreamF
      * End program
     C                   Eval      *InLR = *On
     C                   Return
      **************************************************************************
      * Init - Perform initialisation operations
      **********************************************************************
     C     Init          BegSr
      *
      * Remember start time
     C                   Z-Add     16            QUSBPRV
     C                   Eval      Wrk_Splf = P00_Splf
      *
     C                   EndSr
      *****************************************************************
      * Create User Space to Retrieve Spool Data
      *****************************************************************
     C     UserSpacePrep BegSr
      *
     C                   Eval      splspc_name = 'QSPGETSP  QTEMP'
      * Create User Space.
     C                   Call      'QUSCRTUS'
     C                   Parm                    splspc_name      20        I
     C                   Parm      *Blanks       spc_attr         10        I
     C                   Parm      1024          spc_size                   I
     C                   Parm      X'00'         spc_init          1        I
     C                   Parm      '*CHANGE'     spc_aut          10        I
     C                   Parm      'SPL2TIFF'    spc_text         50        I
     C                   Parm      '*NO'         spc_replace      10        I
     C                   Parm                    QUSEC                      I/O
     C                   Parm      '*USER'       spc_Domain       10        I
      *
     C                   If        QUSBAVL > 0
     C                   If        QUSEI <> 'CPF9870'
     C                   Eval      msg_data = 'API QUSCRTUS failed : ' + QUSEI
     C                   ExSr      PSSR
     C                   EndIf
     C                   EndIf
      *
      * Retrieve pointer to user space
      *
     C                   Call      'QUSPTRUS'
     C                   Parm                    splspc_name                I
     C                   Parm                    splspc_p                   O
     C                   Parm                    QUSEC                      I/O
      *
     C                   If        QUSBAVL > 0
     C                   Eval      msg_data = 'API QUSPTRUS failed : ' + QUSEI
     C                   ExSr      PSSR
     C                   EndIf
      *
      * Create user space for translation
      *
     C                   Eval      xbufspc_name = 'QWPZHPT1  QTEMP'
      *
     C                   Call      'QUSCRTUS'
     C                   Parm                    xbufspc_name     20        I
     C                   Parm      *Blanks       spc_attr                   I
     C                   Parm      200000        spc_size                   I
     C                   Parm      X'00'         spc_init                   I
     C                   Parm      '*CHANGE'     spc_aut                    I
     C                   Parm      'SPL2TIFF'    spc_text                   I
     C                   Parm      '*NO'         spc_replace                I
     C                   Parm                    QUSEC                      I/O
     C                   Parm      '*USER'       spc_Domain                 I
      *
     C                   If        QUSBAVL > 0
     C                   If        QUSEI =  'CPF9870'
     C                   Else
     C                   Eval      msg_data = 'API QUSCRTUS failed : ' + QUSEI
     C                   ExSr      PSSR
     C                   EndIf
     C                   EndIf
      *   Retrieve pointer to user space
     C                   Call      'QUSPTRUS'
     C                   Parm                    xbufspc_name               I
     C                   Parm                    xbufspc_p                  O
     C                   Parm                    QUSEC                      I/O
      *
     C                   If        QUSBAVL > 0
     C                   Eval      msg_data = 'API QUSPTRUS failed : ' + QUSEI
     C                   ExSr      PSSR
     C                   EndIf
      *
     C                   EndSr
      *****************************************************************
      * Get Spool File Information.
      *****************************************************************
     C     GetSpoolFile  BegSr
      *
      * Open spool file
     C                   Call      'QSPOPNSP'
     C                   Parm                    spl_hdl                    O
     C                   Parm                    P00_Job          26        I
     C                   Parm      *Blanks       spl_ijobi        16        I
     C                   Parm      *Blanks       spl_ispli        16        I
     C                   Parm                    Wrk_Splf                   I
     C                   Parm      P00_Nbr       spl_nbr_b                  I
     C                   Parm      -1            spl_bufnbr                 I
     C                   Parm                    QUSEC                      I/O
      *
     C                   If        QUSBAVL > 0
     C                   Eval      msg_data = 'API QSPOPNSP failed : ' + QUSEI
     C                   ExSr      PSSR
     C                   EndIf
      * Get spool data
     C                   Call      'QSPGETSP'
     C                   Parm                    spl_hdl                    I
     C                   Parm                    splspc_name                I
     C                   Parm      'SPFR0200'    fmt_name          8        I
     C                   Parm      -1            spl_bufnbr                 I
     C                   Parm      '*WAIT     '  spl_End          10        I
     C                   Parm                    QUSEC                      I/O
      *
     C                   If        QUSBAVL > 0
     C                   Eval      msg_data = 'API QSPGETSP failed : ' + QUSEI
     C                   ExSr      PSSR
     C                   EndIf
      *   retrieve 'General header'
     C                   Eval      QSPSPFRH = gen_hdr
      * Close spool file
     C                   Call      'QSPCLOSP'
     C                   Parm                    spl_hdl                    I
     C                   Parm                    QUSEC                      I/O
      *
     C                   If        QUSBAVL > 0
     C                   Eval      msg_data = 'API QSPCLOSP failed : ' + QUSEI
     C                   ExSr      PSSR
     C                   EndIf
      *
     C                   If        QSPICI <> 'C'
     C                   Eval      msg_data = 'Cannot process sppoled file ' +
     C                                        'larger than 16M.'
     C                   ExSr      PSSR
     C                   EndIf
      *
     C                   EndSr
      *****************************************************************
      * Run the Host Print Transform(HPT) Engine
      *****************************************************************
     C     HPTEngine     BegSr
      * Clear option specIfic I/O information
     C                   Clear                   QWPPTOSI
     C                   Clear                   QWPPTOSO
      *   API parameters
     C                   Eval      splbuf_p = splspc_p
     C                   Eval      hptsplbuflen = 0
     C                   Eval      hptosolena = 0
     C                   Eval      hptxbuflena = 0
      * Set parameters for QWPZHPTR
     C                   Select
      * 10 = initialize HPT
      *                  (no further parameters required)
      * 20 = process file
     C                   When      hptopt = 20
      *   Option specIfic input information
     C                   Eval      QWPPDN = '*NONE'
     C                   Eval      QWPJN = %SubSt(P00_Job : 1 : 10)
     C                   Eval      QWPUN = %SubSt(P00_Job : 11 : 10)
     C                   Eval      QWPJNBR = %SubSt(P00_Job : 21 : 6)
     C                   Eval      QWPSNBR = P00_Nbr
     C                   Eval      QWPSN = Wrk_Splf
     C                   Eval      QWPRAD = '0'
     C                   Eval      QWPWCOBJ = 'TIFF'
     C                   Eval      QWPWCOL  = '*LIBL'
     C                   Eval      QWPMTM = '*WSCST'
      * 30 = transform data
     C                   When      hptopt = 30
      *   Option specIfic input information
     C                   Eval      QWPRAD = '0'
      *     Adjust page number
     C                   Eval      QWPNBRCP = QSPNBRPE
     C                   Add       QSPNBRPE      total_pages       9 0
     C                   If        QSPBNBR = 1
     C                   If        (QSPNBRPE > 0) AND (QSPLPC = 'Y')
     C                   Sub       1             QWPNBRCP
     C                   EndIf
     C                   Else
     C                   If        QSPLPC = 'N'
     C                   Add       1             QWPNBRCP
     C                   EndIf
     C                   EndIf
      *   API parameters
     C                   Eval      splbuf_p = splspc_p + QSPOPD00
     C                   Eval      hptsplbuflen = QSPSPD00
      * 40 = End file
      *                  (no further parameters required)
      * 50 = terminate HPT
      *                  (no further parameters required)
     C                   EndSL
      * perform HPT
     C                   ExSr      CallHPT
     C                   If        hptopt = 30
      *   Increment counter
     C                   Add       1             counter           7 0
     C                   If        counter >= 5
     C                   Eval      P01_Message = %TRIMR(%Char(total_pages)) +
     C                                   ' pages processed. (' + %TRIMR(
     C                                %Char((QSPBNBR / QSPBRTN01) * 100))
     C                   Eval      P01_Color = 'B'
     C                   Call      'CLRPGMMSG'
     C                   Parm                    P01_Message
     C                   Parm                    P01_Color
     C                   Z-Add     0             counter
     C                   EndIf
     C                   EndIf
      *
     C                   If        QUSBAVL > 0
      * retry hpt If CPF6DF5 (process option parameter not valid)
     C  N99              If        (QUSEI  = 'CPF6DF5') AND (hptopt = 10)
      *   avoid loop
     C                   SETON                                        99
      *   terminate HTP then try again
     C                   Eval      hptopt = 50
     C                   ExSr      CallHPT
     C                   Eval      hptopt = 10
     C                   Clear                   QWPPTOSI
     C                   Clear                   QWPPTOSO
     C                   ExSr      CallHPT
     C                   Else
      * reset hpt and exit
     C                   Eval      msg_data = 'API QwpzHostPrintTransform ' +
     C                               'failed : ' + QUSEI + ' hptopt = ' +
     C                               %TRIM(%EDITC(hptopt:'J'))
     C                   Eval      hptopt = 50
     C                   ExSr      CallHPT
     C                   ExSr      PSSR
     C                   EndIf
     C                   EndIf
      * write data to stream file
     C                   If        hptxbuflena > 0
     C                   Eval      bytesw = write(fd : xbufspc_p : hptxbuflena)
     C                   If        bytesw <> hptxbuflena
     C                   Eval      msg_data = 'write() failed. ' + geterrinfo
     C                   ExSr      PSSR
     C                   EndIf
     C                   EndIf
      *
     C                   EndSr
      *****************************************************************
      * Call Host Print Transform(HPT) API.
      *****************************************************************
     C     CallHPT       BegSr
      * Perform HPT
     C                   CallP     hpt(%Addr(hptopt) :
     C                                 %Addr(QWPPTOSI) :
     C                                 %Addr(hptosilen) :
     C                                 splbuf_p :
     C                                 %Addr(hptsplbuflen) :
     C                                 %Addr(QWPPTOSO) :
     C                                 %Addr(hptosolen) :
     C                                 %Addr(hptosolena) :
     C                                 xbufspc_p :
     C                                 %Addr(hptxbuflen) :
     C                                 %Addr(hptxbuflena) :
     C                                 %Addr(QUSEC))
      *
     C                   EndSr
      *****************************************************************
      * Create/Open Stream File.
      *****************************************************************
     C     OpenStreamF   BegSr
      *
     C                   Eval      Tiff = %TRIM(P00_TiffP) + X'00'
      * Check whether stream file exists or not.
     C                   Eval      fd = open(%Addr(Tiff) : 1)
      *
      * If Stream file exists, close the stream file and check if replace
      * option was specified. If replace, then unlink the stream file.
      *
     C                   If        fd <> -1
     C                   If        -1 = close(fd)
     C                   Eval      msg_data = 'close() failed. ' + geterrinfo
     C                   ExSr      PSSR
     C                   EndIf
      *     replace(*yes) specIfied?
     C                   If        P00_FReplace = '*YES'
     C                   If        -1 = unlink(%Addr(Tiff))
     C                   Eval      msg_data = 'unlink() failed. ' + geterrinfo
     C                   ExSr      PSSR
     C                   Else
     C                   Eval      P01_Message = 'Stream file ' +
     C                                           %TRIMR(P00_TiffP) +
     C                                           ' removed.'
     C                   Eval      P01_Color   = 'R'
     C                   Call      'CLRPGMMSG'
     C                   Parm                    P01_Message
     C                   Parm                    P01_Color
     C                   EndIf
     C                   Else
     C                   Eval      msg_data = 'file already exists.'
     C                   ExSr      PSSR
     C                   EndIf
     C                   Else
     C                   EndIf
      * Open(Create) stream file
     C                   Eval      fd = open(%Addr(Tiff)
     C                               : O_CREAT + O_WRONLY + O_TRUNC + O_CODEPAGE
     C                               : S_IRWXU + S_IROTH
     C                               : 819)
     C                   If        fd = -1
     C                   Eval      msg_data = 'open() failed. ' + geterrinfo
     C                   ExSr      PSSR
     C                   EndIf
      *
     C                   EndSr
      *****************************************************************
      * Close Stream File
      *****************************************************************
     C     CloseStreamF  BegSr
      * Close stream file
     C                   If        -1 = close(fd)
     C                   Eval      msg_data = 'close() failed. ' + geterrinfo
     C                   ExSr      PSSR
     C                   EndIf
      *
     C                   Eval      P01_Message = 'Stream file generated ' +
     C                                            'sucessfully. '
     C                   Eval      P01_Color   = 'Y'
     C                   Call      'CLRPGMMSG'
     C                   Parm                    P01_Message
     C                   Parm                    P01_Color
      *
     C                   EndSr
      *****************************************************************
     C     PSSR          BegSr
      * abort
     C                   Eval      P01_Message = 'Command failed. reason - ' +
     C                                           msg_data
     C                   Eval      P01_Color   = 'R'
     C                   Call      'CLRPGMMSG'
     C                   Parm                    P01_Message
     C                   Parm                    P01_Color
     C                   Eval      *INLR = *On
     C                   Return
      *
     C                   EndSr
      *****************************************************************
     Pgeterrinfo       B
     Dgeterrinfo       PI           128
      *
     Dgeterrno         PR              *   EXTPROC('__errno')
      *
     Dstrerror         PR              *   EXTPROC('strerror')
     D errno                         10I 0 VALUE
      *
     Derrnum           S             10I 0 BASED(errnum_p)
      *
     C                   Eval      errnum_p = geterrno
      *
     C                   Return    %TRIM(%EDITC(errnum : '3')) + ' : ' +
     C                             %STR(strerror(errnum))
     Pgeterrinfo       E 

Dig deeper on iSeries programming commands

0 comments

Oldest 

Forgot Password?

No problem! Submit your e-mail address below. We'll send you an email containing your password.

Your password has been sent to:

SearchEnterpriseLinux

SearchDataCenter

Close