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

level 11

余思培楼主

//本算法基于CSDN论坛上的一个版本
//SHA-256算法我也不太懂，所作的调整不是很多，只是在原有代码的基础上字符串SHA-256支持了中文字符，并新增支持文件SHA-256
//文件SHA-256速度较慢，原因是没有为大量数据进行专门优化，也即按照源码思路先获取Byte数组，再转化为DWord数组，然后计算SHA-256
//有兴趣的可以看看，或者尝试优化下

2022年01月02日 18点01分 1

level 11

余思培楼主

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

2022年01月02日 18点01分 2

level 11

余思培楼主

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

2022年01月02日 18点01分 3

level 11

余思培楼主

源码部分截图

2022年01月02日 18点01分 4

level 11

余思培楼主

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

2022年01月02日 19点01分 5

level 11

余思培楼主

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

2022年01月02日 19点01分 6

level 11

余思培楼主

关于文件拖拽部分代码：
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

2022年01月02日 19点01分 8