MD5加密-Excel VBA程序开发-ExcelHome技术论坛

perfect131 Lv.5

2023-3-20 20:35 关注

本帖最后由 perfect131 于 2023-3-21 13:47 编辑

直接用 System.Security.Cryptography.MD5CryptoServiceProvider，两种方式encode

Function StringToMD5Hex(ByVal s As String) As String
Dim enc As Object
Dim bytes() As Byte
Dim pos As Long
Dim outstr As String
Set enc = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
bytes = encode(s)
bytes = enc.ComputeHash_2(encode(s))
outstr = ""
For pos = 1 To UBound(bytes) + 1
outstr = outstr & Right("0" & Hex(AscB(MidB(bytes, pos, 1))), 2)
Next pos
outstr = LCase(outstr)
StringToMD5Hex = outstr
Set enc = Nothing
End Function
Function StringToMD5Hex1(ByVal temp_sign As String) As String
Dim md As Object
Set md = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
Dim bytes() As Byte
bytes = md.ComputeHash_2(CreateObject("System.Text.UTF8Encoding").GetBytes_4(temp_sign))
Dim sign As String
sign = ""
For i = 1 To UBound(bytes) + 1
sign = sign & Right("0" & Hex(AscB(MidB(bytes, i, 1))), 2)
Next
md.Clear
Set md = Nothing
StringToMD5Hex1 = LCase(sign)
End Function
'''编码转换("我是学员","UTF-8","gbk")
'''decode(encode("我是学员"),"gbk")
'''decode(encode("我是学员","gbk"),"gbk")
Function 编码转换(str, CharSet1, CharSet2)
编码转换 = ""
On Error GoTo err1
Dim ADODB_Stream
Set ADODB_Stream = CreateObject("ADODB.Stream")
Dim bytes() As Byte
Dim gbk_txt As String
With ADODB_Stream
.Charset = CharSet1
.Open
.WriteText str, 0
.Position = 0
.Type = 1
If CharSet1 = CharSet2 Then
.Position = 0
Else
.Position = 3 ''无 bom
End If
bytes = .Read()
.Close
.Open
.Type = 1
.Write bytes
.Position = 0
.Type = 2
.Charset = CharSet2
编码转换 = .ReadText()
.Close
End With
err1:
Set ADODB_Stream = Nothing
End Function
Function encode(ss, Optional ByVal CharSet1 As String = "UTF-8") As Byte()
On Error GoTo err1
Dim ADODB_Stream
Set ADODB_Stream = CreateObject("ADODB.Stream")
With ADODB_Stream
.Charset = CharSet1
.Open
.WriteText ss, 0
.Position = 0
.Type = 1
If CharSet1 <> "UTF-8" Then
.Position = 0
Else
.Position = 3 ''无 bom
End If
encode = .Read()
.Close
End With
err1:
Set ADODB_Stream = Nothing
End Function
Function decode(bytes, Optional ByVal CharSet2 As String = "UTF-8") As String
decode = ""
On Error GoTo err1
Dim ADODB_Stream
Set ADODB_Stream = CreateObject("ADODB.Stream")
With ADODB_Stream
.Open
.Type = 1
.Write bytes
.Position = 0
.Type = 2
.Charset = CharSet2
decode = .ReadText()
.Close
End With
err1:
Set ADODB_Stream = Nothing
End Function