Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Chris Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Ebcdic to Ascii 2

Status
Not open for further replies.
Swi

Swi

Programmer
Feb 4, 2002
1,965
US
Anyone able to help with this? The below code is not returning the extended character set correctly. Any ideas?

Code: 
Function ebcdic_to_ascii(buffer)
    Dim ebcdic
    Dim i, bufferlen
    Dim Result
    ebcdic = Array( _
    &H0, &H1, &H2, &H3, &H9C, &H9, &H86, &H7F, &H97, &H8D, &H8E, &HB, &HC, &HD, &HE, &HF, _
    &H10, &H11, &H12, &H13, &H9D, &H85, &H8, &H87, &H18, &H19, &H92, &H8F, &H1C, &H1D, &H1E, &H1F, _
    &H80, &H81, &H82, &H83, &H84, &HA, &H17, &H1B, &H88, &H89, &H8A, &H8B, &H8C, &H5, &H6, &H7, _
    &H90, &H91, &H16, &H93, &H94, &H95, &H96, &H4, &H98, &H99, &H9A, &H9B, &H14, &H15, &H9E, &H1A, _
    &H20, &HA0, &HA1, &HA2, &HA3, &HA4, &HA5, &HA6, &HA7, &HA8, &H5B, &H2E, &H3C, &H28, &H2B, &H21, _
    &H26, &HA9, &HAA, &HAB, &HAC, &HAD, &HAE, &HAF, &HB0, &HB1, &H5D, &H24, &H2A, &H29, &H3B, &H5E, _
    &H2D, &H2F, &HB2, &HB3, &HB4, &HB5, &HB6, &HB7, &HB8, &HB9, &H7C, &H2C, &H25, &H5F, &H3E, &H3F, _
    &HBA, &HBB, &HBC, &HBD, &HBE, &HBF, &HC0, &HC1, &HC2, &H60, &H3A, &H23, &H40, &H27, &H3D, &H22, _
    &HC3, &H61, &H62, &H63, &H64, &H65, &H66, &H67, &H68, &H69, &HC4, &HC5, &HC6, &HC7, &HC8, &HC9, _
    &HCA, &H6A, &H6B, &H6C, &H6D, &H6E, &H6F, &H70, &H71, &H72, &HCB, &HCC, &HCD, &HCE, &HCF, &HD0, _
    &HD1, &H7E, &H73, &H74, &H75, &H76, &H77, &H78, &H79, &H7A, &HD2, &HD3, &HD4, &HD5, &HD6, &HD7, _
    &HD8, &HD9, &HDA, &HDB, &HDC, &HDD, &HDE, &HDF, &HE0, &HE1, &HE2, &HE3, &HE4, &HE5, &HE6, &HE7, _
    &H7B, &H41, &H42, &H43, &H44, &H45, &H46, &H47, &H48, &H49, &HE8, &HE9, &HEA, &HEB, &HEC, &HED, _
    &H7D, &H4A, &H4B, &H4C, &H4D, &H4E, &H4F, &H50, &H51, &H52, &HEE, &HEF, &HF0, &HF1, &HF2, &HF3, _
    &H5C, &H9F, &H53, &H54, &H55, &H56, &H57, &H58, &H59, &H5A, &HF4, &HF5, &HF6, &HF7, &HF8, &HF9, _
    &H30, &H31, &H32, &H33, &H34, &H35, &H36, &H37, &H38, &H39, &HFA, &HFB, &HFC, &HFD, &HFE, &HFF)
    bufferlen = Len(buffer)
    For i = 1 To bufferlen
      Result = Result & Chr(ebcdic(Asc(Mid(buffer, i, 1))))
    Next
    ebcdic_to_ascii = Result
End Function

Swi
 
Sort by date Sort by votes
So, I input "Bob Rodes" into your function and get "¡?²€ª?´µ½" as a return. Looks ok to me! :) Seriously, what should it be?

Bob
 
Upvote 0 Downvote
It works fine here. Pass it Chr(200) & Chr(133) & Chr(147) & Chr(147) & Chr(150) and it quite happily returns "Hello", which is what I'd expect. I'd suspect that you are trying to pass in a genuine EBCDIC string rather than a Unicoded version ...

Mind you we can use an API call to do almost all this work in one go ...
 
Upvote 0 Downvote
Yes, I am trying to pass a genuine EBCDIC string to the funtion. It seems as if I have the wrong code page. I will have to talk with my mainframe gurus to see what code page we are using. I am however interested in the API method. Please elaborate. Thanks.

Swi
 
Upvote 0 Downvote
No, you don't have the wrong code page (although code pages do lie at the heart of the API solution). You just have a function that does not explain what it is expecting as an input parameter.

Here's the API version that does exactly the same as the function already given (and similarly expects a Unicoded EBCDIC input string). It is a little longer than it might be because it has to convert the Unicode string that represents the EBCDIC characters down into a genuine EBCDIC string buffered in byte array:
Code: 
[blue]
Option Explicit

Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, lpMultiByteStr As Any, ByVal cchMultiByte As Long, lpWideCharStr As Any, ByVal cchWideChar As Long) As Long
                               
Const CP_EBCDIC = 875

Private Function etoa(strSource As String) As String
    Dim buffer() As Byte
    Dim buffer2() As Byte
    Dim lLenb As Long
    
    ReDim buffer(Len(strSource) - 1)
    ReDim buffer2(LenB(strSource) - 1)
    lLenb = LenB(strSource) - 1
    buffer = StrConv(strSource, vbFromUnicode)
    MultiByteToWideChar CP_EBCDIC, 0&, buffer(0), -1, buffer2(0), lLenb
    etoa = buffer2
End Function[/blue]

And here's a simple illustrative example that converts a VB string into EBCDIC in a buffer and then converts that EBCDIC back into a VB string:
Code: 
[blue]Option Explicit

Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, lpWideCharStr As Any, ByVal cchWideChar As Long, lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As Long
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, lpMultiByteStr As Any, ByVal cchMultiByte As Long, lpWideCharStr As Any, ByVal cchWideChar As Long) As Long
                               
Const CP_EBCDIC = 875

Private Sub Command1_Click()
    Dim buffer() As Byte
    Dim buffer2() As Byte
    Dim strSource As String
    Dim strResult As String
    Dim lLenb As Long
    Dim lret As Long
    
    strSource = "Hello" [green]' Here's our apparant ANSI source (actually Unicode under the covers)[/green]
    
    lLenb = Len(strSource)
    [green]' Prepare buffers for this example[/green]
    ReDim buffer(lLenb - 1)
    ReDim buffer2(lLenb * 2 - 1)

    [green]' OK - convert our Unicode string to EBCDIC merely so that we have a legit EBCDIC source
    ' so we can demonstrate a single API call to convert EBCDIC to Unicode, which VB happily
    ' converts back to ANSI ...[/green]
    lret = WideCharToMultiByte(CP_EBCDIC, 0&, ByVal StrPtr(strSource), -1, buffer(0), lLenb, 0&, 0&)
      
    [green]' at this point Buffer contains an EBCDIC string
    ' so now we feed it into our EBCDIC decoder ...[/green]
    lret = MultiByteToWideChar(CP_EBCDIC, 0&, buffer(0), -1, buffer2(0), lLenb)
    strResult = buffer2
    
    MsgBox strSource & ", " & strResult [green]' These should be the same if our converter has worked properly[/green]
End Sub[/blue]
 
Upvote 0 Downvote
Thanks. I will give it a try when I get to work. Thanks.

Swi
 
Upvote 0 Downvote
strongm,

Thanks for the solution, it works when I changed the code page to 37. Much appreciated. Two questions. Is there any way to get around iterating through the byte array to produce the EBCDIC string? Also, I have heard that .NET may have some trouble with API's. Is this true? I may want to port this over when I get some time. Thanks.

Code: 
Option Explicit
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, lpWideCharStr As Any, ByVal cchWideChar As Long, lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As Long
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, lpMultiByteStr As Any, ByVal cchMultiByte As Long, lpWideCharStr As Any, ByVal cchWideChar As Long) As Long
Const CP_EBCDIC = 37

Private Function etoa(strSource As String) As String
    Dim buffer() As Byte
    Dim buffer2() As Byte
    Dim lLenb As Long
    
    ReDim buffer(Len(strSource) - 1)
    ReDim buffer2(LenB(strSource) - 1)
    lLenb = LenB(strSource) - 1
    buffer = StrConv(strSource, vbFromUnicode)
    MultiByteToWideChar CP_EBCDIC, 0&, buffer(0), -1, buffer2(0), lLenb
    etoa = buffer2
End Function

Private Function atoe(strSource As String) As String
    Dim buffer() As Byte
    Dim buffer2() As Byte
    Dim lLenb As Long
    Dim x As Integer
    
    lLenb = Len(strSource)
    ReDim buffer(lLenb - 1)
    ReDim buffer2(lLenb * 2 - 1)
    WideCharToMultiByte CP_EBCDIC, 0&, ByVal StrPtr(strSource), -1, buffer(0), lLenb, 0&, 0&
    [b]
    For x = 0 To UBound(buffer)
        atoe = atoe & Chr$(buffer(x))
    Next
    [/b]
End Function

Private Sub Command1_Click()
    MsgBox etoa("ÈQƒ£–™")
    MsgBox atoe("Héctor")
End Sub

Swi
 
Upvote 0 Downvote
Here was the solution that I was working on yesterday. It is quite a bit more code. It came from Microsoft.


Code: 
Private Sub Command1_Click()
Dim fso As New FileSystemObject
Dim InStream As TextStream
Dim OutStream As TextStream
Dim InputData As String
Dim sASCII As String
Dim sEBCDIC As String
Dim xlat As String
Dim Counter As Long

Set InStream = fso.OpenTextFile("P:\HDSIN\89571\77777A.TXT", ForReading)
Set OutStream = fso.OpenTextFile("P:\HDSI\89571\77777E2.TXT", ForWriting, True)
xlat = ASCII_To_EBCDIC_Table()
'xlat = EBCDIC_To_ASCII_Table()

Do
    sASCII = InStream.Read(730)
    Counter = Counter + 1
    If Counter Mod 1733 = 0 Then
        lblCounter.Caption = "COUNT = " & CStr(Counter)
        DoEvents
    End If
    sEBCDIC = Translate(Left(sASCII, 728), xlat)
    OutStream.Write sEBCDIC
Loop Until InStream.AtEndOfStream

lblCounter.Caption = "COUNT = " & CStr(Counter)
DoEvents
InStream.Close
OutStream.Close
Set InStream = Nothing
Set OutStream = Nothing
Set fso = Nothing
MsgBox "Done!", vbInformation

End Sub


Function Translate(ByVal InText As String, xlatTable As String) As String
'
' Uses a translation table to map InText from one character set to another.
'
Dim Temp As String, I As Long
Temp = Space$(Len(InText))
  For I = 1 To Len(InText)
    Mid$(Temp, I, 1) = Mid$(xlatTable, Asc(Mid$(InText, I, 1)) + 1, 1)
  Next I
  Translate = Temp
End Function

Function ASCII_To_EBCDIC_Table() As String
'
' Returns the following table as a string for use by the Translate
' function to translate an EBCDIC string to an ASCII-ISO/ANSI string.
'
' **************************************************************************
' FROM MICROSOFT
' **************************************************************************
' 00 01 02 03 37 2D 2E 2F 16 05 25 0B 0C 0D 0E 0F
' 10 11 12 13 3C 3D 32 26 18 19 3F 27 1C 1D 1E 1F
' 40 5A 7F 7B 5B 6C 50 7D 4D 5D 5C 4E 6B 60 4B 61
' F0 F1 F2 F3 F4 F5 F6 F7 F8 F9 7A 5E 4C 7E 6E 6F
' 7C C1 C2 C3 C4 C5 C6 C7 C8 C9 D1 D2 D3 D4 D5 D6
' D7 D8 D9 E2 E3 E4 E5 E6 E7 E8 E9 AD E0 BD 5F 6D
' 79 81 82 83 84 85 86 87 88 89 91 92 93 94 95 96
' 97 98 99 A2 A3 A4 A5 A6 A7 A8 A9 C0 4F D0 A1 07
' 20 21 22 23 24 15 06 17 28 29 2A 2B 2C 09 0A 1B
' 30 31 1A 33 34 35 36 08 38 39 3A 3B 04 14 3E E1
' 41 42 43 44 45 46 47 48 49 51 52 53 54 55 56 57
' 58 59 62 63 64 65 66 67 68 69 70 71 72 73 74 75
' 76 77 78 80 8A 8B 8C 8D 8E 8F 90 9A 9B 9C 9D 9E
' 9F A0 AA AB AC 4A AE AF B0 B1 B2 B3 B4 B5 B6 B7
' B8 B9 BA BB BC 6A BE BF CA CB CC CD CE CF DA dB
' DC DD DE DF EA EB EC ED EE EF FA FB FC FD FE FF
' **************************************************************************

'00 01 02 03 37 2D 2E 2F 16 05 25 0B 0C 0D 0E 0F
'10 11 12 13 3C 3D 32 26 18 19 3F 27 1C 1D 1E 1F
'40 5A 7F 7B 5B 6C 50 7D 4D 5D 5C 4E 6B 60 4B 61
'F0 F1 F2 F3 F4 F5 F6 F7 F8 F9 7A 5E 4C 7E 6E 6F
'7C C1 C2 C3 C4 C5 C6 C7 C8 C9 D1 D2 D3 D4 D5 D6
'D7 D8 D9 E2 E3 E4 E5 E6 E7 E8 E9 BA E0 BB B0 6D
'79 81 82 83 84 85 86 87 88 89 91 92 93 94 95 96
'97 98 99 A2 A3 A4 A5 A6 A7 A8 A9 C0 4F D0 A1 07
'68 DC 51 42 43 44 47 48 52 53 54 57 56 58 63 67
'71 9C 9E CB CC CD DB DD DF EC FC 70 B1 80 BF FF
'45 55 CE DE 49 69 9A 9B AB AF 5F B8 B7 AA 8A 8B
'2B 2C 09 21 28 65 62 64 B4 38 31 34 33 4A B2 24
'22 17 29 06 20 2A 46 66 1A 35 08 39 36 30 3A 9F
'8C AC 72 73 74 0A 75 76 77 23 15 14 04 6A 78 3B
'EE 59 EB ED CF EF A0 8E AE FE FB FD 8D AD BC BE
'CA 8F 1B B9 B6 B5 E1 9D 90 BD B3 DA FA EA 3E 41

' **************************************************************************
' FROM MICROSOFT
' **************************************************************************
'  ASCII_To_EBCDIC_Table = _
  HexToStr("00010203372D2E2F1605250B0C0D0E0F101112133C3D322618193F271C1D1E1F") & _
  HexToStr("405A7F7B5B6C507D4D5D5C4E6B604B61F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F") & _
  HexToStr("7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6D7D8D9E2E3E4E5E6E7E8E9ADE0BD5F6D") & _
  HexToStr("79818283848586878889919293949596979899A2A3A4A5A6A7A8A9C04FD0A107") & _
  HexToStr("202122232415061728292A2B2C090A1B30311A333435360838393A3B04143EE1") & _
  HexToStr("4142434445464748495152535455565758596263646566676869707172737475") & _
  HexToStr("767778808A8B8C8D8E8F909A9B9C9D9E9FA0AAABAC4AAEAFB0B1B2B3B4B5B6B7") & _
  HexToStr("B8B9BABBBC6ABEBFCACBCCCDCECFDADBDCDDDEDFEAEBECEDEEEFFAFBFCFDFEFF")
' **************************************************************************

  ASCII_To_EBCDIC_Table = _
  HexToStr("00010203372D2E2F1605250B0C0D0E0F101112133C3D322618193F271C1D1E1F") & _
  HexToStr("405A7F7B5B6C507D4D5D5C4E6B604B61F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F") & _
  HexToStr("7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6D7D8D9E2E3E4E5E6E7E8E9BAE0BBB06D") & _
  HexToStr("79818283848586878889919293949596979899A2A3A4A5A6A7A8A9C04FD0A107") & _
  HexToStr("68DC5142434447485253545756586367719C9ECBCCCDDBDDDFECFC70B180BFFF") & _
  HexToStr("4555CEDE49699A9BABAF5FB8B7AA8A8B2B2C092128656264B4383134334AB224") & _
  HexToStr("22172906202A46661A35083936303A9F8CAC7273740A757677231514046A783B") & _
  HexToStr("EE59EBEDCFEFA08EAEFEFBFD8DADBCBECA8F1BB9B6B5E19D90BDB3DAFAEA3E41")
End Function

Function EBCDIC_To_ASCII_Table() As String
'
' Returns the following table as a string for use by the Translate
' function to traslate an EBCDIC string to an ASCII-ISO/ANSI string.
'
' **************************************************************************
' FROM MICROSOFT
' **************************************************************************
' 00 01 02 03 9C 09 86 7F 97 8D 8E 0B 0C 0D 0E 0F    ....œ.†-?Ž.....
' 10 11 12 13 9D 85 08 87 18 19 92 8F 1C 1D 1E 1F    ....?....‡..'?....
' 80 81 82 83 84 0A 17 1B 88 89 8A 8B 8C 05 06 07    €?‚ƒ"...ˆ‰Š‹Œ...
' 90 91 16 93 94 95 96 04 98 99 9A 9B 14 15 9E 1A    ?'.""•-.˜(tm)š›..ž.
' 20 A0 A1 A2 A3 A4 A5 A6 A7 A8 D5 2E 3C 28 2B 7C    . ¡¢£¤¥¦§...<(+|
' 26 A9 AA AB AC AD AE AF B0 B1 21 24 2A 29 3B 5E    &(c)ª"¬­(r)¯°±!$*);^
' 2D 2F B2 B3 B4 B5 B6 B7 B8 B9 E5 2C 25 5F 3E 3F    -/²³´µ¶·¸¹.,%_>?
' BA BB BC BD BE BF C0 C1 C2 60 3A 23 40 27 3D 22    º"1/41/23/4¿...`:#@'="
' C3 61 62 63 64 65 66 67 68 69 C4 C5 C6 C7 C8 C9    .abcdefghi......
' CA 6A 6B 6C 6D 6E 6F 70 71 72 CB CC CD CE CF D0    .jklmnopqr......
' D1 7E 73 74 75 76 77 78 79 7A D2 D3 D4 5B D6 D7    .~stuvwxyz...[..
' D8 D9 DA DB DC DD DE DF E0 E1 E2 E3 E4 5D E6 E7    .............]..
' 7B 41 42 43 44 45 46 47 48 49 E8 E9 EA EB EC ED    {ABCDEFGHI......
' 7D 4A 4B 4C 4D 4E 4F 50 51 52 EE EF F0 F1 F2 F3    }JKLMNOPQR......
' 5C 9F 53 54 55 56 57 58 59 5A F4 F5 F6 F7 F8 F9    \.STUVWXYZ......
' 30 31 32 33 34 35 36 37 38 39 FA FB FC FD FE FF    0123456789......
' **************************************************************************

' 00 01 02 03 DC 09 C3 7F CA B2 D5 0B 0C 0D 0E 0F
' 10 11 12 13 DB DA 08 C1 18 19 C8 F2 1C 1D 1E 1F
' C4 B3 C0 D9 BF 0A 17 1B B4 C2 C5 B0 B1 05 06 07
' CD BA 16 BC BB C9 CC 04 B9 CB CE DF 14 15 FE 1A
' 20 FF 83 84 85 A0 C6 86 87 A4 BD 2E 3C 28 2B 7C
' 26 82 88 89 8A A1 8C 8B 8D E1 21 24 2A 29 3B AA
' 2D 2F B6 8E B7 B5 C7 8F 80 A5 DD 2C 25 5F 3E 3F
' 9B 90 D2 D3 D4 D6 D7 D8 DE 60 3A 23 40 27 3D 22
' 9D 61 62 63 64 65 66 67 68 69 AE AF D0 EC E7 F1
' F8 6A 6B 6C 6D 6E 6F 70 71 72 A6 A7 91 F7 92 CF
' E6 7E 73 74 75 76 77 78 79 7A AD A8 D1 ED E8 A9
' 5E 9C BE FA B8 F5 F4 AC AB F3 5B 5D EE F9 EF 9E
' 7B 41 42 43 44 45 46 47 48 49 F0 93 94 95 A2 E4
' 7D 4A 4B 4C 4D 4E 4F 50 51 52 FB 96 81 97 A3 98
' 5C F6 53 54 55 56 57 58 59 5A FD E2 99 E3 E0 E5
' 30 31 32 33 34 35 36 37 38 39 FC EA 9A EB E9 9F

' **************************************************************************
' FROM MICROSOFT
' **************************************************************************
'  EBCDIC_To_ASCII_Table = _
  HexToStr("000102039C09867F978D8E0B0C0D0E0F101112139D8508871819928F1C1D1E1F") & _
  HexToStr("80818283840A171B88898A8B8C050607909116939495960498999A9B14159E1A") & _
  HexToStr("20A0A1A2A3A4A5A6A7A8D52E3C282B7C26A9AAABACADAEAFB0B121242A293B5E") & _
  HexToStr("2D2FB2B3B4B5B6B7B8B9E52C255F3E3FBABBBCBDBEBFC0C1C2603A2340273D22") & _
  HexToStr("C3616263646566676869C4C5C6C7C8C9CA6A6B6C6D6E6F707172CBCCCDCECFD0") & _
  HexToStr("D17E737475767778797AD2D3D45BD6D7D8D9DADBDCDDDEDFE0E1E2E3E45DE6E7") & _
  HexToStr("7B414243444546474849E8E9EAEBECED7D4A4B4C4D4E4F505152EEEFF0F1F2F3") & _
  HexToStr("5C9F535455565758595AF4F5F6F7F8F930313233343536373839FAFBFCFDFEFF")
' **************************************************************************

  EBCDIC_To_ASCII_Table = _
  HexToStr("00010203DC09C37FCAB2D50B0C0D0E0F10111213DBDA08C11819C8F21C1D1E1F") & _
  HexToStr("C4B3C0D9BF0A171BB4C2C5B0B1050607CDBA16BCBBC9CC04B9CBCEDF1415FE1A") & _
  HexToStr("20FF838485A0C68687A4BD2E3C282B7C268288898AA18C8B8DE121242A293BAA") & _
  HexToStr("2D2FB68EB7B5C78F80A5DD2C255F3E3F9B90D2D3D4D6D7D8DE603A2340273D22") & _
  HexToStr("9D616263646566676869AEAFD0ECE7F1F86A6B6C6D6E6F707172A6A791F792CF") & _
  HexToStr("E67E737475767778797AADA8D1EDE8A95E9CBEFAB8F5F4ACABF35B5DEEF9EF9E") & _
  HexToStr("7B414243444546474849F0939495A2E47D4A4B4C4D4E4F505152FB968197A398") & _
  HexToStr("5CF6535455565758595AFDE299E3E0E530313233343536373839FCEA9AEBE99F")
End Function

Function HexToStr(ByVal HexStr As String) 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
  HexToStr = Temp
End Function

Swi
 
Upvote 0 Downvote
>Is there any way to get around iterating through the byte array to produce the EBCDIC string?

Sure. In your atoe function that would be

atoe = strconv(buffer, vbUnicode)

As for the Microsoft example - well, if you really want to do it the hard way ...
 
Upvote 0 Downvote
Thanks. No, I agree, the Microsoft example is definitely the hard way. Thanks for the thorough example. Much appreciated.

Swi
 
Upvote 0 Downvote
Sometimes when doing the EBCDIC to ASCII conversion I get the following error and the program bombs.

The instruction at "0x7c93426d" referenced memory at "0xf2009a9a". The memory could not be "read".

Any ideas?

Code: 
  Set InStream = fso.OpenTextFile(txtInputFilename.Text, ForReading)
  Set OutStream = fso.OpenTextFile(txtOutputFilename.Text, ForWriting, True)
  cntr = 0
  lblNumRecs = "of " & (fso.GetFile(txtInputFilename.Text).Size / RecordSize)
  DoEvents
  Do
    InputData = InStream.Read(RecordSize)
    cntr = cntr + 1
    If optA2E Then
      InputData = atoe(Left(InputData, RecordSize))
    Else
      InputData = etoa(Left(InputData, RecordSize))
    End If
    OutStream.Write (InputData)
    If cntr Mod 1733 = 0 Then
      lblRecsDone.Caption = CStr(cntr)
      DoEvents
    End If
  Loop Until InStream.AtEndOfStream
  lblRecsDone.Caption = CStr(cntr)
  DoEvents
  MsgBox "Conversion Complete!", vbInformation + vbOKOnly
  InStream.Close
  OutStream.Close
  Set InStream = Nothing
  Set OutStream = Nothing
  Set fso = Nothing

Private Function etoa(strSource As String) As String
    Dim buffer() As Byte
    Dim buffer2() As Byte
    Dim lLenb As Long
    
    ReDim buffer(Len(strSource) - 1)
    ReDim buffer2(LenB(strSource) - 1)
    lLenb = LenB(strSource) - 1
    buffer = StrConv(strSource, vbFromUnicode)
    MultiByteToWideChar CP_EBCDIC, 0&, buffer(0), -1, buffer2(0), lLenb
    etoa = buffer2
End Function

Private Function atoe(strSource As String) As String
    Dim buffer() As Byte
    Dim buffer2() As Byte
    Dim lLenb As Long
    Dim x As Integer
    
    lLenb = Len(strSource)
    ReDim buffer(lLenb - 1)
    ReDim buffer2(lLenb * 2 - 1)
    WideCharToMultiByte CP_EBCDIC, 0&, ByVal StrPtr(strSource), -1, buffer(0), lLenb, 0&, 0&
    atoe = StrConv(buffer, vbUnicode)
End Function

Swi
 
Upvote 0 Downvote
strongm,

Might this error be happening because of a buffer overrun?

Swi
 
Upvote 0 Downvote
Sorry - haven't really had the chance to look at this. Given that we are copying data from one place to another outside of the safety systems normally imposed by VB then I'd say yes, the problem is almost certainly a buffer overflow
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

sal21
  • Question
how to send SMS via free API or other service
Replies
2
Views
181
strongm
strongm
2009luca
  • Locked
difficult to crteate a query very complicated 1
Replies
9
Views
982
Andrzejek
Andrzejek
2009luca
  • Locked
  • Question
USE find instead to loop
Replies
2
Views
255
Andrzejek
Andrzejek
marty1944
  • Locked
  • Question
error code 380 when trying to run the visual basic v6 deployment wizard
Replies
1
Views
498
marty1944
marty1944
sal21
  • Locked
  • Question
how to read the coordinates in from this file
Replies
3
Views
272
Ken01
Ken01

Part and Inventory Search

Sponsor

Back
Top