Private Declare Function WideCharToMultiByte Lib "Kernel32.dll" ( _
ByVal CodePage As Long, _
ByVal dwFlags As Long, _
ByVal lpWideCharStr As Long, _
ByVal cchWideChar As Long, _
ByVal lpMultiByteStr As Long, _
ByVal cbMultiByte As Long, _
ByVal lpDefaultChar As Long, _
ByVal lpUsedDefaultChar As Long _
) As Long
Private Const CP_ACP As Long = 0
Private Declare Function CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal _
dest As Long, ByVal src As Long, ByVal Length As Long) As Long
Private Const BINARY_CHUNK As Long = 256
Private Function ToCPString(ByRef the_sValue As String) As Byte()
Dim abytOutput() As Byte
Dim nValueLen As Long
Dim nOutputByteLen As Long
' Cache the input length.
nValueLen = Len(the_sValue)
' See how big the output buffer will be.
nOutputByteLen = WideCharToMultiByte(CP_ACP, 0&, StrPtr(the_sValue), nValueLen, 0&, 0&, 0&, 0&)
If nOutputByteLen > 0 Then
' Resize output byte array to the size of the UTF-8 string.
ReDim abytOutput(1 To nOutputByteLen)
' Make this API call again, this time giving a pointer to the output byte array.
WideCharToMultiByte CP_ACP, 0&, StrPtr(the_sValue), nValueLen, VarPtr(abytOutput(1)), nOutputByteLen, 0&, 0&
End If
' Return the array.
ToCPString = abytOutput()
End Function
Private Sub CatBinary(bytData() As Byte, Bytes() As Byte)
Dim BytesLen As Long, BinaryNext As Long
BinaryNext = UBound(bytData) + 1
BytesLen = UBound(Bytes) - LBound(Bytes) + 1
If BinaryNext + BytesLen - 1 > BinaryNext Then
If BytesLen > BINARY_CHUNK Then
ReDim Preserve bytData(BinaryNext + BytesLen - 1)
Else
ReDim Preserve bytData(BinaryNext + BINARY_CHUNK - 1)
End If
End If
CopyMemory bytData(BinaryNext), Bytes(LBound(Bytes)), BytesLen
End Sub
Private Sub CatBinaryString(bytData() As Byte, Text As String)
Dim Bytes() As Byte
Bytes = ToCPString(Text)
CatBinary bytData, Bytes
End Sub
Private Sub TrimBinary(bytData() As Byte)
If UBound(bytData) > 0 Then
ReDim Preserve bytData(UBound(bytData) - 1)
Else
bytData = ""
End If
End Sub
Sub Main()
Dim bytData() As Byte: bytData = ""
CatBinaryString bytData, "test"
MsgBox StrConv(bytData, vbUnicode)
End Sub