字附串加密

彭希仁

Function 解密(xx As String, yy As String) As String
    Dim datx() As Byte
    Dim datx1() As Byte
    Dim daty() As Byte
    Dim H As Long
    Dim s As String
    Dim d As New Dictionary
    If xx = "" Or yy = "" Then Exit Function
    s = "ェヴうウぅゥいイぃィあアぁЯяЮюЭэЬьЫыЪъЩщШшЧчЦцХхФфУуТтСсрПпОоНнМмЛлКкЙйИиЗзЖжЁёЕеДдГгВвБбАаΩωΨψΧχΦφΥυΤτΣσΡρΠπΟοΞξΝνΜμΛλΚκΙιΘθΗηΖζΕεΔδΓγΒβΑαＺｚzZｙyYｘxXｗwWＶｖvVǖǚǜǘūǔüùúＵｕuU℡ＴｔtTsSＲｒrRＱｑqQＰｐpPōǒòóoOnNmMlLＫｋkKＪｊjJīǐìíＩｉiIＨｈhHɡＧｇgGfFēěêèéeEdDcCbBāǎàáaA┫┪┩┨┧┦┥┤┋┊┇┆┃│⊕＋+﹢〆〃〞〝~}|{`_^]\[@?;:/.,*)(&%$#
987654321"
    For i = 0 To 255
        d(Mid(s, i + 1, 1)) = i
    Next i
    ReDim datx(0 To Len(xx) - 1)
    For i = 0 To Len(xx) - 1
        If d.Exists(Mid(xx, i + 1, 1)) Then datx(i) = d(Mid(xx, i + 1, 1))    '明码转数字
    Next i
    datx1 = datx
    daty = StrConv(yy, vbFromUnicode)
    j = 0
    For i = 0 To UBound(datx)
        If j > UBound(daty) Then j = 0
        datx(i) = datx(i) Xor daty(j)
        j = j + 1
    Next i
    For i = UBound(datx) - 1 To 2 Step -2
        H = datx(i)
        H = Abs(H - datx1(i))
        datx(i - 2) = datx(i - 2) Xor H
        datx(i - 1) = datx(i - 1) Xor H
    Next i
    解密 = StrConv(datx, vbUnicode)
End Function
Sub peng()
MsgBox 解密(加密("中华人民工和ゥいイぃィあアぁЯяЮюЭэЬьЫыЪъЩщШшЧчЦцХхФфУу国45模压", "12345"), "12345")
End Sub
Function 加密(xx As String, yy As String) As String   '方案1不行换另一种方式加密
    Dim datx() As Byte
    Dim datx1() As Byte
    Dim daty() As Byte
    Dim H As Long
    Dim s As String
    s = "ェヴうウぅゥいイぃィあアぁЯяЮюЭэЬьЫыЪъЩщШшЧчЦцХхФфУуТтСсрПпОоНнМмЛлКкЙйИиЗзЖжЁёЕеДдГгВвБбАаΩωΨψΧχΦφΥυΤτΣσΡρΠπΟοΞξΝνΜμΛλΚκΙιΘθΗηΖζΕεΔδΓγΒβΑαＺｚzZｙyYｘxXｗwWＶｖvVǖǚǜǘūǔüùúＵｕuU℡ＴｔtTsSＲｒrRＱｑqQＰｐpPōǒòóoOnNmMlLＫｋkKＪｊjJīǐìíＩｉiIＨｈhHɡＧｇgGfFēěêèéeEdDcCbBāǎàáaA┫┪┩┨┧┦┥┤┋┊┇┆┃│⊕＋+﹢〆〃〞〝~}|{`_^]\[@?;:/.,*)(&%$#
987654321"
    If xx = "" Or yy = "" Then Exit Function
    daty = StrConv(yy, vbFromUnicode)
    datx = StrConv(xx, vbFromUnicode)
    datx1 = datx
    j = 0
    For i = 0 To UBound(datx)
        If j > UBound(daty) Then j = 0
        datx(i) = datx(i) Xor daty(j)
        j = j + 1
    Next i
    For i = UBound(datx) - 1 To 2 Step -2
        H = datx(i)
        H = Abs(H - datx1(i))
        datx(i - 2) = datx(i - 2) Xor H
        datx(i - 1) = datx(i - 1) Xor H
    Next i
    xx = ""
    For i = 0 To UBound(datx)    '变成明码
        xx = xx & Mid(s, datx(i) + 1, 1)
    Next i
    加密 = xx
End Function

amesman

又见彭版大作，学习。。。

ccwan

是编码转换啊，学习一下

彭希仁

这个是三重加密
1、异或加密
2、自已前后加密
3、字附加密

liucqa

有空用Rijndael 算法写一个吧

kangatang

可逆加密，好东西

dajiahaoxinku12

感谢楼主分享，学习

xiaoguben

解密自定义函数调用类了吧，无附件，没法用啊

彭希仁

复制到模块就可以用了

sunny_8848

彭希仁 发表于 2014-9-23 08:58
复制到模块就可以用了

请教：代码复制到模块1，Dim d As New Dictionary运行时出现用户定义类型未定义 提示，是怎么回事？excel2003