wiz.code

Visual Basic 6.0, Visual Basic for Application(VBA)での実装

「VBA SHA256」をキーワードにこのサイトへ訪ねて来られる方が結構いらっしゃるので、VB6.0やVBA(Visual Basic for Application)で動作するSHA-256のソースを書いてみました。

処理手順は同じです。 ただ、ビットシフトと符号無し32bit整数型がないので、ビット演算や乗算・除算を使ってゴリゴリやってます。 配列のコピーにCopyMemory、エンディアン変換にWinSockのhtonlという2つの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