記事一覧

暗号化

現在私がVPNで利用している暗号化は3DESです。この3DESという方式は、「DES(Data Encryption Standard)を3回行なう」というものです。DESという方式は鍵長56ビットと決して強力な暗号化手法ではないようですが、一番の利点は「歴史が古く、穴がない」ということでしょう。このDESを3回行なうことで112ビット相当の暗号化となるらしいですね。ずいぶん前に128ビット暗号化が出てましたが、「穴がない」という信頼性からか3DESが今でも多く採用されているみたいです。うちのVPNルータはDESと3DESでの暗号化が選択できます。

と書いていて念のため調べたら、現在川口と吉見で利用しているVPNルータはAES(128ビット)も対応していました。しかも、AESは3DESより安全かつ低負荷らしいです。うーん、塗装工場が対応していないってのが問題だけど、川口-吉見間だけでもAESに変えようかなあ。

話を戻して、「そんな信頼性がある方式なら社内のソフトでもDESを使いたいな」なんて思ってプログラムを作ってみました(2003年11月)。ソースを見てみると分かるのですが、ほとんど行列の計算だけですね。このコードは実際には大して使っていないのですが、本当にきちんとDESで暗号化できているんでしょうか。一応、鍵を変えると暗号化の結果は変わりますし、復元も出来ています。実はDESもどきの穴あり暗号化かも。
ちなみに、3DESの場合はABC三つの鍵を用意して「鍵Aで暗号化、鍵Bで復元、鍵Cで暗号化」というものだそうです。なので、「鍵A=鍵B=鍵Cだと単なるDESになるので上位互換だ」ということみたいですね。

'''''''''VBによるMainのコード

Dim des as new ClassDES
Dim keyStr$ '暗号化するための鍵(任意の文字で設定可)
Dim key$ '上記の鍵を2進法で表したもの(特に必要はない)
Dim SourceString$, ResultString1$, ResultString2$

keyStr$ = "暗号化鍵"
key$ = des.SetKeyStr(keyStr$)
SourceString$ = "何でもいい適当な文字列(この文章が暗号化される)"
ResultString1$ = des.EncryptStr(SourceString$) '暗号化
ResultString2$ = des.UnEncryptStr(ResultString1$) '復元(SourceString$と同じになるはず)


'''''''''VBによる'classDES'の定義

Option Explicit
Private pKey$
Private KS$(0 To 15)
Const ASCII64 = ".!0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"

Property Get Key$()
Key$ = pKey$
End Property
Property Let Key(ByVal vkey$)

If Len(vkey$) <> 64 Then
pKey$ = ""
Exit Property
End If
SetKey vkey$

pKey$ = vkey$
End Property
Public Function SetKeyStr$(ByVal st$)

Dim s1$

s1$ = StrToDigit$(st$)
If Len(s1$) > 64 Then
s1$ = Left$(s1$, 64)
ElseIf Len(s1$) < 64 Then
s1$ = s1$ & String$(64 - Len(s1$), "0")
End If
SetKey s1$
SetKeyStr$ = s1$
End Function
Private Function SetKey(ByVal digit64$)

Dim i&, j&, k&, C1$, D1$, C2$, D2$, shifts As Variant
shifts = Array(1, 1, 2, 2, 2, 2, 2, 2, 1, 2, 2, 2, 2, 2, 2, 1)

C1$ = calcPC1_C(digit64$)
D1$ = calcPC1_D(digit64$)

For i = 0 To 15
KS$(i) = ""
Next
C2$ = C1$
D2$ = D1$
For i = 0 To 15
For k = 0 To shifts(i) - 1
C2$ = Mid$(C2$, 2, 27) & Left$(C2$, 1)
D2$ = Mid$(D2$, 2, 27) & Left$(D2$, 1)
Next
KS$(i) = calcPC2_C(C2$) & calcPC2_D(D2$)
Next
End Function

Public Function EncryptStr$(ByVal st$)

Dim i&, s1$, s2$, s3$, ret$, c&

s1$ = StrToDigit$(st$)
s1$ = s1$ & String$((64 - (Len(s1$) Mod 64)) Mod 64, "0")

For i = 1 To Len(s1$) Step 64
s2$ = s2$ & Encrypt8$(Mid$(s1$, i, 64))
Next

EncryptStr$ = DigitToAscii64$(s2$)
End Function

Public Function UnEncryptStr$(ByVal st$)

Dim i&, s1$, s2$, ret$

s1$ = Ascii64ToDigit$(st$)
For i = 1 To Len(s1$) Step 64
s2$ = s2$ & UnEncrypt8$(Mid$(s1$, i, 64))
Next

UnEncryptStr$ = DigitToStr$(s2$)
End Function

Public Function Encrypt$(ByVal st$)

Dim i&, s1$, s2$, s3$, ret$

st$ = st$ & String$((64 - (Len(st$) Mod 64)) Mod 64, "0")

For i = 1 To Len(st$) Step 64
s2$ = s2$ & Encrypt8$(Mid$(st$, i, 64))
Next

Encrypt$ = s2$
End Function
Public Function UnEncrypt$(ByVal st$)

Dim i&, s1$, s2$, s3$, ret$

st$ = st$ & String$((64 - (Len(st$) Mod 64)) Mod 64, "0")

For i = 1 To Len(st$) Step 64
s1$ = s1$ & UnEncrypt8$(Mid$(st$, i, 64))
Next

UnEncrypt$ = s1$
End Function

Private Function Encrypt8$(ByVal st$)

Dim i&, tempLR$, tempR$, tempL$

tempLR$ = calcIP$(st$)
For i = 0 To 15
tempL = Mid$(tempLR$, 1, 32)
tempR = Mid$(tempLR$, 33, 32)
tempLR$ = tempR$ & StrXOR$(calcP$(calcS$(StrXOR$(calcE$(tempR$), KS$(i)))), tempL)
Next

Encrypt8$ = calcFP$(Mid$(tempLR$, 33, 32) & Mid$(tempLR$, 1, 32))
End Function
Private Function UnEncrypt8$(ByVal st$)

Dim i&, tempLR$, tempR$, tempL$

tempLR$ = calcIP$(st$)
For i = 15 To 0 Step -1
tempL = Mid$(tempLR$, 1, 32)
tempR = Mid$(tempLR$, 33, 32)
tempLR$ = tempR$ & StrXOR$(calcP$(calcS$(StrXOR$(calcE$(tempR$), KS$(i)))), tempL)
Next

UnEncrypt8$ = calcFP$(Mid$(tempLR$, 33, 32) & Mid$(tempLR$, 1, 32))
End Function
Function DigitToAscii64$(ByVal st$)
Dim i&, ret$, c&

st$ = st$ & String$((6 - (Len(st$) Mod 6)) Mod 6, "0")
For i = 1 To Len(st$) Step 6
c = DigitToInt("00" & Mid$(st$, i, 6)) + 1
ret$ = ret$ & Mid$(ASCII64, c, 1)
Next

DigitToAscii64$ = ret$
End Function
Function Ascii64ToDigit$(ByVal st$)

Dim i&, ret$
For i = 1 To Len(st$)
ret$ = ret$ & Right$(IntToDigit$(InStr(ASCII64, Mid$(st$, i, 1)) - 1), 6)
Next
Ascii64ToDigit$ = Left$(ret$, 8 * Int(Len(ret$) / 8))
End Function
Function StrToDigit$(ByVal st$)

Dim i&, c&, ret$

For i = 1 To Len(st$)
Debug.Print i
c = Asc(Mid$(st$, i, 1))
If c >= 0 Then
ret$ = ret$ & IntToDigit$(c)
Else
ret$ = ret$ & IntToDigit$((c And -256) / 256)
ret$ = ret$ & IntToDigit$(c And 255)
End If
Next
StrToDigit$ = ret$
End Function
Function DigitToStr$(ByVal st$)

Dim i&, c&, ret$

For i = 1 To Len(st$) Step 8
c = DigitToInt(Mid$(st$, i, 8))
Select Case c
Case 0 To 127, 160 To 223
ret$ = ret$ & Chr$(c)
Case Else
c = (c * 256 + DigitToInt(Mid$(st$, i + 8, 8))) - 65536
i = i + 8
ret$ = ret$ & Chr$(c)
End Select

Next
DigitToStr$ = ret$
End Function
Private Function IntToDigit$(ByVal x&)
Dim i&, ret$

For i = 7 To 0 Step -1
If (x And 2 ^ i) = 0 Then ret$ = ret$ & "0" Else ret$ = ret$ & "1"
Next
IntToDigit$ = ret$
End Function
Private Function DigitToInt&(ByVal x$)
Dim i&, ret&

For i = 1 To 8
If Mid$(x$, i, 1) = "1" Then ret = ret + 2 ^ (8 - i)
Next
DigitToInt = ret
End Function

Private Function StrXOR$(ByVal s1$, ByVal s2$)

Dim i&, ret$, c&

For i = 1 To Len(s1$)
c = Val(Mid$(s1$, i, 1)) Xor Val(Mid$(s2$, i, 1))
ret$ = ret$ & Format$(c)
Next
StrXOR$ = ret$
End Function

Private Function calcPC1_C(ByVal v$)
Dim i&, ret$, PC1_C As Variant

PC1_C = 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 _
)

For i = 0 To 27
ret$ = ret$ & Mid$(v$, PC1_C(i), 1)
Next
calcPC1_C = ret$
End Function
Private Function calcPC1_D(ByVal v$)
Dim i&, ret$, PC1_D As Variant

PC1_D = Array(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 _
)
For i = 0 To 27
ret$ = ret$ & Mid$(v$, PC1_D(i), 1)
Next
calcPC1_D = ret$
End Function
Private Function calcPC2_C(ByVal v$)
Dim i&, ret$, PC2_C As Variant

PC2_C = 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 _
)

For i = 0 To 23
ret$ = ret$ & Mid$(v$, PC2_C(i), 1)
Next
calcPC2_C = ret$
End Function
Private Function calcPC2_D(ByVal v$)
Dim i&, ret$, PC2_D As Variant

PC2_D = Array(41, 52, 31, 37, 47, 55, _
30, 40, 51, 45, 33, 48, _
44, 49, 39, 56, 34, 53, _
46, 42, 50, 36, 29, 32 _
)
For i = 0 To 23
ret$ = ret$ & Mid$(v$, PC2_D(i) - 28, 1)
Next
calcPC2_D = ret$
End Function
Private Function calcFP$(ByVal v$)
Dim i&, ret$, FP As Variant

FP = 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 _
)

For i = 0 To 63
ret$ = ret$ & Mid$(v$, FP(i), 1)
Next
calcFP$ = ret$

End Function
Private Function calcIP$(ByVal v$)
Dim i&, ret$, IP As Variant

IP = 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 _
)

For i = 0 To 63
ret$ = ret$ & Mid$(v$, IP(i), 1)
Next
calcIP$ = ret$

End Function
Private Function calcE$(ByVal v$)
Dim i&, ret$, E As Variant

E = 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 _
)
For i = 0 To 47
ret$ = ret$ & Mid$(v$, E(i), 1)
Next
calcE$ = ret$
End Function
Private Function calcP$(ByVal v$)
Dim i&, ret$, P As Variant

P = 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 31
ret$ = ret$ & Mid$(v$, P(i), 1)
Next
calcP$ = ret$
End Function
Private Function calcS$(ByVal v$)

Dim i&, tempSin$, temp$, ret$, s(7) As Variant

s(0) = 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 _
)
s(1) = 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 _
)
s(2) = 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 _
)
s(3) = 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 _
)
s(4) = 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 _
)
s(5) = 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 _
)
s(6) = 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 _
)
s(7) = 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 _
)

For i = 0 To 7
tempSin$ = Mid$(v$, i * 6 + 1, 6)
tempSin$ = Left$(tempSin$, 1) & Mid$(tempSin$, 6, 1) & Mid$(tempSin$, 2, 4)
temp$ = Right$(IntToDigit(s(i)(DigitToInt("00" & tempSin$))), 4)
ret$ = ret$ & Mid$(temp$, 4, 1) & Mid$(temp$, 3, 1) & Mid$(temp$, 2, 1) & Mid$(temp$, 1, 1)
Next
calcS$ = ret$
End Function