ファイルの難読化

RelaxToolsの機能に「ファイルの暗号化/複合化」がありましたがあまりにもしょぼいので「ファイルの難読化」に変更しました(v3.11)。
この機能はもともとプログラムの設定ファイルを読めなくする用途で作成されておりまして、プログラムがないといまいち機能でしたので公開いたします。
昔Yah○○!メッセンジャーというものがあり、放送禁止用語がテキストファイルで一緒にインストールされていて、これ難読化ぐらいしておけばいいのになぁ~と思ったことがあります。

用途としては、

1.プログラムの外部に一般の方に見せたくないファイルがあれば事前にRelaxToolsで難読化して配布。
2.プログラム中で難読かを解除してファイルを読み込む。

という感じです。

で、なぜ、1つの関数で難読化と解除が行えるかというと、キー値をXORで演算しているからです。
XORは2度実行すると元にもどる演算となります。

'--------------------------------------------------------------
' ファイルの難読化
' バッファ読み込み対応(2GB以下)
'--------------------------------------------------------------
Sub encryptionFileEx()

    Dim strFile As String
    Dim intIn As Integer
    Dim intOut As Integer
    Dim lngSize As Long
    Dim i As Long
    Dim bytBuf() As Byte
    
    Dim lngRead As Long
    
    Const key As Byte = &H44
    Const C_BUFFER_SIZE = 10485760 '10MB
    Const C_TEMP_FILE_EXT As String = ".tmp"
    
    On Error GoTo ErrHandle
    
    strFile = Application.GetOpenFilename(, , "ファイルの難読化", , False)
    If strFile = "False" Then
        'ファイル名が指定されなかった場合
        Exit Sub
    End If
    
    'ファイルの存在チェック
    If rlxIsFileExists(strFile) Then
    Else
        MsgBox "ファイルが存在しません。", vbExclamation, C_TITLE
        Exit Sub
    End If

    intIn = FreeFile()
    Open strFile For Binary As intIn
    
    intOut = FreeFile()
    Open strFile & C_TEMP_FILE_EXT For Binary As intOut
    
    lngSize = LOF(intIn)
    
    Do While lngSize > 0
    
        If lngSize < C_BUFFER_SIZE Then
            lngRead = lngSize
        Else
            lngRead = C_BUFFER_SIZE
        End If
    
        '最大で10MBのメモリを確保。
        ReDim bytBuf(0 To lngRead - 1)
    
        '確保したバイト数分読み込み
        Get intIn, , bytBuf
        
        'なんちゃって暗号化
        For i = 0 To lngRead - 1
            bytBuf(i) = bytBuf(i) Xor key
        Next
        
        '結果を書き込む
        Put intOut, , bytBuf

        lngSize = lngSize - lngRead
    Loop

    Close intIn
    Close intOut
    
    Kill strFile
    Name strFile & C_TEMP_FILE_EXT As strFile

    MsgBox "簡易暗号化/復号化が完了しました。", vbInformation, C_TITLE
    
    Exit Sub
ErrHandle:
    MsgBox "エラーが発生しました。", vbOKOnly, C_TITLE
End Sub

ABOUTこの記事をかいた人

はてなブックマークで驚愕の1600越えを記録した伝説が今明らかに! エクセル方眼紙 四天王の1人(ほぼ最弱)窓の杜大賞2014 大賞受賞! Excelを便利にする250以上の機能を体系化したアドインはこちらです。