qq_33967085
????C8
2016-03-21 14:45
采纳率: 100%
浏览 3.2k
已采纳

vb加密函数,可加密中文,有密码

求大神帮忙
加密函数
要求可加密中文
而且可根据给定的密码加密
加密(要加密的字符串,密码)
然后密码不同,加密后的就不同
谢谢了

  • 点赞
  • 写回答
  • 关注问题
  • 收藏
  • 邀请回答

4条回答 默认 最新

  • caozhy
    已采纳

    最简单的是先做base64编码,然后不存在什么中文的问题了,再xor下。解密相反,先xor,然后base64解码
    如果要完整代码,请先采纳下。

    点赞 3 评论
  • caozhy
     Option Explicit
    Private Const cstBase64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
    Private arrBase64() As String
    
    Public Function 加密(strSource As String, key As String) As String
        On Error Resume Next
        If UBound(arrBase64) = -1 Then
            arrBase64 = Split(StrConv(cstBase64, vbUnicode), vbNullChar)
        End If
        Dim arrB() As Byte, bTmp(2) As Byte, bT As Byte
        Dim I As Long, J As Long
        arrB = StrConv(strSource, vbFromUnicode)
    
        J = UBound(arrB)
        For I = 0 To J Step 3
            Erase bTmp
            bTmp(0) = arrB(I + 0) Xor (Asc(Mid(key, I \ 3 Mod Len(key) + 1, 1)) Mod 256)
            bTmp(1) = arrB(I + 1) Xor (Asc(Mid(key, I \ 3 Mod Len(key) + 1, 1)) Mod 256)
            bTmp(2) = arrB(I + 2) Xor (Asc(Mid(key, I \ 3 Mod Len(key) + 1, 1)) Mod 256)
    
            bT = (bTmp(0) And 252) / 4
            加密 = 加密 & arrBase64(bT)
    
            bT = (bTmp(0) And 3) * 16
            bT = bT + bTmp(1) \ 16
            加密 = 加密 & arrBase64(bT)
    
            bT = (bTmp(1) And 15) * 4
            bT = bT + bTmp(2) \ 64
            If I + 1 <= J Then
                加密 = 加密 & arrBase64(bT)
            Else
                加密 = 加密 & "="
            End If
    
            bT = bTmp(2) And 63
            If I + 2 <= J Then
                加密 = 加密 & arrBase64(bT)
            Else
                加密 = 加密 & "="
            End If
        Next
    End Function
    
    Public Function 解密(strEncoded As String, key As String) As String
        On Error Resume Next
        Dim arrB() As Byte, bTmp(3) As Byte, bT As Long, bRet() As Byte
        Dim I As Long, J As Long
        arrB = StrConv(strEncoded, vbFromUnicode)
        J = InStr(strEncoded & "=", "=") - 2
        ReDim bRet(J - J \ 4 - 1)
        For I = 0 To J Step 4
            Erase bTmp
            bTmp(0) = ((InStr(cstBase64, Chr(arrB(I))) - 1) And 63)
            bTmp(1) = ((InStr(cstBase64, Chr(arrB(I + 1))) - 1) And 63)
            bTmp(2) = ((InStr(cstBase64, Chr(arrB(I + 2))) - 1) And 63)
            bTmp(3) = ((InStr(cstBase64, Chr(arrB(I + 3))) - 1) And 63)
    
            bT = bTmp(0) * 2 ^ 18 + bTmp(1) * 2 ^ 12 + bTmp(2) * 2 ^ 6 + bTmp(3)
    
            bRet((I \ 4) * 3) = (bT \ 65536) Xor (Asc(Mid(key, I \ 3 Mod Len(key) + 1, 1)) Mod 256)
            bRet((I \ 4) * 3 + 1) = ((bT And 65280) \ 256) Xor (Asc(Mid(key, I \ 3 Mod Len(key) + 1, 1)) Mod 256)
            bRet((I \ 4) * 3 + 2) = (bT And 255) Xor (Asc(Mid(key, I \ 3 Mod Len(key) + 1, 1)) Mod 256)
        Next
        解密 = StrConv(bRet, vbUnicode)
    End Function
    
    Private Sub Command1_Click()
        Text3.Text = 加密(Text2.Text, Text1.Text)
    End Sub
    
    Private Sub Command2_Click()
        Text2.Text = 解密(Text3.Text, Text1.Text)
    End Sub
    
    
    点赞 评论
  • suwu150
    suwu150 2016-04-07 04:55

    看的不是怎么太清楚。。。

    点赞 评论
  • BLOODHWAK
    India slum-dog. 2020-05-05 11:20

    没看懂,为什么有两个入参

    点赞 评论

相关推荐