7,762
社区成员
发帖
与我相关
我的任务
分享C#解密代码转换成VB应该怎么写？
以下是C#解密密码的代码：
//进行加密
SHA1 sha1 = SHA1.Create();
byte[] bytResult = sha1.ComputeHash(Encoding.UTF8.GetBytes(strPassword));
string PwdAfter = Convert.ToBase64String(bytResult);
请问转换成VB的代码应该怎么写？
//进行加密
SHA1 sha1 = SHA1.Create();
byte[] bytResult = sha1.ComputeHash(Encoding.UTF8.GetBytes(strPassword));
string PwdAfter = Convert.ToBase64String(bytResult);
请问转换成VB的代码应该怎么写？
...全文
请发表友善的回复…
发表回复
hbqc_zh 2016-08-02
- 打赏
- 举报
非常感谢，帮我了大忙了，再次谢谢！
hbqc_zh 2016-08-02
- 打赏
- 举报
你自己的模块能给我用用吗？QQ:63467695，请发到我邮箱，谢谢了！
舉杯邀明月 2016-08-01
- 打赏
- 举报
先没注意，它的“摘要算法”不是MD5而是SHA1。
不过能得到你的那个结果。
BASE64模块是我自己的模块，我没使用你贴的那个。
舉杯邀明月 2016-08-01
- 打赏
- 举报
hbqc_zh 2016-08-01
- 打赏
- 举报
不行，你试试【A0000000】 转换结果为【xVEeYHGq32Bda0Pch5cBRtZwa84=】，谢谢了！
舉杯邀明月 2016-08-01
- 打赏
- 举报
MD5、BASE64编码转换。
MD5模块，我发过一个帖子，推荐你使用那个。
网上MD5和BASE64的源码，一搜一大把。
hbqc_zh 2016-08-01
- 打赏
- 举报
'VB Enc - Base64位加密程序源代码上
'创建一个新类，即可调用该类的加密和解密方法
'Option Explicit
'Base64编码函数：Base64Encode
'Instr1 编码前字符串
'Outstr1 编码后字符串
Public Function Base64Encode(InStr1 As String) As String
Dim mInByte(3) As Byte, mOutByte(4) As Byte
Dim myByte As Byte
Dim i As Integer, LenArray As Integer, j As Integer
Dim myBArray() As Byte
Dim OutStr1 As String
myBArray() = StrConv(InStr1, vbFromUnicode)
LenArray = UBound(myBArray) + 1
For i = 0 To LenArray Step 3
If LenArray - i = 0 Then
Exit For
End If
If LenArray - i = 2 Then
mInByte(0) = myBArray(i)
mInByte(1) = myBArray(i + 1)
Base64EncodeByte mInByte, mOutByte, 2
ElseIf LenArray - i = 1 Then
mInByte(0) = myBArray(i)
Base64EncodeByte mInByte, mOutByte, 1
Else
mInByte(0) = myBArray(i)
mInByte(1) = myBArray(i + 1)
mInByte(2) = myBArray(i + 2)
Base64EncodeByte mInByte, mOutByte, 3
End If
For j = 0 To 3
OutStr1 = OutStr1 & Chr(mOutByte(j))
Next j
Next i
Base64Encode = OutStr1
End Function
Private Sub Base64EncodeByte(mInByte() As Byte, mOutByte() As Byte, Num As Integer)
Dim tByte As Byte
Dim i As Integer
If Num = 1 Then
mInByte(1) = 0
mInByte(2) = 0
ElseIf Num = 2 Then
mInByte(2) = 0
End If
tByte = mInByte(0) And &HFC
mOutByte(0) = tByte / 4
tByte = ((mInByte(0) And &H3) * 16) + (mInByte(1) And &HF0) / 16
mOutByte(1) = tByte
tByte = ((mInByte(1) And &HF) * 4) + ((mInByte(2) And &HC0) / 64)
mOutByte(2) = tByte
tByte = (mInByte(2) And &H3F)
mOutByte(3) = tByte
For i = 0 To 3
If mOutByte(i) >= 0 And mOutByte(i) <= 25 Then ' 00-25 --> A-Z
mOutByte(i) = mOutByte(i) + Asc("A")
ElseIf mOutByte(i) >= 26 And mOutByte(i) <= 51 Then ' 26-51 --> a-z
mOutByte(i) = mOutByte(i) - 26 + Asc("a")
ElseIf mOutByte(i) >= 52 And mOutByte(i) <= 61 Then ' 52-61 --> 0-9
mOutByte(i) = mOutByte(i) - 52 + Asc("0")
ElseIf mOutByte(i) = 62 Then ' 62 --> +
mOutByte(i) = Asc("+")
Else
mOutByte(i) = Asc("/") ' 63 --> /
End If
Next i
If Num = 1 Then ' 其它后补 =
mOutByte(2) = Asc("=")
mOutByte(3) = Asc("=")
ElseIf Num = 2 Then
mOutByte(3) = Asc("=")
End If
End Sub
Public Function Base64Decode(InStr1 As String) As String
Dim mInByte(4) As Byte, mOutByte(3) As Byte
Dim i As Integer, LenArray As Integer, j As Integer
Dim myBArray() As Byte
Dim OutStr1 As String
Dim tmpArray() As Byte
myBArray() = StrConv(InStr1, vbFromUnicode)
LenArray = UBound(myBArray)
ReDim tmpArray(((LenArray + 1) / 4) * 3)
j = 0
For i = 0 To LenArray Step 4
If LenArray - i = 0 Then
Exit For
Else
mInByte(0) = myBArray(i)
mInByte(1) = myBArray(i + 1)
mInByte(2) = myBArray(i + 2)
mInByte(3) = myBArray(i + 3)
Base64DecodeByte mInByte, mOutByte, 4
End If
tmpArray(j * 3) = mOutByte(0)
tmpArray(j * 3 + 1) = mOutByte(1)
tmpArray(j * 3 + 2) = mOutByte(2)
j = j + 1
Next i
Base64Decode = BinaryToString(tmpArray)
End Function
Private Sub Base64DecodeByte(mInByte() As Byte, mOutByte() As Byte, ByteNum As Integer)
Dim tByte As Byte
Dim i As Integer
ByteNum = 0
For i = 0 To 3 '4 byte
If mInByte(i) >= Asc("A") And mInByte(i) <= Asc("Z") Then
mInByte(i) = mInByte(i) - Asc("A") ' A-Z--> 0-25
ElseIf mInByte(i) >= Asc("a") And mInByte(i) <= Asc("z") Then
mInByte(i) = mInByte(i) - Asc("a") + 26 ' a-z-->26-51
ElseIf mInByte(i) >= Asc("0") And mInByte(i) <= Asc("9") Then
mInByte(i) = mInByte(i) - Asc("0") + 52 ' 0-9-->52-61
ElseIf mInByte(i) = Asc("+") Then ' + --> 62
mInByte(i) = 62
ElseIf mInByte(i) = Asc("/") Then ' / --> 63
mInByte(i) = 63
Else '"=" ' = --> 0
ByteNum = ByteNum + 1
mInByte(i) = 0
End If
Next i
'取前六位
tByte = (mInByte(0) And &H3F) * 4 + (mInByte(1) And &H30) / 16
'0的六位和1的前两位
mOutByte(0) = tByte
tByte = (mInByte(1) And &HF) * 16 + (mInByte(2) And &H3C) / 4
'1的后四位和2的前四位
mOutByte(1) = tByte
tByte = (mInByte(2) And &H3) * 64 + (mInByte(3) And &H3F)
mOutByte(2) = tByte
'2的后两位和3的六位
End Sub
Private Function BinaryToString(ByVal BinaryStr As Variant) As String '二进制转换为字符串
Dim lnglen As Long
Dim tmpBin As Variant
Dim strC As String
Dim skipflag As Long
Dim i As Long
skipflag = 0
strC = ""
If Not IsNull(BinaryStr) Then
lnglen = LenB(BinaryStr)
For i = 1 To lnglen
If skipflag = 0 Then
tmpBin = MidB(BinaryStr, i, 1)
If AscB(tmpBin) > 127 Then
strC = strC & Chr(AscW(MidB(BinaryStr, i + 1, 1) & tmpBin))
skipflag = 1
Else
strC = strC & Chr(AscB(tmpBin))
End If
Else
skipflag = 0
End If
Next
End If
BinaryToString = strC
End Function
Private Function StringToBinary(ByVal VarString As String) As Variant '字符串转成二进制
Dim strBin As Variant
Dim varchar As Variant
Dim varasc As Long
Dim varlow, varhigh
Dim i As Long
strBin = ""
For i = 1 To Len(VarString)
varchar = Mid(VarString, i, 1)
varasc = Asc(varchar)
If varasc < 0 Then
varasc = varasc + 65535
End If
If varasc > 255 Then
varlow = Left(Hex(Asc(varchar)), 2)
varhigh = Right(Hex(Asc(varchar)), 2)
strBin = strBin & ChrB("&H" & varlow) & ChrB("&H" & varhigh)
Else
strBin = strBin & ChrB(AscB(varchar))
End If
Next
StringToBinary = strBin
End Function
hbqc_zh 2016-08-01
- 打赏
- 举报
'模块:
'---------------------------------------------------------------------------------------
'Attribute VB_Name = "SHA1"
Option Explicit
' TITLE:
' Secure Hash Algorithm, SHA-1
' AUTHORS:
' Adapted by Iain Buchan from Visual Basic code posted at Planet-Source-Code by Peter Girard
' http://www.planetsourcecode.com/xq/ASP/txtCodeId.13565/lngWId.1/qx/vb/scripts/ShowCode.htm
' PURPOSE:
' Creating a secure identifier from person-identifiable data
' The function SecureHash generates a 160-bit (20-hex-digit) message digest for a given message (String).
' It is computationally infeasable to recover the message from the digest.
' The digest is unique to the message within the realms of practical probability.
' The only way to find the source message for a digest is by hashing all possible messages and comparison of their digests.
' REFERENCES:
' For a fuller description see FIPS Publication 180-1:
' http://www.itl.nist.gov/fipspubs/fip180-1.htm
' SAMPLE:
' Message: "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"
' Returns Digest: "84983E441C3BD26EBAAE4AA1F95129E5E54670F1"
' Message: "abc"
' Returns Digest: "A9993E364706816ABA3E25717850C26C9CD0D89D"
Private Type Word
B0 As Byte
B1 As Byte
B2 As Byte
B3 As Byte
End Type
'Public Function idcode(cr As Range) As String
' Dim tx As String
' Dim ob As Object
' For Each ob In cr
' tx = tx & LCase(CStr(ob.Value2))
' Next
' idcode = sha1(tx)
'End Function
Private Function AndW(w1 As Word, w2 As Word) As Word
AndW.B0 = w1.B0 And w2.B0
AndW.B1 = w1.B1 And w2.B1
AndW.B2 = w1.B2 And w2.B2
AndW.B3 = w1.B3 And w2.B3
End Function
Private Function OrW(w1 As Word, w2 As Word) As Word
OrW.B0 = w1.B0 Or w2.B0
OrW.B1 = w1.B1 Or w2.B1
OrW.B2 = w1.B2 Or w2.B2
OrW.B3 = w1.B3 Or w2.B3
End Function
Private Function XorW(w1 As Word, w2 As Word) As Word
XorW.B0 = w1.B0 Xor w2.B0
XorW.B1 = w1.B1 Xor w2.B1
XorW.B2 = w1.B2 Xor w2.B2
XorW.B3 = w1.B3 Xor w2.B3
End Function
Private Function NotW(w As Word) As Word
NotW.B0 = Not w.B0
NotW.B1 = Not w.B1
NotW.B2 = Not w.B2
NotW.B3 = Not w.B3
End Function
Private Function AddW(w1 As Word, w2 As Word) As Word
Dim i As Long, w As Word
i = CLng(w1.B3) + w2.B3
w.B3 = i Mod 256
i = CLng(w1.B2) + w2.B2 + (i \ 256)
w.B2 = i Mod 256
i = CLng(w1.B1) + w2.B1 + (i \ 256)
w.B1 = i Mod 256
i = CLng(w1.B0) + w2.B0 + (i \ 256)
w.B0 = i Mod 256
AddW = w
End Function
Private Function CircShiftLeftW(w As Word, n As Long) As Word
Dim d1 As Double, d2 As Double
d1 = WordToDouble(w)
d2 = d1
d1 = d1 * (2 ^ n)
d2 = d2 / (2 ^ (32 - n))
CircShiftLeftW = OrW(DoubleToWord(d1), DoubleToWord(d2))
End Function
Private Function WordToHex(w As Word) As String
WordToHex = Right$("0" & Hex$(w.B0), 2) & Right$("0" & Hex$(w.B1), 2) _
& Right$("0" & Hex$(w.B2), 2) & Right$("0" & Hex$(w.B3), 2)
End Function
Private Function HexToWord(H As String) As Word
HexToWord = DoubleToWord(Val("&H" & H & "#"))
End Function
Private Function DoubleToWord(n As Double) As Word
DoubleToWord.B0 = Int(DMod(n, 2 ^ 32) / (2 ^ 24))
DoubleToWord.B1 = Int(DMod(n, 2 ^ 24) / (2 ^ 16))
DoubleToWord.B2 = Int(DMod(n, 2 ^ 16) / (2 ^ 8))
DoubleToWord.B3 = Int(DMod(n, 2 ^ 8))
End Function
Private Function WordToDouble(w As Word) As Double
WordToDouble = (w.B0 * (2 ^ 24)) + (w.B1 * (2 ^ 16)) + (w.B2 * (2 ^ 8)) _
+ w.B3
End Function
Private Function DMod(value As Double, divisor As Double) As Double
DMod = value - (Int(value / divisor) * divisor)
If DMod < 0 Then DMod = DMod + divisor
End Function
Private Function F(t As Long, B As Word, C As Word, D As Word) As Word
Select Case t
Case Is <= 19
F = OrW(AndW(B, C), AndW(NotW(B), D))
Case Is <= 39
F = XorW(XorW(B, C), D)
Case Is <= 59
F = OrW(OrW(AndW(B, C), AndW(B, D)), AndW(C, D))
Case Else
F = XorW(XorW(B, C), D)
End Select
End Function
Public Function StringSHA1(inMessage As String) As String
' 计算字符串的SHA1摘要
Dim StringSHA1_str As String
Dim inLen As Long
Dim inLenW As Word
Dim padMessage As String
Dim numBlocks As Long
Dim w(0 To 79) As Word
Dim blockText As String
Dim wordText As String
Dim i As Long, t As Long
Dim temp As Word
Dim K(0 To 3) As Word
Dim H0 As Word
Dim H1 As Word
Dim H2 As Word
Dim H3 As Word
Dim H4 As Word
Dim A As Word
Dim B As Word
Dim C As Word
Dim D As Word
Dim E As Word
inMessage = StrConv(inMessage, vbFromUnicode)
inLen = LenB(inMessage)
inLenW = DoubleToWord(CDbl(inLen) * 8)
padMessage = inMessage & ChrB(128) & StrConv(String((128 - (inLen Mod 64) - 9) Mod 64 + 4, Chr(0)), 128) & ChrB(inLenW.B0) & ChrB(inLenW.B1) & ChrB(inLenW.B2) & ChrB(inLenW.B3)
numBlocks = LenB(padMessage) / 64
' initialize constants
K(0) = HexToWord("5A827999")
K(1) = HexToWord("6ED9EBA1")
K(2) = HexToWord("8F1BBCDC")
K(3) = HexToWord("CA62C1D6")
' initialize 160-bit (5 words) buffer
H0 = HexToWord("67452301")
H1 = HexToWord("EFCDAB89")
H2 = HexToWord("98BADCFE")
H3 = HexToWord("10325476")
H4 = HexToWord("C3D2E1F0")
' each 512 byte message block consists of 16 words (W) but W is expanded
For i = 0 To numBlocks - 1
blockText = MidB$(padMessage, (i * 64) + 1, 64)
' initialize a message block
For t = 0 To 15
wordText = MidB$(blockText, (t * 4) + 1, 4)
w(t).B0 = AscB(MidB$(wordText, 1, 1))
w(t).B1 = AscB(MidB$(wordText, 2, 1))
w(t).B2 = AscB(MidB$(wordText, 3, 1))
w(t).B3 = AscB(MidB$(wordText, 4, 1))
Next
' create extra words from the message block
For t = 16 To 79
' W(t) = S^1 (W(t-3) XOR W(t-8) XOR W(t-14) XOR W(t-16))
w(t) = CircShiftLeftW(XorW(XorW(XorW(w(t - 3), w(t - 8)), _
w(t - 14)), w(t - 16)), 1)
Next
' make initial assignments to the buffer
A = H0
B = H1
C = H2
D = H3
E = H4
' process the block
For t = 0 To 79
temp = AddW(AddW(AddW(AddW(CircShiftLeftW(A, 5), F(t, B, C, D)), E), w(t)), K(t \ 20))
E = D
D = C
C = CircShiftLeftW(B, 30)
B = A
A = temp
Next
H0 = AddW(H0, A)
H1 = AddW(H1, B)
H2 = AddW(H2, C)
H3 = AddW(H3, D)
H4 = AddW(H4, E)
Next
StringSHA1_str = WordToHex(H0) & WordToHex(H1) & WordToHex(H2) & WordToHex(H3) & WordToHex(H4)
StringSHA1 = Base64Encode(StringSHA1_str)
End Function
Public Function SHA1(inMessage() As Byte) As String
' 计算字节数组的SHA1摘要
Dim inLen As Long
Dim inLenW As Word
Dim numBlocks As Long
Dim w(0 To 79) As Word
Dim blockText As String
Dim wordText As String
Dim t As Long
Dim temp As Word
Dim K(0 To 3) As Word
Dim H0 As Word
Dim H1 As Word
Dim H2 As Word
Dim H3 As Word
Dim H4 As Word
Dim A As Word
Dim B As Word
Dim C As Word
Dim D As Word
Dim E As Word
Dim i As Long
Dim lngPos As Long
Dim lngPadMessageLen As Long
Dim padMessage() As Byte
inLen = UBound(inMessage) + 1
inLenW = DoubleToWord(CDbl(inLen) * 8)
lngPadMessageLen = inLen + 1 + (128 - (inLen Mod 64) - 9) Mod 64 + 8
ReDim padMessage(lngPadMessageLen - 1) As Byte
For i = 0 To inLen - 1
padMessage(i) = inMessage(i)
Next i
padMessage(inLen) = 128
padMessage(lngPadMessageLen - 4) = inLenW.B0
padMessage(lngPadMessageLen - 3) = inLenW.B1
padMessage(lngPadMessageLen - 2) = inLenW.B2
padMessage(lngPadMessageLen - 1) = inLenW.B3
numBlocks = lngPadMessageLen / 64
' initialize constants
K(0) = HexToWord("5A827999")
K(1) = HexToWord("6ED9EBA1")
K(2) = HexToWord("8F1BBCDC")
K(3) = HexToWord("CA62C1D6")
' initialize 160-bit (5 words) buffer
H0 = HexToWord("67452301")
H1 = HexToWord("EFCDAB89")
H2 = HexToWord("98BADCFE")
H3 = HexToWord("10325476")
H4 = HexToWord("C3D2E1F0")
' each 512 byte message block consists of 16 words (W) but W is expanded
' to 80 words
For i = 0 To numBlocks - 1
' initialize a message block
For t = 0 To 15
w(t).B0 = padMessage(lngPos)
w(t).B1 = padMessage(lngPos + 1)
w(t).B2 = padMessage(lngPos + 2)
w(t).B3 = padMessage(lngPos + 3)
lngPos = lngPos + 4
Next
' create extra words from the message block
For t = 16 To 79
' W(t) = S^1 (W(t-3) XOR W(t-8) XOR W(t-14) XOR W(t-16))
w(t) = CircShiftLeftW(XorW(XorW(XorW(w(t - 3), w(t - 8)), _
w(t - 14)), w(t - 16)), 1)
Next
' make initial assignments to the buffer
A = H0
B = H1
C = H2
D = H3
E = H4
' process the block
For t = 0 To 79
temp = AddW(AddW(AddW(AddW(CircShiftLeftW(A, 5), _
F(t, B, C, D)), E), w(t)), K(t \ 20))
E = D
D = C
C = CircShiftLeftW(B, 30)
B = A
A = temp
Next
H0 = AddW(H0, A)
H1 = AddW(H1, B)
H2 = AddW(H2, C)
H3 = AddW(H3, D)
H4 = AddW(H4, E)
Next
SHA1 = WordToHex(H0) & WordToHex(H1) & WordToHex(H2) _
& WordToHex(H3) & WordToHex(H4)
End Function
Public Function FileSHA1(strFilename As String) As String
' 计算文件的SHA1摘要
Dim lngFileNo As Long
Dim bytData() As Byte
If Dir(strFilename) = "" Then
GoTo PROC_EXIT
End If
lngFileNo = FreeFile
On Error GoTo PROC_ERR
' 打开文件
Open strFilename For Binary As lngFileNo
' 读取文件内容
ReDim bytData(LOF(lngFileNo) - 1) As Byte
Get #lngFileNo, 1, bytData
' 关闭文件
Close lngFileNo
' 计算文件的SHA1摘要
FileSHA1 = SHA1(bytData)
PROC_EXIT:
Erase bytData
Exit Function
PROC_ERR:
Close
GoTo PROC_EXIT
End Function
