我要字符串加密解密源代码！

Question

这里有代码,你参考一下吧.一个是字符串到字节的转化,一个是字节到字符串的转化.
Function stringtoarray(ByVal str As String) As Variant
Dim i As Long
Dim j As Long
Dim arr() As Byte
i = Len(str)
ReDim arr(i) As Byte
For j = 0 To i - 1
arr(j) = CByte(Asc(Mid(str, j + 1, 1)))
Next
stringtoarray = arr()
End FunctionFunction bytetostr(minbyte() As Byte) As String
Dim ml As Integer
Dim basestring As String
Dim tByte As Byte
Dim i As Integer
Dim msendstring As String
Dim moutbyte(4) As Byte
Dim md As Long
Dim linelen As Long
Dim moutbytee(4) As Stringmd = UBound(minbyte) + 1
md = Len(Str)
If md Mod 3 <> 0 Then ReDim Preserve minbyte(md + (2 - (md Mod 3)))
md = md - md Mod 3
If md Mod 3 = 1 Then
    minbyte(UBound(minbyte)) = 0
    minbyte(UBound(minbyte) - 1) = 0
ElseIf md Mod 3 = 2 Then
    minbyte(UBound(minbyte)) = 0
End Iflinelen = 0For ml = 0 To UBound(minbyte) - 2 Step 3
    DoEvents
    tByte = minbyte(ml) And &HFC
    moutbyte(0) = tByte / 4
    tByte = ((minbyte(ml) And &H3) * 16) + (minbyte(ml + 1) And &HF0) / 16
    moutbyte(1) = tByte
    tByte = ((minbyte(ml + 1) And &HF) * 4) + ((minbyte(ml + 2) And &HC0) / 64)
    moutbyte(2) = tByte
    tByte = (minbyte(ml + 2) And &H3F)
    moutbyte(3) = tByte
    basestring = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
    For i = 0 To 3
        moutbytee(i) = Mid(basestring, moutbyte(i) + 1, 1)
    Next i
    msendstring = msendstring & moutbytee(0) & moutbytee(1) & moutbytee(2) & moutbytee(3)
    linelen = linelen + 1
    If linelen * 4 > 74 Then
        msendstring = msendstring & vbCrLf
        linelen = 0
    End If
Nextmd = md Mod 3
If md = 1 Then msendstring = Left(msendstring, Len(msendstring) - 2) & "=="
If md = 2 Then msendstring = Left(msendstring, Len(msendstring) - 1) & "="
bytetostr = msendstringEnd Function

Answer 1

Public Function nnnn(ByVal s As String) As String '解密
On Error Resume Next
Dim ss As String, i As Byte, lens As Byte
lens = Len(s)
For i = 1 To lens
    ss = ss & Chr(Asc(Mid(s, i, 1)) - lens - i)
Next
nnnn = ss
End Function
Public Function mmmm(ByVal s As String) As String  '加密
On Error Resume Next
Dim ss As String, i As Byte, lens As Byte
lens = Len(s)
For i = 1 To lens
    ss = ss & Chr(Asc(Mid(s, i, 1)) + lens + i)
Next
mmmm = ss
End Function

Answer 2

楼上的算法有点小问题，
可以试试对下面三个字符串的算法：
qwertyuiop
按时大副度sdfd
按时大副度读西

Answer 3

上面的是不对哦？
lens + i)
改成
1

Answer 4

回复人： lihonggen0(李洪根,用VB，标准答案来了) 
如何对字符串进行加密解密
 
本人在操作数据库时，考虑到该数据库还有可能被其他软件打开，所以想能否有另外一种方式把数据库中数据进行加密呢，也
就是说，即使别人利用其他的软件打开了该数据库，看到的也是一片乱码，根本不知道数据库进而是什么内容。出于这种情况，本人利用VB中自带
RND（）函数的功能编写了如下加密解密方法。
当RND（）的参数（我们称它为种子）为负值时，同一种子产生同一个随机序列，同时VB还具有强大的二进制技术功能。
这样我们可以按以下方法实现字符串内容的加密解密。源程序如下：Public Function StringEnDeCodecn(strSource As String, MA) As String
'该函数只对中西文起到加密作用
'参数为：源文件，密码
On Error GoTo ErrEnDeCode
Dim X As Single
Dim CHARNUM As Long, RANDOMINTEGER As Integer
Dim SINGLECHAR As String * 1
Dim strTmp As String
If MA < 0 Then
MA = MA * (-1)
End If
X = Rnd(-MA)
For i = 1 To Len(strSource) Step 1 '取单字节内容
SINGLECHAR = Mid(strSource, i, 1)
CHARNUM = Asc(SINGLECHAR)
g: RANDOMINTEGER = Int(127 * Rnd)
If RANDOMINTEGER < 30 Or RANDOMINTEGER > 100 Then GoTo g
CHARNUM = CHARNUM Xor RANDOMINTEGER
strTmp = strTmp & Chr(CHARNUM)
Next i
StringEnDeCodecn = strTmp
Exit Function
ErrEnDeCode:
StringEnDeCodecn = ""
MsgBox Err.Number & "\" & Err.Description
End Function使用方法：
tmp=stringEnDecn("中华人民共和国",75)
如果要解密的话，只须键入以下语句：
tmp1=stringendecn(tmp,75)如有不妥之处，请与我联系：

Answer 5

在
www.21code.com
找，有很多，其中有一个DES的有些问题，我改过以后可以用了

Answer 6

感谢您使用微软产品您可以使用CAPICOM的EncryptedData 等COM对象实现对文件或字符串的加密、解密。详细信息请参考：
Encrypting a Message in CAPICOM
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/security/security/encrypting_a_message_in_capicom.asp
Using CAPICOM
http://msdn.microsoft.com/library/en-us/security/security/using_capicom.asp从以下链接可获取所需的SDK文件。
Platform SDK Redistributable: CAPICOM 1.0A
http://www.microsoft.com/downloads/release.asp?releaseid=30316 
- 微软全球技术中心 VB技术支持本贴子以“现状”提供且没有任何担保，同时也没有授予任何权利。具体事项可参见使用条款
(http://support.microsoft.com/directory/worldwide/zh-cn/community/terms_chs.asp)。
为了为您创建更好的讨论环境，请参加我们的用户满意度调查
(http://support.microsoft.com/directory/worldwide/zh-cn/community/survey.asp?key=(S,49854782))。

Answer 7

感谢您使用微软产品您可以使用CAPICOM的EncryptedData 等COM对象实现对文件或字符串的加密、解密。详细信息请参考：
Encrypting a Message in CAPICOM
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/security/security/encrypting_a_message_in_capicom.asp
Using CAPICOM
http://msdn.microsoft.com/library/en-us/security/security/using_capicom.asp从以下链接可获取所需的SDK文件。
Platform SDK Redistributable: CAPICOM 1.0A
http://www.microsoft.com/downloads/release.asp?releaseid=30316 
- 微软全球技术中心 VB技术支持本贴子以“现状”提供且没有任何担保，同时也没有授予任何权利。具体事项可参见使用条款
(http://support.microsoft.com/directory/worldwide/zh-cn/community/terms_chs.asp)。
为了为您创建更好的讨论环境，请参加我们的用户满意度调查
(http://support.microsoft.com/directory/worldwide/zh-cn/community/survey.asp?key=(S,49854782))。

Answer 8

这个是可以的
'源代码如下:Private Sub Command1_Click()
CommonDialog1.Filter = "Text File(*.txt)|*.txt|All File (*.*)|*.*"
CommonDialog1.ShowOpen
RichTextBox1.LoadFile CommonDialog1.filename
End SubPrivate Sub Command2_Click()
Dim s, temp, t As String
Dim i As Single
s = RichTextBox1.Text
t = ""
For i = 1 To Len(s)
temp = Mid$(s, i, 1)
'temp = Chr(Asc(temp) - 1)
temp = Chr(Asc(temp) Xor 1)
t = t + temp
Next i
RichTextBox1.Text = t
End SubPrivate Sub Command3_Click()
Dim s, temp, t As String
Dim i As Single
s = RichTextBox1.Text
t = ""
For i = 1 To Len(s)
temp = Mid$(s, i, 1)
'temp = Chr(Asc(temp) + 1)
temp = Chr(Asc(temp) Xor 1)
t = t + temp
Next i
RichTextBox1.Text = t
End SubPrivate Sub Command4_Click()
CommonDialog1.Filter = "text File(*.txt)|*.txt|All File(*.*)|*.*"
CommonDialog1.ShowSave
Open CommonDialog1.filename For Output As #1
Print #1, RichTextBox1.Text
Close #1
End Sub

Answer 9

Option Explicit
'这个也是可以的
Private Sub Command1_Click()
Text2.Text = secret_lock(Text1.Text)
End Sub
Private Function secret_lock(ByVal s_passwd As String) As String
Dim ii As Integer
Dim kk As String
Dim tt As String
Dim i As Integer
Dim str_1 As String    tt = ""
    ii = Len(s_passwd)
    
    For i = 0 To ii - 1
        kk = Asc(Right(s_passwd, ii - i)) Xor 20
        tt = tt + Chr(Int(kk))
    Next i
    
    secret_lock = ttEnd Function