[RESOLVED] Convert Hex String to a normal String

[cc2^^]

my goal here is to make a function that should convert this string "48 45 6C 6C 6F" into this string "Hello".

All i know is that Hex() converts a number into hex but i want to do vice versa.

Help is always appreciated!

[Chris001]

Private Sub Command1_Click()
    MsgBox HexToString("48 45 6C 6C 6F")
End Sub
 
Private Function HexToString(ByVal HexData As String) As String
    Dim Buffer As String
    Dim i As Long
 
    Do While InStr(HexData, " ")
        HexData = Replace(HexData, " ", vbNullString)
    Loop
 
    If Len(HexData) Mod 2 <> 0 Then
        HexToString = vbNullString
    Else
        For i = 1 To Len(HexData) - 1 Step 2
            Buffer = Buffer & Chr("&H" & Mid(HexData, i, 2))
        Next i
        HexToString = Buffer
    End If
End Function

[Merri]

Dim I As Long, strChr() As String, strResult As String
strChr = Split("48 45 6C 6C 6F")
For I = 0 To UBound(strChr)
    strResult = strResult & Chr$("&H" & strChr(i))
Next

This isn't very fast though, but hex strings aren't often very useful so...

A better method would be to have the hex string without extra spaces ("48456C6C6F"), which would make it very easy to calculate the final length of the output string. You can also work within that string:

Dim I As Long, strHex As String
strHex = "48456C6C6F"
For I = 0 To Len(strHex) \ 2 - 1
    Mid$(strHex, I + 1, 1) = Chr$("&H" & Mid$(strHex, I * 2 + 1, 2))
Next
strHex = Left$(strHex, I)

Being much faster than first code sample this still leaves one bottleneck: Chr$ and string concatenated conversion from hex string to Integer.

Edit!
As a function:

Public Function HexANSIToStringShort(Hex As String) As String
    Dim I As Long, strHex As String
    strHex = Replace(Hex, " ", vbNullString)
    For I = 0 To Len(strHex) \ 2 - 1
        Mid$(strHex, I + 1, 1) = Chr$("&H" & Mid$(strHex, I * 2 + 1, 2))
    Next
    HexANSIToStringShort = Left$(strHex, I)
End Function

[dilettante]

So maybe:

Private Function HexANSIToString(ByVal HexANSI As String) As String
    Dim bytANSI() As Byte
    Dim lngHexPos As Long
    Dim lngHex As Long
    Dim blnValidHex As Boolean
    Dim lngNibblePos As Long
    Dim lngBytePos As Long
    
    HexANSI = UCase$(HexANSI)
    ReDim bytANSI(Len(HexANSI) \ 2)
    For lngHexPos = 1 To Len(HexANSI)
        lngHex = AscW(Mid$(HexANSI, lngHexPos, 1))
        Select Case lngHex
            Case &H20
                'Skip
            Case &H30 To &H39
                lngHex = lngHex - &H30
                blnValidHex = True
            Case &H41 To &H46
                lngHex = lngHex - &H37
                blnValidHex = True
            Case Else
                Err.Raise 5 'Invalid procedure call or argument
        End Select
        If blnValidHex Then
            lngBytePos = lngNibblePos \ 2
            bytANSI(lngBytePos) = bytANSI(lngBytePos) * &H10 Or lngHex
            lngNibblePos = lngNibblePos + 1
            blnValidHex = False
        End If
    Next
    HexANSIToString = StrConv(LeftB$(bytANSI, lngBytePos + 1), vbUnicode)
End Function

Works with or without embedded spaces.

[Merri]

I updated my last post (added code as a function). I also made some benchmarking: HexANSIToStringShort is roughly 2.5 times the speed of HexANSIToString (when compiled). I think that is quite well for such a short code.

Then again... I had some brain idle time before I have to start packing my stuff (I'm moving today) so:

Option Explicit

Private Declare Function ArrayPtr Lib "msvbvm60" Alias "VarPtr" (Arr() As Any) As Long
Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Ptr As Long, ByVal Value As Long)

Public Function HexANSIToStringFast(ByVal Hex As String) As String
    Dim Char() As Byte, Header(5) As Long, Ptr As Long
    Dim I As Long, J As Long, K As Long
    Static Table(255) As Byte, Valid(255) As Boolean
    ' table from characters "0123456789", "ABCDEF", "abcdef" to their numeric values (0 - 15)
    If Not Valid(48) Then
        For I = 0 To 9
            Table(48 + I) = I
            Valid(48 + I) = True
        Next
        For I = 10 To 15
            Table(55 + I) = I
            Valid(55 + I) = True
            Table(87 + I) = I
            Valid(87 + I) = True
        Next
    End If
    ' create a custom safearray header
    ' 0 = dimensions, 1 = bytes per item, 3 = pointer to data, 4 = number of items
    Header(0) = 1: Header(1) = 1: Header(3) = StrPtr(Hex): Header(4) = LenB(Hex)
    ' make Char use our safearray header (ie. Char = Hex)
    Ptr = ArrayPtr(Char): PutMem4 Ptr, VarPtr(Header(0))
    ' and now create final string
    For I = 0 To Header(4) - 4 Step 4
        ' is the next character a space?
        If Not (Char(I + 1) = 0 And Char(I) = 32) Then
            ' validate character
            If Char(I + 1) = 0 And Char(I + 3) = 0 And Valid(Char(I)) And Valid(Char(I + 2)) Then
                ' add it in
                Char(J) = Table(Char(I)) * 16 Or Table(Char(I + 2))
                J = J + 1
            Else
                ' invalid character!
                J = 0
                Exit For
            End If
        Else
            ' skip spaces
            For K = I + 2 To Header(4) - 4 Step 2
                If Not (Char(K + 1) = 0 And Char(K) = 32) Then Exit For
            Next
            ' For loop increases at the end of loop by 4, work around this
            I = K - 4
        End If
    Next I
    ' make Char no longer hold any header
    PutMem4 Ptr, 0
    If J Then
        ' output, do ANSI -> Unicode
        HexANSIToStringFast = StrConv(LeftB$(Hex, J), vbUnicode)
    Else
        ' invalid procedure call or argument
        Err.Raise 5
    End If
End Function

This is ~38 times faster than HexANSIToStringShort and ~16 times faster than HexANSIToString Despite the speediness it has the same perfect validation for invalid data as HexANSIToString.

[FireXtol]

Here's a highly optimized hex to asc function I wrote(that relies on no doping), though it expects fixed-length, non-delimited input(like: 0102030405060708090A0B0C0D0E0F), and it also expects all letters to be uppercase(which is fairly normal).

The main performance benefits stem from avoiding any string functions during the actual conversion process(inside the loop), which is restricted to arrays and quick math ops. And it assumes you're passing a valid hex string. With a few more checks it could also check the validity.

Public Function HexToAsc(ByVal hstr As String) As String
Dim x As Long
Dim hBa() As Byte 'store the string as byte array
Dim hBv(1) As Byte 'store each hex character as its value
hBa = StrConv(hstr, vbFromUnicode)
ReDim nstr((UBound(hBa) + 1) / 2 - 1) As Byte
For x = 0 To UBound(hBa) - 1 Step 2
 
  hBv(0) = hBa(x)
  If hBv(0) < 65 Then
    hBv(0) = hBv(0) - 48
  Else
    hBv(0) = hBv(0) - 55
  End If
 
  hBv(1) = hBa(x + 1)
  If hBv(1) < 65 Then
    hBv(1) = hBv(1) - 48
  Else
    hBv(1) = hBv(1) - 55
  End If
 
  nstr(x / 2) = hBv(0) * 16 + hBv(1) 'bit shift and add
Next
HexToAsc = StrConv(nstr, vbUnicode)
End Function

A LUT could offer even more speed. Taking hstr byRef makes it slightly faster, of course.

Though, Merri's 'FastString' version is about 2x faster than this.

[Merri]

The main speed for my function relies on avoiding memory copy: ie. I could have simply done Char = Hex, but this would have made a new byte array which I did not want. So, instead I added two API calls to allow pointing Char to the existing Hex string. All the validation code makes the function a little slower. Despite this it is two times faster than HexToAsc.

If I remove all validation and space character handling (edit! includes space character handling):

Public Function HexANSIToStringFast2(ByVal Hex As String) As String
    Dim Char() As Byte, Header(0 To 5) As Long, Ptr As Long
    Dim B As Byte, I As Long, J As Long, S As Long, TL(0 To 255) As Byte, TU(0 To 255) As Byte
    For B = 49 To 57: TL(B) = B - 48: TU(B) = TL(B) * 16: Next
    For B = 65 To 70: TL(B) = B - 55: TU(B) = TL(B) * 16: TL(B + 32) = TL(B): TU(B + 32) = TU(B): Next
    Header(0) = 1: Header(1) = 1: Header(3) = StrPtr(Hex): Header(4) = LenB(Hex)
    Ptr = ArrayPtr(Char): PutMem4 Ptr, VarPtr(Header(0))
    If Char(4) <> 32 Then S = 4 Else S = 6
    For I = 0 To Header(4) - 4 Step S
        Char(J) = TU(Char(I)) Or TL(Char(I + 2))
        J = J + 1
    Next I
    PutMem4 Ptr, 0
    If J Then
        HexANSIToStringFast2 = StrConv(LeftB$(Hex, J), vbUnicode)
    Else
        Err.Raise 5
    End If
End Function

It gains a considerable amount of more speed: this works just like HexToAsc, but runs 3.5 times faster.


Update!
Project updated with fixed versions.

[FireXtol]

Merri pointed out some things I'd overlooked, here's a 33% faster version. Most notably to the performance is the use of Integer division(\ instead of float div: /). Merri's code is still faster(at least 10-20%, compared to his first to my LUT version, and around 60% using his optimized for raw speed version). StrConv is considered an expensive function.

Public Function HexToAsc(hstr As String) As String
    Dim X As Long
    Dim hBa() As Byte 'store the string as byte array
    Dim hBv(1) As Byte 'store each hex character as its value
    hBa = StrConv(hstr, vbFromUnicode)
    ReDim nstr((UBound(hBa) + 1) \ 2 - 1) As Byte
    For X = 0 To UBound(hBa) - 1 Step 2
    
      hBv(0) = hBa(X)
      If hBv(0) < 65 Then
        hBv(0) = hBv(0) - 48
      Else
        hBv(0) = hBv(0) - 55
      End If
    
      hBv(1) = hBa(X + 1)
      If hBv(1) < 65 Then
        hBv(1) = hBv(1) - 48
      Else
        hBv(1) = hBv(1) - 55
      End If
    
      nstr(X \ 2) = hBv(0) * 16 + hBv(1) 'bit shift and add
    Next
    HexToAsc = StrConv(nstr, vbUnicode)
End Function
 
'and since Merri provided such a fine LUT.... a further 20% boost, and it now handles lowercase letters
 
Public Function HexToAscLUT(hstr As String) As String
    Dim X As Long
    Dim hBa() As Byte 'store the string as byte array
    Dim hBv(1) As Byte 'store each hex character as its value
    Dim I As Long
    
    Static Table(255) As Byte
    ' table from characters "0123456789", "ABCDEF", "abcdef" to their numeric values (0 - 15)
    If Table(49) = 0 Then
        For I = 1 To 9: Table(48 + I) = I: Next
        For I = 10 To 15: Table(55 + I) = I: Table(87 + I) = I: Next
    End If
    'thanks for the LUT, Merri :)
    
    hBa = StrConv(hstr, vbFromUnicode)
    ReDim nstr((UBound(hBa) + 1) \ 2 - 1) As Byte
    For X = 0 To UBound(hBa) - 1 Step 2
      nstr(X \ 2) = Table(hBa(X)) * 16 + Table(hBa(X + 1)) 'bit shift and add
    Next
    HexToAscLUT = StrConv(nstr, vbUnicode)
End Function

Thanks Merri.

[Merri]

StrConv in itself isn't slow... but you can limit the amount of calls into it. Simply remove the first StrConv and adjust the rest of your calculation to match it -> a lot more speed. Also Dim hBv(1) As Byte doesn't need to be an array: if you use two variables instead you again get more speed.


Updated!
This function now fully validates given input. It also allows any invalid character from range 0 to 127 to work as a separator that gets ignored. The formatting can be anything as long as two consecutive characters make up a valid hex pair.

Option Explicit

Private Declare Function ArrayPtr Lib "msvbvm60" Alias "VarPtr" (Arr() As Any) As Long
Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Ptr As Long, ByVal Value As Long)

Public Function HexANSIToStringFast3(ByVal Hex As String) As String
    Dim Char() As Byte, Header(0 To 5) As Long, Ptr As Long
    Dim B As Byte, I As Long, J As Long, TL(0 To 255) As Byte, TU(0 To 255) As Byte, TI(0 To 255) As Byte
    For I = 0 To 127: TI(I) = 1: Next I
    For I = I To 255: TI(I) = 2: Next I
    For B = 48 To 57: TL(B) = B - 48: TU(B) = TL(B) * 16: TI(B) = 0: Next
    For B = 65 To 70: TL(B) = B - 55: TU(B) = TL(B) * 16: TL(B + 32) = TL(B): TU(B + 32) = TU(B): TI(B) = 0: TI(B + 32) = 0: Next
    Header(0) = 1: Header(1) = 1: Header(3) = StrPtr(Hex): Header(4) = LenB(Hex)
    Ptr = ArrayPtr(Char): PutMem4 Ptr, VarPtr(Header(0))
    For I = 0 To Header(4) - 4 Step 4
        B = TI(Char(I))
        If B = 0 Then
            Char(J) = TU(Char(I)) Or TL(Char(I + 2))
            J = J + 1
        ElseIf B = 1 Then
            I = I - 2
        Else
            J = 0
            Exit For
        End If
    Next I
    PutMem4 Ptr, 0
    If J Then
        HexANSIToStringFast3 = StrConv(LeftB$(Hex, J), vbUnicode)
    Else
        Err.Raise 5
    End If
End Function

Just to show what you can do:
Debug.Print HexANSIToStringFast3("[48] [45] [6c] - [6C] [6f]")

[anhn]

@ Merri, Not sure what I was missing but HexANSIToStringFast2() has something wrong when I try it.
This is my independent version, it is 5 times faster than HexANSIToStringFast().

Function QuickHex2Str(sHex As String) As String
    '-- Accepts input as "48 45 6C 6C 6F" or "48456C6C6F"
    Dim i As Long, j As Long, k As Long, n As Long
    Dim bh() As Byte, bs() As Byte
    Dim d1(48 To 102) As Byte
    Dim d2(48 To 102) As Byte
    
    n = Len(sHex): If n = 0 Then Exit Function
    bh = StrConv(sHex, vbFromUnicode)
    If bh(2) = 32 Then k = 3 Else k = 2
    ReDim bs(2 * ((1 + n) \ k) - 1)
    '------------------------------------------
    For i = 49 To 57
        d1(i) = i - 48
        d2(i) = 16 * d1(i)
    Next
    For i = 65 To 70
        d1(i) = i - 55:      d1(i + 32) = d1(i)
        d2(i) = 16 * d1(i):  d2(i + 32) = d2(i)
    Next
    '------------------------------------------
    For i = 0 To n - 1 Step k
        bs(j) = d2(bh(i)) + d1(bh(i + 1))
        j = j + 2
    Next
    QuickHex2Str = bs
End Function

[Merri]

anhn: you have to convert ANSI -> Unicode, because if you put 0 - 255 directly into a string as you do now the data gets corrupted when saving a string to binary file, or atleast it will cause some string comparison errors. This is because there are stooges where VB6 prefers giving a character code above 255 for some ANSI characters (and it doesn't matter which locale you have, and it varies between locales!). So you can't avoid StrConv in the end.

[FireXtol]

I decided to have my own go at some string hacking. You can get the wrapper here: http://www.xbeat.net/vbspeed/i_Dope.htm

(Scroll down, this is what you want

modSafeArray by Paul
wrapping tough string array hacks
modSafeArray_Paul.zip, 1.147 bytes, 20.10.01 11:05:12

Public Function HexToAsc(hstr As String) As String
    Static Table(255) As Byte
    Dim X As Long, I As Long
    Dim saHeader As SAFEARRAYHEADER
    Dim hBa() As Byte 'store the string as byte array
    ReDim nstr(Len(hstr) \ 2 - 1) As Byte
    
    ' table from characters "0123456789", "ABCDEF", "abcdef" to their numeric values (0 - 15)
    If Table(49) = 0 Then
        For I = 1 To 9: Table(48 + I) = I: Next
        For I = 10 To 15: Table(55 + I) = I: Table(87 + I) = I: Next
    End If
    
    RedimArray byteArray, LenB(hstr), saHeader, StrPtr(hstr), VarPtrArray(hBa)
 
    For X = 0 To LenB(hstr) - 3 Step 4
      nstr(X \ 4) = Table(hBa(X)) * 16 + Table(hBa(X + 2)) 'bit shift and add
    Next
    DestroyArray VarPtrArray(hBa)
    HexToAsc = StrConv(nstr, vbUnicode)
End Function

In my own tests it's now the fastest function here, but it could still be improved.

In case you're wondering about the results:

Name                 | Timings        
=========================================
HexANSIToString      = 439.07  ms = 21.1
HexANSIToStringFast2 = 29.21   ms = 1.404
HexANSIToStringFast3 = 32.8225 ms = 1.578
HexToAsc             = 20.8    ms = 1
QuickHex2Str         = 30.4775 ms = 1.465

Method:
Input = 1.5 million HEX characters, output = 750,000 ASC characters
Test was performed 4 times, and the mean taken.

[Merri]

I posted fixed & further optimized versions of HexANSIToStringFast2 and HexANSIToStringFast3.

HexANSIToStringFast2 had a small calculation error which placed results in the wrong place. I also added the same kind of space jump over support that anhn's function used. And it is faster than fixed version of anhn's function, which I think it is faster than the original:

Public Function QuickHex2Str(sHex As String) As String
    '-- Accepts input as "48 45 6C 6C 6F" or "48456C6C6F"
    Dim I As Long, J As Long, k As Long, n As Long
    Dim bh() As Byte, bs() As Byte
    Dim d1(0 To 255) As Byte
    Dim d2(0 To 255) As Byte
    
    n = Len(sHex): If n = 0 Then Exit Function
    bh = sHex
    If bh(4) = 32 Then k = 6 Else k = 4
    ReDim bs(((1 + n * 2) \ k) - 1)
    '------------------------------------------
    For I = 49 To 57
        d1(I) = I - 48
        d2(I) = 16 * d1(I)
    Next
    For I = 65 To 70
        d1(I) = I - 55:      d1(I + 32) = d1(I)
        d2(I) = 16 * d1(I):  d2(I + 32) = d2(I)
    Next
    '------------------------------------------
    For I = 0 To n - 1 Step k
        bs(J) = d2(bh(I)) + d1(bh(I + 2))
        J = J + 1
    Next
    QuickHex2Str = StrConv(bs, vbUnicode)
End Function

But, then: HexANSIToStringFast3 is now your #1 parser for flexibility. It is faster than HexANSIToStringFast, but adds support for some very cool parsing! You can do this for example:
Debug.Print HexANSIToStringFast3("[48] [45] [6c] - [6C],[6f] ~~~" & vbNewLine & "0D0A,21,48456c6C6f")

Output:
HEllo
!HEllo

Any character from 0 - 127 range that is not 0123456789ABCDEFabcdef is accepted as a valid separator. The separator can be of any length. This means if you have outputted some hex stuff from a hex editor that separates rows by a line change the data is parsed correctly by HexANSIToStringFast3.