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!
Printable View
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!
vb Code:
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
This isn't very fast though, but hex strings aren't often very useful so...Code: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
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:
Being much faster than first code sample this still leaves one bottleneck: Chr$ and string concatenated conversion from hex string to Integer.Code: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)
Edit!
As a function:
Code: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
So maybe:
Works with or without embedded spaces.Code: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
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: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.Code: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
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.
vb Code:
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.
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):It gains a considerable amount of more speed: this works just like HexToAsc, but runs 3.5 times faster.Code: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
Update!
Project updated with fixed versions.
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.
vb Code:
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.
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.
Just to show what you can do:Code: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
Debug.Print HexANSIToStringFast3("[48] [45] [6c] - [6C] [6f]")
@ 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().
Code: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
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.
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:)
Quote:
modSafeArray by Paul
wrapping tough string array hacks
modSafeArray_Paul.zip, 1.147 bytes, 20.10.01 11:05:12
vb Code:
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:
Code: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.
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:Code: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.