Formulardaten (multipart)

MULTIPART (RPGLE)



  X * PARAMETER BEGSR MULTIPART 58  
  X * SICHERN BEGSR MULTIPART 150  
  X * *PSSR BEGSR MULTIPART 2  
  X  
  X * *ENTRY PLIST MULTIPART 8  
  X  
H  
H *COPYRIGHT JÜRGEN REULE 2010-2023
H  
H DATFMT(*ISO) TIMFMT(*ISO)
H DFTACTGRP(*NO) ACTGRP('QILE')
H COPYRIGHT('COPYRIGHT JÜRGEN REULE 2010-2023')
H  
D MIMEDS E   DS           EXTNAME(MIMEP)
D FORMDATADS E   DS           EXTNAME(FORMDATAP)
D                    
D FORMTYPE     S   200 A      
D MIMETYPE     S           LIKE(MIMIME)
D FILETYPE     S           LIKE(MIMIME)
D                    
D DATAPTR     S     *      
D DATALEN     S   10 I 0    
D                    
D FILEPTR     S     *      
D FILELEN     S   10 I 0    
D                    
D BUFTEXT     S   32767 A     INZ
D BUFTEXTLEN     C           CONST(%SIZE(BUFTEXT))
D BUFLEN     S   10 I 0   INZ
D                    
D PARMPTR     S     *     INZ
D PARMP     S           LIKE(BUFTEXT)
D                   BASED(PARMPTR)
D                    
D PARMDATAPTR     S     *     INZ
D PARMDATAP     S           LIKE(BUFTEXT)
D                   BASED(PARMDATAPTR)
D                    
D QTQCVRT     PR           EXTPGM('QTQCVRT')
D CCSID1         10 I 0   CONST
D ST1         10 I 0   CONST
D S1         32767 A     OPTIONS(*VARSIZE) CONST
D L1         10 I 0   CONST
D CCSID2         10 I 0   CONST
D ST2         10 I 0   CONST
D GCCASN         10 I 0   CONST
D L2         10 I 0   CONST
D S2         32767 A     OPTIONS(*VARSIZE)
D L3         10 I 0    
D L4         10 I 0    
D FB         10 I 0   DIM(3)
D                    
D ASCII     S   10 I 0   INZ(819)
D EBCDIC     S   10 I 0   INZ(273)
D RCVLEN     S   10 I 0   INZ
D DUMMY     S   10 I 0   INZ
D FB     S   10 I 0   INZ DIM(3)
D                    
D LEN     S   10 I 0   INZ
D POS     S   10 I 0   INZ
D POS2     S   10 I 0   INZ
D CHAR     S   1 A     INZ
D ELEMENT     S   40 A     INZ
D                    
D BNDRY     S   128 A     INZ
D BNDRYLEN     S   10 I 0   INZ
D BNDRYCOMP     S           INZ LIKE(BNDRY)
D                    
D PTR     S     *     INZ
D PTR2A     S   2 A     BASED(PTR)
D PTR4A     S   4 A     BASED(PTR)
D PTRBNDRY     S           BASED(PTR) LIKE(BNDRY)
D                    
D STOPEND     S     *     INZ
D CRLFEND     S     *     INZ
D CRLF2END     S     *     INZ
D BNDRYEND     S     *     INZ
D                    
D CRLFE     C           CONST(X'0D25')
D                    
D START     C           CONST(X'2D2D')
D STOP     C           CONST(X'2D2D')
D CRLF     C           CONST(X'0D0A')
D CRLF2     C           CONST(X'0D0A0D0A')
D                    
D STARTLEN     C           CONST(%SIZE(START))
D STOPLEN     C           CONST(%SIZE(STOP))
D CRLFLEN     C           CONST(%SIZE(CRLF))
D CRLFLEN2     C           CONST(%SIZE(CRLF2))
D                    
D NAME     C           CONST('name=')
D BOUNDARY     C           CONST('boundary=')
D TYPE     C           CONST('Content-Type:')
D                    
D NAMELEN     C           CONST(%SIZE(NAME))
D BOUNDARYLEN     C           CONST(%SIZE(BOUNDARY))
D TYPELEN     C           CONST(%SIZE(TYPE))
D                    
D UPPER     C           CONST('ABCDEFGHIJKLM+
D                          NOPQRSTUVWXYZ')
D LOWER     C           CONST('abcdefghijklm+
D                          nopqrstuvwxyz')
D                    
D UTF8X     PR           EXTPGM('UTF8')
D BUFTEXT         32767 A      
D BUFTEXTLEN         10 I 0   CONST
D BUFLEN         10 I 0    
D TYPE1         1 A     CONST
D TYPE2         1 A     CONST
D                    
C          
C *     --------------------------------------
C *     Variablen initialisieren
C *     --------------------------------------
C       CLEAR   FORMDATADS            
C       CLEAR   MIMETYPE            
C       CLEAR   FILETYPE            
C       CLEAR   FILEPTR            
C       CLEAR   FILELEN            
C          
C *     --------------------------------------
C *     Boundary ermitteln
C *     --------------------------------------
C     BOUNDARY SCAN FORMTYPE POS     — 77 78  
C     *IN78 IFEQ *ON              
C     *ZERO IFLT POS              
C       ADD BOUNDARYLEN POS            
C       SUBST(P) FORMTYPE:POS BNDRY            
C       ENDIF                
C       ENDIF                
C     ' ' CHECKR BNDRY BNDRYLEN            
C *     --------------------------------------
C *     Falls genügend Daten geliefert wurden
C *     --------------------------------------
C     DATALEN IFGE BNDRYLEN              
C          
C *     --------------------------------------
C *     Boundary in ASCII umsetzen
C *     --------------------------------------
C       CALLP(E) QTQCVRT ( EBCDIC:0:
C         BNDRY:BNDRYLEN:
C         ASCII:0:0:BNDRYLEN:
C         BNDRY:RCVLEN:
C         DUMMY:FB)
C *     --------------------------------------
C *     Zeiger setzen
C *     --------------------------------------
C       MOVE DATAPTR PTR            
C       MOVE DATAPTR PARMPTR            
C       MOVE DATAPTR PARMDATAPTR            
C          
C *     --------------------------------------
C *     Begrenzungen setzen
C *     --------------------------------------
C       EVAL STOPEND     = PTR + DATALEN - STOPLEN
C       EVAL CRLFEND     = PTR + DATALEN - CRLFLEN
C       EVAL CRLF2END    = PTR + DATALEN - CRLFLEN2
C       EVAL BNDRYEND    = PTR + DATALEN - BNDRYLEN
C                       - STARTLEN
C *     --------------------------------------
C *     Alle Daten bearbeiten
C *     --------------------------------------
C     PTR DOWLE BNDRYEND              
C          
C *     --------------------------------------
C *     Nächste Boundary suchen
C *     --------------------------------------
C     PTR DOUGE BNDRYEND              
C     BNDRYCOMP OREQ BNDRY              
C          
C *     --------------------------------------
C *     Boundary-Start suchen
C *     --------------------------------------
C     PTR DOWLT BNDRYEND              
C     PTR2A ANDNE START              
C       EVAL PTR        =  PTR + 1
C       ENDDO                
C *     --------------------------------------
C *     Falls Start gefunden
C *     --------------------------------------
C       EVAL PTR        =  PTR + STARTLEN
C     BNDRYLEN SUBST(P) PTRBNDRY BNDRYCOMP            
C       ENDDO                
C *     --------------------------------------
C *     Falls Boundary gefunden
C *     --------------------------------------
C     BNDRYCOMP IFEQ BNDRY              
C          
C *     --------------------------------------
C *     Länge der Daten ermitteln
C *     --------------------------------------
C       EVAL LEN        =  PTR - STARTLEN
C          -  PARMDATAPTR -  CRLFLEN
C          
C *     --------------------------------------
C *     Daten sichern
C *     --------------------------------------
C       EXSR SICHERN              
C          
C *     --------------------------------------
C *     Boundary überlesen
C *     --------------------------------------
C       EVAL PTR        =  PTR + BNDRYLEN
C          
C       SELECT    
C *     --------------------------------------
C *     Ende der Daten gefunden
C *     --------------------------------------
C     PTR WHENLE STOPEND              
C     PTR2A ANDEQ STOP              
C       MOVE STOPEND PTR            
C          
C *     --------------------------------------
C *     Beginn der Informationen gefunden
C *     --------------------------------------
C     PTR WHENLE CRLFEND              
C     PTR2A ANDEQ CRLF              
C       EVAL PTR        =  PTR + CRLFLEN
C       MOVE PTR PARMPTR            
C          
C *     --------------------------------------
C *     Beginn der Daten ermitteln
C *     --------------------------------------
C     PTR DOWLT CRLF2END              
C     PTR4A ANDNE CRLF2              
C       EVAL PTR        =  PTR + 1
C       ENDDO                
C *     --------------------------------------
C *     Falls Beginn der Daten gefunden
C *     --------------------------------------
C     PTR IFLE CRLF2END              
C     PTR4A ANDEQ CRLF2              
C       EVAL PTR        =  PTR + CRLFLEN2
C       MOVE PTR PARMDATAPTR            
C          
C *     --------------------------------------
C *     Länge der Informationen ermitteln
C *     --------------------------------------
C       EVAL LEN        =  PARMDATAPTR
C                  -  PARMPTR - CRLFLEN
C          
C *     --------------------------------------
C *     Informationen auslesen
C *     --------------------------------------
C       EXSR PARAMETER              
C          
C       ENDIF                
C       ENDSL                
C       ENDIF                
C       ENDDO                
C       ENDIF                
C       SETON         — LR —  
C          
  X * *MAIN* EXSR MULTIPART    
  X  
C     PARAMETER BEGSR                
C       CLEAR   BUFTEXT            
C       CLEAR   ELEMENT            
C *     --------------------------------------
C *     Informationen in EBCDIC umsetzen
C *     --------------------------------------
C       CALLP(E) QTQCVRT ( ASCII:0:
C         PARMP:LEN:
C         EBCDIC:0:0:
C         BUFTEXTLEN:
C         BUFTEXT:RCVLEN:
C         DUMMY:FB)
C *     --------------------------------------
C *     Elementname suchen
C *     --------------------------------------
C     NAME:NAMELEN SCAN BUFTEXT POS     — 77 78  
C     *IN78 IFEQ *ON              
C     *ZERO IFLT POS              
C       ADD NAMELEN POS            
C          
C *     --------------------------------------
C *     Elementname ermitteln
C *     --------------------------------------
C     1 SUBST(P) BUFTEXT:POS CHAR            
C     CHAR IFEQ '"'              
C     CHAR OREQ ''''              
C       ADD 1 POS            
C     CHAR:1 SCAN BUFTEXT:POS POS2     — 77 78  
C     *IN78 IFEQ *ON              
C     *ZERO IFLT POS2              
C     *ZERO ADD POS2 LEN            
C       SUB POS LEN            
C     LEN SUBST(P) BUFTEXT:POS ELEMENT            
C     LOWER:UPPER XLATE ELEMENT ELEMENT            
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDIF                
C *     --------------------------------------
C *     Datentyp ermitteln
C *     --------------------------------------
C     TYPE:TYPELEN SCAN BUFTEXT POS     — 77 78  
C     *IN78 IFEQ *ON              
C     *ZERO IFLT POS              
C       ADD TYPELEN POS            
C       ADD 1 POS            
C     CRLFE:2 SCAN BUFTEXT:POS POS2     — 77 78  
C     *IN78 IFEQ *ON              
C     *ZERO IFLT POS2              
C     *ZERO ADD POS2 LEN            
C       SUB POS LEN            
C     LEN SUBST(P) BUFTEXT:POS MIMETYPE            
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDSR                
C          
  X * *MAIN* EXSR MULTIPART    
  X  
C     SICHERN BEGSR                
C *     --------------------------------------
C *     Daten sichern
C *     --------------------------------------
C     'UPLOAD_FILE' IFEQ ELEMENT              
C       MOVEL(P) 'FILE' ELEMENT            
C       ENDIF                
C          
C     'FILE' IFEQ ELEMENT              
C *     --------------------------------------
C *     Datentyp übernehmen
C *     --------------------------------------
C       MOVEL(P) MIMETYPE FILETYPE            
C          
C *     --------------------------------------
C *     Datentyp übernehmen
C *     --------------------------------------
C     *ZERO IFGE LEN              
C       CLEAR   FILETYPE            
C       ENDIF                
C *     --------------------------------------
C *     Beginn und Länge der Daten
C *     --------------------------------------
C       MOVE PARMDATAPTR FILEPTR            
C     *ZERO ADD LEN FILELEN            
C       ELSE                
C       CLEAR   BUFTEXT            
C *     --------------------------------------
C *     Daten in EBCDIC umsetzen
C *     --------------------------------------
C       CALLP(E) QTQCVRT ( ASCII:0:
C         PARMDATAP:LEN:
C         EBCDIC:0:0:
C         BUFTEXTLEN:
C         BUFTEXT:RCVLEN:
C         DUMMY:FB)
C *     --------------------------------------
C *     Formulardaten umsetzen
C *     --------------------------------------
C     *ZERO ADD LEN BUFLEN            
C       CALLP(E) UTF8X ( BUFTEXT:
C         BUFTEXTLEN:BUFLEN:'<':' ')
C          
C     BUFLEN IFGE 1              
C     BUFLEN ANDLE BUFTEXTLEN              
C     BUFLEN SUBST(P) BUFTEXT BUFTEXT            
C       ENDIF                
C *     --------------------------------------
C *     Wert übernehmen
C *     --------------------------------------
C       SELECT    
C     'TITEL' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT TITEL            
C     'TITEL2' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT TITEL2            
C     'KAMERA' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT KAMERA            
C     'FILE' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT FILE            
C     'REMOVE' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT REMOVE            
C     'ZEIGEN' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT ZEIGEN            
C     'SCHMAL' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT SCHMAL            
C     'HINWEIS' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT HINWEIS            
C     'KALENDER' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT KALENDER            
C     'TEXT' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT TEXT            
C     'NFM' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT NFM            
C     'CHAT' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT CHAT            
C     'PTZ' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT PTZ            
C     'FLIP' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT FLIP            
C     'SID' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT SID            
C     'MAIL' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT MAIL            
C     'TIME' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT TIME            
C     'MW' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT MW            
C     'GEB' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT GEB            
C     'WEB' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT WEB            
C     'BERUF' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT BERUF            
C     'HOBBY' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT HOBBY            
C     'HERKUNFT' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT HERKUNFT            
C     'FILENAME' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT FILENAME            
C     'CONTEXT' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT CONTEXT            
C     'SUCCESS' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT SUCCESS            
C     'DEBUG' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT DEBUG            
C     'SERIE' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT SERIE            
C     'SUCHE' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT SUCHE            
C     'COLOR' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT COLOR            
C     'SOUND' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT SOUND            
C     'SMILY1' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT SMILY1            
C     'SMILYS' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT SMILYS            
C     'STERNE' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT STERNE            
C     'SPARKLE' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT SPARKLE            
C     'SPRACHE' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT SPRACHE            
C     'SUBMIT' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT SUBMIT            
C     'SUBMIT1' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT SUBMIT1            
C     'SUBMIT2' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT SUBMIT2            
C     'SMILY' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT SMILY            
C     'OBJEKT' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT OBJEKT            
C     'RUBRIK' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT RUBRIK            
C     'MITGLIED' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT MITGLIED            
C     'BENUTZER' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT BENUTZER            
C     'KENNWORT' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT KENNWORT            
C     'KENNWORT1' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT KENNWORT1            
C     'KENNWORT2' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT KENNWORT2            
C     'KENNWORT3' WHENEQ ELEMENT              
C       MOVEL(P) BUFTEXT KENNWORT3            
C       ENDSL                
C       ENDIF                
C       ENDSR                
C          
C     *PSSR BEGSR                
C       ENDSR '*CANCL'              
C          
C     *ENTRY PLIST                
C       PARM   DATAPTR            
C       PARM   DATALEN            
C       PARM   FORMTYPE            
C       PARM   FORMDATADS            
C       PARM   FILETYPE            
C       PARM   FILEPTR            
C       PARM   FILELEN            

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