咋样加密文件啊？

Question

想做加密文件，但是苦于找不到好的算法，各位提供一个函数吧要可以指定密匙的，而且解密后不会损坏数据

Answer 1

什么方法的加密？
Windows的还是像office的文件的？

Answer 2

就是类似AES啊，DES啊，啥的之类的，反正打开来都是乱码就是了

Answer 3

那这样吧,干脆使用压缩,嘿嘿.看这个文件压缩类:http://www.m5home.com/blog/article.asp?id=350自己改一改算法,就成了你自己的加密&解密&压缩类了,嘿嘿.

Answer 4

看你用什么办法加密了，DES是数据加密标准~你可以先大概参考下。现代加密算法几乎都是微操作的

Answer 5

使用WinRar的命令行版rar.exe
shell("rar.exe a -hp密码 加密后文件 要加密的文件")'加密
shell("rar.exe e -hp密码 加密后文件")'解密

Answer 6

对不起，一个星期没回来了，差点忘了这贴感谢3L的回复，就是速度有点慢了，我希望是纯加密的，压缩就算了纯加密的话，DES加密文件能否提供个类呢？我希望就是全封装型的，调用Func(源文件名string，目标文件名string，密匙string)即可完成，能否做到？

Answer 7

直接去csdn下载频道找吧，basic的不知道，c的N多。

Answer 8

我用VC写了个API形式的DLL，里面有使用范例
VC写的MMEC加解密用的DLL的VB使用范例

Answer 9

对于文件的加解密你可以使用下面的方法看看Private Sub Command2_Click()
   '加密文件测试
   FileCopy "C:\boot.ini", "C:\boot2.ini"   '将 C:\boot.ini 备份出来操作
   Dim fs As Integer
   Dim FileBytes() As Byte
   fs = FreeFile
   ReDim FileBytes(FileLen("C:\boot2.ini") - 1)
   Open "C:\boot2.ini" For Binary As #fs
   Get #fs, 1, FileBytes
   BytesToMMEC FileBytes(0), UBound(FileBytes) + 1, 18, 5, 1358, 26743
   Put #fs, 1, FileBytes
   Close #fs
End SubPrivate Sub Command3_Click()
   '解密文件测试
   Dim fs As Integer
   Dim FileBytes() As Byte
   fs = FreeFile
   ReDim FileBytes(FileLen("C:\boot2.ini") - 1)
   Open "C:\boot2.ini" For Binary As #fs
   Get #fs, 1, FileBytes
   MMECToBytes FileBytes(0), UBound(FileBytes) + 1, 18, 5, 1358, 26743
   Put #fs, 1, FileBytes
   Close #fs
End Sub

Answer 10

来个国际RC4,某来外写的~Option Explicit
Event Progress(Percent As Long)
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
    If (Not FileExist(SourceFile)) Then
        Call Err.Raise(vbObjectError, , "Error in Skipjack EncryptFile procedure (Source file does not exist).")
        Exit Sub
    End If
    Filenr = FreeFile
    Open SourceFile For Binary As #Filenr
    ReDim ByteArray(0 To LOF(Filenr) - 1)
    Get #Filenr, , ByteArray()
    Close #Filenr
    Call EncryptByte(ByteArray(), Key)
    If (FileExist(DestFile)) Then Kill DestFile
    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
    If (Not FileExist(SourceFile)) Then
        Call Err.Raise(vbObjectError, , "Error in Skipjack EncryptFile procedure (Source file does not exist).")
        Exit Sub
    End If
    Filenr = FreeFile
    Open SourceFile For Binary As #Filenr
    ReDim ByteArray(0 To LOF(Filenr) - 1)
    Get #Filenr, , ByteArray()
    Close #Filenr
    Call DecryptByte(ByteArray(), Key)
    If (FileExist(DestFile)) Then Kill DestFile
    Filenr = FreeFile
    Open DestFile For Binary As #Filenr
    Put #Filenr, , ByteArray()
    Close #FilenrEnd Sub
Public Sub DecryptByte(ByteArray() As Byte, Optional Key As String)
    Call EncryptByte(ByteArray(), Key)
End Sub
Public Function EncryptString(Text As String, Optional Key As String) As String
    Dim ByteArray() As Byte
    ByteArray() = StrConv(Text, vbFromUnicode)
    Call EncryptByte(ByteArray(), Key)
    EncryptString = StrConv(ByteArray(), vbUnicode)
End Function
Public Function DecryptString(Text As String, Optional Key As String) As String
    Dim ByteArray() As Byte
    ByteArray() = StrConv(Text, vbFromUnicode)
    Call DecryptByte(ByteArray(), Key)
    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
    If (Len(Key) > 0) Then Me.Key = Key
    Call CopyMem(sBox(0), m_sBox(0), 512)
    OrigLen = UBound(ByteArray) + 1
    CipherLen = OrigLen
    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))
        If (Offset >= NextPercent) Then
            CurrPercent = Int((Offset / CipherLen) * 100)
            NextPercent = (CipherLen * ((CurrPercent + 1) / 100)) + 1
            RaiseEvent Progress(CurrPercent)
        End If
    Next
    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
    If (m_Key = New_Value) Then Exit Property
    m_Key = New_Value
    Key() = StrConv(m_Key, vbFromUnicode)
    KeyLen = Len(m_Key)
    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 11

Option ExplicitPrivate Sub Command1_Click()
    Dim a As String
    a = "如何对汉字字符进行加密、解密是？"
    
    Debug.Print jm("123fadf///", a)
    Debug.Print jm("123fadf///", jm("123fadf///", a))
End SubPrivate Function jm(ByVal key As String, ByVal iStr As String) As String
    Dim i As Long, tmp As String
    For i = 0 To Len(iStr) - 1
        tmp = tmp & Chr(Asc(Mid(iStr, i + 1, 1)) Xor Asc(Mid(key, i Mod Len(key) + 1, 1)))
    Next
    jm = tmp
End Function