midrange.com code scratchpad
Name:
Rick Chevalier
Scriptlanguage:
Plain Text
Tabwidth:
2
Date:
11/11/2008 04:04:00 pm
IP:
Logged
Description:
IFS file access. Error 3450: Descriptor is not valid received when writing to the IFS file (_C_IFS_fputs).
Code:
  1.      h BndDir('QC2LE') DftActGrp(*no) ActGrp(*caller) Option(*NoDebugIO)         
  2.       //-------------------------------------------------------------------------
  3.       //   Program  . . :  ExcelXML                     Author . . :  Rick Cheval
  4.       //   Date . . . . :   1/12/2005                                            
  5.       //   Project  . . :                                                        
  6.       //   Purpose  . . :                                                        
  7.       //-------------------------------------------------------------------------
  8.       //   Modifications:                                                        
  9.       //                                                                         
  10.       //  Project        Date         Developer                  Description     
  11.       //-------------------------------------------------------------------------
  12.       // xxxxxxxxx    xx/xx/xxxx   xxxxxxxxxxxxxxx   xxxxxxxxxxxxxxxxxxxxxxxxxxxx
  13.       //-------------------------------------------------------------------------
  14.       //                                                                         
  15.       //-------------------------------------------------------------------------
  16.       // File definitions                                                        
  17.       //-------------------------------------------------------------------------
  18.                                                                                  
  19.       //-------------------------------------------------------------------------
  20.       // Entry parameter definition                                              
  21.       //-------------------------------------------------------------------------
  22.      d ExcelXML        pr                  ExtPgm('EXCELXML')                    
  23.                                                                                  
  24.       //-------------------------------------------------------------------------
  25.       // External procedure prototypes                                           
  26.       //-------------------------------------------------------------------------
  27.                                                                                  
  28.      ‚* Open a stream file                                                       
  29.      d ifsOpen         Pr              *   ExtProc('_C_IFS_fopen')              F
  30.      d                                 *   Value Options(*String)               F
  31.      d                                 *   Value Options(*String)               O
  32.                                                                                  
  33.      ‚* Close a stream file                                                      
  34.      d ifsClose        Pr            10i 0 ExtProc('_C_IFS_fclose')             R
  35.      d                                 *   Value                                F
  36.                                                                                  
  37.      ‚* Check for stream file EOF condition                                      
  38.      ‚* The function returns a nonzero value if and only if the EOF flag is set; 
  39.      ‚* otherwise, it returns 0.                                                 
  40.      d ifsEOF          pr            10i 0 ExtProc('_C_IFS_feof')               R
  41.      d                                 *   Value                                F
  42.                                                                                  
  43.      ‚* Check for stream file function error                                     
  44.      ‚* The function returns a nonzero value to indicate an error on the given   
  45.      ‚* file. A return value of 0 means that no error has occurred.              
  46.      d ifsError        pr            10i 0 ExtProc('_C_IFS_ferror')             R
  47.      d                                 *   Value                                F
  48.                                                                                  
  49.      ‚* Read from a stream file                                                  
  50.      d ifsGet          Pr              *   ExtProc('_C_IFS_fgets')               
  51.      d                                 *   Value                                I
  52.      d                               10i 0 Value                                B
  53.      d                                 *   Value                                F
  54.                                                                                  
  55.      ‚* Write to a stream file                                                   
  56.      d ifsPut          Pr            10i 0 ExtProc('_C_IFS_fputs')              R
  57.      d                                 *   Value Options(*String)               O
  58.      d                                 *   Value                                F
  59.                                                                                  
  60.      ‚* Return error number                                                      
  61.      d SysErrNo        pr              *   ExtProc('__errno')                   E
  62.                                                                                  
  63.      ‚* Return text for error number                                             
  64.      d StrError        pr              *   ExtProc('strerror')                  E
  65.      d                               10i 0 Value                                F
  66.                                                                                  
  67.       //-------------------------------------------------------------------------
  68.       // Internal procedure prototypes                                           
  69.       //-------------------------------------------------------------------------
  70.                                                                                  
  71.       // Build spreadsheet header rows                                           
  72.      d CreateXLFile    pr              *                                         
  73.                                                                                  
  74.       // Get spreadsheet header XML                                              
  75.      d GetXLHeader     pr                                                        
  76.      d* SpreadsheetFile...                                                       
  77.      d*                                *   Value                                 
  78.                                                                                  
  79.       // Build spreadsheet header rows                                           
  80.      d XLHeader        pr                                                        
  81.                                                                                  
  82.       // Build spreadsheet detail rows                                           
  83.      d XLDetail        pr                                                        
  84.                                                                                  
  85.       // Build spreadsheet total rows                                            
  86.      d XLTotal         pr                                                        
  87.                                                                                  
  88.       //-------------------------------------------------------------------------
  89.       // Procedure interface for program entry                                   
  90.       //-------------------------------------------------------------------------
  91.      d ExcelXML        pi                                                        
  92.                                                                                  
  93.       //-------------------------------------------------------------------------
  94.       // Data definitions                                                        
  95.       //-------------------------------------------------------------------------
  96.                                                                                  
  97.       * Stream file variables                                                    
  98.      d OutText         s             64                                         T
  99.      d ErrTxt          s             50                                         E
  100.      d ErrNo           s             10i 0 Based(ErrNo@) NoOpt                  E
  101.      d RtnCd           s             10i 0                                      R
  102.      d LF              c                   x'25'                                L
  103.      d CR              c                   x'0D'                                C
  104.      d NullTrm         c                   x'00'                                N
  105.      d DblQte          c                   x'7F'                                D
  106.                                                                                  
  107.       //-------------------------------------------------------------------------
  108.       // Calculations                                                            
  109.       //-------------------------------------------------------------------------
  110.                                                                                  
  111.       /Free                                                                      
  112.                                                                                  
  113.         GetXLHeader();                                                           
  114.                                                                                  
  115.         *InLR = *On;                                                             
  116.                                                                                  
  117.       /End-Free                                                                  
  118.                                                                                  
  119.       //-------------------------------------------------------------------------
  120.       // Retrieve spreadsheet header XML                                         
  121.       //-------------------------------------------------------------------------
  122.      p GetXLHeader     b                                                         
  123.      d GetXLHeader     pi                                                        
  124.                                                                                  
  125.       // Heading XML work fields                                                 
  126.      d HeadingXMLPath  c                   '/rcheva1/CustomerHistoryHeader.xml'  
  127.      d HeadingXMLFile  s               *                                         
  128.      d XMLHeader       s            256a                                         
  129.      d TxtRd           s              1    Inz('r')                             O
  130.      d TxtWrt          s              1    Inz('w')                              
  131.      d OutPath         s            100    Inz('/rcheva1/PMTHISTTEST.XML')       
  132.      d OutputDesc      s               *                                        D
  133.                                                                                  
  134.       /Free                                                                      
  135.                                                                                  
  136.         // Create the file and set the codepage.  Receive descriptor             
  137.         // future file operations.                                               
  138.         OutPath = %TrimR(OutPath) + x'00';                                       
  139.         OutputDesc = ifsOpen(%TrimR(OutPath) :TxtWrt + ', codepage=850');        
  140.                                                                                  
  141.         // Close and reopen the file.  This is required to perform translation   
  142.         // from our current job CCSID into the ascii codepage.  THIS IS REQUIRED!
  143.         RtnCd = ifsClose( OutputDesc );                                          
  144.         OutputDesc = ifsOpen(%TrimR(OutPath) :TxtWrt);                           
  145.                                                                                  
  146.         // Open the file and set the codepage.  Receive descriptor (pointer) for 
  147.         // future file operations.                                               
  148.         HeadingXMLFile = ifsOpen(HeadingXMLPath :TxtRd);                         
  149.                                                                                  
  150.         // If file descriptor is null the open command failed.  Retrieve and     
  151.         // display the error information.                                        
  152.         If HeadingXMLFile = *Null;                                               
  153.           ErrNo@ = SysErrNo;                                                     
  154.           ErrTxt = %Char(Errno) + ': ' + %Str(StrError(ErrNo));                  
  155.           // spmMsgID = 'CPF9898';                                               
  156.           // spmMsgF = 'QCPFMSG   *LIBL     ';                                   
  157.           // spmMsgDta = ErrTxt;                                                 
  158.           // spmMsgTyp = '*ESCAPE';                                              
  159.           // spmStkEnt = '*';                                                    
  160.           // spmStkCtr = 3;                                                      
  161.           // CallP     SndPgmMsg(spmMsgID: spmMsgF: spmMsgDta@:                  
  162.           //                     spmMsgTyp: spmStkEnt:                           
  163.           //                     spmStkCtr);                                     
  164.                                                                                  
  165.         // Read header information and write to XML file                         
  166.         Else;                                                                    
  167.           ifsGet(%Addr(XMLHeader) :%Size(XMLHeader) :HeadingXMLFile);            
  168.                                                                                  
  169.           DoW ifsEOF(HeadingXMLFile) = 0 And ifsError(HeadingXMLFile) = 0;       
  170.             RtnCd = ifsPut(%Str(%Addr(XMLHeader)) :OutputDesc);                  
  171.           ErrNo@ = SysErrNo;                                                     
  172.           ErrTxt = %Char(Errno) + ': ' + %Str(StrError(ErrNo));                  
  173.             XMLHeader = *Blanks;                                                 
  174.             ifsGet(%Addr(XMLHeader) :%Size(XMLHeader) :HeadingXMLFile);          
  175.           EndDo;                                                                 
  176.                                                                                  
  177.           // Close the IFS file                                                  
  178.           RtnCd = ifsClose(HeadingXMLFile);                                      
  179.         EndIf;                                                                   
  180.                                                                                  
  181.       /End-Free                                                                  
  182.                                                                                  
  183.      p GetXLHeader     e                                                         
© 2004-2019 by midrange.com generated in 0.008s valid xhtml & css