|
Here's another way to do it expressed as an ILE RPG IV procedure. Procedure "chr2hex" returns the 2-character hex representation of the character passed as parameter. --------------------------------------------------------------------------------- P chr2hex b D chr2hex pi 2a D char 1a value D hexchars c '0123456789ABCDEF' D chi s 5i 0 D clo s 5i 0 D ds D num 5i 0 inz(0) D chr 1a overlay(num:%size(num)) C eval chr = char C eval chi = num / 16 C eval clo = num - chi * 16 C return %subst(hexchars:chi+1:1) C + %subst(hexchars:clo+1:1) P chr2hex e --------------------------------------------------------------------------- ------ Hans Boldt, ILE RPG Development, IBM Toronto Lab, boldt@ca.ibm.com ---------------------- Forwarded by Hans Boldt/Toronto/IBM on 98-03-23 15:15 --------------------------- owner-midrange-l@midrange.com on 98-03-23 15:00:55 Please respond to MIDRANGE-L@midrange.com To: RPG400-L@midrange.com, midrange-l@midrange.com cc: Subject: Hex Values of a Character field does anyone know of a better way to get the hexadecimal value of a character field besides the following method: (which i was forced to come up with for lack of knowing a better way.) thanks in advance *--------------------------------------------------------------------- D TABNUM S 2 0 DIM(15) CTDATA PERRCD(1) D TABHEX S 1 DIM(15) ALT(TABNUM) *--------------------------------------------------------------------- C GET_HEX_VALUE BEGSR *--------------------------------------------------------------------* * THIS SUBROUTINE WILL ACCEPT A 1 POSITION CHARACTER FLD ##CHARACTER * * AND RETURN A TWO CHARACTER FLD ##HEXNUM CONTAINING THE HEXADECIMAL * * REPRESENTATION OF ##CHARACTER * *--------------------------------------------------------------------* C MOVE ##CHARACTER ##CHARACTER 1 C Z-ADD 0 ##NUMBER1 2 0 C Z-ADD 0 ##NUMBER2 2 0 C MOVE *BLANKS ##HEXNUM 2 *--------------------------------------------------------------------- C TESTB '0' ##CHARACTER 99 C IF *IN99 C ADD 8 ##NUMBER1 C ENDIF C TESTB '1' ##CHARACTER 99 C IF *IN99 C ADD 4 ##NUMBER1 C ENDIF C TESTB '2' ##CHARACTER 99 C IF *IN99 C ADD 2 ##NUMBER1 C ENDIF C TESTB '3' ##CHARACTER 99 C IF *IN99 C ADD 1 ##NUMBER1 C ENDIF C TESTB '4' ##CHARACTER 99 C IF *IN99 C ADD 8 ##NUMBER2 C ENDIF C TESTB '5' ##CHARACTER 99 C IF *IN99 C ADD 4 ##NUMBER2 C ENDIF C TESTB '6' ##CHARACTER 99 C IF *IN99 C ADD 2 ##NUMBER2 C ENDIF C TESTB '7' ##CHARACTER 99 C IF *IN99 C ADD 1 ##NUMBER2 C ENDIF *--------------------------------------------------------------------- *--------------------------------------------------------------------- C ##NUMBER1 LOOKUP TABNUM TABHEX 99 C MOVEL TABHEX ##HEXNUM 2 C ##NUMBER2 LOOKUP TABNUM TABHEX 99 C MOVE TABHEX ##HEXNUM 2 *--------------------------------------------------------------------- C ENDSR ** NUMBER TO HEX CONVERSION TABLE 011 022 033 044 055 066 077 088 099 10A 11B 12C 13D 14E 15F +--- | This is the Midrange System Mailing List! | To submit a new message, send your mail to MIDRANGE-L@midrange.com. | To unsubscribe from this list send email to MIDRANGE-L-UNSUB@midrange.com. | Questions should be directed to the list owner/operator: david@midrange.com +--- +--- | This is the Midrange System Mailing List! | To submit a new message, send your mail to MIDRANGE-L@midrange.com. | To unsubscribe from this list send email to MIDRANGE-L-UNSUB@midrange.com. | Questions should be directed to the list owner/operator: david@midrange.com +---
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
midrange.com
