midrange.com code scratchpad
Name:
Write IFS file via MI
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
03/16/2011 07:36:25 pm
IP:
Logged
Description:
Permissions difficulty after opening new file
Code:
  1. DCL SPCPTR .srvPgm    INIT(srvPgm) ;                                   
  2. DCL DD     srvPgm     CHAR(20) ;                                       
  3.  DCL DD     srvPgmObj CHAR(10) DEF(srvPgm) POS( 1) INIT('QP0LLIB1') ;  
  4.  DCL DD     srvPgmLib CHAR(10) DEF(srvPgm) POS(11) INIT('QSYS') ;      
  5.                                                                        
  6. DCL SPCPTR .procName  INIT(procName) ;                                 
  7. DCL DD     procName   CHAR(512) ;                                      
  8.                                                                        
  9. DCL SPCPTR .rtnValFmt INIT(rtnValFmt) ;                                
  10. DCL DD     rtnValFmt  BIN(4) INIT(1)     /* Returns integer */ ;       
  11.                                                                        
  12. DCL SPCPTR .parmFmts ;                                                 
  13.                                                                        
  14. DCL SPCPTR .nbrParms  INIT(nbrParms) ;                                 
  15. DCL DD     nbrParms   BIN(4) INIT(4) ;                                 
  16.                                                                        
  17. DCL SPCPTR .errStr    INIT(errStr) ;                                   
  18. DCL DD     errStr     CHAR(528) ;                                      
  19.   DCL DD     errStrProv BIN(   4) DEF(errStr) POS( 1) INIT(528) ;      
  20.   DCL DD     errStrAvl  BIN(   4) DEF(errStr) POS( 5) INIT(  0) ;      
  21.   DCL DD     errStrID   CHAR(  7) DEF(errStr) POS( 9) INIT(' ') ;    
  22.   DCL DD     *          CHAR(  1) DEF(errStr) POS(16) INIT(' ') ;    
  23.   DCL DD     errStrDta  CHAR(512) DEF(errStr) POS(17) INIT(' ') ;    
  24.                                                                      
  25. DCL SPCPTR .rtnVal ;                                                 
  26. DCL SPCPTR .parm1 ;                                                  
  27. DCL SPCPTR .parm2 ;                                                  
  28. DCL SPCPTR .parm3 ;                                                  
  29. DCL SPCPTR .parm4 ;                                                  
  30. DCL SPCPTR .parm5 ;                                                  
  31. DCL SPCPTR .parm6 ;                                                  
  32. DCL SPCPTR .parm7 ;                                                  
  33.                                                                      
  34.    DCL SYSPTR .QZRUCLSP INIT('QZRUCLSP', CTX('QSYS'), TYPE(PGM)) ;   
  35.                                                                      
  36. DCL OL QZRUCLSP (.srvPgm,   .procName, .rtnValFmt, .parmFmts         
  37.                , .nbrParms, .errStr,   .rtnVal                       
  38.                , .parm1,    .parm2,    .parm3,     .parm4            
  39.                , .parm5,    .parm6,    .parm7) ARG ;                 
  40.                                                                      
  41.                                                                      
  42. DCL DD     fileHandle BIN(   4) ;                                      
  43. DCL DD     DBGHANDLE  BIN(   4) DEF(fileHandle) ;                      
  44. DCL DD     fileName   CHAR(128) ;                                      
  45. DCL DD     openFlag   CHAR(4) INIT(X'0100004A') ;                      
  46.                                         /* TEXT+CREAT+TRUNC+WRONLY */ ;
  47. DCL DD     permission BIN(4) INIT(438)  /* rw-rw-rw- */ ;              
  48. DCL DD     PERMISSION BIN(4) DEF(permission) POS(1) ;                  
  49. DCL DD     fileccsid  BIN(4) INIT(819) ;                               
  50. DCL DD     openccsid  BIN(4) INIT( 37) ;                               
  51.                                                                        
  52. DCL DD     rc+errno   CHAR(8) ;                                        
  53.   DCL DD     rc       BIN( 4) DEF(rc+errno) POS(1) INIT(0) ;           
  54.   DCL DD     errno    BIN( 4) DEF(rc+errno) POS(5) INIT(0) ;           
  55. DCL DD     DBGRCERR   CHAR(8) DEF(rc+errno) POS(1) ;                   
  56. DCL DD     unlinkFmts(1) BIN(4) INIT(2) /* 1 Pointer */ ;              
  57. DCL DD     openFmts(4)   BIN(4)                                        
  58.                        INIT(2, 1, 1, 1) /* Pointer and 3 Ints */ ;     
  59. DCL DD     writefmts(3)  BIN(4)                                        
  60.                        INIT(1, 2, 1) /* Int, Ptr, Int */ ;             
  61. DCL DD     closeFmts(1)  BIN(4) INIT(1) /* 1 binary */ ;              
  62.                                                                       
  63.                                                                       
  64. DCL DD     writeThis CHAR(512) ;                                      
  65.   DCL DD    *           CHAR(27) INIT('Here is some data to write.') ;
  66.   DCL DD    CR          CHAR( 1) INIT(X'25') ;                        
  67.   DCL DD    LF          CHAR( 1) INIT(X'0A') ;                        
  68. DCL DD     writeLen  BIN(   4) INIT(29) ;                             
  69.                                                                       
  70.                                                                       
  71.                                                                       
  72.                                                                       
  73.                                                                       
  74.         CPYBLAP    fileName, 'mi-ifs-file.txt', X'00' ;               
  75.                                                                       
  76. newTextFile: ;                                                        
  77.                                                                       
  78. /* First, we unlink the file in case it already exists */ ;           
  79.                                                                       
  80.         CPYBLAP    procName, 'unlink', X'00' /* Remove IFS file */ ;  
  81.         CPYNV      rtnValFmt, 3            /* rtncode + errno */ ;      
  82.         SETSPP     .parmFmts, unlinkFmts   /* Set formats for OPEN */ ; 
  83.         CPYNV      nbrParms, 1             /* Four parameters */ ;      
  84.         SETSPP     .rtnVal, rc+errno       /* Return code */ ;          
  85.         SETSPP     .parm1, fileName        /* Name of file to open */ ; 
  86.         CALLX      .QZRUCLSP, QZRUCLSP, * /* Unlink the file */ ;       
  87.                                                                         
  88. BRK 'UNLINKED' ;                                                        
  89.                                                                         
  90.         CPYNV      errno, 0 ;                                           
  91.                                                                         
  92. /* Now, let's create a new file */ ;                                    
  93.                                                                         
  94.         CPYBLAP    procName, 'open', X'00' /* Open an IFS file */ ;     
  95.         CPYNV      rtnValFmt, 3            /* rtncode + errno */ ;      
  96.         SETSPP     .parmFmts, openFmts     /* Set formats for OPEN */ ; 
  97.         CPYNV      nbrParms, 4             /* Four parameters */ ;      
  98.         CPYBLA     openFlag, X'0100004A' ;                              
  99.                                         /* TEXT+CREAT+TRUNC+WRONLY */ ; 
  100.         SETSPP     .rtnVal, rc+errno       /* Return our handle */ ;    
  101.         SETSPP     .parm1, fileName        /* Name of file to open */ ; 
  102.         SETSPP     .parm2, openFlag        /* Open flags */ ;           
  103.         SETSPP     .parm3, permission      /* Permissions */ ;          
  104.         SETSPP     .parm4, fileccsid       /* CCSID of new file */ ;    
  105.         CALLX      .QZRUCLSP, QZRUCLSP, * /* Open the file */ ;         
  106.                                                                         
  107.         CPYNV      fileHandle, rc ;        /* Copy the file handle */ ; 
  108.                                                                         
  109. BRK 'OPENED' ;                                                          
  110.                                                                         
  111.         CMPNV(B)   fileHandle, 0 /LO(getOut) ;                          
  112.         CPYNV      errno, 0 ;                                           
  113.                                                                         
  114. writeLine:                                                              
  115.                                                                         
  116.         CPYBLAP    procName, 'write', X'00' /* Write line */ ;          
  117.         CPYNV      rtnValFmt, 3            /* rtncode + errno */ ;      
  118.         SETSPP     .parmFmts ,writefmts    /* int, pointer, int */ ;    
  119.         CPYNV      nbrParms, 3             /* hdl, data, len */ ;       
  120.         SETSPP     .rtnVal, rc+errno       /* rtncode + errno */ ;      
  121.         SETSPP     .parm1, fileHandle      /* Handle to our file */ ;   
  122.         SETSPP     .parm2, writeThis       /* Data to write */ ;        
  123.         SETSPP     .parm3, writeLen        /* Length to write */ ;      
  124.         CALLX      .QZRUCLSP, QZRUCLSP, * /* Write the line */ ;        
  125.                                                                         
  126. BRK 'WROTELINE1' ;                                                      
  127.                                                                         
  128.         CPYNV      errno, 0 ;                                           
  129.                                                                         
  130. /* Close the new file, prepare to open for append... */                 
  131.                                                                         
  132.         CPYBLAP    procName, 'close', X'00' /* Close IFS file */ ;      
  133.         CPYNV      rtnValFmt, 3            /* Returns integer */ ;      
  134.         SETSPP     .parmFmts, closeFmts    /* Set formats for close */; 
  135.         CPYNV      nbrParms, 1             /* One parameter */ ;        
  136.         SETSPP     .rtnVal, rc+errno       /* Capture return code */ ;  
  137.         SETSPP     .parm1, fileHandle      /* File to close */ ;        
  138.         CALLX      .QZRUCLSP, QZRUCLSP, * /* Call the procedure */ ;    
  139.                                                                         
  140. BRK 'CLOSED2' ;                                                         
  141.                               
  142.         CPYNV      errno, 0 ; 
  143.                               
  144. getOut: ;                     
  145.                               
  146.         RTX        * ;        
  147.  
© 2004-2019 by midrange.com generated in 0.006s valid xhtml & css