VBAのXXEncode形式、またはドキュメントにバイナリを読み込む方法

多くのExcel + VBAで作業する場合、コンテンツ制限を課すコンテナにバイナリデータを保存する必要がある場合があります。 これらのタスクのために、 XXEncode形式が開発されました。 そして今、VBAプロジェクトに関連する必要なライブラリとユーティリティを、.xlsワークブック内に常に持ち歩きたいとしましょう。 以下に、VBAプロジェクトの標準モジュールのコメントにバイナリファイルのストレージを実装する方法を示します。



XXEでのバイナリデータのエンコードと逆変換-デコード-2つの関数、 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 ABCDEFGHIJKLMNOPQRSTU VWXYZ abcdefghijklmnopqrstu vwxyz") 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
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     

さらに、エンコード/デコード用のいくつかのシェルプロシージャもタスク用に作成されています。VBAプロジェクトの標準モジュールにバイナリファイルを読み込むfile2stdm（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
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     

もちろん、今やるべきことは仕事に従事することだけです。 2つのテスト手順。1つはモジュールにファイルをロードし、もう1つはモジュールからディスクにファイルを解凍します。

 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形式のエンコードは、添付ファイルを保存するために電子メールで（base64とともに）使用でき、エンコード文字セット（+ -A-Za-z）を使用すると、コメントなどで、ほぼすべてのインタラクティブサイトにバイナリを投稿できます。これはリソースのルールに反するものではありません。



ソース：

ウィキペディアのXencoding記事