VBAで暗号を実装しよう その7 単一換字式暗号

• はじめに

ヴィジュネル暗号に進む前にひとつ忘れ物。
シーザー暗号よりはちょっとはましな
単一換字式暗号を実装しちゃいましょう。
おそらくこれがエニグマまでの原型になるはず。。
まだ作ってないのでわからんけど。。

• さくっと歴史

ちょっと調べてみた感じでは
この暗号の歴史はよくわかりませんでした。

暗号の歴史というとヨーロッパが舞台になっていることが多いのですが
次世代の暗号であるヴィジュネル暗号が登場するまで
つまり16世紀のルネサンス期までは
いわゆる暗黒時代というやつだと思うので
その時期の記録があんまりないのかなーと想像しています。

• とりあえず暗号

そなどひぃるぽむげゆあなどひぎはぎぽわひんぃゆ　くぼなほるとぎあなどひぎどひぴばひえびぺ　みっだゎはびぬなべげや　えるゆほまどぽく　そなべぃるぽむげぎそなあとほまひぃどあすはぎぽわ　どあっぅまおげいわひえいく

• さくっと概要

頻度分析が一般的になるまでは主流だった暗号。
文字を別の文字と一対一対応させて
暗号と復元を行うものです。
これくらいしか言うことない笑

• 暗号化のコード

今回はまずは換字表を作ります。
ポリュビオス暗号の際に使った換字式作成の関数をちょっといじればできます。

Function pattern_make  
Function pattern_make()
 
 Dim field As Range
 Dim list() As Variant
 Dim pattern() As String
 Dim str As String
 Dim file_name As String
 
'----------------------
'作業用シートで並び替えて
'listに書き込む
'----------------------
 Sheets.Add
 
 For i = 1 To 83
    Cells(i, 1) = Chr(-32097 + (i - 1))
    Cells(i, 2) = Chr(-32097 + (i - 1))
    Cells(i, 3) = Rnd()
 Next
 
 Set field = Range(Cells(1, 2), Cells(83, 3))
 field.Sort Cells(1, 3), xlAscending
 Set field = Range(Cells(1, 1), Cells(83, 2))
 list = field
 
 Application.DisplayAlerts = False
 ActiveSheet.Delete
 Application.DisplayAlerts = True
'----------------------------
'換字表を作成する
'----------------------------
 ReDim pattern(1 To 83)

 For i = 1 To UBound(list)
    pattern(i) = list(i, 1) & " - " & list(i, 2)
 Next
 
'------------------------------
'strをファイルに書き出す
'------------------------------
 file_name = "ファイルのアドレス"
 Call txt_outputs(pattern, file_name)
 
End Function

うん。
むしろポリュビオス暗号の回よりもきれいになりましたね。
あれは表の見た目のためにだいぶ汚い書き方をしていたから。。
今回はシンプルにかけたかな？

あ。
ちゃっかり新関数「txt_outputs」を使ってます。
これについては次の投稿で書きます。
「txt_inputs」のアウトプット版です。

よし。
メイン関数。

。。。
はっ！
そうか！
俺が天才だったんだ！！

パワプロ風です笑

気づいちゃいました。
今回のアルゴリズムでは暗号化も復元もおんなじ関数で出来ちゃうことに。
どういうことかというと。
サブ関数を一つ減らせるということです。

換字式暗号では
２つのメイン関数
「???coding」
「???restoration」
(???にその暗号の名前が入ります)
4つのサブ関数
「pattern_make」
「pattern_input」
「coding」
「restoration」
を扱ってきましたが。

今回は「coding」と「restoration」の関数を統合します。
「conversion」と名付けましょう。

引数をうまく設定すればこれができるんです。
この喜びは伝わりにくいかな。
基本的に統合出来たらうれしいです笑

って話がそれました。
さて。
とりあえずここでは暗号化のコードを載せますね。

メイン関数。

Sub tanitu_coding()

 Dim str As String
 Dim str2 As String
 Dim file_name As String
 Dim version As String
'---------------------------------------------------------------
'strを読み込む
'---------------------------------------------------------------
 file_name = "ファイルのアドレス"
 str = txt_input(file_name)
'---------------------------------------------------------------
'strを暗号化
'---------------------------------------------------------------
 version = "coding"
 str2 = conversion(str, version)
'---------------------------------------------------------------
'str2を記述
'---------------------------------------------------------------
 file_name = "ファイルのアドレス"
 Call txt_output(str2, file_name)
 
End Sub

あらたに変数「version」が採用されています。
これは「conversion」で用いる変数です。

続いて「conversion」

Function conversion(str, version) As String

 Dim pattern() As String
 Dim char As String
 Dim num As Integer
 Dim ans As String
 ReDim pattern(1 To 83)
'------------------------
'換字表を読み込む
'------------------------
 pattern = pattern_input(version)
'------------------------
'strを暗号化
'------------------------
 For i = 1 To Len(str)
    char = Mid(str, i, 1)

    num = Asc(char) + 32098
    If num < 1 Or 83 < num Then
        ans = ans & char
    Else
        ans = ans & pattern(num)
    End If
 Next
 
 conversion = ans
End Function

「version」は「pattern_input」に引き継がれていますね。

その「pattern_input」はこんな感じ。

Function pattern_input(version) As String()

 Dim ans() As String
 Dim char(0 To 1) As String
 Dim num As Integer
 Dim file_name As String
 Dim d(1) As Integer
 Dim str() As String
 Dim line As Variant
'--------------------
'換字表を読み込む
'--------------------
 file_name = "ファイルのアドレス"
 
 str() = txt_inputs(file_name)
 
 ReDim ans(1 To 83)
 
 Select Case version
    Case Is = "coding"
        d(0) = 0
        d(1) = 1
    Case Is = "restoration"
        d(0) = 1
        d(1) = 0
 End Select
 
 For i = 0 To UBound(str)

    char(d(0)) = Left(str(i), 1)
    char(d(1)) = Right(str(i), 1)
    
    num = Asc(char(0)) + 32098
    ans(num) = char(1)
 Next

 pattern_input = ans
End Function

配列の「d」の値の設定のために
変数「version」を扱っています。
これはなかなかいい思いつきでは？？

• 復元のコード

今回も換字表を知っている前提で書きます。

ちなみに換字表はこんな感じ。

スクショです。
全体が入らなくてすみません。

さて。
今回の復元は難しいことはないですねー。
今までで一番簡単かも。

Sub tanitu_restoration()

 Dim str As String
 Dim str2 As String
 Dim file_name As String
 Dim version As String
 
'---------------------------------------------------------------------
'strを読み込む
'---------------------------------------------------------------------
 file_name = "ファイルのアドレス"
 str = txt_input(file_name)
'---------------------------------------------------------------------
'strを復元
'---------------------------------------------------------------------
 version = "restoration"
 str2 = conversion(str, version)
'---------------------------------------------------------------------
'str2を記述
'---------------------------------------------------------------------
 file_name = "ファイルのアドレス"
 Call txt_output(str2, file_name)

End Sub

中の関数は先ほど書いたものとおんなじ。
というか引数の中身以外は先ほどとおんなじ。

ということは。。。？？？

復元結果はこれ。

こんかいのじっそうでなんかいもおもっているので　たぶんきじにもなんかいもかいちゃいますが　ぽりゅびおすあんごうは　まじできつかった　こんごのじっそうもこんなにきついのかなとおもって　かなりぜつぼうしていました

笑
弱音を隠していました笑

• まとめ

今回実装してみて思ったのは
ポリュビオス暗号の実装がなかなかキツい回だったということ。

今回はそれを基盤にしたのでそこまで大変なところはありませんでした。

あ。「coversion」を思いついたのは今回の収穫でしたね。

次回はまた「形式の修正」を行いましょう。

「txt_outputs」についてと
出来そうなら「txt_output」と統合しちゃいましょう。

あと関数間の連携がちょっと甘いので
それらを統括するコントロール関数もつくりたいな。
たぶん今って関数を作りすぎ笑
無駄にね笑