一对VBA加密解密函数，与大家共享

风雨之后

一对VBA加密解密函数，与大家共享
Public Sub Cipher(ByVal password As String, ByVal from_text As String, to_text As String)　　'加密
Const MIN_ASC = 32  ' Space.
Const MAX_ASC = 126 ' ~.
Const NUM_ASC = MAX_ASC - MIN_ASC + 1

Dim offset As Long
Dim str_len As Integer
Dim i As Integer
Dim ch As Integer

    offset = NumericPassword(password)
    Rnd -1
    Randomize offset

    str_len = Len(from_text)
    For i = 1 To str_len
        ch = Asc(Mid$(from_text, i, 1))
        If ch >= MIN_ASC And ch <= MAX_ASC Then
            ch = ch - MIN_ASC
            offset = Int((NUM_ASC + 1) * Rnd)
            ch = ((ch + offset) Mod NUM_ASC)
            ch = ch + MIN_ASC
            to_text = to_text & Chr$(ch)
        End If
    Next i
End Sub


Public Sub Decipher(ByVal password As String, ByVal from_text As String, to_text As String)  '解密
Const MIN_ASC = 32  ' Space.
Const MAX_ASC = 126 ' ~.
Const NUM_ASC = MAX_ASC - MIN_ASC + 1

Dim offset As Long
Dim str_len As Integer
Dim i As Integer
Dim ch As Integer

    offset = NumericPassword(password)
    Rnd -1
    Randomize offset

    str_len = Len(from_text)
    For i = 1 To str_len
        ch = Asc(Mid$(from_text, i, 1))
        If ch >= MIN_ASC And ch <= MAX_ASC Then
            ch = ch - MIN_ASC
            offset = Int((NUM_ASC + 1) * Rnd)
            ch = ((ch - offset) Mod NUM_ASC)
            If ch < 0 Then ch = ch + NUM_ASC
            ch = ch + MIN_ASC
            to_text = to_text & Chr$(ch)
        End If
    Next i
End Sub

Public Function NumericPassword(ByVal password As String) As Long
Dim value As Long
Dim ch As Long
Dim shift1 As Long
Dim shift2 As Long
Dim i As Integer
Dim str_len As Integer

    str_len = Len(password)
    For i = 1 To str_len
        ch = Asc(Mid$(password, i, 1))
        value = value Xor (ch * 2 ^ shift1)
        value = value Xor (ch * 2 ^ shift2)

        shift1 = (shift1 + 7) Mod 19
        shift2 = (shift2 + 13) Mod 23
    Next i
    NumericPassword = value
End Function

附件
VB读写TXT文件加密解密函数自定义.rar (29.4 KB, 下载次数: 1044)

2011-5-18 21:00 上传

点击文件名下载附件

yaojil

先谢过楼主，仔细看看

baomaboy

没仔细看，不过总觉得最多应该叫"字符串"加密解密，这样更广义一点，因为这种自定义函数本身就是这个作用，没没必要写太复杂，只是颠倒一下字符串顺序甚至都可以叫加密解密，

如果真想叫“VBA加密解密”要做到自解密并自执行才行。只是操作一下字符串没点意思。

doitbest

先收藏,回头再研究

monkeywq

多谢分享，来学习一下

海婷

多谢分享，回头再研究

qczvba

只要认为是好的与大家分享，就是值得支持，谢楼主了。

shaojinliu

谢谢分享！谢谢了！

liucqa

看看            

goldowl2011

Mark it.Thanks a lot.