Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

EBCDIC - ASCII

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • EBCDIC - ASCII

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

    Code:
       #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

  • #2
    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).

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

    Comment


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

      Solution #2 (it ten's times faster)

      Code:
         #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).]

      Comment


      • #4
        Solution #3 for the non-assembler types:
        Code:
        $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]
        Michael Mattias
        Tal Systems (retired)
        Port Washington WI USA
        [email protected]
        http://www.talsystems.com

        Comment

        Working...
        X