Senden

IFS$SEND (RPGLE)



  X * SIZEBUF BEGSR IFS$SEND 10  
  X * NULLBUF BEGSR IFS$SEND 7  
  X * READBUF BEGSR IFS$SEND 7  
  X * READFILE BEGSR IFS$SEND 7  
  X * *PSSR BEGSR IFS$SEND 2  
  X  
  X * *ENTRY PLIST IFS$SEND 4  
  X  
H  
H *COPYRIGHT JÜRGEN REULE 2017-2023
H  
H BNDDIR('QC2LE':'BAR$')
H DATFMT(*ISO) TIMFMT(*ISO)
H DFTACTGRP(*NO) ACTGRP('QILE')
H COPYRIGHT('COPYRIGHT JÜRGEN REULE 2017-2023')
H  
D FILENAME     S   5000 A     VARYING
D FILENAMEDS     DS           INZ
D FILENAMEDS1         5000 A     INZ
D           1 A     INZ
D                    
D FD     S   10 I 0   INZ
D RC     S   10 I 0   INZ
D                    
D SIZEX     S   10 S 0   INZ
D BUFSIZEX     S   10 S 0   INZ
D                    
D SIZE     S   10 S 0    
D OFFSET     S   10 S 0    
D                    
D       DS            
D BUF         32767 A     INZ VARYING
D BUFLEN         5 U 0   OVERLAY(BUF)
D BUFTEXT         32767 A     OVERLAY(BUF:*NEXT)
D BUFTEXTLEN     C           CONST(%SIZE(BUFTEXT))
D                    
D /COPY SOURCE,IFS$PROC
D /COPY SOURCE,BAR$PROC
C          
C *     --------------------------------------
C *     Datei lesen und ausgeben
C *     --------------------------------------
C       EVAL FILENAMEDS =  %TRIM(FILENAME)+NULL
C       EVAL FD = OPEN ( %ADDR(FILENAMEDS):RDONLY)
C     FD IFGE *ZERO              
C          
C *     --------------------------------------
C *     Datei positionieren
C *     --------------------------------------
C       EVAL RC = LSEEK ( FD:OFFSET:SEEKSET)
C     RC IFGE *ZERO              
C          
C     *ZERO ADD SIZE SIZEX            
C       EXSR READFILE              
C *     --------------------------------------
C *     Datei lesen und ausgeben
C *     --------------------------------------
C     RC DOWGE 1              
C     RC ANDLE BUFSIZEX              
C       SUB RC SIZEX            
C       CALLP(E) STOUT ( BUFTEXT:RC:QUSEC)
C       EXSR READFILE              
C       ENDDO                
C *     --------------------------------------
C *     NULL-Bytes lesen und ausgeben
C *     --------------------------------------
C     SIZEX IFGE 1              
C       EXSR NULLBUF              
C       EXSR READBUF              
C *     --------------------------------------
C *     NULL-Bytes lesen und ausgeben
C *     --------------------------------------
C     RC DOWGE 1              
C     RC ANDLE BUFSIZEX              
C       SUB RC SIZEX            
C       CALLP(E) STOUT ( BUFTEXT:RC:QUSEC)
C       EXSR READBUF              
C       ENDDO                
C       ENDIF                
C       ENDIF                
C       EVAL RC = CLOSE ( FD)
C       ENDIF                
C       SETON         LR  
C          
  X * NULLBUF EXSR IFS$SEND    
  X * READBUF EXSR IFS$SEND    
  X * READFILE EXSR IFS$SEND    
  X  
C     SIZEBUF BEGSR                
C *     --------------------------------------
C *     Größe ermitteln
C *     --------------------------------------
C     BUFTEXTLEN IFGT SIZEX              
C     *ZERO ADD SIZEX BUFSIZEX            
C       ELSE                
C     *ZERO ADD BUFTEXTLEN BUFSIZEX            
C       ENDIF                
C       ENDSR                
C          
  X * *MAIN* EXSR IFS$SEND    
  X  
C     NULLBUF BEGSR                
C *     --------------------------------------
C *     NULL-Bytes in Puffer schreiben
C *     --------------------------------------
C       EXSR SIZEBUF              
C       EVAL %SUBST(BUFTEXT:1:BUFSIZEX) = *ALLX'00'
C       ENDSR                
C          
  X * *MAIN* EXSR IFS$SEND    
  X * *MAIN* EXSR IFS$SEND    
  X  
C     READBUF BEGSR                
C *     --------------------------------------
C *     Puffer lesen
C *     --------------------------------------
C       EXSR SIZEBUF              
C       EVAL RC = BUFSIZEX
C       ENDSR                
C          
  X * *MAIN* EXSR IFS$SEND    
  X * *MAIN* EXSR IFS$SEND    
  X  
C     READFILE BEGSR                
C *     --------------------------------------
C *     Datei lesen
C *     --------------------------------------
C       EXSR SIZEBUF              
C       EVAL RC = READ ( FD:%ADDR(BUFTEXT):BUFSIZEX)
C       ENDSR                
C          
C     *PSSR BEGSR                
C       ENDSR '*CANCL'              
C          
C     *ENTRY PLIST                
C       PARM   FILENAME            
C       PARM   SIZE            
C       PARM   OFFSET            

301 ms | Contact | Information | Aibo-Bar © 2005-2024