qq_33967085
????C8
采纳率100%
2016-03-21 14:45

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

已采纳

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

  • 点赞
  • 写回答
  • 关注问题
  • 收藏
  • 复制链接分享
  • 邀请回答

4条回答

  • caozhy 回答这么多问题就耍赖把我的积分一笔勾销了 5年前

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

    点赞 2 评论 复制链接分享
  • BLOODHWAK India slum-dog. 1年前

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

    点赞 评论 复制链接分享
  • suwu150 suwu150 5年前

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

    点赞 评论 复制链接分享
  • caozhy 回答这么多问题就耍赖把我的积分一笔勾销了 5年前
     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
    
    
    点赞 1 评论 复制链接分享

为你推荐