0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

[Excel VBA] ポリュビオス暗号で暗号化する

Last updated at Posted at 2024-09-02

最初に一言

ネストが深いんじゃぁ

ざっくり説明

  • 渡された文字列をポリュビオスの暗号表に当てはめて暗号化します
  • 渡された暗号文をポリュビオスの暗号表に当てはめて復号します

そもそもポリュビオス暗号とは

暗号表という物を用いて、特定の文字を別の文字(数字含む)に置き換える換字式暗号です。

コード

暗号化(ポリュビオスの暗号表)
Function EncryptWithPolybiusSquare(ByVal plaintext As String, ByVal WS As Worksheet) As String
'================================
'用途  :ポリュビオスの暗号表による暗号化
'--------------------------------
'第一引数:平文 (String型)
'第二引数:暗号表のあるシートのWorksheetオブジェクト (Worksheet型)
'戻り値 :暗号文 (String型)
'================================
    Dim PS_ARR As Variant
    PS_ARR = LoadPolybiusSquare(WS, 1, 1)

    Dim convertedText As String
    Dim i As Long
    For i = 1 To Len(plaintext)
        Dim convertedCode As String
        Dim j As Long
        For j = 0 To 99
            If Mid(plaintext, i, 1) = PS_ARR(j) Then
                convertedCode = Right("0" & j, 2)
                convertedText = convertedText + convertedCode
                Exit For
            End If
        Next
    Next

    EncryptWithPolybiusSquare = convertedText
End Function
復号(ポリュビオスの暗号表)
Function DecryptWithPolybiusSquare(ByVal ciphertext As String, ByVal WS As Worksheet) As String
'================================
'用途  :ポリュビオスの暗号表による復号
'--------------------------------
'第一引数:暗号文 (String型)
'第二引数:暗号表のあるシートのWorksheetオブジェクト (Worksheet型)
'戻り値 :平文 (String型)
'================================
    Dim PS_ARR As Variant
    PS_ARR = LoadPolybiusSquare(WS, 1, 1)

    Dim convertedText As String
    Dim i As Long
    For i = 1 To Len(ciphertext) Step 2
        Dim code As Long
        code = Mid(ciphertext, i, 2)
        
        Dim convertedCharacter As String
        convertedCharacter = PS_ARR(code)
        convertedText = convertedText + convertedCharacter
    Next

    DecryptWithPolybiusSquare = convertedText
End Function
ポリュビオス方陣の読み込み
Function LoadPolybiusSquare(ByVal WS As Worksheet, ByVal col As Long, ByVal row As Long) As Variant
'================================
'用途  :ポリュビオス方陣の読み込み
'--------------------------------
'第一引数:Worksheetオブジェクト (Worksheet型)
'第二引数:ポリュビオス方陣 左上セル行番号 (Long型)
'第三引数:ポリュビオス方陣 左上セル列番号 (Long型)
'戻り値 :ポリュビオス方陣の配列 (Variant型)
'================================
    Dim PS_TOPLEFT_CELL As Range
    Dim PS_BOTTOMRIGHT_CELL As Range
    Dim PS As Range
    Set PS_TOPLEFT_CELL = WS.Cells(col, row) 'ポリュビオス方陣の左上セルを指定
    Set PS_BOTTOMRIGHT_CELL = PS_TOPLEFT_CELL.Offset(9, 9)
    Set PS = WS.Range(PS_TOPLEFT_CELL, PS_BOTTOMRIGHT_CELL)

    Dim prePS_ARR As Variant
    prePS_ARR = PS.Value

    Dim PS_ARR(0 To 99) As String
    Dim i As Long
    For i = 1 To 10
        Dim j As Long
        For j = 1 To 10
            Dim num_str As String
            Dim num_lng As String
            num_str = CStr(i Mod 10) & CStr(j Mod 10)
            num_lng = CLng(num_str)
            PS_ARR(num_lng) = prePS_ARR(i, j)
        Next
    Next

    LoadPolybiusSquare = PS_ARR
End Function

使用方法

第一引数に暗号化/復号対象の文字列
第二引数に暗号表のあるシートのオブジェクト
を渡します。

LoadPolybiusSquare()という3つ目のFunctionは共通の部品なので、
どちらを使用する場合も導入が必要です。

仕様等

  • 表にない文字は暗号化されません
  • 表にないコードは復号されません
  • 大文字/小文字、全角/半角は区別されます

注意点

  • 暗号表は10×10の範囲まで使用でき、下表のような方眼の列番号と行番号の組み合わせが暗号化後の文字列となります
  • ポリュビオス方陣の位置はLoadPolybiusSquare()へ渡す引数で制御しています。下表にてAが入力されているセル位置をLoadPolybiusSquare()へ渡して下さい。例えば下表のAと入力されたセルがF3セルに入力されているのであれば、LoadPolybiusSquare()の第二引数は3、第三引数は6(Fは6番目であるため)となります
  • 平文に" "を使用した場合、スペース(" ")も暗号表に入力して下さい
    image.png

その他

特になし

0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?