| 
***********************************************************************
** **
** Ce pgm convertit des données UNICODE en EBCDIC. **
** **
** le premier paramètre contient la chaîne de caractères en UNICODE **
** - chaque caractère est codé sur 2 octets (pour DBCS) **
** 1er octet x'00' **
** 2ème octet le caractère en ASCII **
** - le deuxième paramètre donne la longueur du premier **
** - le troisième paramètre est la variable qui contiendra **
** le code EBCDIC (elle doit être de 2 fois plus petite) **
** **
** ATTENTION **
** **
** ce programme ne tient pas compte des paramètres nationaux **
** (caractères accentués), il n'est donc fiables que pour **
** la partie invariante des codes page **
***********************************************************************
Dinput s 2048
Doutput s 1024
Dunids ds
Dunicod 2048
Dunitab 1 dim(2048) overlay(unicod)
Debcds ds
Debcdic 1024
Debctab 1 dim(1024) overlay(ebcdic)
Dinl s 15 5
Dinl2 s 5 0
Doutl s 5 0
Di s 5 0
Dqebcdic s 10 inz('QEBCDIC')
Dqebcdiclib s 10 inz('*LIBL')
C *entry plist
C parm input
C parm inl
C parm output
* la lg d'output doit être inl / 2
c eval inl2 = inl
C eval unicod = %subst(input:1:inl2)
c eval outl = inl2 / 2
* ignorer tous les octets impaires (1,3,5,...)
c do inl2 z 4 0
c z div 2 result 4 0
c mvr reste 1 0
|
|
c if reste = 0 c eval i = i + 1 c eval ebctab(i) = unitab(z) c endif c enddo * cvt ascii / ebcdic c call 'QDCXLATE' C PARM outl C PARM ebcdic C PARM qebcdic C PARM qebcdiclib c eval %subst(output:1:outl) = ebcdic c eval *inlr = *on |
