UTF-8 | 5250

UTF8 (RPGLE)



  X * TYPE8 BEGSR UTF8 57  
  X * TYPEIN BEGSR UTF8 79  
  X * READ BEGSR UTF8 29  
  X * TYPE# BEGSR UTF8 85  
  X * NUMDIV BEGSR UTF8 33  
  X * NUMDIV1 BEGSR UTF8 24  
  X * NUMDIV1B BEGSR UTF8 9  
  X * NUMDIV2 BEGSR UTF8 36  
  X * NUMDIV3 BEGSR UTF8 22  
  X * REPLACE BEGSR UTF8 23  
  X * ARRAY BEGSR UTF8 26  
  X * *PSSR BEGSR UTF8 3  
  X  
  X * *ENTRY PLIST UTF8 6  
  X  
H  
H *COPYRIGHT JÜRGEN REULE 2018-2023
H  
H BNDDIR('QC2LE')
H DATFMT(*ISO) TIMFMT(*ISO)
H DFTACTGRP(*NO) ACTGRP('QILE')
H COPYRIGHT('COPYRIGHT JÜRGEN REULE 2018-2023')
H  
D CVTCH     PR           EXTPROC('cvtch')
D           16 A     OPTIONS(*VARSIZE)
D           32 A     OPTIONS(*VARSIZE) CONST
D           10 I 0   VALUE
D                    
D CVTHC     PR           EXTPROC('cvthc')
D           32 A     OPTIONS(*VARSIZE)
D           16 A     OPTIONS(*VARSIZE) CONST
D           10 I 0   VALUE
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 N     S   3 S 0   INZ
D NUMX     S   3 S 0   INZ
D NUMD     S   3 S 0   INZ
D NUMD2     S   3 S 0   INZ
D                    
D NUM     S   10 S 0   INZ
D NUM1     S           INZ LIKE(NUM)
D NUM2     S           INZ LIKE(NUM)
D NUM3     S           INZ LIKE(NUM)
D NUM4     S           INZ LIKE(NUM)
D NUM5     S           INZ LIKE(NUM)
D NUM6     S           INZ LIKE(NUM)
D NUM7     S           INZ LIKE(NUM)
D NUM8     S           INZ LIKE(NUM)
D                    
D POS     S   10 S 0   INZ
D POS2     S           INZ LIKE(POS)
D POS3     S           INZ LIKE(POS)
D POS4     S           INZ LIKE(POS)
D POSADD     S           INZ LIKE(POS)
D                    
D LEN2     S           INZ LIKE(POS)
D                    
D TEXT     S   32767 A      
D TEXTLEN     S   10 I 0    
D BUFLEN     S   10 I 0    
D TYPE1     S   1 A      
D TYPE2     S   1 A      
D                    
D BUFLENX     S           INZ LIKE(BUFLEN)
D BUFX     S   200 A     INZ VARYING
D                    
D MSG     S   52 A     INZ
D                    
D CHAR2     S   2 A     INZ
D CHAR6     S   6 A     INZ
D                    
D CHAR2LEN     C           CONST(%SIZE(CHAR2))
D CHAR6LEN     C           CONST(%SIZE(CHAR6))
D                    
D CHARB     DS            
D NUMB         3 U 0   INZ OVERLAY(CHARB)
D                    
D BYTEDS     DS            
D           1 A      
D BYTE                  
D B2         1 A     INZ OVERLAY(BYTE)
D                   DIM(255)
D N2         3 U 0   INZ OVERLAY(BYTE)
D                   DIM(255)
D B1         1 A     INZ OVERLAY(BYTEDS)
D                   DIM(256)
D N1         3 U 0   INZ OVERLAY(BYTEDS)
D                   DIM(256)
D BYTES                 INZ OVERLAY(BYTEDS)
D BYTES123                 INZ OVERLAY(BYTES)
D BYTES12                 INZ OVERLAY(BYTES123)
D BYTES1         64 A     INZ OVERLAY(BYTES12)
D BYTES2         64 A     INZ OVERLAY(BYTES12:
D                               *NEXT)
D BYTES3         64 A     INZ OVERLAY(BYTES123:
D                               *NEXT)
D BYTES4                 INZ OVERLAY(BYTES:
D                               *NEXT)
D BYTES41         32 A     INZ OVERLAY(BYTES4)
D                    
D BYTES42         16 A     INZ OVERLAY(BYTES4:
D                               *NEXT)
D BYTES43         8 A     INZ OVERLAY(BYTES4:
D                               *NEXT)
D BYTES44         4 A     INZ OVERLAY(BYTES4:
D                               *NEXT)
D BYTES45         2 A     INZ OVERLAY(BYTES4:
D                               *NEXT)
D BYTES46         1 A     INZ OVERLAY(BYTES4:
D                               *NEXT)
D BYTES47         1 A     INZ OVERLAY(BYTES4:
D                               *NEXT)
D                    
D BYTELEN     C           CONST(%SIZE(BYTE))
D BYTESLEN     C           CONST(%SIZE(BYTES))
D BYTES3LEN     C           CONST(%SIZE(BYTES3))
D                    
D HEXCHARS     C           CONST('0123456789+
D                          ABCDEFabcdef')
D                    
D NL     C           CONST(X'15')
D                    
C          
C     BUFLEN IFLE TEXTLEN              
C       EXSR ARRAY              
C          
C       SELECT    
C     '<' WHENEQ TYPE1              
C       EXSR TYPEIN              
C     '>' WHENEQ TYPE1              
C     ' ' IFEQ TYPE2              
C     '8' OREQ TYPE2              
C       EXSR TYPE8              
C       ENDIF                
C     ' ' IFEQ TYPE2              
C     '%' OREQ TYPE2              
C       EXSR TYPE#              
C       ENDIF                
C       ENDSL                
C       ENDIF                
C       SETON         — LR —  
C          
  X * *MAIN* EXSR UTF8    
  X  
C     TYPE8 BEGSR                
C     *ZERO ADD 1 POS            
C *     --------------------------------------
C *     Nach UTF-8 umsetzen
C *     --------------------------------------
C     POS DOWLE BUFLEN              
C     POS ANDLE TEXTLEN              
C       SUBST(P) TEXT:POS CHARB     — 77 —  
C          
C *     --------------------------------------
C *     Nach UTF-8 umsetzen
C *     --------------------------------------
C     CHARB SCAN BYTES4 NUM2     — 77 78  
C     *IN78 IFEQ *ON              
C     1 ADD 195 NUM            
C       ADD 128 NUM2            
C       ELSE                
C *     --------------------------------------
C *     Nach UTF-8 umsetzen
C *     --------------------------------------
C     CHARB IFNE NL              
C     CHARB SCAN BYTES3 NUM2     — 77 78  
C     *IN78 IFEQ *ON              
C     1 ADD 194 NUM            
C       ADD 128 NUM2            
C       ENDIF                
C       ENDIF                
C       ENDIF                
C *     --------------------------------------
C *     Zeichen ausgeben
C *     --------------------------------------
C     *IN78 IFEQ *ON              
C     POS ADD 1 POS2            
C          
C *     --------------------------------------
C *     Zeichen ausgeben
C *     --------------------------------------
C     NUM SUB 1 NUMB            
C       CALLP(E) CVTHC ( CHAR2:CHARB:2)
C       EVAL BUFX = '%'  + CHAR2
C          
C *     --------------------------------------
C *     Zeichen ausgeben
C *     --------------------------------------
C     NUM2 SUB 1 NUMB            
C       CALLP(E) CVTHC ( CHAR2:CHARB:2)
C       EVAL BUFX =
C       BUFX + '%'  + CHAR2
C          
C *     --------------------------------------
C *     Zeichen ausgeben
C *     --------------------------------------
C       EXSR REPLACE              
C       ENDIF                
C       ADD 1 POS            
C       ENDDO                
C       ENDSR                
C          
  X * *MAIN* EXSR UTF8    
  X  
C     TYPEIN BEGSR                
C     *ZERO ADD 1 POS            
C *     --------------------------------------
C *     Start-Byte
C *     --------------------------------------
C     POS DOWLE BUFLEN              
C     POS ANDLE TEXTLEN              
C       SUBST(P) TEXT:POS CHARB     — 77 —  
C          
C *     --------------------------------------
C *     Start-Byte
C *     --------------------------------------
C     CHARB SCAN BYTES123       — 77 78  
C     *IN78 IFEQ *OFF              
C     *ZERO ADD POS POS2            
C       EXSR READ              
C     CHARB SCAN BYTES4       — 77 78  
C     *IN78 IFEQ *ON              
C     CHARB SCAN BYTES41 NUM     — 77 78  
C   N78 CHARB SCAN BYTES42 NUM     — 77 78  
C   N78 CHARB SCAN BYTES43 NUM     — 77 78  
C   N78 CHARB SCAN BYTES44 NUM     — 77 78  
C   N78 CHARB SCAN BYTES45 NUM     — 77 78  
C   N78 CHARB SCAN BYTES46 NUM     — 77 78  
C   N78 CHARB SCAN BYTES47 NUM     — 77 78  
C   N78 *ZERO ADD 1 NUM            
C       SUB 1 NUM            
C       ADD 1 POS2            
C       ADD POSADD POS2            
C          
C *     --------------------------------------
C *     Folge-Bytes
C *     --------------------------------------
C       EXSR READ              
C     CHARB SCAN BYTES3       — 77 78  
C     *IN78 IFEQ *ON              
C     *IN78 DOWEQ *ON              
C       MULT BYTES3LEN NUM            
C     CHARB SCAN BYTES3 NUM2     — 77 78  
C       ADD NUM2 NUM            
C       SUB 1 NUM            
C       ADD 1 POS2            
C       ADD POSADD POS2            
C       EXSR READ              
C     CHARB SCAN BYTES3       — 77 78  
C       ENDDO                
C *     --------------------------------------
C *     Zeichen ausgeben
C *     --------------------------------------
C     NUM IFLT BYTESLEN              
C       ADD 1 NUM            
C       MOVEL(P) B1(NUM) CHARB            
C          
C     '%' IFEQ TYPE2              
C       CALLP(E) CVTHC ( CHAR2:CHARB:2)
C       EVAL BUFX = '%'  + CHAR2
C       ELSE                
C       EVAL BUFX =        CHARB
C       ENDIF                
C *     --------------------------------------
C *     Zeichen ausgeben
C *     --------------------------------------
C       ELSE                
C     '%' IFEQ TYPE2              
C       EVAL BUFX = '%50%7B'+%CHAR(NUM)+'%5E'
C       ELSE                
C       EVAL BUFX =     '&#'+%CHAR(NUM)+';'
C       ENDIF                
C       ENDIF                
C *     --------------------------------------
C *     Zeichen ausgeben
C *     --------------------------------------
C       EXSR REPLACE              
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ADD 1 POS            
C       ENDDO                
C       ENDSR                
C          
  X * TYPEIN EXSR UTF8    
  X * TYPEIN EXSR UTF8    
  X * TYPEIN EXSR UTF8    
  X  
C     READ BEGSR                
C       CLEAR   CHARB            
C       CLEAR   POSADD            
C *     --------------------------------------
C *     Zeichen lesen
C *     --------------------------------------
C     POS2 IFLE BUFLEN              
C     POS2 ANDLE TEXTLEN              
C       SUBST(P) TEXT:POS2 CHARB     — 77 —  
C          
C *     --------------------------------------
C *     %
C *     --------------------------------------
C     '%' IFEQ CHARB              
C     '%' IFEQ TYPE2              
C     POS2 ADD 1 POS3            
C     POS3 ADD 1 POS4            
C     POS4 IFLE BUFLEN              
C     POS4 ANDLE TEXTLEN              
C       SUBST(P) TEXT:POS3 CHAR2     — 77 —  
C          
C     HEXCHARS CHECK CHAR2       — 77 78  
C   N78   CALLP(E) CVTCH ( CHARB:CHAR2:2)
C   N78   ADD 2 POSADD            
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDSR                
C          
  X * *MAIN* EXSR UTF8    
  X  
C     TYPE# BEGSR                
C     *ZERO ADD 1 POS            
C *     --------------------------------------
C *     &#nnn; / %26%23nnn; in UTF-8 umsetzen
C *     --------------------------------------
C     POS DOWLE BUFLEN              
C     POS ANDLE TEXTLEN              
C       SETOFF         — — 78  
C *     --------------------------------------
C *     %26%23nnn;
C *     --------------------------------------
C     '%' IFEQ TYPE2              
C     POS ADD CHAR6LEN POS4            
C       SUB 1 POS4            
C     POS4 IFLE BUFLEN              
C     POS4 ANDLE TEXTLEN              
C       SUBST(P) TEXT:POS CHAR6     — 77 —  
C          
C     '%26%23' COMP CHAR6       — — 78  
C   78 POS ADD CHAR6LEN POS3            
C       ENDIF                
C *     --------------------------------------
C *     &#nnn;
C *     --------------------------------------
C       ELSE                
C     POS ADD CHAR2LEN POS4            
C       SUB 1 POS4            
C     POS4 IFLE BUFLEN              
C     POS4 ANDLE TEXTLEN              
C       SUBST(P) TEXT:POS CHAR2     — 77 —  
C          
C     '&#' COMP CHAR2       — — 78  
C   78 POS ADD CHAR2LEN POS3            
C       ENDIF                
C       ENDIF                
C *     --------------------------------------
C *     &#nnn; / %26%23nnn; in UTF-8 umsetzen
C *     --------------------------------------
C     *IN78 IFEQ *ON              
C       MOVEL(P) '0' CHARB            
C     *ZERO ADD POS3 POS2            
C          
C *     --------------------------------------
C *     &#nnn; / %26%23nnn; in UTF-8 umsetzen
C *     --------------------------------------
C     POS2 DOWLE BUFLEN              
C     POS2 ANDLE TEXTLEN              
C     CHARB ANDGE '0'              
C     CHARB ANDLE '9'              
C       SUBST(P) TEXT:POS2 CHARB     — 77 —  
C       ADD 1 POS2            
C       ENDDO                
C       SUB 1 POS2            
C *     --------------------------------------
C *     &#nnn; / %26%23nnn; in UTF-8 umsetzen
C *     --------------------------------------
C     POS2 IFLE BUFLEN              
C     POS2 ANDLE TEXTLEN              
C       SUBST(P) TEXT:POS2 CHARB     — 77 —  
C          
C     ';' IFEQ CHARB              
C     POS2 SUB POS3 LEN2            
C       ADD 1 POS2            
C     LEN2 IFGE 1              
C     LEN2 ANDLE 10              
C       EVAL BUFX = %SUBST ( TEXT:POS3:LEN2)
C       EVAL NUM1 =   %DEC ( BUFX:10:0)
C          
C *     --------------------------------------
C *     Zeichen ermitteln
C *     --------------------------------------
C       EXSR NUMDIV              
C       EXSR NUMDIV2              
C          
C *     --------------------------------------
C *     Zeichen ausgeben
C *     --------------------------------------
C       EXSR REPLACE              
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ADD 1 POS            
C       ENDDO                
C       ENDSR                
C          
  X * TYPE# EXSR UTF8    
  X  
C     NUMDIV BEGSR                
C     *ZERO ADD 128 NUMD            
C       CLEAR   NUMD2            
C       CLEAR   NUMX            
C *     --------------------------------------
C *     Zeichen ermitteln
C *     --------------------------------------
C     NUM1 IFGE NUMD              
C       EXSR NUMDIV1B              
C       EXSR NUMDIV1              
C     NUM1 IFGE NUMD              
C       EXSR NUMDIV1              
C     NUM1 IFGE NUMD              
C       EXSR NUMDIV1              
C     NUM1 IFGE NUMD              
C       EXSR NUMDIV1              
C     NUM1 IFGE NUMD              
C       EXSR NUMDIV1              
C     NUM1 IFGE NUMD              
C       EXSR NUMDIV1              
C     NUM1 IFGE NUMD              
C       EXSR NUMDIV1              
C     NUM1 IFGE NUMD              
C       EXSR NUMDIV1              
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDSR                
C          
  X * NUMDIV EXSR UTF8    
  X * NUMDIV EXSR UTF8    
  X * NUMDIV EXSR UTF8    
  X * NUMDIV EXSR UTF8    
  X * NUMDIV EXSR UTF8    
  X * NUMDIV EXSR UTF8    
  X * NUMDIV EXSR UTF8    
  X * NUMDIV EXSR UTF8    
  X  
C     NUMDIV1 BEGSR                
C *     --------------------------------------
C *     Zeichen ermitteln
C *     --------------------------------------
C     *ZERO ADD NUM7 NUM8            
C     *ZERO ADD NUM6 NUM7            
C     *ZERO ADD NUM5 NUM6            
C     *ZERO ADD NUM4 NUM5            
C     *ZERO ADD NUM3 NUM4            
C     *ZERO ADD NUM2 NUM3            
C     *ZERO ADD NUM1 NUM            
C          
C *     --------------------------------------
C *     Zeichen ermitteln
C *     --------------------------------------
C     NUM DIV 64 NUM1            
C     NUM1 MULT 64 NUM2            
C     NUM SUB NUM2 NUM2            
C          
C *     --------------------------------------
C *     Zeichen ermitteln
C *     --------------------------------------
C       EXSR NUMDIV1B              
C       ENDSR                
C          
  X * NUMDIV EXSR UTF8    
  X * NUMDIV1 EXSR UTF8    
  X  
C     NUMDIV1B BEGSR                
C *     --------------------------------------
C *     Zeichen ermitteln
C *     --------------------------------------
C       ADD NUMD NUMD2            
C       DIV 2 NUMD            
C       ADD 1 NUMX            
C          
C       ENDSR                
C          
  X * TYPE# EXSR UTF8    
  X  
C     NUMDIV2 BEGSR                
C       CLEAR   BUFX            
C *     --------------------------------------
C *     Zeichen ermitteln
C *     --------------------------------------
C     NUMD2 ADD NUM1 NUMB            
C       EXSR NUMDIV3              
C     NUMX IFGE 2              
C     128 ADD NUM2 NUMB            
C       EXSR NUMDIV3              
C     NUMX IFGE 3              
C     128 ADD NUM3 NUMB            
C       EXSR NUMDIV3              
C     NUMX IFGE 4              
C     128 ADD NUM4 NUMB            
C       EXSR NUMDIV3              
C     NUMX IFGE 5              
C     128 ADD NUM5 NUMB            
C       EXSR NUMDIV3              
C     NUMX IFGE 6              
C     128 ADD NUM6 NUMB            
C       EXSR NUMDIV3              
C     NUMX IFGE 7              
C     128 ADD NUM7 NUMB            
C       EXSR NUMDIV3              
C     NUMX IFGE 8              
C     128 ADD NUM8 NUMB            
C       EXSR NUMDIV3              
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDIF                
C       ENDSR                
C          
  X * NUMDIV2 EXSR UTF8    
  X * NUMDIV2 EXSR UTF8    
  X * NUMDIV2 EXSR UTF8    
  X * NUMDIV2 EXSR UTF8    
  X * NUMDIV2 EXSR UTF8    
  X * NUMDIV2 EXSR UTF8    
  X * NUMDIV2 EXSR UTF8    
  X * NUMDIV2 EXSR UTF8    
  X  
C     NUMDIV3 BEGSR                
C *     --------------------------------------
C *     Zeichen ermitteln
C *     --------------------------------------
C     '%' IFEQ TYPE2              
C       CALLP(E) CVTHC ( CHAR2:CHARB:2)
C       EVAL BUFX =
C       BUFX + '%'  + CHAR2
C       ELSE                
C *     --------------------------------------
C *     Zeichen ermitteln
C *     --------------------------------------
C     NUMB IFLT BYTESLEN              
C     NUMB ADD 1 NUMD            
C       MOVEL(P) B1(NUMD) CHARB            
C       ENDIF                
C *     --------------------------------------
C *     Zeichen ermitteln
C *     --------------------------------------
C       EVAL BUFX = BUFX + CHARB
C       ENDIF                
C       ENDSR                
C          
  X * TYPE8 EXSR UTF8    
  X * TYPEIN EXSR UTF8    
  X * TYPE# EXSR UTF8    
  X  
C     REPLACE BEGSR                
C     ' ' CHECKR BUFX POSADD            
C     *ZERO ADD BUFLEN BUFLENX            
C *     --------------------------------------
C *     Zeichen ausgeben
C *     --------------------------------------
C       SUB POS2 BUFLEN            
C       ADD POS BUFLEN            
C       ADD POSADD BUFLEN            
C          
C *     --------------------------------------
C *     Zeichen ausgeben
C *     --------------------------------------
C     BUFLEN IFLE TEXTLEN              
C       EVAL %SUBST(TEXT:1:BUFLEN)=%REPLACE(BUFX:
C       %SUBST(TEXT:1:BUFLENX):POS:POS2-POS)
C       ENDIF                
C *     --------------------------------------
C *     Zeichen ausgeben
C *     --------------------------------------
C       ADD POSADD POS            
C       SUB 1 POS            
C       ENDSR                
C          
  X * *MAIN* EXSR UTF8    
  X  
C     ARRAY BEGSR                
C       CLEAR   N            
C *     --------------------------------------
C *     Bytes 0-255
C *     --------------------------------------
C       CLEAR   N1(1)            
C     1 DO BYTELEN N            
C     *ZERO ADD N N2(N)            
C       ENDDO                
C       CLEAR   NUMB            
C *     --------------------------------------
C *     Bytes in EBCDIC umsetzen
C *     --------------------------------------
C       CALLP(E) QTQCVRT ( ASCII:0:
C         BYTES:BYTESLEN:
C         EBCDIC:0:0:BYTESLEN:
C         BYTES:RCVLEN:
C         DUMMY:FB)
C          
C *     --------------------------------------
C *     %
C *     --------------------------------------
C     '%' SCAN BYTES NUM     — 77 78  
C   78   MOVEL(P) B1(1) B1(NUM)            
C          
C       ENDSR                
C          
C     *PSSR BEGSR                
C     'UTF8' DSPLY                
C       ENDSR '*CANCL'              
C          
C     *ENTRY PLIST                
C       PARM   TEXT            
C       PARM   TEXTLEN            
C       PARM   BUFLEN            
C       PARM   TYPE1            
C       PARM   TYPE2            

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