请教大家字符串加密问题（只有270分，送100分）

Question

有一加密函数，如下
Public Function JiaMi(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
 JiaMi = strTmp
 Exit Function
 ErrEnDeCode:
 JiaMi = ""
 MsgBox Err.Number & "\" & Err.Description
 End Function
加密过程：str=jiami(oldstr,1)
加密过程:str=jiami(oldstr,1)
问题出现：
   当
oldstr="红珊瑚手串是一个朋友送的离别礼物。晓婕想到了那个犯人，只有他和自己接触过。审讯室里他竟然说：A属于你的东西是不会丢的。B送给我吧。"
  经过加密再解密后，old变成
"红珊瑚手串是一个朋友送的离别礼物c晓婕想到了那个犯人，只有他和自己接触过。审讯室里他竟然说：A属于你的东西是不会丢的。B送给我吧。"
  
  请问问题出在那里？谢谢了
  

Answer 1

两者不同之处在：第一个oldstr中的一个”。“变成了”c“

Answer 2

'这个加密函数也不错.Public Function Encode(ByVal S As String) As String '加密
On Error GoTo acd
    If Len(S) = 0 Then Exit Function
    Dim Buff() As Byte
    Buff = StrConv(S, vbFromUnicode)
    Dim i As Long
    Dim j As Byte
    Dim k As Byte, m As Byte
    Dim mstr As String
    mstr = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghijklmnopqrstuvwxyz"
    Dim outs As String
    i = UBound(Buff) + 1
    outs = Space(2 * i)
    Dim Temps As String
    For i = 0 To UBound(Buff)
        Randomize Time
        j = CByte(5 * (Math.Rnd()) + 0) '最大产生的随机数只能是5，不能再大了,再大的话，就要多用一个字节
        Buff(i) = Buff(i) Xor j
        k = Buff(i) Mod Len(mstr)
        m = Buff(i) \ Len(mstr)
        m = m * 2 ^ 3 + j
        Temps = Mid(mstr, k + 1, 1) + Mid(mstr, m + 1, 1)
        Mid(outs, 2 * i + 1, 2) = Temps
     Next
     Encode = outs
Exit Function
acd:
End FunctionPublic Function Decode(ByVal S As String) As String '解密
    On Error GoTo acd
    Dim i As Long
    Dim j As Byte
    Dim k As Byte
    Dim m As Byte
    Dim mstr As String
    mstr = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghijklmnopqrstuvwxyz"
    Dim t1 As String, t2 As String
    Dim Buff() As Byte
    Dim n As Long
    n = 0
    For i = 1 To Len(S) Step 2
        t1 = Mid(S, i, 1)
        t2 = Mid(S, i + 1, 1)
        k = InStr(1, mstr, t1) - 1
        m = InStr(1, mstr, t2) - 1
        j = m \ 2 ^ 3
        m = m - j * 2 ^ 3
        ReDim Preserve Buff(n)
        Buff(n) = j * Len(mstr) + k
        Buff(n) = Buff(n) Xor m
        n = n + 1
     Next
     Decode = StrConv(Buff, vbUnicode)
     Exit Function
acd:
     Decode = ""
End Function

Answer 3

使用矩阵加密类 不错
Option Explicit   Private LCW As Integer                 'Length of CodeWord
   Private LS2E As Integer                 'Length of String to be Encrypted
   Private LAM As Integer                 'Length of Array Matrix
   Private MP As Integer                    'Matrix Position
   Private Matrix As String                  'Starting Matrix
   Private mov1 As String                    'First Part of Replacement String
   Private mov2 As String                    'Second Part of Replacement String
   Private CodeWord As String            'CodeWord
   Private CWL As String                    'CodeWord Letter
   Private EncryptedString As String     'String to Return for Encrypt or String to UnEncrypt for UnEncrypt
   Private EncryptedLetter As String     'Storage Variable for Character just Encrypted
   Private strCryptMatrix(97) As String 'Matrix Array
Public Property Let KeyString(sKeyString As String)
    CodeWord = sKeyString
End Property
Public Function Encrypt(mstext As String) As String
    Dim X As Integer                    ' Loop Counter
    Dim Y As Integer                    'Loop Counter
    Dim Z As Integer                     'Loop Counter
    Dim C2E As String                   'Character to Encrypt
    Dim Str2Encrypt As String        'Text from TextBox    Str2Encrypt = mstext
    LS2E = Len(mstext)
    LCW = Len(CodeWord)
    EncryptedLetter = ""
    EncryptedString = ""    Y = 1
    For X = 1 To LS2E
        C2E = Mid(Str2Encrypt, X, 1)
        MP = InStr(1, Matrix, C2E, 0)
        CWL = Mid(CodeWord, Y, 1)
        For Z = 1 To LAM
            If Mid(strCryptMatrix(Z), MP, 1) = CWL Then
                EncryptedLetter = Left(strCryptMatrix(Z), 1)
                EncryptedString = EncryptedString + EncryptedLetter
                Exit For
            End If
        Next Z
        Y = Y + 1
        If Y > LCW Then Y = 1
    Next X
    Encrypt = EncryptedStringEnd Function
Private Sub Class_Initialize()    Dim W As Integer 'Loop Counter to set up Matrix
    Dim X As Integer     'Loop through Matrix
    
    Matrix = "8x3p5BeabcdfghijklmnoqrstuvwyzACDEFGHIJKLMNOPQRSTUVWXYZ 1246790-.#/\!@$<>&*()[]{}';:,?=+~`^|%_"
    Matrix = Matrix + Chr(13)  'Add Carriage Return to Matrix
    Matrix = Matrix + Chr(10)  'Add Line Feed to Matrix
    Matrix = Matrix + Chr(34)  'Add "
    ' Unique String used to make Matrix - 8x3p5Be
    ' Unique String can be any combination that has a character only ONCE.
    ' EACH Letter in the Matrix is Input ONLY once.
    W = 1
    LAM = Len(Matrix)
    strCryptMatrix(1) = Matrix
  
    For X = 2 To LAM ' LAM = Length of Array Matrix
        mov1 = Left(strCryptMatrix(W), 1)   'First Character of strCryptMatrix
        mov2 = Right(strCryptMatrix(W), (LAM - 1))   'All but First Character of strCryptMatrix
        strCryptMatrix(X) = mov2 + mov1  'Makes up each row of the Array
        W = W + 1
    Next X
End Sub

Answer 4

上面的类使用方法：Option Explicit
Private MydsEncrypt As dsEncrypt 'dsEncrypt为刚才加密类的名字Private Sub Command1_Click()
    Text1.Text = MydsEncrypt.Encrypt(Text1.Text)
End SubPrivate Sub Form_Load()
    Set MydsEncrypt = New dsEncrypt
    MydsEncrypt.KeyString = ("KATHER")
End Sub

Answer 5

忘记说了 KeyString 属性是设置其 密匙

Answer 6

我看过一个用rsa加密的，你可以搜一下。

Answer 7

加密过程：str=jiami(oldstr,1)
加密过程:str=jiami(oldstr,1)
改为：
加密过程：str=jiami(oldstr,75)
加密过程:str=jiami(oldstr,75)
试试

Answer 8

RC4加密Public Sub EncryptByte(ByteArray() As Byte, Optional Key As String)  Dim i As Long
  Dim j As Long
  Dim Temp As Byte
  Dim Offset As Long
  Dim OrigLen As Long
  Dim CipherLen As Long
  Dim CurrPercent As Long
  Dim NextPercent As Long
  Dim sBox(0 To 255) As Integer
  
  'Set the new key (optional)
  If (Len(Key) > 0) Then Me.Key = Key
  
  'Create a local copy of the sboxes, this
  'is much more elegant than recreating
  'before encrypting/decrypting anything
  Call CopyMem(sBox(0), m_sBox(0), 512)
  
  'Get the size of the source array
  OrigLen = UBound(ByteArray) + 1
  CipherLen = OrigLen
  
  'Encrypt the data
  For Offset = 0 To (OrigLen - 1)
    i = (i + 1) Mod 256
    j = (j + sBox(i)) Mod 256
    Temp = sBox(i)
    sBox(i) = sBox(j)
    sBox(j) = Temp
    ByteArray(Offset) = ByteArray(Offset) Xor (sBox((sBox(i) + sBox(j)) Mod 256))
    
    'Update the progress if neccessary
    If (Offset >= NextPercent) Then
      CurrPercent = Int((Offset / CipherLen) * 100)
      NextPercent = (CipherLen * ((CurrPercent + 1) / 100)) + 1
      RaiseEvent Progress(CurrPercent)
    End If
  Next  'Make sure we return a 100% progress
  If (CurrPercent <> 100) Then RaiseEvent Progress(100)End SubPublic Property Let Key(New_Value As String)  Dim a As Long
  Dim b As Long
  Dim Temp As Byte
  Dim Key() As Byte
  Dim KeyLen As Long
  
  'Do nothing if the key is buffered
  If (m_Key = New_Value) Then Exit Property
  
  'Set the new key
  m_Key = New_Value
  
  'Save the password in a byte array
  Key() = StrConv(m_Key, vbFromUnicode)
  KeyLen = Len(m_Key)
  
  'Initialize s-boxes
  For a = 0 To 255
    m_sBox(a) = a
  Next a
  For a = 0 To 255
    b = (b + m_sBox(a) + Key(a Mod KeyLen)) Mod 256
    Temp = m_sBox(a)
    m_sBox(a) = m_sBox(b)
    m_sBox(b) = Temp
  Next
  
End Property

Answer 9

加密字符串引用它Public Function EncryptString(Text As String, Optional Key As String) As String  Dim ByteArray() As Byte
 
  'Convert the data into a byte array
  ByteArray() = StrConv(Text, vbFromUnicode)
  
  'Encrypt the byte array
  Call EncryptByte(ByteArray(), Key)
  
  'Convert the byte array back into a string
  EncryptString = StrConv(ByteArray(), vbUnicode)
  
End Function
加密文件引用它Public Sub EncryptFile(SourceFile As String, DestFile As String, Optional Key As String)  Dim Filenr As Integer
  Dim ByteArray() As Byte
  
  'Make sure the source file do exist
  If (Not FileExist(SourceFile)) Then
    Call Err.Raise(vbObjectError, , "Error in Skipjack EncryptFile procedure (Source file does not exist).")
    Exit Sub
  End If
  
  'Open the source file and read the content
  'into a bytearray to pass onto encryption
  Filenr = FreeFile
  Open SourceFile For Binary As #Filenr
  ReDim ByteArray(0 To LOF(Filenr) - 1)
  Get #Filenr, , ByteArray()
  Close #Filenr
  
  'Encrypt the bytearray
  Call EncryptByte(ByteArray(), Key)  'If the destination file already exist we need
  'to delete it since opening it for binary use
  'will preserve it if it already exist
  If (FileExist(DestFile)) Then Kill DestFile
  
  'Store the encrypted data in the destination file
  Filenr = FreeFile
  Open DestFile For Binary As #Filenr
  Put #Filenr, , ByteArray()
  Close #FilenrEnd Sub

Answer 10

to aohan(陈景升) ：怎么给分啊？我怎么给不了分你啊？我给您的留言收到了吗？请回复，谢谢

Answer 11

TO:space6212() 已收到你的消息
关于给分，请在本页的
“回复 | 推荐 | 收藏 | 专题 | 公告 | 管理 | 保存 | 关闭窗口” 点击“管理”，然后就可以结此贴了