Visual Basic 6.0, Visual Basic for Application(VBA)での実装
「VBA SHA256」をキーワードにこのサイトへ訪ねて来られる方が結構いらっしゃるので、VB6.0やVBA(Visual Basic for Application)で動作するSHA-256のソースを書いてみました。
処理手順は同じです。 ただ、ビットシフトと符号無し32bit整数型がないので、ビット演算や乗算・除算を使ってゴリゴリやってます。 配列のコピーにCopyMemory、エンディアン変換にWinSockのhtonlという２つのAPI関数を使っています。
プロジェクトにクラスを追加して「SHA256」とでも名付けてください。 呼び出しサンプルはページ下部にあります。
' SHA-256ハッシュアルゴリズムを用いてバイト配列のハッシュ（メッセージダイジェスト）を取得するクラスです。
'
' コード作成 : StudioAREA.WIZ ( http://wiz-code.net/ )
'
' 参照文書 : FIPS 180-2
' 文書URL : http://csrc.nist.gov/publications/fips/fips180-2/fips180-2.pdf
Option Explicit
' バイト配列と整数型の相互変換に使います
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" _
(ByVal dest As Long, ByVal src As Long, ByVal length As Long)
' エンディアン変換の変わりにネットワークバイトオーダー変換関数を使います
Private Declare Function htonl Lib "wsock32.dll" (ByVal hostlong As Long) As Long
Private k(63) As Long
Private Bit32(31) As Long
Private Const w As Integer = 32
Private Sub Class_Initialize()
' 定数Kの設定
k(0) = &H428A2F98: k(1) = &H71374491: k(2) = &HB5C0FBCF: k(3) = &HE9B5DBA5
k(4) = &H3956C25B: k(5) = &H59F111F1: k(6) = &H923F82A4: k(7) = &HAB1C5ED5
k(8) = &HD807AA98: k(9) = &H12835B01: k(10) = &H243185BE: k(11) = &H550C7DC3
k(12) = &H72BE5D74: k(13) = &H80DEB1FE: k(14) = &H9BDC06A7: k(15) = &HC19BF174
k(16) = &HE49B69C1: k(17) = &HEFBE4786: k(18) = &HFC19DC6: k(19) = &H240CA1CC
k(20) = &H2DE92C6F: k(21) = &H4A7484AA: k(22) = &H5CB0A9DC: k(23) = &H76F988DA
k(24) = &H983E5152: k(25) = &HA831C66D: k(26) = &HB00327C8: k(27) = &HBF597FC7
k(28) = &HC6E00BF3: k(29) = &HD5A79147: k(30) = &H6CA6351: k(31) = &H14292967
k(32) = &H27B70A85: k(33) = &H2E1B2138: k(34) = &H4D2C6DFC: k(35) = &H53380D13
k(36) = &H650A7354: k(37) = &H766A0ABB: k(38) = &H81C2C92E: k(39) = &H92722C85
k(40) = &HA2BFE8A1: k(41) = &HA81A664B: k(42) = &HC24B8B70: k(43) = &HC76C51A3
k(44) = &HD192E819: k(45) = &HD6990624: k(46) = &HF40E3585: k(47) = &H106AA070
k(48) = &H19A4C116: k(49) = &H1E376C08: k(50) = &H2748774C: k(51) = &H34B0BCB5
k(52) = &H391C0CB3: k(53) = &H4ED8AA4A: k(54) = &H5B9CCA4F: k(55) = &H682E6FF3
k(56) = &H748F82EE: k(57) = &H78A5636F: k(58) = &H84C87814: k(59) = &H8CC70208
k(60) = &H90BEFFFA: k(61) = &HA4506CEB: k(62) = &HBEF9A3F7: k(63) = &HC67178F2
' ビット演算を高速化するためのビット配列
Dim i As Integer
Bit32(0) = 1: Bit32(31) = &H80000000
For i = 1 To 30: Bit32(i) = Bit32(i - 1) * 2: Next
End Sub
' 右ビットシフト(SHift Right)
Private Function SHR(ByVal v As Long, ByVal n As Integer) As Long
Dim r As Long, s As Long
If n <= 0 Then SHR = v: Exit Function
If n >= 32 Then SHR = 0: Exit Function
s = v And &H80000000
v = (v And &H7FFFFFFF) \ Bit32(n)
If s Then v = v Or Bit32(31 - n)
SHR = v
End Function
' 左ビットシフト(Shift Left)
Private Function SHL(ByVal v As Long, ByVal n As Integer) As Long
Dim r As Long, s As Long
If n <= 0 Then SHL = v: Exit Function
If n >= 32 Then SHL = 0: Exit Function
If n = 31 Then SHL = &H80000000 * (v And &H1&): Exit Function
s = v And Bit32(31 - n)
v = (v And (Bit32(31 - n) - 1)) * Bit32(n)
If s Then v = v Or &H80000000
SHL = v
End Function
' 右ビット回転(ROTate Right)
Private Function ROTR(ByVal v As Long, ByVal n As Integer) As Long
ROTR = SHR(v, n) Or SHL(v, w - n)
End Function
' 左ビット回転(ROTate Left)
Private Function ROTL(ByVal v As Long, ByVal n As Integer) As Long
ROTL = SHL(v, n) Or SHR(v, w - n)
End Function
' オーバーフローを回避して複数の値を加算
Private Function SafeAdd(ParamArray Values() As Variant) As Long
Dim r As Long, tmp As Long, i As Integer
r = Values(0)
For i = 1 To UBound(Values)
' 下位30bit同士を加算(31bit→32bitの桁上がりはしない)
tmp = ((r And &H3FFFFFFF) + (Values(i) And &H3FFFFFFF))
' 32bitへ桁上がりする場合は32bitを付加
If ((r And Values(i)) Or ((r Or Values(i)) And tmp)) And &H40000000 Then
tmp = tmp Or &H80000000
End If
' 31-32bitを桁上がりなしで加算
r = tmp Xor (r And &HC0000000) Xor (Values(i) And &HC0000000)
Next
SafeAdd = r
End Function
' Ch
Private Function Ch(ByVal x As Long, ByVal y As Long, _
ByVal z As Long) As Long
Ch = (x And y) Xor ((Not x) And z)
End Function
' Maj
Private Function Maj(ByVal x As Long, ByVal y As Long, _
ByVal z As Long) As Long
Maj = (x And y) Xor (x And z) Xor (y And z)
End Function
' シグマA0(Σ0)
Private Function SigmaA0(ByVal x As Long) As Long
SigmaA0 = ROTR(x, 2) Xor ROTR(x, 13) Xor ROTR(x, 22)
End Function
' シグマA1(Σ1)
Private Function SigmaA1(ByVal x As Long) As Long
SigmaA1 = ROTR(x, 6) Xor ROTR(x, 11) Xor ROTR(x, 25)
End Function
' シグマB0(σ0)
Private Function SigmaB0(ByVal x As Long) As Long
SigmaB0 = ROTR(x, 7) Xor ROTR(x, 18) Xor SHR(x, 3)
End Function
' シグマB1(σ1)
Private Function SigmaB1(ByVal x As Long) As Long
SigmaB1 = ROTR(x, 17) Xor ROTR(x, 19) Xor SHR(x, 10)
End Function
' ハッシュ計算処理
Private Sub Computation(buff() As Long, block() As Byte)
Dim i As Integer
' ハッシュ計算用変数
Dim t1 As Long
Dim t2 As Long
Dim w(63) As Long
' 現在のハッシュ値を記憶
Dim a As Long, b As Long, c As Long, d As Long
Dim e As Long, f As Long, g As Long, h As Long
a = buff(0): b = buff(1): c = buff(2): d = buff(3)
e = buff(4): f = buff(5): g = buff(6): h = buff(7)
For i = 0 To 63
If i < 16 Then
CopyMemory VarPtr(w(i)), VarPtr(block(i * 4)), 4
w(i) = htonl(w(i))
Else
w(i) = SafeAdd(SigmaB1(w(i - 2)), w(i - 7), _
SigmaB0(w(i - 15)), w(i - 16))
End If
t1 = SafeAdd(h, SigmaA1(e), Ch(e, f, g), k(i), w(i))
t2 = SafeAdd(SigmaA0(a), Maj(a, b, c))
h = g
g = f
f = e
e = SafeAdd(d, t1)
d = c
c = b
b = a
a = SafeAdd(t1, t2)
Next
buff(0) = SafeAdd(a, buff(0))
buff(1) = SafeAdd(b, buff(1))
buff(2) = SafeAdd(c, buff(2))
buff(3) = SafeAdd(d, buff(3))
buff(4) = SafeAdd(e, buff(4))
buff(5) = SafeAdd(f, buff(5))
buff(6) = SafeAdd(g, buff(6))
buff(7) = SafeAdd(h, buff(7))
End Sub
' SHA-256アルゴリズムによりメッセージダイジェストを取得します。
Public Function Hash(bytes() As Byte) As Byte()
Dim bytesLen As Long
Dim length(3) As Byte
bytesLen = UBound(bytes) + 1
CopyMemory VarPtr(length(0)), VarPtr(htonl(bytesLen * 8)), 4
ReDim Preserve bytes(bytesLen)
bytes(bytesLen) = &H80
bytesLen = bytesLen + 1
Dim blocks As Long
blocks = (bytesLen \ 64) + 1
If (bytesLen And &H3F) > 56 Then blocks = blocks + 1
ReDim Preserve bytes(blocks * 64 - 1)
CopyMemory VarPtr(bytes(UBound(bytes) - 3)), VarPtr(length(0)), 4
Dim h(7) As Long
h(0) = &H6A09E667: h(1) = &HBB67AE85: h(2) = &H3C6EF372: h(3) = &HA54FF53A
h(4) = &H510E527F: h(5) = &H9B05688C: h(6) = &H1F83D9AB: h(7) = &H5BE0CD19
Dim block(63) As Byte
Dim i As Long
For i = 0 To UBound(bytes) Step 64
CopyMemory VarPtr(block(0)), VarPtr(bytes(i)), 64
Computation h, block
Next
Dim result(31) As Byte
For i = 0 To 7: h(i) = htonl(h(i)): Next
CopyMemory VarPtr(result(0)), VarPtr(h(0)), 32
Hash = result
End Function
SHA256クラスを利用するサンプルコード
Sub Main()
Dim sha As New SHA256 ' SHA256クラスのインスタンスを作成
Dim bytes() As Byte
Dim shaHash() As Byte
' ハッシュを得る文字列をバイト配列化(ASCII)
bytes = StrConv("abc", vbFromUnicode)
' ハッシュ値を算出
shaHash = sha.Hash(bytes)
' バイナリダンプ
Dim i As Integer
For i = 0 To 31
Debug.Print Right("00" & Hex(shaHash(i)), 2) & " ";
Next
End Sub