Excel VBAでSSHAの生成・検証を実装してみた

#動機
仕事で使うとあるシステムで、XMLに書き出した登録ユーザーの認証情報をサーバーにインポートすることがあります。
ユーザー登録リクエストのリストもExcelで受け取るし、他の同僚も使えるように、リストを元にXMLへの書き出しを行うコードをExcel VBAで書いてみました。
各ユーザーのパスワードはSSHAとしてXMLに格納されますが、パスワードからSSHAへの変換とその検証もVBAで書いてみました。本記事は、このSSHAの生成と検証を行う部分についてです。

#参考にした情報
SHA1暗号化やBase64に関する部分は、下記サイトを参考にさせていただき、掲載されているコードを一部変更して利用させていただいています。

- SHA1暗号化について
    - [WSHのVBScriptでsha1ハッシュを生成するサンプル（DLL不要)](https://blog.ver001.com/vbscript-sha1/)
    - こちらのコードを利用するには.NET Frameworkが必要です。
- Base64エンコーディング、デコーディングについて
    - [【参照設定不要】Base64フォーマットにエンコードする](https://localbias.work/796)

SSHAの部分は随分前に書いていたRubyスクリプトをベースにしました。それもどこかのサイトの情報を元に書いたはずですが、参考にさせていただいたサイトを失念してしまいました。

今回のコードではソルトのバイト長(`SaltLength`)を8バイト固定としていますが、これは今回対象としたシステムの仕様に従っています。またSSHA生成時にランダムに生成するソルトは`SaltChars`に含まれるASCII文字列のみですが、今回対象としたシステムによって生成されるSSHAは非ASCIIのバイト列からなるソルトも利用されており、このようなSSHAの検証にも対応しているつもりです。

#使い方
- `sshaString = ssha(aStrIn, aSalt)` … SSHAを生成します。
    - 引数 `aStrIn` (必須): SSHA生成の元となる文字列またはパスワード。
    - 引数 `aSalt` (省略可): SSHA生成時のソルト。省略時はランダムに生成。
        - バイト配列をカンマ区切りの16進数文字列として指定します。 (例： `"53,4E,39,59,4D,42,53,66,"`)
    - 戻り値 `sshaString`: SSHA文字列。(例： `{SSHA}JFKGJJxxHO5KAGt/NmYOdi6PTxhvN3N4UkM5MQ==`)

- `isValid = isValidPassword(aSSHA, aPasswd)` … 指定されたSSHAとパスワードのペアがマッチするかを検証します。
    - 引数 `aSSHA` (必須): 検証に使用するSSHA文字列。
    - 引数 `aPasswd` (必須): 検証に使用するパスワード文字列。
    - 戻り値 `isValid`: 検証結果をBoolean値で返します。(True: マッチした、False: マッチしなかった)

#動作環境
Windows 10 Enterprise (Version 20H2, OS Build 19042.1052)
Microsoft Excel for Microsoft 365 MSO (16.0.13127.21656) 32-bit

#ハマったところ、改善点？
当初、関数`ssha()`に第2引数`aSalt`をbyte arrayとして渡そうとしていたのですが、`ByVal`で渡すと途中でUTF-16に変換されるのか(?)期待通りに値を渡せませんでした。`ByRef`にすると引数省略時の値(`Nothing`)の設定が上手くいかなかったりしました(詳細忘れかけてます)。
結局、バイト配列を一旦、カンマ区切りの16進数文字列に変換して渡すようにしたのが現在の実装です。もっとスマートな方法があれば教えていただけると嬉しいです。

#最後に
SSHAの仕様や参考にさせていただいたコードについても、あまり詳細まで確認できておりません。もしかしたら勘違いや間違った使い方をしているかも知れません。お気づきの点があればご指摘いただければ幸いです。

```visualbasic:ssha.bas
Const SaltLength = 8
Const SaltChars = "./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"

Function ssha(ByVal aStrIn As String, Optional ByVal aSalt As String = "") As String

   Dim sha1 As Object, b64 As Object, enc As Object
   Dim bytes() As Byte, hash() As Byte
   Dim salt(SaltLength-1) As Byte, i As Integer, max As Integer, saltHex As Variant
  ' Prepare objects
   Set b64 = CreateObject("Msxml2.DOMDocument.3.0").createElement("base64")
   Set enc = CreateObject("System.Text.UTF8Encoding")

   ' Prepare "salt" for SSHA
   If Len(aSalt) = 0 Then ' It was not specified
      max = Len(SaltChars)
      For i = 0 To SaltLength-1
         Randomize
         salt(i) = enc.GetBytes_4(Mid(SaltChars, Int(max * Rnd + 1), 1))(0) ' as UTF-8
      Next i
   Else
      saltHex = Split(aSalt, ",")
      For i = 0 To SaltLength-1
         salt(i) = Val("&H" & saltHex(i))
      Next i
   End If

   ' Convert the string into byte array and catenate it with salt
   bytes = CStr(enc.GetBytes_4(aStrIn)) & CStr(salt)

   ' Compute the SHA1 hash with salt
   Set sha1 = CreateObject("System.Security.Cryptography.SHA1CryptoServiceProvider")
   sha1.ComputeHash_2(bytes)
   hash = CStr(sha1.Hash) & CStr(salt) ' concatenate byte arrays (hash + salt)

  ' Base64 Encoding
  b64.DataType = "bin.base64"
  b64.nodeTypedValue = hash

  ssha = "{SSHA}" & Replace(b64.Text, vbLf, "") ' Replace() seems not necessary, though
End Function

Function isValidPassword(ByVal aSSHA As String, ByVal aPasswd As String) As Boolean
   Dim b64 As Object, enc As Object, bytes() As Byte, salt As String, i As Integer

   ' Prepare objects
   Set b64 = CreateObject("Msxml2.DOMDocument.3.0").createElement("base64")
   Set enc = CreateObject("System.Text.UTF8Encoding")
   ' Base64 Decoding
   b64.DataType = "bin.base64"
   b64.Text = Replace(aSSHA, "{SSHA}", "", count:=1)

   ' Extract the salt from SSHA phrase
   bytes = b64.nodeTypedValue
   salt = ""
   For i = UBound(bytes) - SaltLength + 1 To UBound(bytes) ' Extract last SaltLength bytes
      salt = salt & Hex(bytes(i)) & "," ' the last "," will be ignored
   Next i
   ' Check if the password is valid or not
   If ssha(aPasswd, salt) = aSSHA Then ' pass salt as hex strings separated by ",".
      isValidPassword = True
   Else
      isValidPassword = False
   End If
End Function
```