VB6 可用的SHA256模块(可用，但速度较慢)

算法来源：https://bbs.csdn.net/topics/392514703

源码分享：
链接：https://pan.baidu.com/s/1DEPmGVh9iqv_r4KfS_rPGw
提取码：hvj3
复制这段内容后打开百度网盘手机App，操作更方便哦

源码部分截图

mSHA256源码：部分1
Attribute VB_Name = "mSHA256"
Option Explicit
'========================================
'【获取SHA-256模块】
'========================================
'================================
'声明模块变量
'================================
Private dwBitFill&(30) '位填充
Private dwPowerOfTwo&(30) '2的n次幂
Private k&(63)
'================================
'声明模块常量
'================================
Private Const BITS_TO_A_BYTE As Long = 8 '字节包含位常数： 1 Byte = 8 Bits
Private Const BYTES_TO_A_WORD As Long = 4 '双字包含字节常数：1 DWord = 4 Bytes
Private Const BITS_TO_A_WORD As Long = 32 '双字包含位常数： 1 DWord = 32 Bits
'================================
'主函数过程
'================================
'========================
'获取文件或字符串SHA-256值
'========================
Public Function SHA256(ByRef sInput As String, Optional ByVal IsFile As Boolean = False) As String
'声明变量
Dim a&, b&, c&, d&, e&, f&, g&, h&
Dim i&, j&
Dim T1&
Dim T2&
Dim dwBytes&
Dim sRet$
Dim bArr() As Byte
Dim dwArr() As Long
Dim HASH&(7)
Dim W&(63)
'初始化
Call Init
HASH(0) = &H6A09E667
HASH(1) = &HBB67AE85
HASH(2) = &H3C6EF372
HASH(3) = &HA54FF53A
HASH(4) = &H510E527F
HASH(5) = &H9B05688C
HASH(6) = &H1F83D9AB
HASH(7) = &H5BE0CD19
'处理参数
If IsFile Then
dwBytes = getBytes(sInput, bArr)
Else
dwBytes = toBytes(sInput, bArr)
End If
'转换字节数组为32位双字矩阵
Call ToDWordArr(dwArr, bArr, dwBytes)
For i = 0 To UBound(dwArr) Step 16
a = HASH(0)
b = HASH(1)
c = HASH(2)
d = HASH(3)
e = HASH(4)
f = HASH(5)
g = HASH(6)
h = HASH(7)
For j = 0 To 63
If j < 16 Then
W(j) = dwArr(j + i)
Else
W(j) = AddUnsigned(AddUnsigned(AddUnsigned(Gamma1(W(j - 2)), W(j - 7)), Gamma0(W(j - 15))), W(j - 16))
End If
T1 = AddUnsigned(AddUnsigned(AddUnsigned(AddUnsigned(h, Sigma1(e)), Ch(e, f, g)), k(j)), W(j))
T2 = AddUnsigned(Sigma0(a), Maj(a, b, c))
h = g
g = f
f = e
e = AddUnsigned(d, T1)
d = c
c = b
b = a
a = AddUnsigned(T1, T2)
Next
HASH(0) = AddUnsigned(a, HASH(0))
HASH(1) = AddUnsigned(b, HASH(1))
HASH(2) = AddUnsigned(c, HASH(2))
HASH(3) = AddUnsigned(d, HASH(3))
HASH(4) = AddUnsigned(e, HASH(4))
HASH(5) = AddUnsigned(f, HASH(5))
HASH(6) = AddUnsigned(g, HASH(6))
HASH(7) = AddUnsigned(h, HASH(7))
Next
sRet = ""
For i = 0 To 7
sRet = sRet & Right("00000000" & Hex(HASH(i)), 8)
Next
SHA256 = LCase(sRet)End Function

mSHA256源码：部分2
'================================
'算法函数过程
'================================
'========================
'初始化主要常数
'========================
Private Sub Init()
Dim i&
For i = 0 To 30
dwBitFill(i) = 2 ^ (i + 1) - 1
dwPowerOfTwo(i) = 2 ^ i
Next
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
End Sub
'========================
'Gamma1
'========================
Private Function Gamma1(x)
Gamma1 = (S(x, 17) Xor S(x, 19) Xor R(x, 10))
End Function
'========================
'Gamma0
'========================
Private Function Gamma0(x)
Gamma0 = (S(x, 7) Xor S(x, 18) Xor R(x, 3))
End Function
'========================
'Sigma1
'========================
Private Function Sigma1(x)
Sigma1 = (S(x, 6) Xor S(x, 11) Xor S(x, 25))
End Function
'========================
'Sigma0
'========================
Private Function Sigma0(x)
Sigma0 = (S(x, 2) Xor S(x, 13) Xor S(x, 22))
End Function
'========================
'Ch
'========================
Private Function Ch(x, y, z)
Ch = ((x And y) Xor ((Not x) And z))
End Function
'========================
'Maj
'========================
Private Function Maj(x, y, z)
Maj = ((x And y) Xor (x And z) Xor (y And z))
End Function
'========================
'S
'========================
Private Function S(x, n)
S = (RShift(x, (n And dwBitFill(4))) Or LShift(x, (32 - (n And dwBitFill(4)))))
End Function
'========================
'R
'========================
Private Function R(x, n)
R = RShift(x, CInt(n And dwBitFill(4)))
End Function

关于文件拖拽部分代码：
Private Sub boxMsg_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
Dim sFile$
sFile = Data.Files(1)
boxMsg = sFile
IsStrHash = False
End Sub

一点点优化，没有解决根本原因
将VB语言的无符号数加法函数和逻辑位移函数改为了内联汇编的相应函数，速度略微有所提升

同时关于内联汇编的部分，模块我已经上传至分享的链接，文件名为：22010401_mFuncInline
其中，较为关键的函数如下