滝の音

滝の音

名こそ流れてなお聞こえけれ

5-3-1プログラムとは Excel所有者むけコード付き

はじめに

このブログ内では人気の記事だったので、わかりやすく書き直しました~!

5-3-1プログラムとは?

全16回からなるプログラムです。

1. max重量の70% 5セット5レップ
2. max重量の75% 5セット3レップ
3. max重量の80% 5セット1レップ
4. max重量の60% 2セット8レップ
以上4回がセクション1。

セクション2は1,2,3を+5%にして、4はそのまま。
1. max重量の75% 5セット5レップ
2. max重量の80% 5セット3レップ
3. max重量の85% 5セット1レップ
4. max重量の60% 2セット8レップ

セクション3、セクション4も同様に重量を上げていきます。
そして16回目にMax測定を行います。

ちょっとわかりずらいですかね。。

表にするとこんな感じです。

day workout day workout
1 70% 5セット5レップ 2 75% 5セット3レップ
3 80% 5セット1レップ 4 60% 2セット8レップ
5 75% 5セット5レップ 6 80% 5セット3レップ
7 85% 5セット1レップ 8 60% 2セット8レップ
9 80% 5セット5レップ 10 85% 5セット3レップ
11 90% 5セット1レップ 12 max重量の60% 2セット8レップ
13 85% 5セット5レップ 14 90% 5セット3レップ
15 95% 5セット1レップ 16 max測定

メニュー自動作成プログラミングコード

エクセルの環境を持っている人向けです。
VBAでメニュー自動作成プログラミングを書きました。

VBAの使い方はわからないけど興味はある…という人向けに

taki-no-oto.hatenablog.com

VBAの使い方、「5-3-1プログラム自動作成」を走らせるまでの解説記事もあります!

ぜひぜひ使ってみてください!

ちなみにうまく実装して結果をPDF化するとこうなります!

f:id:nozomi-hayashi:20180108094405p:plain

めちゃ便利なので、これを機に試してみてください!

VBAを使う方法の解説! 5-3-1プログラムを走らせるまで

はじめに

筋トレのプログラム自動作成のコードを載せたのですが、 VBAの使い方が分からない! という声を聞いたので、解説を作ってみました。

ぜひご活用ください。

Excelを起動する

これは簡単ですね。

名前を付けて保存

起動してまずしてほしいことは、 名前を付けて保存 です。

そしてその時にファイル形式を変更してください。

f:id:nozomi-hayashi:20180731182216p:plain

こんな風に!

VBEの起動

VBEってなんだろう?
とかはどうでもいいですよね笑
コードを書き込む場所 と思ってください。

[alt] + [F11] キーを押すことで出てきます。

f:id:nozomi-hayashi:20180731182552p:plain

こんな感じの殺風景なものが現れれば成功!

標準モジュールを挿入する

コードを書き込む場所を作ります。
といってもやり方は簡単。

f:id:nozomi-hayashi:20180731182715p:plain

[挿入]
[標準モジュール]
を押してください。

f:id:nozomi-hayashi:20180731182816p:plain

こうなったら成功です!

コードを書き込む

今回は5-3-1プログラムのコードを書き込みます。

以下をシートに貼り付けてください

Sub proguram_531_16()
 
 Dim cul(0 To 16, 1 To 4) As Variant
 Dim x As Single
 Dim y As Single
 
 Cells.ClearContents
 
'MAX重量の入力
continue:
 m = InputBox("MAX重量を半角数字で入力")
 If Val(m) <= 0 Then GoTo continue
 
 Cells(2, 2) = "プログラム531"
 Cells(2, 5) = "max " & m & "kg"
 
'日数設定
 cul(0, 1) = "day"
 For i = 1 To 16
    cul(i, 1) = "day" & i
 Next
 
'重量設定
 cul(0, 2) = "重量(kg)"
 For i = 0 To 3
    p = 0.05 * i
    cul(4 * i + 1, 2) = m * (0.7 + p)
    cul(4 * i + 2, 2) = m * (0.75 + p)
    cul(4 * i + 3, 2) = m * (0.8 + p)
    cul(4 * i + 4, 2) = m * 0.6
 Next
 
'重量の調整
 For i = 1 To 16
    x = cul(i, 2) * 10
    y = x \ 25
    y = x - y * 25
    
    If y > 12.5 Then
        x = x + (25 - y)
    Else
        x = x - y
    End If
    
    cul(i, 2) = x / 10
 Next
   
 
'set数とrep数の設定
 cul(0, 3) = "set数"
 cul(0, 4) = "rep数"
 
 For i = 0 To 3
    cul(4 * i + 1, 3) = 5
    cul(4 * i + 1, 4) = 5
    
    cul(4 * i + 2, 3) = 5
    cul(4 * i + 2, 4) = 3
    
    cul(4 * i + 3, 3) = 5
    cul(4 * i + 3, 4) = 1
    
    cul(4 * i + 4, 3) = 2
    cul(4 * i + 4, 4) = 8
 Next
 
'day16の修正
 cul(16, 2) = "MAX測定"
 cul(16, 3) = ""
 cul(16, 4) = ""
 
'セルへ貼り付け
 Range(Cells(4, 2), Cells(20, 5)) = cul
End Sub

f:id:nozomi-hayashi:20180731183127p:plain

これで後はコードを走らせるだけ!
もう少し頑張りましょう!

コードを走らせる

[F5]キーを押してください。
それだけで走ります。
f:id:nozomi-hayashi:20180731183554p:plain

こんな入力フォームが現れるので、自分の現在のMax重量を入力してください。
半角 でお願いします!

f:id:nozomi-hayashi:20180731183852p:plain

すると何やらシートに出来上がった形跡があるので、〇で囲った部分をクリックしてVBEを閉じます。

f:id:nozomi-hayashi:20180731184113p:plain

これにて完了!
あとはこれをコピーするなりPDF化するなりして使ってください!!

以上でVBAを使う方法の解説は終わりです!
お疲れさまでした!

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」のアウトプット版です。

よし。
メイン関数。

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

パワプロ風です笑

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

換字式暗号では
2つのメイン関数
「???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」を扱っています。
これはなかなかいい思いつきでは??

  • 復元のコード

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

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

f:id:nozomi-hayashi:20180725111203g:plain

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

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

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」と統合しちゃいましょう。

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

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

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

結果はこんな感じ。

f:id:nozomi-hayashi:20180721024355g:plain

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

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

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

と思ったけどちょっと面倒なことが。
換字表を作成するときに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

復元文

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

こんなもんでぃ!!

  • まとめ

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

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

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

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

VBAで暗号を実装しよう その4 読み書きするファイルを指定しよう

  • はじめに

暗号を実装しようの第4弾。

今回はなんと暗号を実装しません笑

前回の告知のように「形式の修正」

関数の「txt_input」と「txt_output」に

読み込み先、書き込み先のテキストファイルを選択する機能を付け足します。

*

なぜ必要なのか

ファイルのテキストデータを読み込む関数を「txt_input」

ファイルにテキストデータを書き出す関数を「txt_output」

としています。

そうすることでメイン関数をスリムにできたり

あちこちで関数を使いまわすことができます。

ただ。

関数先でファイルのアドレスを固定してしまうとうまくいかないことが多いんですよね。

例えば。

あくまで自分はですが。

暗号の原文はinput.txtに

暗号化された文はcoding.txtに

復元された文はrestoration.txtに

という風に場合のよって読み込むファイルや書き出すファイルを変えたいんです。

それが現状ではできない。

ちなみに前回のポリュビオス暗号の時は

ファイル名を定義する文を複数書いておいて

その時に使いたいもの以外はコメント化して扱っていました笑

それは面倒くさいし正直ダサいので

今回何とかしようと思ったわけです。

*コード

といってもそんなに難しいことはないです。

拍子抜けされてしまうかも?

まずは「txt_input」を書き換えましょう。

ほんとに簡単。

メイン関数から「txt_input」を呼び出すときに引数として

アクセスしたいファイルのアドレスを送るだけです。

今回の書き換えは関数を呼び出すメイン関数自体も書き換える必要があるので

ポリュビオス暗号のcodingを扱います。

Sub polybius_coding()

 

Dim str As String

 Dim str2 As String

 Dim file_name As String

 

'---------------------------------------------------------------

'strを読み込む

'---------------------------------------------------------------

 file_name = "ファイル名を記述"

 str = txt_input

'---------------------------------------------------------------

'strを暗号化

'---------------------------------------------------------------

 str2 = coding(str)

'---------------------------------------------------------------

'str2を記述

'---------------------------------------------------------------

 file_name = "ファイル名を記述"

 Call txt_output(str2)

 

End Sub

分かりますか??

「input_txt」を呼び出す前にfile_nameに値を入れて

それを引数としています。

次にFunction txt_input

Function txt_input(file_name) As String

 Dim ans As String

 

 Open file_name For Input As #1

    Line Input #1, ans

 Close #1

 txt_input = ans

End Function

前回よりもスリムになりました。

Function txt_outputもほとんど同じ変更です。

コードだけ載せます。

Function txt_output(str, file_name)

 

 Open file_name For Output As #1

    Print #1, str

 Close #1

 

End Function

こちらはさらにスリムですね。

いわゆるvoid型?っていうのかな?

そういうやつなので

  • まとめ

前回のライフゲームで学んだことですが

こういう「形式の修正」は早めに行って

そのサポートを受けた関数を書いていったほうが面倒がないです。

昔に書いたコードを対応させるためにちまちま書き直すときに

本当にみじめな気持ちになるので。

俯瞰というか大局観というか

そういうものが自分には足りていないんだろうなぁと反省。

というわけでなかなか先に進めなくてつらいのですが。

次回はもうひとつ「形式の修正」を行います。

現状では換字表をシートに貼り付けて扱っているのですが

それはかなり不安定な仕組みなので

そこをきちんとしましょう。

もう一つくらい暗号を書いてからやろうかなーとか思っていましたが

そういう甘えは味が変わって

二つの意味で辛くなるので。

VBAで暗号を実装しよう その3 ポリュビオス暗号

  • はじめに

さてさて。 「暗号を実装しよう」の第3段です。
記事のストックがないので大急ぎで書いています笑

今回はポリュビオス暗号。
全く聞いたことない笑

  • さっくと歴史

紀元前2世紀に古代ギリシアポリュビオスが発明。

5*5の25マス目にアルファベットを入れて
各アルファベットを記入する代わりに
そのマス目の行列番号を記述していく
タイプのものです。

行列 1 2 3 4 5
1 a b c d e
2 f g h I,j k
3 l m n o p
4 q r s t u
5 v w x y z

この表がフォーマルタイプ。

Go home を伝達したい場合は

書き手は 22 34 23 34 32 15
のように変換して

読み手は
表を見ながら Gohome と復元します。

これももっと詳しく知りたい方はググってきてください笑

  • とりあえず暗号化

96 93 13 35 21  48 45 17 46 76 54 56 93 43 81 28 54  72 24 93 43 21 56 36 39 75 32 92 57 57 63 51 92 99  26 64 54 81 51 76 76 35 19 28  87 35 76 81 14 91 81 73 27 44 36 19 72 26  14 57 44 67 81

わー。
きーもーちーわーるーいー。
ほんとにぞわぞわする。
自分は暗号に触れる適性がないのかな笑

これがポリュビオス暗号です。
本来は全角の空行は入らないでしょうが
原文の見やすさのために取り入れました。

  • 暗号について

またまた能書き。
この手のものは換字式暗号といいます。
「かんじ」じゃなくて「かえじ」って読むらしいです。

文字を何かに置き換えるってやつですね。
今回は文字を数字に置き換えています。

文字と数字が一対一対応になっているので
換字表を知っている人同士では簡単に読み書きできます。

じゃあ換字表を知らない人が解読するにはどうすればいいのか。

これって無理ゲーっぽいですよね。。 だって対応の起こりうるパターン数が多すぎるのだもの。
スキュタレー暗号のように物量作戦はむりですね。

じゃあ最強の暗号だ!!
と思いきや

これも現代ではすでにザルの暗号になっています。
頻度分析と呼ばれる手法によって。

これは
文字の出現頻度と暗号文での換字の出現頻度を対応付けて復元していくやり方です。

9世紀にすでに解読法が記録されているみたいですね。

でもポリュビオス暗号が生まれた時期が紀元前1世紀であることを考えると
記録上では800~900年くらいは解読不能(正確には難しい?)なツールだったのかもしれませんね。

  • 暗号化のコード

今回はまず換字表を用意する必要があるので
それを作成するコードから

Function pattern_make()
 
 Dim trgt As Range
 Dim t As Integer
 Dim list() As Variant
 Dim d(0 To 1) As Integer
 Dim rp As Range
 Dim div As Integer
'----------------------
'作業用シートで並び替えて
'listに書き込む
'----------------------
 Sheets.Add
 
 For i = 1 To 83
    Cells(i, 1) = Chr(-32097 + (i - 1))
    Cells(i, 2) = Rnd()
 Next
 
 t = Cells(1, 1).End(xlDown).Row
 
 Set trgt = Range(Cells(1, 1), Cells(t, 2))
 trgt.Sort Cells(1, 2), xlAscending
 
 list = trgt
 
 Application.DisplayAlerts = False
 ActiveSheet.Delete
 Application.DisplayAlerts = True
'----------------------------
'換字表を作成する
'----------------------------
 Set rp = Cells(11, 1)
 div = 9
 For i = 1 To UBound(list, 1)
    d(0) = (i - 1) \ div + 1
    d(1) = (i - 1) Mod div + 1
    rp.Offset(d(0), d(1)) = list(i, 1)
 Next
 
End Function

コードの中のdivという変数も結構だいじです。
だたこれは根性さえあれば暗号文から読み取れますが。

次にメインの関数

Sub polybius_coding()

 Dim str As String
 Dim str2 As String
'------------------
'strを読み込む
'------------------
  str = txt_input
'------------------
'strを暗号化
'------------------
 str2 = coding(str)
'------------------
'str2を記述
'------------------
 Call txt_output(str2)
 
End Sub

形式は前回のスタキュレー暗号とほとんど一緒ですね。
というか一緒になるようにしています。

このコードの肝は関数codingなのですが
それはもちろんスタキュレーとは違う仕様です。

以下詳細。

Function coding(str) As String

 Dim pattern() As Integer
 Dim char As String
 Dim num As Integer
 Dim ans As String
 ReDim pattern(1 To 83)
'------------------------
'換字表を読み込む
'------------------------
 pattern = pattern_input
'------------------------
'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
 
 coding = ans
End Function

この中にもさらに関数pattern_inputが入っています。
それで換字表を認識して
それに沿った変換をそれ以降で行っています。

その中でも特にいい感じのコードはこれ。

If num < 1 Or 83 < num Then
    ans = ans & char
Else
    ans = ans & pattern(num) & " "
End If

これによって換字表に入っていない文字はそのままの形で暗号文に組み込まれます。
全角のスペースとか
“―”これとか “。”これとか
がそのまま読み込まれます。
やりたい人は
上の記号たちも換字表に入れちゃえばいいのかなと思います。
多分簡単にできると思いますよー。

  • 復元のコード

換字表を持っていない状態での復元には頻度分析を使うと思いますが
頻度分析のプログラミングは難しそうなので
今回はスルーします。

今回は換字表を持っている人が復元する方法だけで。

ちなみに換字表は以下の通り。

行列 1 2 3 4 5 6 7 8 9
1
2
3
4
5
6
7
8
9
10

まずはメイン

Sub polybius_restoration()
Sheets("ポリュビオス").Activate
 Dim str As String
 Dim str2 As String
'------------------
'strを読み込む
'------------------
  str = txt_input
'------------------
'strを復元
'------------------
 str2 = restoration(str)
'------------------
'str2を記述
'------------------
 Call txt_output(str2)

End Sub

次は関数coding

Function restoration(str) As String

 Dim pattern() As Integer
 Dim box As Variant
 Dim kaeji As Variant
 Dim d(0 To 1) As Integer
 Dim ans As String
 
 ReDim pattern(1 To 83)
'------------------------
'換字表を読み込む
'------------------------
 pattern = pattern_input
'------------------------
'strを復元
'------------------------
 box = Split(str, " ")
 kaeji = Range(Cells(12, 2), Cells(21, 10))
 
 For i = LBound(box) To UBound(box)
    If Val(box(i)) = 0 Then
        ans = ans & box(i)
    Else
        d(0) = Mid(box(i), 1, Len(box(i)) - 1)
        d(1) = Right(box(i), 1)
        ans = ans & kaeji(d(0), d(1))
    End If
 Next
 
 restoration = ans
End Function

復元した結果はこちらー。

こんかいは ぽりゅぴおすあんごうです にほんごはあるふぁべっととちがって もじすうがおおいので たいおうひょうをつくるのにも ひとくろう

またしてもやる価値のない暗号化でした笑

あ。
そういえば換字表はシート上に出力しているので
そのセル番号がこのコードで考慮されていないものになってしまうと
正しく変換されなくなってしまいます。
これはちょっとシステムとして脆弱かも。。

どうやって解決しようかなー。
たぶんメモ帳に出力することになるんだろうけど。
今回はパスで。。

  • まとめ

換字式の暗号は
換字表をどうやって共有するのかが肝ですね。
これを奪い取ることが一番楽な解読法な気がするもの笑

次回はまたちょっと「形式の修正」を行います。
関数の「txt_input」と「txt_output」に不満な部分があるので。。

具体的には
読み込み先、書き込み先のテキストファイルを選択できるようにします。

おわり。

VBAで暗号を実装しよう その2 暗号文をメモ帳で管理

  • はじめに

前回スキュタレー暗号を扱いましたが
書いたコードで不便な場所があったので
ひとつ「形式の修正」をします。

  • メモ帳を扱う

前回はシート上のセルから文字列を読み込んで
また別のセルに書き出していましたが
それだとちょっと不便かもしれないので
メモ帳から文字列を読み込んで
VBAで演算をして
結果をメモ帳に返す仕様にしましょう。

  • コード

まずはファイルから文字列を読み込んで
その値を返す関数です。

Function txt_input() As String
 Dim ans As String
 Dim file_name As String
 
 file_name = "ここにファイルのアドレスを載せます"
 Open file_name For Input As #1
    Line Input #1, ans
 Close #1
 txt_input = ans
End Function

次は演算した文字列データを
ファイルに書き出す関数です。

Function txt_output(str As String)

 Dim file_name As String
 
 file_name = "ここにファイルのアドレスを載せます"
 Open file_name For Output As #1
    Print #1, str
 Close #1

End Function
  • 組み込んでみよう

スキュタレー暗号に組み込んでみましょう。

関数をプログラムの中に組み込むことって
意外と難しいですよね。。

どこに組み込めばいいんだろう??
という風になりがち。

Sub Scytare_coding()
 Sheets("スキュタレー").Activate
 Dim str As String
 Dim str2 As String
'------------------
'strを認識
'------------------
 str = txt_input
'------------------
'strを暗号化
'------------------
 str2 = coding(str)
'------------------
'str2を記述
'------------------
 Call txt_output(str2)
End Sub

各関数は既出なので
気になる方は前回の投稿を見てください。

機能を分割しておくと
その中のどれかをちょっと書き換えるだけで済むから楽ですね~

  • まとめ

さっきも書いたのですが
機能を分割しておけば
仕様を変えたいときに変えやすいですね。
オブジェクト指向ではないのだろうけど
このやり方もまるっきり不便というわけではないかなと思っています。