При работе в связке Excel+VBA бывает нужно хранить бинарные данные в контейнере, который накладывает ограничения содержимое. Для этих задач были разработан формат XXEncode. И вот, допустим, Вам захотелось иметь необходимые библиотеки и утилиты, связанные с вашим проектом VBA всегда при себе, внутри Рабочей книги .xls. Ниже я покажу, как я реализовал у себя хранение бинарных файлов в комментариях стандартных модулей проектов VBA.
Кодирование бинарных данных в XXE и обратное преобразование — лкодирование — я рализовал двумя функциями, bin2xxt и xxe2bin соответственно. Чтобы код был более-менее переносим между разными задачами, бинарные данные представлены массивом байт, а закодированные в XXE данные храню в строках.
'' Кодирование массива байт в строку 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 A B C D E F G H I J K L M N O P Q R S T U V W X Y Z a b c d e f g h i j k l m n o p q r s t u v w x y 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
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(Left$(t(j), 1)))
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(Left$(t(j), 1)))
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Кроме того, для поставленной задачи написаны также пара процедур оболочек к кодированию/декодированию: file2stdm загрузка бинарного файла в стандартный модуль проекта VBA (xxe-код размещается в отдельном модуле в комментариях) и обратное преобразование — распаковка файла из того, что закодировано в стандартный модуль stdm2file. Здесь надо отметить, что для свободных манипуляций в VBProject на целевой машине должен быть разрешен доступ к проектам VBA. Ниже привожу пару процедур-оболочек:
' Сохранение файла в стандартном модуле 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Разумеется, надо теперь все, что имеем — задействовать в работе. Две тестовые процедуры, одна загружает файл в модуль, другая — распаковывает файл из модуля на диск.
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Кроме, того, кодировка в формат XXE может применяется в e-mail (наряду с base64) для хранения вложений, а набор символов кодировки (+-A-Za-z) позволяет запостить бинарник почти на любом интерактивном сайте, скажем в комментариях, если это не противоречит правилам ресурса.
Источники:
Статья Xxencoding в Wikipedia
Автор: mcblack
