Excel VBAでDES(Data Encryption Standard)を組んでみた

スポンサーリンク

DESが必要となりました

未使用の「MIFARE Ultralight C」というICカードを入手したので、遊んでみようと思い、データシートを読み始めました。そうしたら、Triple DES(以下3DES)暗号を使う必要があるみたい。

ちょっと調べてみたところ、EncryptStringTripleDESという関数を使えばTriple DES暗号化できると書いてあるページがありました。でも、8文字の文字列を暗号化すると、24文字になってしまい、僕の使いたい用途には使えないようです。

僕の欲しいのは32ビットが32ビットで暗号化される関数なんだけどな。

Excel VBAでDESを組んでみた

簡単な関数では実現できなさそうなので、公表されているDESのアルゴリズムを基に、ExcelのVBAで組んでみることにしました。

3DESはDESを用いて暗号化、複合化、暗号化すれば実現できるので、先ずはDESが実現できることが肝心です。

こちらがVBAのコードです。
ExcelのVisual Basicエディタを開いて、標準モジュールを追加し、コードをコピペしてください。

'-----------------------------------------------------------------------
' Summary: DES(Data Encryption Standard)により暗号化/復号する
'-----------------------------------------------------------------------

'-----------------------------------------------------------------------
' Summary: 2進文字列をバイト配列に変換する
' Input  : strBin: 2進文字列
' Returns: バイト配列[Base0]
'-----------------------------------------------------------------------
Private Function Bin2Byte(ByVal strBin As String) As Byte()
    Dim byt()   As Byte     ' 戻り値作成用
    Dim i       As Integer  ' 制御変数
    
    ' 引数が存在することを確認
    If strBin = "" Then Exit Function
    ' 戻り値の配列サイズを確保
    ReDim byt(Len(strBin) - 1)
    ' 文字列を1文字ずつ処理
    For i = LBound(byt) To UBound(byt)
        ' 文字をバイト配列にする(コード変換しない)
        byt(i) = CByte(Mid(strBin, i + 1, 1))
    Next i
    ' 戻り値としてセットする
    Bin2Byte = byt
End Function

'-----------------------------------------------------------------------
' Summary: 2進文字列を16進文字列に変換する
' Input  : strBin: 2進文字列
' Returns: 16進文字列
'-----------------------------------------------------------------------
Public Function Bin2Hex(ByVal strBin As String) As String
    Dim i       As Integer  ' 制御変数
    Dim strTmp  As String   ' 戻り値作成用
    
    ' 戻り値をクリア
    strTmp = ""
    ' 2進文字列長が4の倍数でない場合は先頭に0を付けて4の倍数にする
    strBin = String((4 - (Len(strBin) Mod 4)) Mod 4, "0") & strBin
    ' LSBから4文字ずつ16進に変換する
    For i = Len(strBin) \ 4 To 1 Step -1
        ' 2進数の4文字が一致した16進を前に付け加える
        Select Case UCase(Mid(strBin, i * 4 - 3, 4))
            Case "0000": strTmp = "0" & strTmp
            Case "0001": strTmp = "1" & strTmp
            Case "0010": strTmp = "2" & strTmp
            Case "0011": strTmp = "3" & strTmp
            Case "0100": strTmp = "4" & strTmp
            Case "0101": strTmp = "5" & strTmp
            Case "0110": strTmp = "6" & strTmp
            Case "0111": strTmp = "7" & strTmp
            Case "1000": strTmp = "8" & strTmp
            Case "1001": strTmp = "9" & strTmp
            Case "1010": strTmp = "A" & strTmp
            Case "1011": strTmp = "B" & strTmp
            Case "1100": strTmp = "C" & strTmp
            Case "1101": strTmp = "D" & strTmp
            Case "1110": strTmp = "E" & strTmp
            Case "1111": strTmp = "F" & strTmp
            Case Else
        End Select
    Next i
    ' 戻り値としてセットする
    Bin2Hex = strTmp
End Function

'-----------------------------------------------------------------------
' Summary: バイト配列を数字にする
' Input  : byt(): バイト配列
' Returns: 数字文字列
'-----------------------------------------------------------------------
Private Function Byte2Num(ByRef byt() As Byte) As String
    Dim i       As Integer  ' 制御変数
    Dim strTmp  As String   ' 戻り値作成用

    ' 戻り値をクリア
    strTmp = ""
    ' 先頭バイトから順に処理する
    For i = LBound(byt) To UBound(byt)
        ' 目的とするバイト配列の数値が0~9であることを確認する
        If 0 <= byt(i) And byt(i) <= 9 Then
            ' 文字列に値を追記する
            strTmp = strTmp & Format(byt(i), "0")
        End If
    Next i
    ' 戻り値をセットする
    Byte2Num = strTmp
End Function

'-----------------------------------------------------------------------
' Summary: DES(Data Encryption Standard)による暗号化/復号
' Input  : bytDat(): バイト配列で渡される64ビット長のデータ
'        : bytKey(): バイト配列で渡される64ビット長のキー
'        : blnEnc  : Ture → 暗号化, False → 復号
' Returns: バイト配列で渡す64ビット長の暗号化/復号されたデータ
'-----------------------------------------------------------------------
Private Function DES( _
        ByRef bytDat() As Byte, _
        ByRef bytKey() As Byte, _
        ByVal blnEnc As Boolean) _
        As Byte()
    Const cstDataLen    As Integer = 64     ' Dataのビット長
    Const cstHalfKeyLen As Integer = 28     ' 56ビットキーの半分の長さ
    Const cstKLen       As Integer = 48     ' Sボックス投入前のビット長
    Const cstRoundCnt   As Integer = 16     ' 繰り返しラウンド数
    Dim bytDES(cstDataLen - 1)          As Byte ' 暗号化(復号)されたData
    Dim bytIP(cstDataLen - 1)           As Byte ' IPで並べ替えられたData
    Dim bytKeyC(2 * cstHalfKeyLen - 1)  As Byte ' C鍵
    Dim bytKeyCD(2 * cstHalfKeyLen - 1) As Byte ' C鍵にD鍵を連結した鍵
    Dim bytKeyD(2 * cstHalfKeyLen - 1)  As Byte ' D鍵
    Dim bytKeyShftd(cstRoundCnt - 1, _
            cstKLen - 1)                As Byte ' ラウンド毎に使う鍵
    Dim bytL(cstDataLen \ 2 - 1)        As Byte ' 半分に分けたDataの左側
    Dim bytLR(cstDataLen - 1)           As Byte ' 最終転置後のData
    Dim bytPout(cstDataLen \ 2 - 1)     As Byte ' S Box出力の並び替え
    Dim bytR(cstDataLen \ 2 - 1)        As Byte ' 半分に分けたDataの右側
    Dim bytRbak(cstDataLen \ 2 - 1)     As Byte ' 左右のデータ入れ替え用
    Dim bytSin(cstKLen - 1)             As Byte ' S Boxへの入力
    Dim bytSout(cstDataLen \ 2 - 1)     As Byte ' S Boxからの出力
    Dim i                               As Integer  ' 制御変数
    Dim intColumn                       As Integer  ' S Box内の列番号
    Dim intLoc                          As Integer  ' ビットシフトの位置
    Dim intRow                          As Integer  ' S Box内の行番号
    Dim intSBox(8 - 1, 4 - 1, 16 - 1)   As Integer  ' S Box行列[Base0]
    Dim intSout                         As Integer  ' S Box出力値
    Dim j                               As Integer  ' 制御変数
    Dim k                               As Integer  ' 制御変数
    Dim vrtEbitSel                      As Variant  ' E bit選択
    Dim vrtInvIP                        As Variant  ' IPの逆変換
    Dim vrtIP                           As Variant  ' InitialPermutation
    Dim vrtLS                           As Variant  ' 鍵の左シフト数
    Dim vrtP                            As Variant  ' Pテーブル
    Dim vrtPC1                          As Variant  ' Permuted Choice 1
    Dim vrtPC2                          As Variant  ' Permuted Choice 2
    Dim vrtSBox(1 To 8)                 As Variant  ' S Box配列[Base1]
    
    ' IP(Initial Permutation)のテーブル
    vrtIP = Array( _
            58, 50, 42, 34, 26, 18, 10, 2, _
            60, 52, 44, 36, 28, 20, 12, 4, _
            62, 54, 46, 38, 30, 22, 14, 6, _
            64, 56, 48, 40, 32, 24, 16, 8, _
            57, 49, 41, 33, 25, 17, 9, 1, _
            59, 51, 43, 35, 27, 19, 11, 3, _
            61, 53, 45, 37, 29, 21, 13, 5, _
            63, 55, 47, 39, 31, 23, 15, 7)
    ' DataをIPで並べ替える
    For i = LBound(vrtIP) To UBound(vrtIP)
        bytIP(i) = bytDat(CInt(vrtIP(i)) - 1)
    Next i
    ' 32bitずつ左右に分ける
    For i = 0 To cstDataLen \ 2 - 1
        bytL(i) = bytIP(i)
        bytR(i) = bytIP(cstDataLen \ 2 + i)
    Next i
    
    ' PC1(Permuted Choice 1)のテーブル
    vrtPC1 = Array( _
            57, 49, 41, 33, 25, 17, 9, _
            1, 58, 50, 42, 34, 26, 18, _
            10, 2, 59, 51, 43, 35, 27, _
            19, 11, 3, 60, 52, 44, 36, _
            63, 55, 47, 39, 31, 23, 15, _
            7, 62, 54, 46, 38, 30, 22, _
            14, 6, 61, 53, 45, 37, 29, _
            21, 13, 5, 28, 20, 12, 4)
    
    ' 元の鍵をPC1で並べ替え
    For i = 0 To cstHalfKeyLen - 1
        '上位・下位28ビットをそれぞれC鍵、D鍵とする
        bytKeyC(i) = bytKey(CInt(vrtPC1(i)) - 1)
        bytKeyD(i) = bytKey(CInt(vrtPC1(i + cstHalfKeyLen)) - 1)
        ' 鍵のシフトに備えて、後ろに28ビット分コピーして繋げておく
        bytKeyC(cstHalfKeyLen + i) = bytKeyC(i)
        bytKeyD(cstHalfKeyLen + i) = bytKeyD(i)
    Next i
    
    ' 鍵の左シフト数のテーブル(合計12*2+4=28[bit]のシフト)
    vrtLS = Array( _
            1, 1, 2, 2, 2, 2, 2, 2, _
            1, 2, 2, 2, 2, 2, 2, 1)
            
    ' PC2(Permuted Choice 2)のテーブル
    vrtPC2 = Array( _
            14, 17, 11, 24, 1, 5, _
            3, 28, 15, 6, 21, 10, _
            23, 19, 12, 4, 26, 8, _
            16, 7, 27, 20, 13, 2, _
            41, 52, 31, 37, 47, 55, _
            30, 40, 51, 45, 33, 48, _
            44, 49, 39, 56, 34, 53, _
            46, 42, 50, 36, 29, 32)
    
    ' ビットシフトの位置を先頭にする
    intLoc = 0
    ' ラウンドの回数だけループ
    For i = 0 To cstRoundCnt - 1
        ' ビットシフトの値を決める
        intLoc = intLoc + CInt(vrtLS(i))
        ' ビットシフトしながらCDキーの連結を作る
        For j = 0 To cstHalfKeyLen - 1
            bytKeyCD(j) = bytKeyC(intLoc + j)
            bytKeyCD(cstHalfKeyLen + j) = bytKeyD(intLoc + j)
        Next j
        ' CDの連結キーをPC2で並べ替えてラウンドごとの鍵を得る
        For j = LBound(vrtPC2) To UBound(vrtPC2)
            bytKeyShftd(i, j) = bytKeyCD(CInt(vrtPC2(j)) - 1)
        Next j
    Next i
    
    ' E bit選択テーブル
    vrtEbitSel = Array( _
            32, 1, 2, 3, 4, 5, _
            4, 5, 6, 7, 8, 9, _
            8, 9, 10, 11, 12, 13, _
            12, 13, 14, 15, 16, 17, _
            16, 17, 18, 19, 20, 21, _
            20, 21, 22, 23, 24, 25, _
            24, 25, 26, 27, 28, 29, _
            28, 29, 30, 31, 32, 1)

    ' S Boxテーブル
    vrtSBox(1) = Array( _
            14, 4, 13, 1, 2, 15, 11, 8, 3, 10, 6, 12, 5, 9, 0, 7, _
            0, 15, 7, 4, 14, 2, 13, 1, 10, 6, 12, 11, 9, 5, 3, 8, _
            4, 1, 14, 8, 13, 6, 2, 11, 15, 12, 9, 7, 3, 10, 5, 0, _
            15, 12, 8, 2, 4, 9, 1, 7, 5, 11, 3, 14, 10, 0, 6, 13)
    vrtSBox(2) = Array( _
            15, 1, 8, 14, 6, 11, 3, 4, 9, 7, 2, 13, 12, 0, 5, 10, _
            3, 13, 4, 7, 15, 2, 8, 14, 12, 0, 1, 10, 6, 9, 11, 5, _
            0, 14, 7, 11, 10, 4, 13, 1, 5, 8, 12, 6, 9, 3, 2, 15, _
            13, 8, 10, 1, 3, 15, 4, 2, 11, 6, 7, 12, 0, 5, 14, 9)
    vrtSBox(3) = Array( _
            10, 0, 9, 14, 6, 3, 15, 5, 1, 13, 12, 7, 11, 4, 2, 8, _
            13, 7, 0, 9, 3, 4, 6, 10, 2, 8, 5, 14, 12, 11, 15, 1, _
            13, 6, 4, 9, 8, 15, 3, 0, 11, 1, 2, 12, 5, 10, 14, 7, _
            1, 10, 13, 0, 6, 9, 8, 7, 4, 15, 14, 3, 11, 5, 2, 12)
    vrtSBox(4) = Array( _
            7, 13, 14, 3, 0, 6, 9, 10, 1, 2, 8, 5, 11, 12, 4, 15, _
            13, 8, 11, 5, 6, 15, 0, 3, 4, 7, 2, 12, 1, 10, 14, 9, _
            10, 6, 9, 0, 12, 11, 7, 13, 15, 1, 3, 14, 5, 2, 8, 4, _
            3, 15, 0, 6, 10, 1, 13, 8, 9, 4, 5, 11, 12, 7, 2, 14)
    vrtSBox(5) = Array( _
            2, 12, 4, 1, 7, 10, 11, 6, 8, 5, 3, 15, 13, 0, 14, 9, _
            14, 11, 2, 12, 4, 7, 13, 1, 5, 0, 15, 10, 3, 9, 8, 6, _
            4, 2, 1, 11, 10, 13, 7, 8, 15, 9, 12, 5, 6, 3, 0, 14, _
            11, 8, 12, 7, 1, 14, 2, 13, 6, 15, 0, 9, 10, 4, 5, 3)
    vrtSBox(6) = Array( _
            12, 1, 10, 15, 9, 2, 6, 8, 0, 13, 3, 4, 14, 7, 5, 11, _
            10, 15, 4, 2, 7, 12, 9, 5, 6, 1, 13, 14, 0, 11, 3, 8, _
            9, 14, 15, 5, 2, 8, 12, 3, 7, 0, 4, 10, 1, 13, 11, 6, _
            4, 3, 2, 12, 9, 5, 15, 10, 11, 14, 1, 7, 6, 0, 8, 13)
    vrtSBox(7) = Array( _
            4, 11, 2, 14, 15, 0, 8, 13, 3, 12, 9, 7, 5, 10, 6, 1, _
            13, 0, 11, 7, 4, 9, 1, 10, 14, 3, 5, 12, 2, 15, 8, 6, _
            1, 4, 11, 13, 12, 3, 7, 14, 10, 15, 6, 8, 0, 5, 9, 2, _
            6, 11, 13, 8, 1, 4, 10, 7, 9, 5, 0, 15, 14, 2, 3, 12)
    vrtSBox(8) = Array( _
            13, 2, 8, 4, 6, 15, 11, 1, 10, 9, 3, 14, 5, 0, 12, 7, _
            1, 15, 13, 8, 10, 3, 7, 4, 12, 5, 6, 11, 0, 14, 9, 2, _
            7, 11, 4, 1, 9, 12, 14, 2, 0, 6, 10, 13, 15, 3, 5, 8, _
            2, 1, 14, 7, 4, 10, 8, 13, 15, 12, 9, 0, 3, 5, 6, 11)

    ' SBoxを3次元配列に変換する(BASE1→BASE0)
    For i = LBound(intSBox, 1) To UBound(intSBox, 1)
        For j = LBound(intSBox, 2) To UBound(intSBox, 2)
            For k = LBound(intSBox, 3) To UBound(intSBox, 3)
                intSBox(i, j, k) = CInt(vrtSBox(i + 1)(j * 16 + k))
            Next k
        Next j
    Next i
    
    ' Pテーブル
    vrtP = Array( _
            16, 7, 20, 21, 29, 12, 28, 17, _
            1, 15, 23, 26, 5, 18, 31, 10, _
            2, 8, 24, 14, 32, 27, 3, 9, _
            19, 13, 30, 6, 22, 11, 4, 25)
    
    For i = 0 To cstRoundCnt - 1
        ' Sボックス投入前のビット選択
        For j = LBound(bytSin) To UBound(bytSin)
            If blnEnc Then
                ' 暗号化の場合
                bytSin(j) = bytR(vrtEbitSel(j) - 1) _
                        Xor bytKeyShftd(i, j)
            Else
                ' 復号の場合
                bytSin(j) = bytR(vrtEbitSel(j) - 1) _
                        Xor bytKeyShftd(cstRoundCnt - 1 - i, j)
            End If
        Next j
        ' 8つのSBoxに対して処理する
        For k = LBound(intSBox, 1) To UBound(intSBox, 1)
            ' 6bitずつ区切ったときのMSBとLSBが行番号になる
            intRow = "&H" & _
                    Bin2Hex(bytSin(k * 6 + 0) & bytSin(k * 6 + 5))
            ' 間の4bitが列番号になる
            intColumn = "&H" & Bin2Hex( _
                    bytSin(k * 6 + 1) & _
                    bytSin(k * 6 + 2) & _
                    bytSin(k * 6 + 3) & _
                    bytSin(k * 6 + 4))
            ' SBoxの行番号と列番号を指定して数値を得る
            intSout = intSBox(k, intRow, intColumn)
            ' ビットに分解してバイト配列に保持する
            bytSout(k * 4 + 0) = (intSout And 8) \ 8
            bytSout(k * 4 + 1) = (intSout And 4) \ 4
            bytSout(k * 4 + 2) = (intSout And 2) \ 2
            bytSout(k * 4 + 3) = (intSout And 1) \ 1
        Next k
        ' Pテーブルでビットを並び替えると同時にRのバックアップをとる
        For j = LBound(bytR) To UBound(bytR)
            bytPout(j) = bytSout(CInt(vrtP(j) - 1))
            bytRbak(j) = bytR(j)
        Next j
        ' 新RはLとPoutのXorとし、新LはRのバックアップとする
        For j = LBound(bytR) To UBound(bytR)
            bytR(j) = bytL(j) Xor bytPout(j)
            bytL(j) = bytRbak(j)
        Next j
    Next i
    ' LとRの左右を入れ替えて連結する
    For i = LBound(bytR) To UBound(bytR)
        bytLR(i) = bytR(i)
        bytLR(cstDataLen \ 2 + i) = bytL(i)
    Next i
    
    ' InvIPのテーブル
    vrtInvIP = Array( _
        40, 8, 48, 16, 56, 24, 64, 32, _
        39, 7, 47, 15, 55, 23, 63, 31, _
        38, 6, 46, 14, 54, 22, 62, 30, _
        37, 5, 45, 13, 53, 21, 61, 29, _
        36, 4, 44, 12, 52, 20, 60, 28, _
        35, 3, 43, 11, 51, 19, 59, 27, _
        34, 2, 42, 10, 50, 18, 58, 26, _
        33, 1, 41, 9, 49, 17, 57, 25)
        
    ' InvIPで並べ替えて暗号にする
    For i = LBound(bytDES) To UBound(bytDES)
        bytDES(i) = bytLR(CInt(vrtInvIP(i)) - 1)
    Next i
    
    ' 戻り値としてセットする
    DES = bytDES
End Function

'-----------------------------------------------------------------------
' Summary: 16進文字列を2進文字列に変換する
' Input  : strHex: 16進文字列
' Returns: 2進文字列
'-----------------------------------------------------------------------
Private Function Hex2Bin(ByVal strHex As String) As String
    Dim i       As Integer
    Dim strTmp  As String

    ' 戻り値をクリア
    strTmp = ""
    ' 16進文字列を頭から1文字ずつ処理
    For i = 1 To Len(strHex)
        ' コードによって分岐し、対応する2進コードを追記する
        Select Case UCase(Mid(strHex, i, 1))
            Case "0": strTmp = strTmp & "0000"
            Case "1": strTmp = strTmp & "0001"
            Case "2": strTmp = strTmp & "0010"
            Case "3": strTmp = strTmp & "0011"
            Case "4": strTmp = strTmp & "0100"
            Case "5": strTmp = strTmp & "0101"
            Case "6": strTmp = strTmp & "0110"
            Case "7": strTmp = strTmp & "0111"
            Case "8": strTmp = strTmp & "1000"
            Case "9": strTmp = strTmp & "1001"
            Case "A": strTmp = strTmp & "1010"
            Case "B": strTmp = strTmp & "1011"
            Case "C": strTmp = strTmp & "1100"
            Case "D": strTmp = strTmp & "1101"
            Case "E": strTmp = strTmp & "1110"
            Case "F": strTmp = strTmp & "1111"
            Case Else
        End Select
    Next i
    ' 戻り値としてセットする
    Hex2Bin = strTmp
End Function

'-----------------------------------------------------------------------
' Summary: 64ビット(8バイト)のデータとキーをDES関数に渡して結果を得る
' Input  : strData: 16進文字列16文字で表したData
'        : strKey : 16進文字列16文字で表したKey
'        : blnEnc  : Ture → 暗号化, False → 復号
' Returns: 16進文字列16文字で表した暗号/複合
'-----------------------------------------------------------------------
Public Function CallDES( _
        ByVal strData As String, _
        ByVal strKey As String, _
        ByVal blnEnc As Boolean) _
        As String
    Const cstLen    As Integer = 64 ' Data及びKeyのビット長
    Dim strBinData  As String       ' 2進数文字列で表したData
    Dim strBinKey   As String       ' 2進数文字列で表したKey
    
    ' Dataを2進数に変換
    strBinData = Hex2Bin(strData)
    ' Keyを2進数に変換
    strBinKey = Hex2Bin(strKey)
    ' Dataが64ビットであることを確認する
    If Len(strBinData) <> cstLen Then _
            CallDES = "データ異常です": Exit Function
    ' Keyが64ビットであることを確認する
    If Len(strBinKey) <> cstLen Then _
            CallDES = "キー異常です": Exit Function
    ' DES関数を呼び出し、戻り値を16新文字列に変換して戻り値とする
    CallDES = Bin2Hex(Byte2Num( _
            DES(Bin2Byte(strBinData), Bin2Byte(strBinKey), blnEnc)))
End Function

使い方はこちら。
Excelシートから、C4、C5セルのようにして呼び出せます。

DES

DES

暗号化するには、DataとKeyを16進文字列16文字にして、

= CallDES(DATA, KEY, TRUE)

とします。

また、復号は、

= CallDES(暗号, KEY, FALSE)

でできます。

ここでは、B2、B3、B4に、それぞれDATA、KEY、暗号という名前を付けて使っています。
セルに名前を付ける方法はこちらをご覧ください。

なお、使っているKEYは、乱数を用いて適当に決めたので、意味はありません。

まとめ

DESをVBAで組みました。暗号化したデータが無事に復号できたので、アルゴリズムは一応、合っていると思います。

3DESについては、こちらに示します。

コメント

タイトルとURLをコピーしました