各位帮帮忙!!我急需一个密码加密的算法!!谢谢!

[siyuting]

我是一个即将毕业的大学生.毕业设计即将结束,但是老是说我的密码保护机制做的不好.应该给密码加密,不能直接存在数据库中.
所以我想请各位帮帮我,提供一个不是很难懂,但是可行的加密算法!!!
而且,马上就要答辩了,我真的很着急.
先谢谢各位了.

[rainstormmaster]

参考：
md5加密算法：
http://www.csdn.net/Develop/article/13%5C13587.shtm
vb中的md5算法如何实现：
http://expert.csdn.net/Expert/topic/1395/1395641.xml?temp=.225567

[pigsanddogs]

你是什么样的数据库？ 里面存储密码字段怎么样的？ 是不是只能存可见字符？
给你个函数，刚写的哦

'//////////////////////////////////////////////////////////////////////////////////
'功能: 实现ini配制文件中口令的加密
'参数: 需要加密的字符串
'返回值: 加密后的字符串
'完成日期: 2002-6-3
'//////////////////////////////////////////////////////////////////////////////////
Function UserCode(PassWord As String) As String
'用户口令加密
Dim i As Long
Dim key As String, keyIndex As Integer, tmpByte As Byte
key = "hujunjie"
keyIndex = 1

For i = 1 To LenB(PassWord)
If keyIndex > LenB(key) Then keyIndex = 1
tmpByte = AscB(MidB(PassWord, i, 1)) Xor AscB(MidB(key, keyIndex, 1))
UserCode = UserCode & Chr(&H40 + tmpByte Mod &H10) & Chr(&H40 + tmpByte \ &H10)
Next i
End Function



'//////////////////////////////////////////////////////////////////////////////////
'功能: 实现ini配制文件中口令的解密. 注:如果不按上述加密产生的字符串, 可能会产生错误
'参数: 需要解密的字符串
'返回值: 解密后的字符串
'完成日期: 2002-6-3
'//////////////////////////////////////////////////////////////////////////////////
Function UserDeCode(PassWord As String) As String
'口令解密
On Error GoTo errHandle

Dim i As Long
Dim key As String, keyIndex As Integer, tmpByte As Byte, a As Byte, b As Byte
key = "hujunjie"
keyIndex = 1

For i = 1 To Len(PassWord) Step 2
If keyIndex > LenB(key) Then keyIndex = 1
a = AscB(Mid(PassWord, i, 1)) - &H40
b = AscB(Mid(PassWord, i + 1, 1)) - &H40
tmpByte = b * &H10 + a
tmpByte = tmpByte Xor AscB(MidB(key, keyIndex, 1))
UserDeCode = UserDeCode & ChrB(tmpByte)
Next i
Exit Function

errHandle:
Debug.Print "UserDeCode产生错误! " & Err.Number & " " & Err.Description
End Function

[bydisplay]

http://www.csdn.net/cnshare/soft/16/16046.shtm看看

[pigsanddogs]

呵呵， 是2003年

[siyuting]

谢谢各位,我没想到会这么快就有回复.我做的是一个模拟的银行信贷系统.所以用户的密码必须有一定的保护机制.当然密码可以是数字也可以是字符也可以是下划线一类的. pigsanddogs(我爱吃猪肉,但是长不胖,为什么??) 的算法采用的原理是异或???

[极速小王子]

gz

[siyuting]

pigsanddogs(我爱吃猪肉,但是长不胖,为什么??)你现在在网上吗??把你的qq告诉我吧.那样说话方便一些.

[rainstormmaster]

是xor，不过建议采用一些比较成熟的加密算法，如MD5，RC4，MARS等
可以参考：
RC4经典加密算法VB版本代码

[www.Googln.com 2002-9-11 8:00:29 ]

VB版rc4算法

Public Sub main()
Dim key As String
For i = 1 To 16
Randomize
key = key & Chr(Rnd * 255)
Next i
MsgBox RC4(RC4("Welcome To Plindge Studio!", key), key)
End Sub
Public Function RC4(inp As String, key As String) As String
Dim S(0 To 255) As Byte, K(0 To 255) As Byte, i As Long
Dim j As Long, temp As Byte, Y As Byte, t As Long, x As Long
Dim Outp As String

For i = 0 To 255
S(i) = i
Next

j = 1
For i = 0 To 255
If j > Len(key) Then j = 1
K(i) = Asc(Mid(key, j, 1))
j = j + 1
Next i

j = 0
For i = 0 To 255
j = (j + S(i) + K(i)) Mod 256
temp = S(i)
S(i) = S(j)
S(j) = temp
Next i

i = 0
j = 0
For x = 1 To Len(inp)
i = (i + 1) Mod 256
j = (j + S(i)) Mod 256
temp = S(i)
S(i) = S(j)
S(j) = temp
t = (S(i) + (S(j) Mod 256)) Mod 256
Y = S(t)

Outp = Outp & Chr(Asc(Mid(inp, x, 1)) Xor Y)
Next
RC4 = Outp
End Function

[Dickson]

给你NASA美国宇航局的加密法！！！

[rainstormmaster]

经典加密算法Rsa 在VB中的实现 查看此会员其它文章

Public key(1 To 3) As Long
Private Const base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrst
uvwxyz0123456789+/"

Public Sub GenKey()
Dim d As Long, phi As Long, e As Long
Dim m As Long, x As Long, q As Long
Dim p As Long
Randomize
On Error GoTo top
top:
p = Rnd * 1000 \ 1
If IsPrime(p) = False Then GoTo top
Sel_q:
q = Rnd * 1000 \ 1
If IsPrime(q) = False Then GoTo Sel_q
n = p * q \ 1
phi = (p - 1) * (q - 1) \ 1
d = Rnd * n \ 1
If d = 0 Or n = 0 Or d = 1 Then GoTo top
e = Euler(phi, d)
If e = 0 Or e = 1 Then GoTo top

x = Mult(255, e, n)
If Not Mult(x, d, n) = 255 Then
DoEvents
GoTo top
ElseIf Mult(x, d, n) = 255 Then
key(1) = e
key(2) = d
key(3) = n
End If
End Sub

Private Function Euler(ByVal a As Long, ByVal b As Long) As Long
On Error GoTo error2
r1 = a: r = b
p1 = 0: p = 1
q1 = 2: q = 0
n = -1
Do Until r = 0
r2 = r1: r1 = r
p2 = p1: p1 = p
q2 = q1: q1 = q
n = n + 1
r = r2 Mod r1
c = r2 \ r1
p = (c * p1) + p2
q = (c * q1) + q2
Loop
s = (b * p1) - (a * q1)
If s > 0 Then
x = p1
Else
x = (0 - p1) + a
End If
Euler = x
Exit Function

error2:
Euler = 0
End Function

Private Function Mult(ByVal x As Long, ByVal p As Long, ByVal m As Lon
g) As Long
y = 1
On Error GoTo error1
Do While p > 0
Do While (p / 2) = (p \ 2)
x = (x * x) Mod m
p = p / 2
Loop
y = (x * y) Mod m
p = p - 1
Loop
Mult = y
Exit Function

error1:
y = 0
End Function

Private Function IsPrime(lngNumber As Long) As Boolean
Dim lngCount As Long
Dim lngSqr As Long
Dim x As Long

lngSqr = Sqr(lngNumber) ' get the int square root

If lngNumber < 2 Then
IsPrime = False
Exit Function
End If

lngCount = 2
IsPrime = True

If lngNumber Mod lngCount = 0& Then
IsPrime = False
Exit Function
End If

lngCount = 3

For x& = lngCount To lngSqr Step 2
If lngNumber Mod x& = 0 Then
IsPrime = False
Exit Function
End If
Next
End Function

Private Function Base64_Encode(DecryptedText As String) As String
Dim c1, c2, c3 As Integer
Dim w1 As Integer
Dim w2 As Integer
Dim w3 As Integer
Dim w4 As Integer
Dim n As Integer
Dim retry As String
For n = 1 To Len(DecryptedText) Step 3
c1 = Asc(Mid$(DecryptedText, n, 1))
c2 = Asc(Mid$(DecryptedText, n + 1, 1) + Chr$(0))
c3 = Asc(Mid$(DecryptedText, n + 2, 1) + Chr$(0))
w1 = Int(c1 / 4)
w2 = (c1 And 3) * 16 + Int(c2 / 16)
If Len(DecryptedText) >= n + 1 Then w3 = (c2 And 15) * 4 + Int(c
3 / 64) Else w3 = -1
If Len(DecryptedText) >= n + 2 Then w4 = c3 And 63 Else w4 = -1

retry = retry + mimeencode(w1) + mimeencode(w2) + mimeencode(w3)
+ mimeencode(w4)
Next
Base64_Encode = retry
End Function

Private Function Base64_Decode(a As String) As String
Dim w1 As Integer
Dim w2 As Integer
Dim w3 As Integer
Dim w4 As Integer
Dim n As Integer
Dim retry As String

For n = 1 To Len(a) Step 4
w1 = mimedecode(Mid$(a, n, 1))
w2 = mimedecode(Mid$(a, n + 1, 1))
w3 = mimedecode(Mid$(a, n + 2, 1))
w4 = mimedecode(Mid$(a, n + 3, 1))
If w2 >= 0 Then retry = retry + Chr$(((w1 * 4 + Int(w2 / 16)) An
d 255))
If w3 >= 0 Then retry = retry + Chr$(((w2 * 16 + Int(w3 / 4)) An
d 255))
If w4 >= 0 Then retry = retry + Chr$(((w3 * 64 + w4) And 255))
Next
Base64_Decode = retry
End Function

Private Function mimeencode(w As Integer) As String
If w >= 0 Then mimeencode = Mid$(base64, w + 1, 1) Else mimeencode
= ""
End Function

Private Function mimedecode(a As String) As Integer
If Len(a) = 0 Then mimedecode = -1: Exit Function
mimedecode = InStr(base64, a) - 1
End Function

Public Function Encode(ByVal Inp As String, ByVal e As Long, ByVal n A
s Long) As String
Dim s As String
s = ""
m = Inp

If m = "" Then Exit Function
s = Mult(CLng(Asc(Mid(m, 1, 1))), e, n)
For i = 2 To Len(m)
s = s & "+" & Mult(CLng(Asc(Mid(m, i, 1))), e, n)
Next i
Encode = Base64_Encode(s)
End Function

Public Function Decode(ByVal Inp As String, ByVal d As Long, ByVal n A
s Long) As String
St = ""
ind = Base64_Decode(Inp)
For i = 1 To Len(ind)
nxt = InStr(i, ind, "+")
If Not nxt = 0 Then
tok = Val(Mid(ind, i, nxt))
Else
tok = Val(Mid(ind, i))
End If
St = St + Chr(Mult(CLng(tok), d, n))
If Not nxt = 0 Then
i = nxt
Else
i = Len(ind)
End If
Next i
Decode = St
End Function

[pigsanddogs]

是啊，不过不方便开qq，我在公司， 你加我吧， 900572

[siyuting]

我需要的是一个能加密,当然也要能解的.那些经典的算法我看了.不过很惭愧我看不懂.所以我才想先找个,让我能懂的算法.rc4的算法流程是什么样的.
还有bydisplay(时光) 谢谢你.你提供的我down了.不过还没看呢??不好意思.
论文忙死我.

[pigsanddogs]

顺便说说 MD5算法是不可逆的， 如果可以最好用这个，我可以给你个模块，
经过我修改了的，即是MD5生成的结果是2进制的， 把他转换成了可显ascii码

[siyuting]

谢谢各位了.没想到在这么短的时间的到大家这么多的帮助.谢谢了.
我决定先用个简单的方法,把毕业设计搞定,然后学点经典的.
我以后会经常来学习的.
谢谢.