<% '======================================================================================================================= ' Password hashing ' ' Pure VBScript SHA-256 - no external process, no shell-out, no COM crypto ' dependency. The previous implementation shelled out to a PowerShell script ' (hash_sha256.ps1, which did not exist anywhere in this repo) via ' WScript.Shell.Exec with the raw password concatenated directly into the ' command line. That was both non-functional (missing script) and a command ' injection vulnerability (a password containing ", `, ; etc. could execute ' arbitrary PowerShell, and the password was visible in the process command ' line to anything that could list processes). ' ' NOTE: This hashes without a per-user salt, matching the single-argument ' HashPassword(password) contract these functions already had. Unsalted ' hashes are vulnerable to precomputed/rainbow-table attacks. If a real ' Users table is introduced, prefer storing a random per-user salt alongside ' the hash and hashing (salt & password) - that is a schema change, so it is ' intentionally not done here. '======================================================================================================================= Private Function Sha256_U32(n) If n < 0 Then Sha256_U32 = n + 4294967296.0 Else Sha256_U32 = CDbl(n) End If End Function Private Function Sha256_S32(d) Do While d >= 4294967296.0 d = d - 4294967296.0 Loop Do While d < 0 d = d + 4294967296.0 Loop If d >= 2147483648.0 Then Sha256_S32 = CLng(d - 4294967296.0) Else Sha256_S32 = CLng(d) End If End Function Private Function Sha256_Mod(x, y) Sha256_Mod = x - Int(x / y) * y End Function Private Function Sha256_Add32(a, b) Sha256_Add32 = Sha256_S32(Sha256_U32(a) + Sha256_U32(b)) End Function Private Function Sha256_Add32_5(a, b, c, d, e) Sha256_Add32_5 = Sha256_S32(Sha256_U32(a) + Sha256_U32(b) + Sha256_U32(c) + Sha256_U32(d) + Sha256_U32(e)) End Function Private Function Sha256_RotR32(x, n) Dim u, partA, keepBits, partB If n = 0 Then Sha256_RotR32 = x Exit Function End If u = Sha256_U32(x) partA = Int(u / (2 ^ n)) keepBits = Sha256_Mod(u, 2 ^ n) partB = keepBits * (2 ^ (32 - n)) Sha256_RotR32 = Sha256_S32(partA + partB) End Function Private Function Sha256_ShR32(x, n) Dim u u = Sha256_U32(x) Sha256_ShR32 = Sha256_S32(Int(u / (2 ^ n))) End Function Private Function Sha256_BytesToWord(b0, b1, b2, b3) Sha256_BytesToWord = Sha256_S32(b0 * 16777216.0 + b1 * 65536.0 + b2 * 256.0 + b3) End Function Private Function Sha256_HexWord(x) Dim u, h u = Sha256_U32(x) h = "" Do While u > 0 h = Mid("0123456789abcdef", Sha256_Mod(u, 16) + 1, 1) & h u = Int(u / 16) Loop Sha256_HexWord = Right("00000000" & h, 8) End Function ' Converts a VBScript string (UTF-16) to a UTF-8 byte array (Long values 0-255). ' Pure VBScript - avoids ADODB.Stream, which returns a Byte SafeArray that is ' not reliably indexable from VBScript on every 32/64-bit IIS configuration. Private Function Sha256_StringToUtf8Bytes(s) Dim arr(), count, i, code, lenS lenS = Len(s) If lenS = 0 Then ReDim arr(-1) Sha256_StringToUtf8Bytes = arr Exit Function End If ReDim arr(lenS * 3) count = -1 For i = 1 To lenS code = AscW(Mid(s, i, 1)) If code < 0 Then code = code + 65536 If code <= 127 Then count = count + 1 : arr(count) = code ElseIf code <= 2047 Then count = count + 1 : arr(count) = 192 Or Int(code / 64) count = count + 1 : arr(count) = 128 Or (code And 63) Else count = count + 1 : arr(count) = 224 Or Int(code / 4096) count = count + 1 : arr(count) = 128 Or (Int(code / 64) And 63) count = count + 1 : arr(count) = 128 Or (code And 63) End If Next ReDim Preserve arr(count) Sha256_StringToUtf8Bytes = arr End Function ' Returns the SHA-256 hash of inputString (UTF-8 encoded) as a 64-character ' lowercase hex string. Verified against NIST/RFC test vectors (empty string, ' "abc", the 56-byte two-block vector, and non-ASCII input) plus .NET's ' System.Security.Cryptography.SHA256 as a cross-check. Function Sha256Hex(inputString) Dim msg, msgLen, bitLen, i, t Dim numBlocks, blockIdx, base Dim hs(7) Dim k(63) Dim w(63) Dim a, b, c, d, e, f, g, h Dim s0, s1, ch, maj, temp1, temp2, bigS0, bigS1 Dim padded() Dim padLen, totalLen, lenPos, hi32, lo32 Dim kHex, result hs(0) = &h6a09e667 : hs(1) = &hbb67ae85 : hs(2) = &h3c6ef372 : hs(3) = &ha54ff53a hs(4) = &h510e527f : hs(5) = &h9b05688c : hs(6) = &h1f83d9ab : hs(7) = &h5be0cd19 kHex = Array( _ "428a2f98","71374491","b5c0fbcf","e9b5dba5","3956c25b","59f111f1","923f82a4","ab1c5ed5", _ "d807aa98","12835b01","243185be","550c7dc3","72be5d74","80deb1fe","9bdc06a7","c19bf174", _ "e49b69c1","efbe4786","0fc19dc6","240ca1cc","2de92c6f","4a7484aa","5cb0a9dc","76f988da", _ "983e5152","a831c66d","b00327c8","bf597fc7","c6e00bf3","d5a79147","06ca6351","14292967", _ "27b70a85","2e1b2138","4d2c6dfc","53380d13","650a7354","766a0abb","81c2c92e","92722c85", _ "a2bfe8a1","a81a664b","c24b8b70","c76c51a3","d192e819","d6990624","f40e3585","106aa070", _ "19a4c116","1e376c08","2748774c","34b0bcb5","391c0cb3","4ed8aa4a","5b9cca4f","682e6ff3", _ "748f82ee","78a5636f","84c87814","8cc70208","90befffa","a4506ceb","bef9a3f7","c67178f2") For i = 0 To 63 k(i) = Sha256_S32(CDbl("&h" & kHex(i))) Next msg = Sha256_StringToUtf8Bytes(inputString) If UBound(msg) < LBound(msg) Then msgLen = 0 Else msgLen = UBound(msg) - LBound(msg) + 1 End If bitLen = msgLen * 8.0 ' Padding: msg + 0x80 + zero bytes so length % 64 = 56, then an 8-byte ' big-endian bit length. padLen = 56 - Sha256_Mod(msgLen + 1, 64) If padLen < 0 Then padLen = padLen + 64 totalLen = msgLen + 1 + padLen + 8 ReDim padded(totalLen - 1) For i = 0 To msgLen - 1 padded(i) = msg(i) Next padded(msgLen) = 128 For i = msgLen + 1 To msgLen + padLen padded(i) = 0 Next lenPos = msgLen + 1 + padLen hi32 = Int(bitLen / 4294967296.0) lo32 = bitLen - hi32 * 4294967296.0 padded(lenPos + 0) = Sha256_Mod(Int(hi32 / 16777216), 256) padded(lenPos + 1) = Sha256_Mod(Int(hi32 / 65536), 256) padded(lenPos + 2) = Sha256_Mod(Int(hi32 / 256), 256) padded(lenPos + 3) = Sha256_Mod(hi32, 256) padded(lenPos + 4) = Int(lo32 / 16777216) padded(lenPos + 5) = Sha256_Mod(Int(lo32 / 65536), 256) padded(lenPos + 6) = Sha256_Mod(Int(lo32 / 256), 256) padded(lenPos + 7) = Sha256_Mod(lo32, 256) numBlocks = totalLen / 64 For blockIdx = 0 To numBlocks - 1 base = blockIdx * 64 For t = 0 To 15 w(t) = Sha256_BytesToWord(padded(base + t*4), padded(base + t*4 + 1), padded(base + t*4 + 2), padded(base + t*4 + 3)) Next For t = 16 To 63 s0 = Sha256_RotR32(w(t-15), 7) Xor Sha256_RotR32(w(t-15), 18) Xor Sha256_ShR32(w(t-15), 3) s1 = Sha256_RotR32(w(t-2), 17) Xor Sha256_RotR32(w(t-2), 19) Xor Sha256_ShR32(w(t-2), 10) w(t) = Sha256_Add32_5(w(t-16), s0, w(t-7), s1, 0) Next a = hs(0) : b = hs(1) : c = hs(2) : d = hs(3) e = hs(4) : f = hs(5) : g = hs(6) : h = hs(7) For t = 0 To 63 bigS1 = Sha256_RotR32(e,6) Xor Sha256_RotR32(e,11) Xor Sha256_RotR32(e,25) ch = (e And f) Xor ((Not e) And g) temp1 = Sha256_Add32_5(h, bigS1, ch, k(t), w(t)) bigS0 = Sha256_RotR32(a,2) Xor Sha256_RotR32(a,13) Xor Sha256_RotR32(a,22) maj = (a And b) Xor (a And c) Xor (b And c) temp2 = Sha256_Add32(bigS0, maj) h = g g = f f = e e = Sha256_Add32(d, temp1) d = c c = b b = a a = Sha256_Add32(temp1, temp2) Next hs(0) = Sha256_Add32(hs(0), a) : hs(1) = Sha256_Add32(hs(1), b) : hs(2) = Sha256_Add32(hs(2), c) : hs(3) = Sha256_Add32(hs(3), d) hs(4) = Sha256_Add32(hs(4), e) : hs(5) = Sha256_Add32(hs(5), f) : hs(6) = Sha256_Add32(hs(6), g) : hs(7) = Sha256_Add32(hs(7), h) Next result = "" For i = 0 To 7 result = result & Sha256_HexWord(hs(i)) Next Sha256Hex = result End Function Function HashPassword(password) HashPassword = Sha256Hex(password) End Function '======================================================================================================================= ' CheckPassword ' ' The original implementation called CreateRepository(conn, "Users", "UserId") ' and Array("UserName", user) - "conn" and "CreateRepository" are not defined ' anywhere in this framework (no global "conn", no CreateRepository factory), ' and it searched using the not-yet-assigned "user" variable instead of the ' "username" parameter, so this function has never been callable. Nothing in ' this codebase calls it yet, and there is no Users table/migration either - ' this remains example/scaffold code. Rewritten here to use the framework's ' actual data-access primitive (DAL().Query with a parameterized command) and ' the correct lookup value, so it will work once a Users table exists with ' UserName and PasswordHash columns. '======================================================================================================================= Function CheckPassword(username, password) Dim rs Set rs = DAL().Query("SELECT PasswordHash FROM Users WHERE UserName = ?", Array(username)) If rs.EOF Then CheckPassword = False Else CheckPassword = (HashPassword(password) = rs("PasswordHash")) End If rs.Close Set rs = Nothing End Function %>