XXEncode format on VBA, or how to load a binary into a document

When working in conjunction with Excel + VBA, you may need to store binary data in a container that imposes restrictions on the contents. For these tasks, the XXEncode format was developed. So, let's say you wanted to have the necessary libraries and utilities related to your VBA project always with you, inside the .xls Workbook. Below I will show how I implemented the storage of binary files in the comments of standard modules of VBA projects.

I encrypted binary data in XXE and inverse transform - decoding - I implemented two functions, bin2xxt and xxe2bin, respectively. To make the code more or less portable between different tasks, the binary data is represented by an array of bytes, and the data encoded in XXE is stored in rows.

''      xxe Function bin2xxe(src() As Byte, fname As String) As String Dim i As Long, n As Long, t As Byte, xxe() As String, s As String, sz As Long, pt As Long xxe = Split("+ - 0 1 2 3 4 5 6 7 8 9 ABCDEFGHIJKLMNOPQRSTU VWXYZ abcdefghijklmnopqrstu vwxy z") i = 0 n = UBound(src) s = Space(((n + 1) \ 45) * 63 + ((n + 1) Mod 45) * 4 \ 3 + 280) pt = 1 sz = 12 + Len(fname) Mid$(s, 1, sz) = "begin 644 " & fname & vbCrLf pt = pt + sz + 1 sz = pt - 1 Do While i <= n If i Mod 3 = 0 Then Mid$(s, pt, 1) = xxe(src(i) \ 4): pt = pt + 1 t = (src(i) And 3) * 16 ElseIf i Mod 3 = 1 Then Mid$(s, pt, 1) = xxe(t + (src(i) \ 16)): pt = pt + 1 t = (src(i) And 15) * 4 ElseIf i Mod 3 = 2 Then Mid$(s, pt, 2) = xxe(t + src(i) \ 64) & xxe(src(i) And 63): pt = pt + 2 t = 0 End If If i Mod 45 = 44 Then Mid$(s, sz, 1) = "h" Mid$(s, pt, 2) = vbCrLf: pt = pt + 3: sz = pt - 1 End If i = i + 1 Loop If (n + 1) Mod 3 <> 0 Then Mid$(s, pt, 1) = xxe(t): pt = pt + 1 End If t = (n Mod 45) + 1 If t <> 45 Then Mid$(s, sz, 1) = xxe(t) Mid$(s, pt, 3) = "+" & vbCrLf: pt = pt + 3 End If Mid$(s, pt, 3) = "end": sz = pt + 2 bin2xxe = Left(s, sz) End Function '   xxe    Function xxe2bin(src As String, fname As String) As Byte() Dim t() As String, t0() As String, i As Long, j As Long, k As Long Dim xxe As String, bStrLen As Byte, lStart As Long, h As Byte, x As Byte Dim dst() As Byte, xxeIdx(43 To 122) As Byte xxeIdx(43) = 0: xxeIdx(45) = 1 For i = 48 To 57: xxeIdx(i) = i - 46: Next For i = 65 To 90: xxeIdx(i) = i - 53: Next For i = 97 To 122: xxeIdx(i) = i - 59: Next t = Split(src, vbCrLf) t0 = Split(t(0)) If t0(0) <> "begin" Then Exit Function If UBound(t0) = 2 Then fname = t0(2) Else Exit Function j = 1 Do While t(j) <> "end" And j <= UBound(t) lStart = lStart + xxeIdx(Asc(t(j))) j = j + 1 Loop ReDim dst(0 To lStart - 1) j = 1: lStart = 0: x = 0 Do While t(j) <> "end" And j <= UBound(t) bStrLen = xxeIdx(Asc(t(j))) i = 2 k = 0 Do While i <= Len(t(j)) And k <= bStrLen - 1 h = xxeIdx(Asc(Mid$(t(j), i, 1))) Select Case i And 3 Case 0: dst(lStart + k) = x + h \ 4 x = (h And 3) * 64 k = k + 1 Case 1: dst(lStart + k) = x + h x = 0 k = k + 1 Case 2: x = h * 4 Case 3: dst(lStart + k) = x + h \ 16 x = (h And 15) * 16 k = k + 1 End Select i = i + 1 Loop lStart = lStart + bStrLen j = j + 1 Loop xxe2bin = dst End Function 

In addition, for the task, a pair of encoding / decoding shells procedures are also written: file2stdm load a binary file into a standard VBA project module (xxe code is placed in a separate module in the comments) and reverse conversion — unpack the file from what is encoded into a standard module stdm2file It should be noted here that for free manipulations in VBProject on the target machine access to VBA projects must be allowed. Below are a couple of wrapper procedures:

 '      VBA Sub file2stdm(fpath As String, fname As String, wbk As Workbook) Dim src() As Byte, s As String, i As Long, t() As String Dim stdm As VBComponent, f As Long f = FreeFile Open fpath & "\" & fname For Binary Access Read As #f ReDim src(0 To LOF(f) - 1) As Byte Get #f, 1, src Close #f s = bin2xxe(src, fname) t = Split(s, vbCrLf) For i = 0 To UBound(t) t(i) = "'" & t(i) Next s = Join(t, vbCrLf) Set stdm = wbk.VBProject.VBComponents.Add(vbext_ct_StdModule) stdm.Name = "m" & Replace(fname, ".", "") stdm.CodeModule.AddFromString s Set stdm = Nothing End Sub '      VBA Sub stdm2file(fpath As String, fname As String, wbk As Workbook) Dim stdm As VBComponent, i As Long, m As Long, n As Long Dim s As String, t() As String, dst() As Byte, f As Long Set stdm = wbk.VBProject.VBComponents("m" & Replace(fname, ".", "")) For i = 1 To stdm.CodeModule.CountOfLines If stdm.CodeModule.Lines(i, 1) Like "'begin *" Then m = i If stdm.CodeModule.Lines(i, 1) Like "'end*" Then n = i - m + 1 Next s = stdm.CodeModule.Lines(m, n) Set stdm = Nothing t = Split(s, vbCrLf) For i = 0 To UBound(t) t(i) = Mid(t(i), 2) Next s = Join(t, vbCrLf) dst = xxe2bin(s, fname) f = FreeFile Open ThisWorkbook.Path & "\" & fname For Binary Access Write As #f Put #f, 1, dst Close #f End Sub 

Of course, we must now all that we have - to engage in work. Two test procedures, one loads the file into the module, the other unpacks the file from the module to disk.

 Sub test1() '     (  xxe) stdm2file ThisWorkbook.Path, "dzp.exe", ThisWorkbook '  ,    'Shell ThisWorkbook.Path & "\" & "dzp.exe", vbNormalNoFocus End Sub Sub test2() '   mdzpexe   On Error Resume Next With ThisWorkbook.VBProject.VBComponents .Remove .Item("mdzpexe") End With '     (  xxe) file2stdm ThisWorkbook.Path, "dzp.exe", ThisWorkbook End Sub 

In addition, the encoding in the XXE format can be used in the e-mail (along with base64) to store attachments, and the encoding character set (+ -A-Za-z) allows you to post the binary on almost any interactive site, say in the comments, if This is not contrary to the rules of the resource.

Sources:
Xxencoding article in Wikipedia