Excel（VBA）哈希字符串使用SHA1-假名

Posted 2021-02-22

Create a bespoke Excel function that allows you to hash (anonnymise / pseudonymise) strings such as unique identifiers. Once you've inserted the VBA, use the function "=BASE64SHA1(cellreference)" to generate the hash.

Public Function BASE64SHA1(ByVal sTextToHash As String)
 
    Dim asc As Object
    Dim enc As Object
    Dim TextToHash() As Byte
    Dim SharedSecretKey() As Byte
    Dim bytes() As Byte
    Const cutoff As Integer = 5
 
    Set asc = CreateObject("System.Text.UTF8Encoding")
    Set enc = CreateObject("System.Security.Cryptography.HMACSHA1")
 
    TextToHash = asc.GetBytes_4(sTextToHash)
    SharedSecretKey = asc.GetBytes_4(sTextToHash)
    enc.Key = SharedSecretKey
 
    bytes = enc.ComputeHash_2((TextToHash))
    BASE64SHA1 = EncodeBase64(bytes)
    BASE64SHA1 = Left(BASE64SHA1, cutoff)
 
    Set asc = Nothing
    Set enc = Nothing
 
End Function
 
Private Function EncodeBase64(ByRef arrData() As Byte) As String
 
    Dim objXML As Object
    Dim objNode As Object
 
    Set objXML = CreateObject("MSXML2.DOMDocument")
    Set objNode = objXML.createElement("b64")
 
    objNode.DataType = "bin.base64"
    objNode.nodeTypedValue = arrData
    EncodeBase64 = objNode.text
 
    Set objNode = Nothing
    Set objXML = Nothing
 
End Function