How to make HexToByteArray Faster!

[msdl]

hello..
I Just need to convert A huge amount of Hex to ByteArray ..
i have one awesome function written by Merri ..

Here it is ..

Public Function HexStringToByteArray(ByRef HexString As String) As Byte()
    Dim bytOut() As Byte, bytHigh As Byte, bytLow As Byte, lngA As Long
    If LenB(HexString) Then
        ' preserve memory for output buffer
        ReDim bytOut(Len(HexString) \ 2 - 1)
        ' jump by every two characters (in this case we happen to use byte positions for greater speed)
        For lngA = 1 To LenB(HexString) Step 4
            ' get the character value and decrease by 48
            bytHigh = AscW(MidB$(HexString, lngA, 2)) - 48
            bytLow = AscW(MidB$(HexString, lngA + 2, 2)) - 48
            ' move old A - F values down even more
            If bytHigh > 9 Then bytHigh = bytHigh - 7
            If bytLow > 9 Then bytLow = bytLow - 7
            ' I guess the C equivalent of this could be like: *bytOut[++i] = (bytHigh << 8) || bytLow
            bytOut(lngA \ 4) = (bytHigh * &H10) Or bytLow
        Next lngA
        ' return the output
        HexStringToByteArray = bytOut
    End If
End Function

The problem is that on some computers converting takes a lot of time and
sometimes it doesn't even work ..
any help please to mod this function making it a little faster ..

thanks in advance .. and sorry for my bad english ..

[RhinoBull]

Not sure if it is faster but it's worth trying - try using StrConv function:

Option Explicit

Private Sub Command1_Click()
Dim arBytes() As Byte
Dim hexString As String
Dim i As Long

    hexString = "&H00C0FFC0&"
    arBytes() = StrConv(hexString, vbFromUnicode)
    
    For i = 0 To UBound(arBytes)
        Debug.Print Chr(arBytes(i))
    Next i

End Sub

[LaVolpe]

One thing that should be a concern: "sometimes it doesn't even work". That indicates a problem with the source string or your routine.

One speed-up would be to ditch the bytOut() declaration and usage. Instead, ReDim & use HexStringToByteArray directly. When you eventually call "HexStringToByteArray = bytOut" you are making a copy of the processed array; waste of time.

But for more advice from others; maybe post a sample of your source string

[msdl]

@RhinoBull:
thanks for the replay but I'm already using this function to avoid using StrConv since "StrConv " doesn't
work correct when you set "the language for non unicode chars" option to anything than english !!

[msdl]

@LaVolpe: removing the bytOut() declaration and usage and using the redim directly will make the code just a little faster but doesn't solve the problem ..

what i do is converting EXE file to it's HEX string then i put this HEX string into
other application that convert The Hex String to ByteArray and drop it as EXE file again ...

here is an example of a small program that show msgbox says "hello vbForums"
converted to hex ..

take a look plz at the source attached ..

[dilettante]

The CryptoAPI (NT systems, not Win9x) is pretty quick at this. See the attachment.

[sspoke]

you can make it a little faster by changing

bytOut(lngA \ 4) = (bytHigh * &H10) Or bytLow
to
bytOut(lngA \ 4) = (bytHigh * 16) Or bytLow

not much faster

[Jmacp]

Out of curiousty why are you not doing this in C++?

[LeandroA]

hello, is not a nice way to embed a file, (best to use resource files + LoadResData) but it is their decision,
another method similar to that of a dilettante but with a compression to not very large the array to be encrypted.

Option Explicit

Private Declare Function CryptBinaryToString Lib "Crypt32" Alias "CryptBinaryToStringW" (ByRef pbBinary As Byte, ByVal cbBinary As Long, ByVal dwFlags As Long, ByVal pszString As Long, ByRef pcchString As Long) As Long
Private Declare Function CryptStringToBinary Lib "Crypt32" Alias "CryptStringToBinaryW" (ByVal pszString As Long, ByVal cchString As Long, ByVal dwFlags As Long, ByVal pbBinary As Long, ByRef pcbBinary As Long, ByRef pdwSkip As Long, ByRef pdwFlags As Long) As Long
Private Declare Function RtlGetCompressionWorkSpaceSize Lib "NTDLL" (ByVal flags As Integer, WorkSpaceSize As Long, UNKNOWN_PARAMETER As Long) As Long
Private Declare Function NtAllocateVirtualMemory Lib "ntdll.dll" (ByVal ProcHandle As Long, BaseAddress As Long, ByVal NumBits As Long, regionsize As Long, ByVal flags As Long, ByVal ProtectMode As Long) As Long
Private Declare Function RtlCompressBuffer Lib "NTDLL" (ByVal flags As Integer, ByVal BuffUnCompressed As Long, ByVal UnCompSize As Long, ByVal BuffCompressed As Long, ByVal CompBuffSize As Long, ByVal UNKNOWN_PARAMETER As Long, OutputSize As Long, ByVal WorkSpace As Long) As Long
Private Declare Function RtlDecompressBuffer Lib "NTDLL" (ByVal flags As Integer, ByVal BuffUnCompressed As Long, ByVal UnCompSize As Long, ByVal BuffCompressed As Long, ByVal CompBuffSize As Long, OutputSize As Long) As Long
Private Declare Function NtFreeVirtualMemory Lib "ntdll.dll" (ByVal ProcHandle As Long, BaseAddress As Long, regionsize As Long, ByVal flags As Long) As Long

Public Function CompressToHex(Data() As Byte, strHexOut As String) As Boolean
    Dim WorkSpaceSize As Long
    Dim WorkSpace As Long
    Dim lCompress As Long
    Dim Out() As Byte

    If UBound(Data) < 0 Then Exit Function
    
    ReDim Out(UBound(Data) * 1.13 + 4)
    RtlGetCompressionWorkSpaceSize 2, WorkSpaceSize, 0
    NtAllocateVirtualMemory -1, WorkSpace, 0, WorkSpaceSize, 4096, 64
    RtlCompressBuffer 2, VarPtr(Data(0)), UBound(Data) + 1, VarPtr(Out(0)), (UBound(Data) * 1.13 + 4), 0, lCompress, WorkSpace
    NtFreeVirtualMemory -1, WorkSpace, 0, 16384

    If CryptBinaryToString(Out(0), lCompress + 1, &H4, 0&, WorkSpaceSize) <> 0 Then
        strHexOut = String(WorkSpaceSize - 1, 0)
        If CryptBinaryToString(Out(0), lCompress + 1, &H4, StrPtr(strHexOut), WorkSpaceSize) <> 0 Then
            strHexOut = Replace$(Replace$(Replace$(strHexOut, " ", vbNullString), vbNewLine, vbNullString), vbTab, vbNullString)
            CompressToHex = True
        End If
    End If

End Function
 
Public Function DeCompressToByte(ByRef sData As String, BitOut() As Byte) As Boolean
    Dim lBufferSize As Long
    Dim WorkSpaceSize As Long
    Dim dwActualUsed As Long
    Dim bytBuf() As Byte
    
    If CryptStringToBinary(StrPtr(sData), Len(sData), &H4, 0&, WorkSpaceSize, 0&, dwActualUsed) <> 0 Then
        ReDim bytBuf(WorkSpaceSize - 1)
        If CryptStringToBinary(StrPtr(sData), Len(sData), &H4, VarPtr(bytBuf(0)), WorkSpaceSize, 0&, dwActualUsed) <> 0 Then
            ReDim BitOut(UBound(bytBuf) * 12.5)
            RtlDecompressBuffer 2, VarPtr(BitOut(0)), (UBound(bytBuf) * 12.5), VarPtr(bytBuf(0)), UBound(bytBuf), lBufferSize
            If lBufferSize Then
                ReDim Preserve BitOut(lBufferSize - 1)
                DeCompressToByte = True
            End If
        End If
    End If
End Function

[Witis]

Not sure exactly what you are doing with the hex string although if you just want to put it into a byte array fast, then this is similar to RhinoBull's except it avoids the StrConv and should work:

Private Sub Command1_Click()
Dim ba() As Byte, test$, i&, count&

test = "A5B1C5" 'hex string

ba = test
For i = 0 To UBound(ba) Step 2
    Debug.Print Chr(ba(i))
Next i

End Sub

Run it and output is to the debug window (ctrl + g):
A
5
B
1
C
5

[lone_REBEL]

I've had to convert many strings to their hex codes and I didn't know it was possible with APIs. So I have made my own functions for this. I do not know if these would work faster than what you are already using but yeah, stand sure that they will work accurately. Oh plus these functions convert an integer value of only upto 255 (enough for a byte eh?) and add a 0 the hex code if its ASCII is less than 16 (in dec). Anyway here are the functions of the paranoid lone rebel:

'get the hex code of the given integer
Private Function DecToHex(ByRef val As Integer) As String
    Dim T As Integer, u As Integer
    Dim res As String
    T = val \ 16
    u = val - (T * 16)
    If T > 9 Then
        res = Chr(55 + T)
    Else
        res = Chr(48 + T)
    End If
    If u > 9 Then
        res = res & Chr(55 + u)
    Else
        res = res & Chr(48 + u)
    End If
    DecToHex = res
End Function


'get the decimal value of a 2 bytes hex code
Private Function HexToDec(ByRef val As String) As Integer
    Dim res As Integer
    Dim ht As String, hu As String
    ht = Left(val, 1)
    hu = Right(val, 1)
    If Asc(ht) > 64 Then
        res = (Asc(ht) - 55) * 16
    Else
        res = (Asc(ht) - 48) * 16
    End If
    If Asc(hu) > 64 Then
        res = res + Asc(hu) - 55
    Else
        res = res + Asc(hu) - 48
    End If
    HexToDec = res
End Function


'convert whole string into its hex code
Public Function EncodeHex(ByRef data As String) As String
    Dim res As String
    Dim i As Integer
    For i = 1 To Len(data)
        res = res & DecToHex(Asc(Mid(data, i, 1)))
    Next i
    EncodeHex = res
End Function


'convert a batch of hex coded data to its original text data form
Public Function DecodeHex(ByRef data As String) As String
    Dim res As String
    Dim i As Long
    For i = 1 To Len(data) Step 2
        res = res & Chr(HexToDec(Mid(data, i, 2)))
    Next i
    DecodeHex = res
End Function

The usage is very simple:

Dim hcode As String
hcode = EncodeHex("hello world")
Msgbox "Hex code of 'hello world' is: " & hcode & VbNewLine & "Decoding " & hcode & " back to string form yields: " & DecodeHex(hcode)

EDIT: I do not know about the intricate type conversion and calculation speed values but it takes less than 1 second to encode 10 KB data from string form to hex code (and vice versa).

EDIT 2: I see you only need to covert hex codes back to string form. So here is a function that will do it faster than the previous functions:

Function DecodeHexFaster(ByRef str As String) As String
    Dim i As Long
    Dim t As String * 1, u As String * 1
    Dim ac As Integer, at As Integer, au As Integer
    Dim result As String
    For i = 1 To Len(str) Step 2
        t = Mid(str, i, 1)
        u = Mid(str, i + 1, 1)
        at = asc(t)
        au = asc(u)
        ac = IIf(at > 64, at - 55, at - 48) * 16
        ac = ac + IIf(au > 64, au - 55, au - 48)
        result = result & Chr(ac)
    Next i
    DecodeHexFaster = result
End Function

[Merri]

I'll post some code later, for now I just subscribe to this thread. Some problems with Opera Mini that prevent the regular method...

Also, people, before claiming something works faster, test it! And I'm not pointing at any single person here (would quote but it is quite hard via phone) .

[dilettante]

@LaVolpe: removing the bytOut() declaration and usage and using the redim directly will make the code just a little faster but doesn't solve the problem ..

what i do is converting EXE file to it's HEX string then i put this HEX string into
other application that convert The Hex String to ByteArray and drop it as EXE file again ...

here is an example of a small program that show msgbox says "hello vbForums"
converted to hex ..

take a look plz at the source attached ..

This sounds enough like "help me make a trojan horse dropper" that I'm refraining from further participation. Even at best I can't conceive of a reason to do what this will be doing.

[lone_REBEL]

The idea seems bizarre indeed. Perhaps this person does not know how to upload binary data to the website or transfer binary data in a network using winsock thats why he/she is approaching to hex-code the file first (hence coding the binary data to text data) and then transferring the text data through the channel he/she is using.

But its all right to use this approach too, although much faster and more reliable approaches obviously exist.

@dilettante: I myself made a powerful trojan ... it was long time ago. Its still on my HD. I don't think PROGRAMMING trojans is a bad thing. It helps you learn how these things work. However USING these such programs is indeed a negative act. Its like owning/inventing guns isn't a crime, doing murders with them is.

[msdl]

@dilettante:
I really don't know what are you talking about.. But i'll tell you what this is for ..
I got an idea to protect my program from cracking..
instead of checking the license from the main program i will add a hex code for
the a license verifier application into the main program

so..
as usual cracker won't find what he is looking for at the main program ..
it's not that pretty idea but believe me it works great against some crackers

the problem is some customers complained about that it the program always
says "Error Verifying Your license .. Please Conatct Me @..."

i found that this problem happens when the hex code arenot decoded successfully ..
or if it takes a lot time ..
that is why i want help ..

Edit: Sorry Now i understand what you me mean with "help me make a trojan horse dropper" ..
No man i'm not a hacker i'm just making simple programs ..
sorry again if i described my problem in wrong way ..

[msdl]

here is the benchmarking result..

Merri Original Function : 12.70094ms
sspoke : 11.05539ms
lone_REBEL : 103.64753ms (!!!)
LeandroA : 7.11279ms

Edit: Don't know why using LeandroA Code make my antivirus alert for a virus !!!!??!!

[lone_REBEL]

Hmmf I expected something like this, lol. How much data did you try decoding to/from Hex? I didn't use any APIs so obviously the manual code would work slower than API. However I'd like to know the amount of data that you tested the functions with.

[msdl]

Hmmf I expected something like this, lol. How much data did you try decoding to/from Hex? I didn't use any APIs so obviously the manual code would work slower than API. However I'd like to know the amount of data that you tested the functions with.

I used hex string for 16kb application for the four trials ..

[dilettante]

@dilettante:
I really don't know what are you talking about.. But i'll tell you what this is for ..
I got an idea to protect my program from cracking..
instead of checking the license from the main program i will add a hex code for
the a license verifier application into the main program

Well ok, though it seems sort of goofy. So you re-create the actual program every run?


On 16K of Hex characters in a String the CryptoAPI decodes to an 8K Byte array in 0 (!) to 4ms here, just using Timer() calls for timing which isn't very precise. Encoding is very slow for some reason, but you wanted a decoder anyway.

[Merri]

If nothing else, I make it very hard to write a faster VB6 version.

Option Explicit

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

' 2011-01-31 "the quite insane version really"
Public Function HexStringToBytes(Hex As String) As Byte()
    Static LH(0 To 5) As Long, LHP As Long
    Dim LA() As Long, LP As Long
    
    Static IH(0 To 5) As Long, IHP As Long
    Dim IA() As Integer, IP As Long
    
    Dim C As Long, H As Long, L As Long, LB As Long
    
    ' ignore half byte information
    L = Len(Hex) And Not 1
    ' check length
    If L >= 12 Then
        ' cache safe array headers, Static means created only once
        If LH(0) = 0 Then
            LH(0) = 1: LH(1) = 4: LH(4) = &H3FFFFFFF: LHP = VarPtr(LH(0))
            IH(0) = 1: IH(1) = 2: IHP = VarPtr(IH(0))
        End If
        ' safe array: Long
        LP = ArrPtr(LA)
        PutMem4 LP, LHP
        ' safe array: Integer
        IP = ArrPtr(IA)
        LH(3) = IP: LA(0) = IHP
        ' create an empty byte array
        HexStringToBytes = vbNullString
        ' length of byte array
        LB = (L \ 2)
        ' get pointer to safe array header for manipulation
        LH(3) = Not Not HexStringToBytes: Debug.Assert App.hInstance
        ' create a BSTR, it works as our byte array!
        LA(3) = SysAllocStringByteLen(0, LB - 6) - 4: LA(4) = LB
        
        IH(3) = StrPtr(Hex): IH(4) = L
        ' set long array to output data (= byte array)
        LH(3) = LA(3)
        ' go through 8 hex string characters at a time = 4 bytes = 32-bits
        For L = 0 To UBound(IA) - 7 Step 8
            ' byte 1
            C = IA(L + 1)
            Select Case C
                Case 48 To 57: H = C And Not 48&
                Case 65 To 70: H = C - 55&
                Case Else: H = 0
            End Select
            C = IA(L)
            Select Case C
                Case 48 To 57: H = H Or ((C And Not 48&) * &H10&)
                Case 65 To 70: H = H Or ((C - 55&) * &H10&)
            End Select
            ' byte 2
            C = IA(L + 3)
            Select Case C
                Case 48 To 57: H = H Or ((C And Not 48&) * &H100&)
                Case 65 To 70: H = H Or ((C - 55&) * &H100&)
            End Select
            C = IA(L + 2)
            Select Case C
                Case 48 To 57: H = H Or ((C And Not 48&) * &H1000&)
                Case 65 To 70: H = H Or ((C - 55&) * &H1000&)
            End Select
            ' byte 3
            C = IA(L + 5)
            Select Case C
                Case 48 To 57: H = H Or ((C And Not 48&) * &H10000)
                Case 65 To 70: H = H Or ((C - 55&) * &H10000)
            End Select
            C = IA(L + 4)
            Select Case C
                Case 48 To 57: H = H Or ((C And Not 48&) * &H100000)
                Case 65 To 70: H = H Or ((C - 55&) * &H100000)
            End Select
            ' byte 4
            C = IA(L + 7)
            Select Case C
                Case 48 To 57: H = H Or ((C And Not 48&) * &H1000000)
                Case 65 To 70: H = H Or ((C - 55&) * &H1000000)
            End Select
            C = IA(L + 6)
            Select Case C
                Case 48 To 55: H = H Or ((C And Not 48&) * &H10000000)
                Case 56 To 57: H = H Or ((C And Not 56&) * &H10000000) Or &H80000000
                Case 65 To 70: H = H Or ((C - 63&) * &H10000000) Or &H80000000
            End Select
            ' write
            LA(L \ 8) = H
        Next L
        
        ' memory safety
        Select Case (UBound(IA) + 1) - L
        Case 0 ' we are done!
        Case 2
            ' read
            H = LA(L \ 8) And &HFFFFFF00
            ' byte 1
            C = IA(L + 1)
            Select Case C
                Case 48 To 57: H = H Or (C And Not 48&)
                Case 65 To 70: H = H Or (C - 55&)
            End Select
            C = IA(L)
            Select Case C
                Case 48 To 57: H = H Or ((C And Not 48&) * &H10&)
                Case 65 To 70: H = H Or ((C - 55&) * &H10&)
            End Select
            ' write
            LA(L \ 8) = H
        Case 4
            ' read
            H = LA(L \ 8) And &HFFFF0000
            ' byte 1
            C = IA(L + 1)
            Select Case C
                Case 48 To 57: H = H Or (C And Not 48&)
                Case 65 To 70: H = H Or (C - 55&)
            End Select
            C = IA(L)
            Select Case C
                Case 48 To 57: H = H Or ((C And Not 48&) * &H10&)
                Case 65 To 70: H = H Or ((C - 55&) * &H10&)
            End Select
            ' byte 2
            C = IA(L + 3)
            Select Case C
                Case 48 To 57: H = H Or ((C And Not 48&) * &H100&)
                Case 65 To 70: H = H Or ((C - 55&) * &H100&)
            End Select
            C = IA(L + 2)
            Select Case C
                Case 48 To 57: H = H Or ((C And Not 48&) * &H1000&)
                Case 65 To 70: H = H Or ((C - 55&) * &H1000&)
            End Select
            ' write
            LA(L \ 8) = H
        Case 6
            ' read
            H = LA(L \ 8) And &HFF000000
            ' byte 1
            C = IA(L + 1)
            Select Case C
                Case 48 To 57: H = H Or (C And Not 48&)
                Case 65 To 70: H = H Or (C - 55&)
            End Select
            C = IA(L)
            Select Case C
                Case 48 To 57: H = H Or ((C And Not 48&) * &H10&)
                Case 65 To 70: H = H Or ((C - 55&) * &H10&)
            End Select
            ' byte 2
            C = IA(L + 3)
            Select Case C
                Case 48 To 57: H = H Or ((C And Not 48&) * &H100&)
                Case 65 To 70: H = H Or ((C - 55&) * &H100&)
            End Select
            C = IA(L + 2)
            Select Case C
                Case 48 To 57: H = H Or ((C And Not 48&) * &H1000&)
                Case 65 To 70: H = H Or ((C - 55&) * &H1000&)
            End Select
            ' byte 3
            C = IA(L + 5)
            Select Case C
                Case 48 To 57: H = H Or ((C And Not 48&) * &H10000)
                Case 65 To 70: H = H Or ((C - 55&) * &H10000)
            End Select
            C = IA(L + 4)
            Select Case C
                Case 48 To 57: H = H Or ((C And Not 48&) * &H100000)
                Case 65 To 70: H = H Or ((C - 55&) * &H100000)
            End Select
            ' write
            LA(L \ 8) = H
        End Select
        ' end safearrays
        LH(3) = IP: LA(0) = 0
        LH(3) = LP: LA(0) = 0
    ElseIf L > 0 Then
        Dim B() As Byte, BL As Byte, BH As Byte
        B = LeftB$(Hex, L \ 2)
        For L = 0 To UBound(B)
            BH = AscB(Mid$(Hex, L + L + 1, 1)) And Not 48
            BL = AscB(Mid$(Hex, L + L + 2, 1)) And Not 48
            If BH < 10 Then BH = BH * 16 Else BH = ((BH - 7) And 15) * 16
            If BL < 10 Then B(L) = BL Or BH Else B(L) = ((BL - 7) And 15) Or BH
        Next L
        HexStringToBytes = B
    End If
End Function

In addition I make it hard to write a longer version.

[msdl]

@Merri:
it worked for 2-3 times then it gives Error msg

Runtime-Error '6':
overflow

?!!?!?!

[Merri]

Doesn't help me much, I need to know the line. I've had only 3 hours of sleep last night so an error wouldn't be a big surprise.

[msdl]

at this line :

Case 48 To 57: H = H Or ((C And Not 48&) * &H10000000)

an example attached...

Benchmarking -->

[Merri]

You copied the old version of the code before I edited my post 35 minutes before your post #21.

57 should be 55.

Also, the code runs a lot faster compiled, especially if you go turning on some of the advanced optimizations (remove array boundary check and integer overflow checks).

[msdl]

100% working ...

Benchmarking after turning remove array boundary check and integer overflow checks



thanks Merri , now i'll try it on people who reported that error and i'll see
the difference ...

[Merri]

Spent a bit of time to see how fast CryptStringToBinary really works:

Option Explicit

Private Const CRYPT_STRING_HEX As Long = 4

Private Declare Function CryptBinaryToString Lib "Crypt32" Alias "CryptBinaryToStringW" (ByRef pbBinary As Byte, ByVal cbBinary As Long, ByVal dwFlags As Long, ByVal pszString As Long, ByRef pcchString As Long) As Long
Private Declare Function CryptStringToBinary Lib "Crypt32" Alias "CryptStringToBinaryW" (ByVal pszString As Long, ByVal cchString As Long, ByVal dwFlags As Long, ByVal pbBinary As Long, ByRef pcbBinary As Long, ByRef pdwSkip As Long, ByRef pdwFlags As Long) As Long

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

Private LH(0 To 5) As Long, LHP As Long
Private LA() As Long, LP As Long

Public Function Decode(ByRef StringBuf As String) As Byte()
    Dim lngOutLen As Long
    Dim dwActualUsed As Long
    Dim bytBuf() As Byte
    Dim lngBufPtr As Long
    
    If LHP = 0 Then
        LH(0) = 1: LH(1) = 4: LH(4) = &H7FFFFFFF
        LHP = VarPtr(LH(0))
        LP = ArrPtr(LA)
    End If

    lngOutLen = LenB(StringBuf) \ 4
    If lngOutLen >= 6 Then
        PutMem4 LP, LHP
        bytBuf = vbNullString
        LH(3) = Not Not bytBuf: Debug.Assert App.hInstance
        lngBufPtr = SysAllocStringByteLen(0, lngOutLen - 6) - 4
        LA(3) = lngBufPtr
        LA(4) = lngOutLen
        LH(3) = LP: LA(0) = 0
    Else
        ReDim bytBuf(lngOutLen - 1)
        lngBufPtr = VarPtr(bytBuf(0))
    End If
    If CryptStringToBinary(StrPtr(StringBuf), Len(StringBuf), CRYPT_STRING_HEX, lngBufPtr, lngOutLen, 0&, dwActualUsed) = 0 Then
        Err.Raise &H80044100, "Decode", "CryptStringToBinary failed, error " & CStr(Err.LastDllError)
    Else
        Decode = bytBuf
    End If
End Function

This optimization does a custom ReDim for bytBuf, avoiding nullifying the memory that is reserved for the byte array. It also assumes the data is "tight" with no formatting: this takes the first call to the function away. The end result is that it still takes about five to six times the time for CryptStringToBinary to do the same than it takes for HexStringToBytes The test string I used was a continuous repetition of 00010203...FCFDFEFF within a string of 65536 bytes that results in a 16384 bytes Byte array.

Edit!
Using 100x larger data my HexStringToBytes gets it done in ~7.7 ms while CryptStringToBinary does the same in rougly 50 ms. This, of course, on my computer, results always vary between computers.

[dilettante]

Of course CryptStringToBinary has to handle multiple formats as well, not just raw hex. Hopefully people aren't trying to decode 6MB of hex in a tight loop very often either!

Using CRYPT_STRING_HEXRAW = &HC& might shave some time but not much.

[Merri]

There is no change at all.


Then! Nobody requested it, but I thought I'd make HexStringToBytes more useful, so I wrote a version that:

1. Allows for both upper & lowercase notation
2. Ignores invalid characters
3. Other than that, allows for any valid hex pair it can find and parses that as a single byte

It is a little bit slower (roughly 1/8th more time), but you can give it pretty much any string and it'll parse the hex to bytes out of it.

Attached as a text file because *gasp* the code is too long for a post...

[Merri]

Finally remembered the code that does the opposite, written at RichTextBox Tips & Tricks. Maybe should convert into a standalone function.

[RhinoBull]

This thread should really be in the api forum since it has very little to do with "pure" vb.

[Merri]

How come? Id like to know why.

[RhinoBull]

IMHO because most of samlle code is heavily using windows api functions - that's basically why.
And there is a dedicated forum for that so is database development, reporting, etc...

[Merri]

Uh, the text file sample includes one API call (for string allocation), or about 4 if you include PutMem4 and ArrPtr...