EBCDIC - ASCII

[Semen Matusovski]

Source: http://support.microsoft.com/support.../Q216/3/99.ASP

   #Compile Exe
   #Register None
   #Dim All

   Function HexToStr(HexStr As Asciiz) As String
      Dim Temp As String, I As Long
      Temp = Space$(Len(HexStr) \ 2)
      For i = 1 To Len(HexStr) \ 2
         Mid$(Temp, i, 1) = Chr$(Val("&H" & Mid$(HexStr, i * 2 - 1, 2)))
      Next I
      Function = Temp
   End Function

   Function Translate(InText As String, xlatTable As String * 256) As String
      Dim Temp As String, i As Long
      Temp = Space$(Len(InText))
      For I = 1 To Len(InText)
         Mid$(Temp, I, 1) = Mid$(xlatTable, Asc(InText, i) + 1, 1)
      Next
      Function = Temp
   End Function


   Function PbMain
      Dim ASCII_To_EBCDIC_Table As String * 256
      ASCII_To_EBCDIC_Table = HexToStr _
         ("00010203372D2E2F1605250B0C0D0E0F101112133C3D322618193F271C1D1E1F" + _
          "405A7F7B5B6C507D4D5D5C4E6B604B61F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F" + _
          "7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6D7D8D9E2E3E4E5E6E7E8E9ADE0BD5F6D" + _
          "79818283848586878889919293949596979899A2A3A4A5A6A7A8A9C04FD0A107" + _
          "202122232415061728292A2B2C090A1B30311A333435360838393A3B04143EE1" + _
          "4142434445464748495152535455565758596263646566676869707172737475" + _
          "767778808A8B8C8D8E8F909A9B9C9D9E9FA0AAABAC4AAEAFB0B1B2B3B4B5B6B7" + _
          "B8B9BABBBC6ABEBFCACBCCCDCECFDADBDCDDDEDFEAEBECEDEEEFFAFBFCFDFEFF")
      Dim EBCDIC_To_ASCII_Table As String * 256
      EBCDIC_To_ASCII_Table = HexToStr _
          ("000102039C09867F978D8E0B0C0D0E0F101112139D8508871819928F1C1D1E1F" + _
           "80818283840A171B88898A8B8C050607909116939495960498999A9B14159E1A" + _
           "20A0A1A2A3A4A5A6A7A8D52E3C282B7C26A9AAABACADAEAFB0B121242A293B5E" + _
           "2D2FB2B3B4B5B6B7B8B9E52C255F3E3FBABBBCBDBEBFC0C1C2603A2340273D22" + _
           "C3616263646566676869C4C5C6C7C8C9CA6A6B6C6D6E6F707172CBCCCDCECFD0" + _
           "D17E737475767778797AD2D3D45BD6D7D8D9DADBDCDDDEDFE0E1E2E3E45DE6E7" + _
           "7B414243444546474849E8E9EAEBECED7D4A4B4C4D4E4F505152EEEFF0F1F2F3" + _
           "5C9F535455565758595AF4F5F6F7F8F930313233343536373839FAFBFCFDFEFF")
   
      Dim i As Long, sEBCDIC As String
      For i = 1 To 4
         Select Case i
            Case 1: sEBCDIC$ = HexToStr("40404040404040404040404040C3C8D9C9E240D3C5C540404040404040")
            Case 2: sEBCDIC$ = HexToStr("40404040404040404040404040C7D3C5D5D6C1D2E240C1D7C1D9E3D4C5")
            Case 3: sEBCDIC$ = HexToStr("40404040404040404040404040D7D640C2D6E740F7F4F0F54040404040")
            Case 4: sEBCDIC$ = HexToStr("40404040404040404040404040D3C1C7E4D5C140D5C9C7E4C5D3404040")
         End Select
         MsgBox Translate(sEBCDIC$, EBCDIC_To_ASCII_Table)
      Next
   End Function

[Peter Voll]

Beware that the 2 tables (ASCII_To_EBCDIC_Table and EBCDIC_To_ASCII_Table) are country dependent. Almost every language/country has its own character-set, called CODEPAGE.
In Denmark we use CODEPAGE 277 in EBCDIC and CODEPAGE 865 (or 850) in ASCII. The CODEPAGEs in the US are 037-EBCDIC and 437-ASCII. Russia has 1025-EBCDIC (I don't know what it is in ASCII).

------------------

[Semen Matusovski]

Of course, Peter is right - international users should use own tables.

Solution #2 (it ten's times faster)

   #Compile Exe
   #Register None
   #Dim All
   Sub Translate (Tr As String)
      Register i As Long, j As Long
      i = Len(Tr): j = StrPtr(Tr)
      ! LEA EBX, TrtTable
      ! MOV ECX, i
      ! MOV EDX, j
      ! ADD ECX, EDX
   LbTrt:
      ! MOV AL, [EDX]
      ! XLAT
      ! MOV [EDX], AL
      ! INC EDX
      ! CMP EDX, ECX
      ! JNE LbTrt  
      Exit Sub
 TrtTable:
      ! DB &H00,&H01,&H02,&H03,&H9C,&H09,&H86,&H7F,&H97,&H8D,&H8E,&H0B,&H0C,&H0D,&H0E,&H0F
      ! DB &H10,&H11,&H12,&H13,&H9D,&H85,&H08,&H87,&H18,&H19,&H92,&H8F,&H1C,&H1D,&H1E,&H1F
      ! DB &H80,&H81,&H82,&H83,&H84,&H0A,&H17,&H1B,&H88,&H89,&H8A,&H8B,&H8C,&H05,&H06,&H07
      ! DB &H90,&H91,&H16,&H93,&H94,&H95,&H96,&H04,&H98,&H99,&H9A,&H9B,&H14,&H15,&H9E,&H1A
      ! DB &H20,&HA0,&HA1,&HA2,&HA3,&HA4,&HA5,&HA6,&HA7,&HA8,&HD5,&H2E,&H3C,&H28,&H2B,&H7C
      ! DB &H26,&HA9,&HAA,&HAB,&HAC,&HAD,&HAE,&HAF,&HB0,&HB1,&H21,&H24,&H2A,&H29,&H3B,&H5E
      ! DB &H2D,&H2F,&HB2,&HB3,&HB4,&HB5,&HB6,&HB7,&HB8,&HB9,&HE5,&H2C,&H25,&H5F,&H3E,&H3F
      ! DB &HBA,&HBB,&HBC,&HBD,&HBE,&HBF,&HC0,&HC1,&HC2,&H60,&H3A,&H23,&H40,&H27,&H3D,&H22
      ! DB &HC3,&H61,&H62,&H63,&H64,&H65,&H66,&H67,&H68,&H69,&HC4,&HC5,&HC6,&HC7,&HC8,&HC9
      ! DB &HCA,&H6A,&H6B,&H6C,&H6D,&H6E,&H6F,&H70,&H71,&H72,&HCB,&HCC,&HCD,&HCE,&HCF,&HD0
      ! DB &HD1,&H7E,&H73,&H74,&H75,&H76,&H77,&H78,&H79,&H7A,&HD2,&HD3,&HD4,&H5B,&HD6,&HD7
      ! DB &HD8,&HD9,&HDA,&HDB,&HDC,&HDD,&HDE,&HDF,&HE0,&HE1,&HE2,&HE3,&HE4,&H5D,&HE6,&HE7
      ! DB &H7B,&H41,&H42,&H43,&H44,&H45,&H46,&H47,&H48,&H49,&HE8,&HE9,&HEA,&HEB,&HEC,&HED
      ! DB &H7D,&H4A,&H4B,&H4C,&H4D,&H4E,&H4F,&H50,&H51,&H52,&HEE,&HEF,&HF0,&HF1,&HF2,&HF3
      ! DB &H5C,&H9F,&H53,&H54,&H55,&H56,&H57,&H58,&H59,&H5A,&HF4,&HF5,&HF6,&HF7,&HF8,&HF9
      ! DB &H30,&H31,&H32,&H33,&H34,&H35,&H36,&H37,&H38,&H39,&HFA,&HFB,&HFC,&HFD,&HFE,&HFF
   End Sub
   
   Function HexToStr(HexStr As Asciiz) As String
      Dim Temp As String, I As Long
      Temp = Space$(Len(HexStr) \ 2)
      For i = 1 To Len(HexStr) \ 2
         Mid$(Temp, i, 1) = Chr$(Val("&H" & Mid$(HexStr, i * 2 - 1, 2)))
      Next
      Function = Temp
   End Function
   
   Function PbMain
      Dim i As Long, sEBCDIC As String
      For i = 1 To 4
         Select Case i
            Case 1: sEBCDIC$ = HexToStr("40404040404040404040404040C3C8D9C9E240D3C5C540404040404040")
            Case 2: sEBCDIC$ = HexToStr("40404040404040404040404040C7D3C5D5D6C1D2E240C1D7C1D9E3D4C5")
            Case 3: sEBCDIC$ = HexToStr("40404040404040404040404040D7D640C2D6E740F7F4F0F54040404040")
            Case 4: sEBCDIC$ = HexToStr("40404040404040404040404040D3C1C7E4D5C140D5C9C7E4C5D3404040")
         End Select
         Translate sEBCDIC$
         MsgBox sEBCDIC$
      Next
   End Function

[This message has been edited by Semen Matusovski (edited April 16, 2000).]

[Michael Mattias]

Solution #3 for the non-assembler types:

$IF 0
  FILE: EBD2ASCC.BAS FOR PB/CC 2.0
' CONSOLE PROGRAM TO CONVERT A FILE FROM US EBCDIC TO US ASCII
' Author : Michael Mattias Racine WI
' NOTE: Both the ASCII and EBCDIC character sets are national; that is, may vary
' from country to country.
' This is a revised version of the PB/DOS code first placed in the public domain by
' the author July, 1994. This code is placed in the public domain April 17, 2001.
' The table conversion code was tested using PB/CC v 2.0 and PB/DLL 6.0.
' It should work IN PB/DOS 3.5 as well, but this has not been tested.
' Should be easily convertible for any table substitution requirement.
' For more information on EBCDIC-ASCII conversions, as well as information on
' converting COBOL datatypes to IEEE datatypes, see the author's article at
' [url="http://www.flexus.com/ebd2asc.html"]http://www.flexus.com/ebd2asc.html[/url] 
$ENDIF


#REGISTER NONE
DECLARE FUNCTION BufferEBD2ASC (BYVAL pInput AS DWORD, BYVAL pOutput AS DWORD,BYVAL CB AS LONG) AS LONG
DECLARE FUNCTION ConvertFile (InFile AS STRING, OutFile AS STRING)  AS LONG

FUNCTION WinMain (BYVAL hCurInstance  AS LONG, _
                  BYVAL hPrevInstance AS LONG, _
                  lpszCmdLine         AS ASCIIZ PTR, _
                  BYVAL nCmdShow      AS LONG) EXPORT AS LONG
   
   DIM Stat AS LONG
   DIM InFile AS STRING, OutFile AS STRING
   
   InFile  = "C:\Software_Development\Testdata\cob2ieee.ebc"
   OutFile = "C:\Software_Development\Testdata\cob2ieee.Asc"
   Stat = ConvertFile (InFile, OutFile)
   PRINT "All Done.."
   WAITKEY$

END FUNCTION

FUNCTION BufferEBD2ASC (BYVAL pInput AS DWORD, BYVAL pOutput AS DWORD, BYVAL CB AS LONG) AS LONG
   ' pInput: address of input buffer
   ' pOutput  address of output buffer (must be pre-allocated!)
   ' CB = # bytes to convert
   ' if Poutput = pInpout, then the input string in converted

   STATIC BeenHere AS LONG, Table AS STRING * 256
   DIM  pIn AS BYTE PTR
   DIM  pOut AS BYTE PTR
   STATIC pTable AS BYTE PTR
   REGISTER I AS LONG

   IF ISFALSE Beenhere THEN
      BeenHere = NOT BeenHere
     ' build the conversion table as a 256 byte buffer
      pTable = VARPTR(Table)
      FOR I = 0 TO 255
          @pTable[I] = VAL(READ$(I+1))
      NEXT I
   END IF
   pIn = pInput
   pOut = POutput
   FOR I = 1 TO CB
     @pOut = @pTable[@pIn]
     INCR pIn
     INCR pOut
   NEXT I

   FUNCTION = 0

EBDDATA:
' Each entry represents the US ASCII value of US EBCDIC character "n"
' 0 <= N <= 255
DATA   0,  1,  2,  3,  0,  9,  0,127,  0,  0,  0, 11, 12, 13, 14, 15
DATA  16, 17, 18, 19,  0,  0,  8,  0, 24, 25,  0,  0, 28, 29, 30, 31
DATA   0,  0,  0,  0,  0, 10, 23, 27,  0,  0,  0,  0,  0,  5,  6,  7
DATA   0,  0, 22,  0,  0,  0,  0,  4,  0,  0,  0,  0, 20, 21,  0, 26
DATA  32, 32,131,132,133,160,166,134,135,164, 91, 46, 60, 40, 43,124
DATA  38,130,136,137,138,161,140,139,141,225, 93, 36, 42, 41, 59,170
DATA  45, 47,  0,142,  0,  0,  0,143,128,165,124, 44, 37, 95, 62, 63
DATA 237,144,  0,  0,  0,  0,  0,  0,  0, 96, 58, 35, 64, 39, 61, 34
DATA 237, 97, 98, 99,100,101,102,103,104,105,174,175,235,  0,  0,241
DATA 248,106,107,108,109,110,111,112,113,114,166,167,145,  0,146,  0
DATA 230,126,115,116,117,118,119,120,121,122,173,168,  0, 89,  0,  0
DATA  94,156,157,250,  0, 21, 20,172,171,  0, 91, 93,  0,  0, 39,  0
DATA 123, 65, 66, 67, 68, 69, 70, 71, 72, 73, 45,147,148,149,162,167
DATA 125, 74, 75, 76, 77, 78, 79, 80, 81, 82,  0,150,129,151,163,152
DATA  92,246, 83, 84, 85, 86, 87, 88, 89, 90,253,  0,153,  0,  0,  0
DATA  48, 49, 50, 51, 52, 53, 54, 55, 56, 57,  0,150,154,  0,  0,  0

END FUNCTION

FUNCTION ConvertFile (InFile AS STRING, OutFile AS STRING)  AS LONG
   
   DIM IH AS LONG, OH AS LONG, X AS STRING, ECode AS LONG, BytesToProcess AS LONG,_
       FileBuffer AS STRING, BytesThisTrip AS LONG, ReadBlock AS LONG
       
   IH = FREEFILE
   OPEN Infile FOR BINARY AS IH BASE=0
   ECode = ERRCLEAR
   IF Ecode THEN
      PRINT "Error on Input File, code=" & STR$(Ecode)
      EXIT FUNCTION
   END IF

   OH = FREEFILE
   OPEN OutFile FOR BINARY AS OH BASE=0
   ECode = ERRCLEAR
   IF Ecode THEN
      PRINT "Error on Output File, code=" & STR$(Ecode)
      EXIT FUNCTION
   END IF
   SETEOF (OH)
   
   ReadBlock = 100000&      ' any good buffer size OK here
   BytesToProcess = LOF(IH)

   WHILE ISTRUE BytesToProcess
         BytesThisTrip = MIN(BytesToProcess, ReadBlock)
         GET$ #Ih,BytesThisTrip, FileBuffer
         BufferEbd2ASC BYVAL STRPTR(FileBuffer), BYVAL STRPTR(FileBuffer), BytesThisTrip
         PUT #Oh, , FileBuffer
         BytesToProcess = BytesToProcess - BytesThisTrip
   WEND

   CLOSE IH, OH

   FUNCTION = 0
   
END FUNCTION
   
   
FUNCTION ManualConversionForTesting AS LONG
   
   DIM X AS STRING, Stat AS LONG
   DO
      LINE INPUT "Enter string to Convert", X
      PRINT " Input String before function==>";X
      Stat = BufferEBD2ASC (BYVAL STRPTR(X), BYVAL STRPTR(X), LEN(X))
      PRINT " Input String after  function==>";X
      X=WAITKEY$
      IF X= CHR$(27) THEN EXIT DO
   LOOP


END FUNCTION

------------------
Michael Mattias
Racine WI USA
[email protected]