Sponsors
Search
Link to our site
Learning Resources
H DftActGrp(*NO) Option(*SRCSTMT) H BNDDIR('QC2LE') // Convert string of hex characters representing ASCII data to // EBCDIC values. Vendor is supplying a file that contains data // like '414243303132' which needs to be interpreted as ABC012. // The entire string received from the vendor is hex representation // of ASCII characters. // by D. Lovelady D EBCDIC_CCSID C 37 // 1208 is the common UTF-8 CCSID D ASCII_CCSID C 819 D sscanf PR 10I 0 ExtProc('sscanf') D fmtString * Value Options(*String) D field1 * Value Options(*NoPass) D asciiHexToEBCDIC... D PR 32767 Varying extProc('ascHexToBCD') D hexIn 65534 Value D hexLen 10I 0 Value D hexInput S 32767 Varying D result S 32767 Varying D Translate PR ExtPgm('QDCXLATE') D Length 5P 0 const D Data 32766A options(*varsize) D Table 10A const D up c 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' D lo c 'abcdefghijklmnopqrstuvwxyz' D valueToConvert... D C '436f6d7042656e656669747320+ D 6f6620496c6c696e6f69732020+ D 2020202032303020572E204A61+ D 636B736F6E2020202020202020+ D 20202020202039746820466C6F+ D 6F722020202020202020436869+ D 6361676F202020202020202049+ D 4C363036303620202020203830+ D 302D3833372D3233343115AAC2+ D E1333035303031737979797966+ D 00460050005A00057920202020+ D 20202020202020202020202020+ D 20202020202020202020203230+ D 6E79206E332E3330206E6E6E62+ D 6130306E6E6E6E6E6E6E202020+ D 20202020202020202020202020+ D 20202020202020202020202030+ D 3030306E6E6F30316E6E6E6E6E20' D /Free hexInput = valueToConvert ; result = asciiHexToEBCDIC(valueToConvert:%Len(valueToConvert)) ; *INLR = *On ; /End-free P asciiHexToEBCDIC... P B // Convert string of hex characters representing ASCII data to // EBCDIC values D asciiHexToEBCDIC... D PI 32767 Varying D hexIn 65534 Value D hexLen 10I 0 Value D cvtch PR ExtProc('cvtch') D ptrcharOut 32A Options(*VarSize) D ptrHexIn 64A Const D charLength 10I 0 Value *================================================================== * Type definitions for Code Conversion APIs *================================================================== D iconv_hndl_T ds Based(proto_only) Qualified D rtnval 10I 0 D cd 10I 0 dim(12) *================================================================== * Prototype for iconv_open()--Code Conversion Allocation API *================================================================== D iconv_open PR extproc('QtqIconvOpen') D LikeDS(iconv_hndl_T) D pToCode * value D pFromCode * value *================================================================== * Prototype for iconv()--Code Conversion API *================================================================== D iconv PR 10I 0 extproc('iconv') D cd value LikeDS(iconv_hndl_T) D pInBuf * Const D inBytesLeft 10u 0 Const D pOutBuf * Const D outBytesLeft 10u 0 Const // ================================================================ // Prototype for iconv_close()--Code Conversion Deallocation API // ================================================================ D iconv_close PR 10I 0 extproc('iconv_close') D cd value LikeDS(iconv_hndl_T) D loHex C 'abcdef' D hiHex C 'ABCDEF' ? D hexWork S 65534 D ASCII S 32767 D EBCDIC S 32767 D resultLen S 5U 0 D rc S 10I 0 *============================================= * VARIABLES USED BY SUBPROCEDURE "iconv*" D iconv_t DS Qualified Inz D ccsid 10I 0 inz(0) D convA 10I 0 inz(0) D subA 10I 0 inz(0) D shftA 10I 0 inz(1) D lnOpt 10I 0 inz(0) D erOpt 10I 0 inz(1) D reserved 12 inz(*LoVal) D isInitIconv S N inz(*off) static D hIconv DS LikeDS(iconv_hndl_T) Static Inz D toCde DS LikeDS(iconv_t) Static Inz(*LikeDS) D frmCde DS LikeDS(iconv_t) Static Inz(*LikeDS) *============================================= /Free hexWork = %Xlate(loHex: hiHex: %Subst(hexIn: 1: hexLen)) ; resultLen = hexLen / 2 ; cvtch(ASCII: hexWork: hexLen) ; // Initialize Code Conversion if not isInitIconv ; toCde.ccsid = EBCDIC_CCSID ; frmCde.ccsid = ASCII_CCSID ; hIconv = iconv_open(%Addr(toCde): %Addr(frmCde)) ; isInitIconv = (hIconv.rtnval = *Zero) ; EndIF ; rc = iconv(hIconv : %addr(ASCII): resultLen : %addr(EBCDIC): resultLen ) ; Return %Subst(EBCDIC: 1: resultLen) ; /End-free P asciiHexToEBCDIC... P E
[report a broken link by clicking here]