【VBA】画像ファイルを（意図的に）壊して不慮の事故を防ぐ あるいは暗号化してみる（２）

前回は１つのファイルだけを書き換えましたが、今回はフォルダ内の画像を一括変換する処理を書いていきましょう。

celaeno42.hatenablog.com

なお、ここでは「ファイルを壊す」ことを（説明の都合上）「暗号化」と表現することにします。

まずはフォルダの選択

今回はフォルダ内の複数の画像ファイルを一括して暗号化したいので、まずはフォルダ選択の処理を作成します。
Sheet1 の A1 セルをダブルクリックするとフォルダ選択ダイアログが開いて、フォルダを選択すると A1 セルにパスが格納されます。

【Sheet1】

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim dirPath As String
    
    If Target = Range("A1") Then
        
        Cancel = True
        
        With Application.FileDialog(msoFileDialogFolderPicker)
            If .Show = True Then
                Range("A1").Value = .SelectedItems(1)
            End If
        End With
        
    End If
End Sub

ファイル一覧の取得

選択したフォルダ内の画像ファイルを取得します。今回は「.jpg」ファイルのみを対象としていますが、そのあたりは必要に応じて適当に変えてみてください。
取得したファイルのパスは（通常であれば）Sheet1 の A2 セルから順番に格納されていきます。

【標準モジュール】

Option Explicit

Public Sub Click_ファイル一覧取得()
    Dim dirPath As String
    Dim fileName As String
    Dim r As Long
    
    r = 2
    dirPath = Range("A1").Value & "\"
    fileName = Dir(dirPath & "*.jpg", vbNormal)

    While fileName <> ""
        Cells(r, 1).Value = dirPath & fileName
        r = r + 1
        fileName = Dir()
    Wend
    
    MsgBox "ファイル一覧を取得しました"
    
End Sub

これで処理すべき対象ファイルのパスがわかりました。

どう暗号化するか？

前回は先頭 1byte を 16進数の「89」から「90」に書き換えましたが、今回は複数のファイルを一括変換したいので、何らかのルールにもとづいて書き換えを実行した方がよさそうです。ルールを設定しておけば元に戻す場合も簡単です。
前回みたように、今回の処理では、ファイルをバイナリモードで読み込んでByte型の配列変数に格納しています。Byte型は「0～255」までの整数を扱いますが、「Not」演算子を使うことで値を反転させることができます。例えば変数 a が Byte型で値が 0 だった場合、 [ Not a ] とすると 255 が戻ります。また、a が 1 のときは 254、a が 253 のときは 2 が戻ります。今回はこれを利用して 暗号化、復号化 の処理を実装しましょう。なお、真ん中あたりの数値、a が 127 のときは 128, a が 128 のときは 127 になるので「Not」演算子で必ず自分とは別の値が戻ることは保証されます（同じ値が戻ってしまうと暗号化できませんので…）。

暗号化（エンコード）

では、実際に暗号化の処理を書いていきましょう。復号化の場合も暗号化と逆の処理（「Not」演算子で反転）をしているだけなので、プロシージャを分ける必要はありません。なので、プロシージャ名は「encode_decode()」としています。
また、引数としてファイルのパスを受け取るようにしています。なお、配列変数の「buffer」は Byte の配列であることに注意してください。

【標準モジュール】

'ファイルを暗号化（復号化）する
Private Sub encode_decode(ByRef filePath As String)
    Dim fileNo As Long
    Dim buffer() As Byte
    
    fileNo = FreeFile
    'ファイルをバイナリモードで開いてbuffer配列に格納する
    Open filePath For Binary As #fileNo
        ReDim buffer(LOF(fileNo))
        Get #fileNo, , buffer
    Close #fileNo
    
    '先頭 1byte を反転させる
    buffer(0) = Not buffer(0)
    
    fileNo = FreeFile
    'buffer配列をファイルとして書き出す
    Open filePath For Binary As #fileNo
        Put #fileNo, , buffer
    Close #fileNo
    
End Sub

暗号化処理の呼び出し

上で作った暗号化処理を呼び出しましょう。取得したファイル一覧を元に、「encode_decode()」プロシージャに順番にパスを渡していきます。
「Not」演算子で値を反転させているだけなので、暗号化されていない場合は暗号化が、暗号化されている場合は暗号化解除（復号化）が行われます。

【標準モジュール】

Public Sub Click_暗号化_暗号化解除()
    Dim r As Long
    Dim eRow As Long

    eRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    For r = 2 To eRow
        Call encode_decode(Cells(r, 1).Value)
    Next
    
    MsgBox "終了しました"
    
End Sub

動作確認

これで「Click_暗号化_暗号化解除()」プロシージャを実行すればこのとおり。
サムネイルが表示されなくなる（ファイルが壊れる）ので誰かに勝手にフォルダを開けられても安心ですね。



もう一度実行すればこのとおり。ちゃんと元に戻ります。

あっ！… orz

※今回使用した（かわいい）画像は「V☆カツ」で作成しました。