Par2: EBCDIC to ASCII 1998-09-03 -- Wesley Coleman Clarion will also convert to and from EBCDIC attached is a source module
that will do both.
MEMBER
MAP
CheckConvert Function(LONG),BYTE
EbcdicToAscii Procedure(*STRING)
AsciiToEbcdic Procedure(*STRING)
END
EbStr STRING('< 40h, 40h, 40h, 40h, 40h, 40h, 40h, 40h>'&|
'< 40h, 40h, 40h, 40h, 40h, 40h, 40h, 40h>'&|
'< 40h, 40h, 40h, 40h, 40h, 40h, 40h, 40h>'&|
'< 40h, 40h, 40h, 40h, 40h, 40h, 40h, 40h>'&|
'< 40h, 5Ah, 7Fh, 7Bh, 5Bh, 6Ch, 50h, 7Dh>'&|
'< 4Dh, 5Dh, 5Ch, 4Eh, 6Bh, 60h, 4Bh, 61h>'&|
'<0F0h,0F1h,0F2h,0F3h,0F4h,0F5h,0F6h,0F7h>'&|
'<0F8h,0F9h, 7Ah, 5Eh, 4Ch, 7Eh, 6Eh, 6Fh>'&|
'< 7Ch,0C1h,0C2h,0C3h,0C4h,0C5h,0C6h,0C7h>'&|
'<0C8h,0C9h,0D1h,0D2h,0D3h,0D4h,0D5h,0D6h>'&|
'<0D7h,0D8h,0D9h,0E2h,0E3h,0E4h,0E5h,0E6h>'&|
'<0E7h,0E8h,0E9h,0BAh,0E0h,0BBh, 5Fh, 6Dh>'&|
'< 79h, 81h, 82h, 83h, 84h, 85h, 86h, 87h>'&|
'< 88h, 89h, 91h, 92h, 93h, 94h, 95h, 96h>'&|
'< 97h, 98h, 99h,0A2h,0A3h,0A4h,0A5h,0A6h>'&|
'<0A7h,0A8h,0A9h,0C0h, 6Ah,0D0h,0A1h, 8Fh>')
AsStr STRING('< 20h, 20h, 20h, 20h, 20h, 20h, 20h, 20h, 20h,
20h, 0Ah, 20h, 20h, 0Dh, 20h, 20h>'&|
'< 20h, 20h, 20h, 20h, 20h, 20h, 20h, 20h, 20h,
20h, 20h, 20h, 20h, 20h, 20h, 20h>'&|
'< 20h, 20h, 20h, 20h, 20h, 20h, 20h, 20h, 20h,
20h, 20h, 20h, 20h, 20h, 20h, 20h>'&|
'< 20h, 20h, 20h, 20h, 20h, 20h, 20h, 20h, 20h,
20h, 20h, 20h, 20h, 20h, 20h, 20h>'&|
'< 20h, 20h, 83h, 84h, 85h,0A0h, 20h, 86h,
87h,0A4h, 9Bh, 2Eh, 3Ch, 28h, 2Bh,0B3h>'&|
'< 26h, 82h, 88h, 89h, 8Ah,0A1h, 8Ch, 8Bh,
8Dh,0E1h, 21h, 24h, 2Ah, 29h, 3Bh,0AAh>'&|
'< 2Dh, 2Fh, 83h, 8Eh, 85h,0A0h, 20h, 8Fh,
80h,0A5h, 7Ch, 2Ch, 25h, 5Fh, 3Eh, 3Fh>'&|
'<0EDh, 90h, 88h, 89h, 8Ah,0A1h, 8Ch, 8Bh, 8Dh,
60h, 3Ah, 23h, 40h, 27h, 3Dh, 22h>'&|
'<0EDh, 61h, 62h, 63h, 64h, 65h, 66h, 67h, 68h,
69h,0AEh,0AFh, 20h,0F3h, 20h,0F1h>'&|
'<0F8h,06Ah,06Bh,06Ch,06Dh,06Eh,06Fh, 70h, 71h,
72h,0A6h,0A7h, 91h,0F7h, 92h, 20h>'&|
'<0E6h, 7Eh, 73h, 74h, 75h, 76h, 77h, 78h, 79h,
7Ah,0ADh,0A8h, 20h, 20h, 20h, 20h>'&|
'< 5Eh, 9Ch, 9Dh, 9Eh, 9Fh, 20h, 20h,0ACh,0ABh,
20h, 5bh, 5Dh,0C4h,0F9h, 27h,0CDh>'&|
'< 7Bh, 41h, 42h, 43h, 44h, 45h, 46h, 47h, 48h,
49h, 2Dh, 93h, 94h, 95h,0A2h, 20h>'&|
'< 7Dh, 4Ah, 4Bh, 4Ch, 4Dh, 4Eh, 4Fh, 50h, 51h,
52h,0F2h, 96h, 81h, 97h,0A3h, 98h>'&|
'< 5Ch, 20h, 53h, 54h, 55h, 56h, 57h, 58h, 59h,
5Ah,0FDh, 93h, 99h, 95h,0A2h, 20h>'&|
'< 30h, 31h, 32h, 33h, 34h, 35h, 36h, 37h, 38h,
39h,0FCh, 96h, 9Ah, 97h,0A3h, 20h>') !216
ae BYTE,DIM(128),OVER(EbStr)
ea BYTE,DIM(256),OVER(AsStr)
x LONG
CheckConvert Function(ByteCnt)
CODE
RETURN(True)
EbcdicToAscii Procedure(Buff)
LoopCnt long
CODE
LOOP LoopCnt = 1 TO SIZE(Buff)
IF CheckConvert(Loopcnt) THEN
Buff[LoopCnt] = CHR(ea[VAL(Buff[LoopCnt])+1])
END
END
AsciiToEbcdic Procedure(Buff)
LoopCnt LONG
CODE
LOOP LoopCnt = 1 TO SIZE(Buff)
IF CheckConvert(Loopcnt) THEN
Buff[LoopCnt] = CHR(ae[VAL(Buff[LoopCnt])+1])
END
END
ADDITION FOR PACKED DECIMALS:
Packed decimal fields are usable as they are with no conversion. But if you
have negative numbers in unpacked fields, they contain a character as the last
digit that will need to be changed to the correct number and then
multiplied by -1 to get the right number. I am attaching a function that
will change the character to a number and return True if the number needs to
be multiplied by -1 for the correct result.
A example of it's use is,
IF IbmNumToPc(IbmNum) THEN
NewVariable = IbmNum * -1
ELSE
NewVariable = IbmNum
END
IbmNumToPc Function(IbmNum)
Loc:String cstring(20)
loc:Length short
code
loc:String = IbmNum
loc:Length = len(loc:string)
if numeric(loc:string[loc:length]) then
return(False)
else
case loc:string[loc:length]
of '}'
IbmNum[loc:length] = '0'
of 'J'
IbmNum[loc:length] = '1'
of 'K'
IbmNum[loc:length] = '2'
of 'L'
IbmNum[loc:length] = '3'
of 'M'
IbmNum[loc:length] = '4'
of 'N'
IbmNum[loc:length] = '5'
of 'O'
IbmNum[loc:length] = '6'
of 'P'
IbmNum[loc:length] = '7'
of 'Q'
IbmNum[loc:length] = '8'
of 'R'
IbmNum[loc:length] = '9'
end
RETURN(True)
end
Printed May 4, 2024, 3:10 pm This article has been viewed/printed 35119 times. |