Escape machine code bytes to extended chars

				
Option Explicit
Private sCurPath As String
Private sFileName As String
 ''''''''''''''''''''''''''''''''''''''''''
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal ptrMC As Long, ByVal P1 As Long, ByVal P2 As Long, ByVal P3 As Long, ByVal P4 As Long) As Long
 Private abAsmMC() As Byte ' Array to hold machine code
 Const sASMCode As String = "558BECB82312353C8BE55DC21000"
 '
' HexStr2MCode abAsmMC, sASMCode
' lpMC = VarPtr(abAsmMC(0))
' CallWindowProc lpMC, arg1, arg2, arg3, arg4
 '
Private Sub HexStr2MCode(abMCode() As Byte, sHexCode As String) 'Original code RR
Dim i As Long, iSize As Long
iSize = Len(sHexCode)
Debug.Assert Not iSize = 0&
Debug.Assert Not iSize And 1& 'may not be odd (hex pairs)!
iSize = iSize * 0.5
ReDim abMCode(iSize - 1)
Do: abMCode(i) = Val("&H" & Mid$(sHexCode, i + i + 1&, 2&))
i = i + 1&
Loop Until i = iSize
End Sub
 '
' Asm2HexStr "C:\Asm\ASMCode.bin"
 '
Private Sub Asm2HexStr(sBinFile As String) 'Original code UMGEDV GmbH/RR ?
Dim hx As String, s As String
Dim i As Long, j As Long, k As Long
Dim hFile As Long
hFile = FreeFile
On Error Resume Next
 Open sBinFile For Binary Access Read Lock Write As hFile
 If Not Err = 0& Then Exit Sub
On Error GoTo 0
j = LOF(hFile)
If Not j = 0& Then
ReDim b(j - 1) As Byte
Get #hFile, , b
Close hFile
hx = Space$(j + j)
k = 1&
Do: Mid$(hx, k&) = Right$("0" & Hex$(b(i)), 2&)
i = i + 1&
k = k + 2&
Loop Until i = j
i = InStrRev(sBinFile, "\") + 1&
j = InStrRev(sBinFile, ".")
s = Mid$(sBinFile, i, j - i)
AsmStr2Const s, hx, 100
'Const sASMCode As String = "558BECB84E61BC008BE55DC21000"
Else
Close hFile
End If
End Sub
Sub AsmStr2Const(sConstName As String, sEscStr As String, Optional ByVal iMaxLineLen As Long = 100)
Dim i As Long, cnt As Long, s As String
' Note - if you get the 'too many continuation lines' message,
' simply set maxlinelen higher, anything up to a little over 900
Debug.Print ""
Debug.Print "' Please do not edit the following machine code"
s = Space$(19 + Len(sConstName))
cnt = Len(sEscStr)
Select Case cnt
Case Is < iMaxLineLen
Debug.Print "Const " & sConstName & " As String = """ & sEscStr & """"
'Const sASMCode As String = "ÆÕ‰åÓÖ׸Ò„€€ßÞÛ‹‰ìݐ€"
Case Is < iMaxLineLen + iMaxLineLen
iMaxLineLen = cnt * 0.5 ' Rounds down - relevant only for extended input
iMaxLineLen = cnt - iMaxLineLen ' Odd length displays extra char on first line
Debug.Print "Const " & sConstName & " As String = """ & Left$(sEscStr, iMaxLineLen) & """ & _"
Debug.Print s & """" & Mid$(sEscStr, iMaxLineLen + 1&) & """"
Case Else
cnt = cnt - iMaxLineLen
Debug.Print "Const " & sConstName & " As String = """ & Left$(sEscStr, iMaxLineLen) & """ & _"
i = iMaxLineLen + 1&
Do While cnt > iMaxLineLen
cnt = cnt - iMaxLineLen
Debug.Print s & """" & Mid$(sEscStr, i, iMaxLineLen) & """ & _"
i = i + iMaxLineLen
Loop
Debug.Print s & """" & Mid$(sEscStr, i) & """"
End Select
MsgBox "Copy code in your debug window"
End Sub

 ' ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ' Escape all machine code bytes to extended chars
 ' A more compact storage of bytes in string than using Hex. Storing data (anything)
 ' in a string can be done more compactly using this method than using Hex strings.
 ' Any data copied to a byte array can be stored for 8 character per 7 bytes compared
 ' with 14 when using a predictable-length Hex string which is 2 characters per byte
 ' 558BEC669C53568B75088B1E8B16C1EB02891E83E2038B750C89168B75108B1E83C321891E8B45145E5B669D8BE55DC21000
 ' –Õ‹ìæœÓÖ©‹õˆ‹ž‹–ëÁ낉žƒâÒƒ‹õŒ‰–‹´õ‹žƒÃ¡…‰ž‹Å”Þۮ杋åݐ€€
 ' Original proof and very cool concept thanks to jeremyxtz :)
Private Sub AsmBin2EscStr(sBinFile As String, Optional ByVal iMaxLineLen As Long = 100)
Dim i As Long, sEsc As String
Dim cnt As Long, cmeta As Long
Dim power As Byte, meta As Byte
Dim hFile As Long
hFile = FreeFile
On Error Resume Next
 Open sBinFile For Binary Access Read Lock Write As hFile
 If Not Err = 0& Then Exit Sub
On Error GoTo 0
cnt = LOF(hFile) ' Machine code byte count
If Not cnt = 0& Then
ReDim b(0 To cnt - 1) As Byte
Get #hFile, , b
Close hFile
If (cnt Mod 7) Then i = 1& ' Account for remainder meta byte (set to 1 if needed)
sEsc = Space$(cnt + (cnt \ 7&) + i) ' Byte cnt + meta byte cnt (1 per 7 code bytes) + remainder meta byte
meta = 128 ' Byte MSBit used to escape machine code bytes to extended chars
cmeta = 2& ' Set read pointer one based, skip first meta byte
For i = 0 To UBound(b) ' Bit flag indicates when already an extended char
If b(i) And 128 Then meta = meta Or (2 ^ power)
Mid$(sEsc, i + cmeta) = Chr$(b(i) Or 128)
power = (i + 1) Mod 7' Escape all machine code bytes to extended chars
If power = 0 Then' Write meta bits to first byte of completed byte set
Mid$(sEsc, i + cmeta - 7&) = Chr$(meta)
meta = 128 ' Reset meta byte LSBits for next set of seven (w/ escaped MSBit)
cmeta = cmeta + 1&
End If
Next' Write remainder meta byte (less than 7 meaningful bits)
If power Then Mid$(sEsc, i + cmeta - power - 1&) = Chr$(meta) ' We -1 as i incremented on exit
i = InStrRev(sBinFile, "\") + 1&' Extract the binary objects filename
' Remove the extension and create the Const string
AsmStr2Const Mid$(sBinFile, i, InStrRev(sBinFile, ".") - i), sEsc, iMaxLineLen
Else
Close hFile
End If
End Sub
Sub AsmEscStr2Bin(b() As Byte, sEscStr As String) ' Original code jeremyxtz
Dim cmeta As Long, remainder As Long
Dim c7Bs As Long, i As Long, j As Long
Dim power As Byte, meta As Byte
j = Len(sEscStr)' mbbbbbbbmbbbbbbbmbbbbbbbmbb
i = (j \ 8) ' mbbbbbbbmbbbbbbbmbbbbbbb
remainder = j Mod 8 ' mbb
c7Bs = i * 7' bbbbbbbbbbbbbbbbbbbbb
c7Bs = c7Bs - 1& ' Account for zero based array
If remainder = 0& Then
ReDim b(c7Bs) As Byte ' No remainder bytes (7 is a divisor of cnt)
Else ' Remove remainder meta byte from count
remainder = remainder - 1&
ReDim b(c7Bs + remainder) ' bb
End If
meta = Asc(Mid$(sEscStr, 1&, 1&)) ' Assign bit flags for first set of 7 machine code bytes
cmeta = 2&' Set read pointer, dodge first meta byte
For i = 0 To c7Bs + remainder ' Unexcape all machine code bytes into array
If meta And (2 ^ power) Then ' If already extended then assign it as is
b(i) = Asc(Mid$(sEscStr, i + cmeta, 1&))
Else ' Else assign it with MSBit masked out
b(i) = Asc(Mid$(sEscStr, i + cmeta, 1&)) And (Not 128)
End If
power = (i + 1) Mod 7
If power = 0 Then ' If set complete grab next set of meta bits
cmeta = cmeta + 1&' Skip the meta byte
If i + cmeta > j Then Exit For ' No remainder condition (so no meta byte)
meta = Asc(Mid$(sEscStr, i + cmeta, 1&))
End If
Next
End Sub

Const sHexMCode As String = "558BEC669C53568B75088B1E8B16C1EB02891E83E2038B750C89168B75108B1E83C321891E8B45145E5B669D8BE55DC21000"
Const sEscMCode As String = "–Õ‹ìæœÓÖ©‹õˆ‹ž‹–ëÁ낉žƒâÒƒ‹õŒ‰–‹´õ‹žƒÃ¡…‰ž‹Å”Þۮ杋åݐ€€"