SHA-1 などの標準アルゴリズムを使用してパスワードをハッシュする、Excel VBA で記述された関数が必要です。次のようなシンプルなインターフェースを備えたもの：
Public Function CreateHash(Value As String) As String
...
End Function
この関数は、Excel 2003 がインストールされた XP ワークステーションで動作する必要がありますが、それ以外の場合はサード パーティのコンポーネントを使用してはなりません。XP で利用可能な CryptoAPI などの DLL を参照して使用できます。
このハッシュ機能を実現するためのサンプルを知っている人はいますか?
これは、Excelの数式に使用できるSHA1ハッシュを計算するためのモジュールです。'= SHA1HASH（ "test"）'。これを使用するには、「module_sha1」という新しいモジュールを作成し、それをすべてコピーして貼り付けます。これは、http： //vb.wikia.com/wiki/SHA-1.basのVBAコードに基づいており、サポートが変更されています。文字列を渡し、Excelセルの数式から実行可能にします。
' Based on: http://vb.wikia.com/wiki/SHA-1.bas
Option Explicit
Private Type FourBytes
A As Byte
B As Byte
C As Byte
D As Byte
End Type
Private Type OneLong
L As Long
End Type
Function HexDefaultSHA1(Message() As Byte) As String
Dim H1 As Long, H2 As Long, H3 As Long, H4 As Long, H5 As Long
DefaultSHA1 Message, H1, H2, H3, H4, H5
HexDefaultSHA1 = DecToHex5(H1, H2, H3, H4, H5)
End Function
Function HexSHA1(Message() As Byte, ByVal Key1 As Long, ByVal Key2 As Long, ByVal Key3 As Long, ByVal Key4 As Long) As String
Dim H1 As Long, H2 As Long, H3 As Long, H4 As Long, H5 As Long
xSHA1 Message, Key1, Key2, Key3, Key4, H1, H2, H3, H4, H5
HexSHA1 = DecToHex5(H1, H2, H3, H4, H5)
End Function
Sub DefaultSHA1(Message() As Byte, H1 As Long, H2 As Long, H3 As Long, H4 As Long, H5 As Long)
xSHA1 Message, &H5A827999, &H6ED9EBA1, &H8F1BBCDC, &HCA62C1D6, H1, H2, H3, H4, H5
End Sub
Sub xSHA1(Message() As Byte, ByVal Key1 As Long, ByVal Key2 As Long, ByVal Key3 As Long, ByVal Key4 As Long, H1 As Long, H2 As Long, H3 As Long, H4 As Long, H5 As Long)
'CA62C1D68F1BBCDC6ED9EBA15A827999 + "abc" = "A9993E36 4706816A BA3E2571 7850C26C 9CD0D89D"
'"abc" = "A9993E36 4706816A BA3E2571 7850C26C 9CD0D89D"
Dim U As Long, P As Long
Dim FB As FourBytes, OL As OneLong
Dim i As Integer
Dim W(80) As Long
Dim A As Long, B As Long, C As Long, D As Long, E As Long
Dim T As Long
H1 = &H67452301: H2 = &HEFCDAB89: H3 = &H98BADCFE: H4 = &H10325476: H5 = &HC3D2E1F0
U = UBound(Message) + 1: OL.L = U32ShiftLeft3(U): A = U \ &H20000000: LSet FB = OL 'U32ShiftRight29(U)
ReDim Preserve Message(0 To (U + 8 And -64) + 63)
Message(U) = 128
U = UBound(Message)
Message(U - 4) = A
Message(U - 3) = FB.D
Message(U - 2) = FB.C
Message(U - 1) = FB.B
Message(U) = FB.A
While P < U
For i = 0 To 15
FB.D = Message(P)
FB.C = Message(P + 1)
FB.B = Message(P + 2)
FB.A = Message(P + 3)
LSet OL = FB
W(i) = OL.L
P = P + 4
Next i
For i = 16 To 79
W(i) = U32RotateLeft1(W(i - 3) Xor W(i - 8) Xor W(i - 14) Xor W(i - 16))
Next i
A = H1: B = H2: C = H3: D = H4: E = H5
For i = 0 To 19
T = U32Add(U32Add(U32Add(U32Add(U32RotateLeft5(A), E), W(i)), Key1), ((B And C) Or ((Not B) And D)))
E = D: D = C: C = U32RotateLeft30(B): B = A: A = T
Next i
For i = 20 To 39
T = U32Add(U32Add(U32Add(U32Add(U32RotateLeft5(A), E), W(i)), Key2), (B Xor C Xor D))
E = D: D = C: C = U32RotateLeft30(B): B = A: A = T
Next i
For i = 40 To 59
T = U32Add(U32Add(U32Add(U32Add(U32RotateLeft5(A), E), W(i)), Key3), ((B And C) Or (B And D) Or (C And D)))
E = D: D = C: C = U32RotateLeft30(B): B = A: A = T
Next i
For i = 60 To 79
T = U32Add(U32Add(U32Add(U32Add(U32RotateLeft5(A), E), W(i)), Key4), (B Xor C Xor D))
E = D: D = C: C = U32RotateLeft30(B): B = A: A = T
Next i
H1 = U32Add(H1, A): H2 = U32Add(H2, B): H3 = U32Add(H3, C): H4 = U32Add(H4, D): H5 = U32Add(H5, E)
Wend
End Sub
Function U32Add(ByVal A As Long, ByVal B As Long) As Long
If (A Xor B) < 0 Then
U32Add = A + B
Else
U32Add = (A Xor &H80000000) + B Xor &H80000000
End If
End Function
Function U32ShiftLeft3(ByVal A As Long) As Long
U32ShiftLeft3 = (A And &HFFFFFFF) * 8
If A And &H10000000 Then U32ShiftLeft3 = U32ShiftLeft3 Or &H80000000
End Function
Function U32ShiftRight29(ByVal A As Long) As Long
U32ShiftRight29 = (A And &HE0000000) \ &H20000000 And 7
End Function
Function U32RotateLeft1(ByVal A As Long) As Long
U32RotateLeft1 = (A And &H3FFFFFFF) * 2
If A And &H40000000 Then U32RotateLeft1 = U32RotateLeft1 Or &H80000000
If A And &H80000000 Then U32RotateLeft1 = U32RotateLeft1 Or 1
End Function
Function U32RotateLeft5(ByVal A As Long) As Long
U32RotateLeft5 = (A And &H3FFFFFF) * 32 Or (A And &HF8000000) \ &H8000000 And 31
If A And &H4000000 Then U32RotateLeft5 = U32RotateLeft5 Or &H80000000
End Function
Function U32RotateLeft30(ByVal A As Long) As Long
U32RotateLeft30 = (A And 1) * &H40000000 Or (A And &HFFFC) \ 4 And &H3FFFFFFF
If A And 2 Then U32RotateLeft30 = U32RotateLeft30 Or &H80000000
End Function
Function DecToHex5(ByVal H1 As Long, ByVal H2 As Long, ByVal H3 As Long, ByVal H4 As Long, ByVal H5 As Long) As String
Dim H As String, L As Long
DecToHex5 = "00000000 00000000 00000000 00000000 00000000"
H = Hex(H1): L = Len(H): Mid(DecToHex5, 9 - L, L) = H
H = Hex(H2): L = Len(H): Mid(DecToHex5, 18 - L, L) = H
H = Hex(H3): L = Len(H): Mid(DecToHex5, 27 - L, L) = H
H = Hex(H4): L = Len(H): Mid(DecToHex5, 36 - L, L) = H
H = Hex(H5): L = Len(H): Mid(DecToHex5, 45 - L, L) = H
End Function
' Convert the string into bytes so we can use the above functions
' From Chris Hulbert: http://splinter.com.au/blog
Public Function SHA1HASH(str)
Dim i As Integer
Dim arr() As Byte
ReDim arr(0 To Len(str) - 1) As Byte
For i = 0 To Len(str) - 1
arr(i) = Asc(Mid(str, i + 1, 1))
Next i
SHA1HASH = Replace(LCase(HexDefaultSHA1(arr)), " ", "")
End Function
最近では、VBA から .NET ライブラリを利用できます。以下は、Excel 2016 で機能します。ハッシュを大文字の 16 進数として返します。
Public Function SHA1(ByVal s As String) As String
Dim Enc As Object, Prov As Object
Dim Hash() As Byte, i As Integer
Set Enc = CreateObject("System.Text.UTF8Encoding")
Set Prov = CreateObject("System.Security.Cryptography.SHA1CryptoServiceProvider")
Hash = Prov.ComputeHash_2(Enc.GetBytes_4(s))
SHA1 = ""
For i = LBound(Hash) To UBound(Hash)
SHA1 = SHA1 & Hex(Hash(i) \ 16) & Hex(Hash(i) Mod 16)
Next
End Function