VBAで暗号を実装しよう その5 換字表をメモ帳で管理しよう

• はじめに

今回は暗号を実装しようの第5弾かな？

今回も「形式の修正」です。

換字式暗号の肝である換字表の作成と読み込みです。

このコーナーの半分以上が暗号を実装しない回になってしまっている。

まだまだ「一歩目」が甘い証拠です。
体勢を崩しても転ばない技術よりは
体勢が崩れない道を選ぶ技術が欲しい

つまり王道の見極め

• なぜ形式を修正するのか？

一応今のままでもコードは作動するのですが。
それでも修正したいのはひとえに
現状が抽象度の低い、不安定なコードだからです。

個人的に抽象度の高いコードが好きです。
現状は換字表はシートのある位置に書き込まれて
その位置を読み込むことで換字表を認識しているのですが
それは抽象度が低い。

もし何かの作動でシートに行列が挿入されて換字表が書き込まれたエリアがずれてしまったら
それだけで正常に作動しなくなってしまいます。

実は自分の書いたポリュビオス暗号はそれにも対応されてはいるのですが
「もしもの処理」が起こりうる要因がはっきり見えているのなら
それはつぶしておいたほうがいいと思います。

• 換字表をメモ帳に書き込む

前回の「txt_output」に引数を導入する

みたいに簡単には解決しません。

どうしましょうかね～。

たしかポリュビオス暗号の回で最後に書いたのですが
メモ帳に換字表を保管することが現実的ですかね。

Function pattern_make()
 
 Dim field As Range
 Dim list() As Variant
 Dim d As Integer
 Dim tmp As String
 Dim pattern() As String
 Dim str As String
 Dim div As Integer
 Dim file_name As String
 
'----------------------
'作業用シートで並び替えて
'listに書き込む
'----------------------
 Sheets.Add
 
 For i = 1 To 83
    Cells(i, 1) = Chr(-32097 + (i - 1))
    Cells(i, 2) = Rnd()
 Next
 
 Set field = Range(Cells(1, 1), Cells(83, 2))
 field.Sort Cells(1, 2), xlAscending
 
 list = field
 
 Application.DisplayAlerts = False
 ActiveSheet.Delete
 Application.DisplayAlerts = True
'----------------------------
'換字表を作成する
'----------------------------
 div = 9
 ReDim pattern(0 To (83 - 1) \ div + 1)
'-----------------------------
'一列目の作成
'-----------------------------
 For i = 1 To div
    pattern(0) = pattern(0) & "   " & i
 Next
'-----------------------------
'それ以降の作成
'-----------------------------
 For i = 1 To UBound(list, 1)
    d = (i - 1) \ div + 1
    pattern(d) = pattern(d) & "  " & list(i, 1)
 Next
'-----------------------------
'文字列の連結
'-----------------------------
  For i = 0 To UBound(pattern)

    pattern(i) = i & pattern(i)
    str = str & pattern(i) & vbCrLf
 Next
'------------------------------
'strをファイルに書き出す
'------------------------------
 file_name = "C:\Users\DiCE\Desktop\work\kaeji.txt"
 Call txt_output(str, file_name)
 
End Function

んー。
とりあえず書いたんですけど
なんだか汚いし汎用性がなさそう。。。

結果はこんな感じ。

まぁ良しとしましょう。。

• メモ帳の換字表を読み込む

この手のものは作り方さえわかってしまえば
読み込みはさほど難しくありません。

と思ったけどちょっと面倒なことが。
換字表を作成するときにVbCrLfを入れてしまった
つまり改行してしまいましたよね。

Line Input はテキストファイルの一行を読むものなので
それだけだとテキストデータを読みきれない。。

なので「txt_inputs」という関数を作って使うことにします。

まずは換字表を読み込む「pattern_input」から

Function pattern_input() As Integer()

 Dim ans() As Integer
 Dim tmp As Integer
 Dim file_name As String
 Dim str() As String
 Dim line As Variant
'--------------------
'換字表を読み込む
'--------------------
 file_name = "ファイル名を記述"
 
 str() = txt_inputs(file_name)
 
 ReDim ans(1 To 83)
 
 For i = 1 To UBound(str)
    line = Split(str(i), "  ")
    For j = 1 To UBound(line)
        tmp = Asc(line(j)) + 32098
        ans(tmp) = i & j
    Next
 Next

 pattern_input = ans
End Function

こちらは以前のタイプよりすっきりしたかもですね。
split関数はほんまに神です！

続いてFunction txt_inputs

Function txt_inputs(file_name) As String()
 Dim ans() As String
 Dim n As Integer
 
 n = 0
 
 Open file_name For Input As #1
    Do While Not EOF(1)
        ReDim Preserve ans(n)
        Line Input #1, ans(n)
        n = n + 1
    Loop
 Close #1
 txt_inputs = ans
End Function

ふぅ。

これにて実装完了！！

• 一応テスト

ちゃんと動くか確認です。

暗号文
89 35 15 88 19 15 17 81 65 35 　 57 35 81 96 57 84 51 　 35 49 19 64 95 93 19 57 94 93 22 28 54 　 57 94 93 22 19 96 57 84 21 　 52 45 57 72 63 64 91 81 13 35 52 28 26 27 13 92 99 15 49 81 19 28 　 56 35 99 72 22 81 29 81 55 94 36 96 57 51 76 76 13 92 87 45

復元文

けいしきのしゅうせい　ということばが　いまのじぶんのとれんどです　とれんどのことばは　わりとにちじょうかいわでもつかってしまうので　あいてにどうようされることがおおかったり

こんなもんでぃ！！

• まとめ

暗号で話したとおり
「形式の修正」という言葉が今のトレンドです。

デザインってなくても生きてはいけると思うのですが
なんというか
華だなぁと思います。

そろそろ新しい暗号を作成したいですね～

次回はシーザー暗号！！
ゆうめいなやーつ。