| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 573 人关注过本帖
标题:关于 vb6 加解密字符串的问题
只看楼主 加入收藏
Ez330阿牛
Rank: 2
等 级:论坛游民
帖 子:42
专家分:14
注 册:2014-3-5
结帖率:11.11%
收藏
 问题点数:0 回复次数:0 
关于 vb6 加解密字符串的问题
EncodeDecode.rar (126.22 KB)


因为算法太多,无法一一帖出来,只好用附件的方式,我遇到到的部分是我用这些算法加密文件都能正常使用,加密字符串后一直提示下标越界!研究了两三天都找不到问题在哪个,请教精通加解密的大神指点

以下是其中一种加密方式,字符串加密,无法解密

'Download by http://www.
'RC4 Encryption/Decryption Class
'------------------------------------
'
'Information concerning the RC4
'algorithm can be found at:
'http://www.
'
'(c) 2000, Fredrik Qvarfort
'

Option Explicit

'For progress notifications
Event Progress(Percent As Long)

'Key-dependant data
Private m_Key As String
Private m_sBox(0 To 255) As Integer

Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
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 #Filenr
   
End Sub
Public Sub DecryptFile(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 decrypt
    Filenr = FreeFile
    Open SourceFile For Binary As #Filenr
    ReDim ByteArray(0 To LOF(Filenr) - 1)
    Get #Filenr, , ByteArray()
    Close #Filenr
   
    'Decrypt the bytearray
    Call DecryptByte(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 decrypted data in the destination file
    Filenr = FreeFile
    Open DestFile For Binary As #Filenr
    Put #Filenr, , ByteArray()
    Close #Filenr
   
End Sub

Public Sub DecryptByte(ByteArray() As Byte, Optional Key As String)

  'The same routine is used for encryption as well
  'decryption so why not reuse some code and make
  'this class smaller (that is it it wasn't for all
  'those damn comments ;))
  Call EncryptByte(ByteArray(), Key)

End Sub

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 Function DecryptString(Text As String, Optional Key As String) As String

  Dim ByteArray() As Byte
 
  'Convert the data into a byte array
  ByteArray() = StrConv(Text, vbFromUnicode)
  
  'Decrypt the byte array
  Call DecryptByte(ByteArray(), Key)
  
  'Convert the byte array back into a string
  DecryptString = StrConv(ByteArray(), vbUnicode)
  
End Function
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 Sub

Public 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

[ 本帖最后由 Ez330阿牛 于 2014-5-19 20:57 编辑 ]
搜索更多相关主题的帖子: concerning Download 字符串 天都 加密 
2014-05-18 17:24
快速回复:关于 vb6 加解密字符串的问题
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.026876 second(s), 9 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved