[求代码]对字符串加密与解密的函数

Question

本来是想自己写的,但怎样都不对头,晕.目的很简单,让写入文件的字符串别一眼就看出来了就行.定义如下:EnCodeStr(ByVal Str1 As String, ByVal EnCodeMode As Integer) As StringStr1是输入的字符串,EnCodeMode是开关,为1就是加密,其他值为解密.返回值为处理后的字符串.这个好象是不难.我也写出来了:Private Function EnCodeStr(ByVal Str1 As String, ByVal EnCodeMode As Integer) As String
Dim I As Long, TmpStr As StringFor I = 1 To Len(Str1)
    If Mid(Str1, I, 1) = "," Then
        TmpStr = TmpStr & ","
    Else
        TmpStr = TmpStr & Chr(Asc(Mid(Str1, I, 1)) + IIf(EnCodeMode = 1, 5, -5))
    End If
Next IEnCodeStr = TmpStrEnd Function但是,在文件输出时有了问题.所加密的字符串放在了一个动态数组里,写入一个文件后,的确已经乱七八糟了.只是,在读入时,却无法正确地读入.我在想,是否是我的文件输入模式有问题?我用的是For Output来输出:Open cDlg.FileName For Output As #1使用的是For Input来输入:Open FileName For Input As #1问题是否在这里?

Answer 1

另,读入的字符串仅有部分不对,其他都能正常解出来.如汉字.只是像"@#$"类字符,读入时用DEBUG看,就是一个问号.读入部分代码如下:        Open FileName For Input As #1
            Do While Not EOF(1)
                
                Line Input #1, TmpStr
            
                TmpStr = Mid(TmpStr, 2, Len(TmpStr) - 2)    '去掉首尾的引号
                
                TmpStr = EnCodeStr(TmpStr, 2)        '解密字符串.在这里出了问题.
                                                 '某些字符读出来是问号.
          ............     '省略N行代码            Loop
        Close #1写入部分代码如下:        Open cDlg.FileName For Output As #1
            
            For I = 1 To UBound(ProgTypeList)           '保存分类列表
                Write #1, EnCodeStr(ProgTypeList(I), 1)
            Next I
              ...........再省略N行代码
        Close #1是否是文件I/O的方式不对?

Answer 2

最简单的加解密就是用xor方式啦。

Answer 3

Option ExplicitPrivate i As Long
Private j As Long
Private k As Long
Private a As Byte
Private b As Byte
Private M As Long
Private L As Long
Private CENKEY(255) As Byte
Private ADDTABLE(255, 255) As Byte
Private STATE(0 To 255) As BytePrivate Sub FILL_LINEAR()
    Dim bCONST(0 To 255) As Byte
    For M = 0 To 255
        bCONST(M) = M
        STATE(M) = bCONST(M)
    Next M
End SubPublic Sub CEN(BYTEARRAY() As Byte, Optional ByVal PASSWORD As String)
  If PASSWORD <> "" Then PREPARE_KEY PASSWORD
  For L = 0 To UBound(BYTEARRAY)
    i = ADDTABLE(i, 1)
    j = ADDTABLE(j, STATE(i))
    a = STATE(i): STATE(i) = STATE(j): STATE(j) = a
    b = STATE(ADDTABLE(STATE(i), STATE(j)))
    BYTEARRAY(L) = BYTEARRAY(L) Xor b
  Next L
End SubPrivate Sub PREPARE_KEY(ByVal sKEY As String)
  INITIALIZE_ADDTABLE
  FILL_LINEAR
  k = Len(sKEY)
  For i = 0 To k - 1
    b = Asc(Mid$(sKEY, i + 1, 1))
    For j = i To 255 Step k
      CENKEY(j) = b
    Next j
  Next i
  j = 0
  For i = 0 To 255
    k = ADDTABLE(STATE(i), CENKEY(i))
    j = ADDTABLE(j, k)
    b = STATE(i): STATE(i) = STATE(j): STATE(j) = b
  Next i
  i = 0
  j = 0
End SubPrivate Sub INITIALIZE_ADDTABLE()
  Static BeenHereDoneThat As Boolean
  If BeenHereDoneThat Then Exit Sub
  For j = 0 To 255
    For i = 0 To 255
      ADDTABLE(i, j) = CByte((i + j) And 255)
    Next i
  Next j
  BeenHereDoneThat = True
End SubPublic Function STRING_TO_BYTES(sString As String) As Byte()
  STRING_TO_BYTES = StrConv(sString, vbFromUnicode)
End FunctionPublic Function BYTES_TO_STRING(bBytes() As Byte) As String
  BYTES_TO_STRING = bBytes
  BYTES_TO_STRING = StrConv(BYTES_TO_STRING, vbUnicode)
End Function

Answer 4

使用方法对字符加解密
dim data() as byte
Data = STRING_TO_BYTES("slkadgjlsjdg;sdgl;jsda;gsdgsd")
CEN Data, "password"这时的DATA已是经过加密的，再
cen data,"password" 就是解密

Answer 5

非常感谢楼上的朋友!分给你啦~~~不过,我觉得这个模块如果能只用一个函数就可以完成加解密就好了.因此,我作了点小小的改动,希望不要见怪!**********************************************Option ExplicitPrivate I As Long
Private j As Long
Private k As Long
Private a As Byte
Private b As Byte
Private M As Long
Private L As Long
Private CENKEY(255) As Byte
Private ADDTABLE(255, 255) As Byte
Private STATE(0 To 255) As BytePublic Function EnCode(ByVal Str As String, ByVal PwdCode As String) As String
Dim Data() As Byte
Data = STRING_TO_BYTES(Str)
CEN Data, PwdCode
EnCode = BYTES_TO_STRING(Data)
End FunctionPrivate Sub FILL_LINEAR()
    Dim bCONST(0 To 255) As Byte
    For M = 0 To 255
        bCONST(M) = M
        STATE(M) = bCONST(M)
    Next M
End SubPrivate Sub CEN(BYTEARRAY() As Byte, Optional ByVal PASSWORD As String)
  If PASSWORD <> "" Then PREPARE_KEY PASSWORD
  For L = 0 To UBound(BYTEARRAY)
    I = ADDTABLE(I, 1)
    j = ADDTABLE(j, STATE(I))
    a = STATE(I): STATE(I) = STATE(j): STATE(j) = a
    b = STATE(ADDTABLE(STATE(I), STATE(j)))
    BYTEARRAY(L) = BYTEARRAY(L) Xor b
  Next L
End SubPrivate Sub PREPARE_KEY(ByVal sKEY As String)
  INITIALIZE_ADDTABLE
  FILL_LINEAR
  k = Len(sKEY)
  For I = 0 To k - 1
    b = Asc(Mid$(sKEY, I + 1, 1))
    For j = I To 255 Step k
      CENKEY(j) = b
    Next j
  Next I
  j = 0
  For I = 0 To 255
    k = ADDTABLE(STATE(I), CENKEY(I))
    j = ADDTABLE(j, k)
    b = STATE(I): STATE(I) = STATE(j): STATE(j) = b
  Next I
  I = 0
  j = 0
End SubPrivate Sub INITIALIZE_ADDTABLE()
  Static BeenHereDoneThat As Boolean
  If BeenHereDoneThat Then Exit Sub
  For j = 0 To 255
    For I = 0 To 255
      ADDTABLE(I, j) = CByte((I + j) And 255)
    Next I
  Next j
  BeenHereDoneThat = True
End SubPrivate Function STRING_TO_BYTES(sString As String) As Byte()
  STRING_TO_BYTES = StrConv(sString, vbFromUnicode)
End FunctionPrivate Function BYTES_TO_STRING(bBytes() As Byte) As String
  BYTES_TO_STRING = bBytes
  BYTES_TO_STRING = StrConv(BYTES_TO_STRING, vbUnicode)
End Function************************************************调用方法:STRING1 = EnCode(STRING2,PASSWORD)其中,STRING1用于存放加密/解密后的字符串,STRING2是欲加密/解密的字符串,PASSWORD是密码.