简单而强悍的文件加密工具

吃腥的猫

好像楼主给的图解密后啥也看不到。。。

gyzzf

不会用呀，请版主讲解用法，操作的文件都是乱字符呀

li2653

按右键能设置直接加解密的快捷方式更好.！

ldy

原帖由 彭希仁 于 2009-6-7 08:51 发表
如果只是文本加密，那防破解还不是很强，因为可以单独对一位或二位进行破解，计算可识别字附的个数就OK了。

所以多重加密是非常必要。

可识别字符仅中文就有上万个 ，按常用汉字5000 个计算 用5个汉字做密钥 就是 5000^5  依然是个天文数字，
大约3000000......00后面共17个0 ，如果密钥再长一点......用某个图片的二进制做密钥.....

原帖由 humengqiang 于 2009-6-7 09:04 发表
请问版主的加密文件如何使用？我随便用个文件加密，打开文件就成了乱码，是不是我使用不当？

文件加密过当然都是乱码，只有解密后才能看到， 而密钥只有你自己知道。

原帖由 吃腥的猫 于 2009-6-7 09:43 发表
好像楼主给的图解密后啥也看不到。。。

图是用这个工具加密过的，直接打开当然啥也看不到，这是给喜欢研究破解的朋友测试用的，即使知道我的加密方法，
但不知道密钥（只有我知道），也是无法解开的。

原帖由 gyzzf 于 2009-6-7 10:11 发表
不会用呀，请版主讲解用法，操作的文件都是乱字符呀

很简单，点击文件加密按钮，选择要加密的文件，选择加密后保存的地方，输入密钥（只有自己知道）就OK了。
然后你就会得到一个加密的文件，这个文件谁也看不到其中的内容。原来的文件可以删除。

等你想看这个文件的时候，点击文件解密按钮 选择要解密的文件，选择解密后保存的地方，输入密钥（只有自己知道）就OK了。

laoyebin

很强，学习学习一下

jilijun

测试成功了，感谢分享！

lcmphy

很实用，要是能改进一下就更好了！改进建议如下：
　　一般的电脑都装有Excel（或者将其宏做成Dll文件），将加密对话框加入右键菜单，不要打开Excel，直接用右键加密文件，不需另存其他文件名，直接替换原文件，不解密打开看不到内容；
　　解密也一样，不要打开Excel，直接用右键解密文件，不需另存其他文件名，直接替换原文件，然后可正常打开。　


这个建议挺好，但实施起来有点麻烦，没做过类似的东西，只知道要从注册表下手。
等有空时尝试一下。

                                                       ------ldy  09-06-07

humengqiang

学会了，确实不错，谢谢楼主分享

MSLEE

使用过程出现如下问题，还请Idy斑斑帮忙分析一下。
谢谢。

ldy

原帖由 MSLEE 于 2009-6-7 16:06 发表
使用过程出现如下问题，还请Idy斑斑帮忙分析一下。
谢谢。

简体版文件繁体版打开的问题，源代码如下，你建立个模块复制进去好了

'原创ExcelHome LDY 26258103@163.com  2009-6-6
Sub xor加密()
    Dim keyStr As String, b1() As Byte, b2() As Byte, lenKey As Long, J As Long, i As Long
    Dim pth As String, pth2 As String, fileTp As String
    pth = Application.GetOpenFilename("", , , "选测要加密的文件")
    If pth = "False" Then MsgBox "没有选择文件。": Exit Sub
    arr = Split(pth, ".")
    fileTp = arr(UBound(arr))
    pth2 = Application.GetSaveAsFilename("", fileTp & " 文件 ,*." & fileTp, , "保存加密后的文件名")
    If pth2 = "False" Then MsgBox "没有保存文件。": Exit Sub
    keyStr = InputBox("请输入密钥", "请输入任意字符，但要易于记忆，比如一句唐诗", "床前明月光")
    If Len(keyStr) = 0 Then MsgBox "密钥长度为0，不能加解密": Exit Sub
    ' 解密和加密的程序都一样，只是对话框的标题不同，下面的代码一模一样
    f# = FreeFile
    Open pth For Binary As f
    If LOF(f) > 3 * 1024 * 1024& Then  '文件大于3M, 2M内存双核1.5cpu 6M文件约1秒
        If MsgBox("文件大于3M,估算用时约 " & CLng(LOF(f) \ 6 * 1024 * 1024&) & _
                  "秒,继续吗？ ", 1, "较大文件确认") = vbCancel Then Close f#: Exit Sub
    End If
    t = Timer
    ReDim b1(LOF(f) - 1)
    Get f#, , b1
    Close f#

    '''''''''''''''''''''''''''''''''
    '真正的加密解密语句就这么简单，但确是非常强悍的
    '如果密钥仅有两个字符，将会有42亿种可能，如果不知道密钥，是无法解密的.
    '密钥的复杂度计算公式为 256的（密钥长度*2）的次方= 256^(密钥长度*2）
    b2 = keyStr
    lenKey = UBound(b2) + 1
    For i = 60 To UBound(b1)
        J = i Mod lenKey
        b1(i) = b1(i) Xor b2(J)
    Next
    '''''''''''''''''''''''''''''''''
    f# = FreeFile
    Open pth2 For Binary As f
    Put f#, , b1
    Close f#
    MsgBox Timer - t & " 秒 OK " & pth2
End Sub
Sub xor解密()
    Dim keyStr As String, b1() As Byte, b2() As Byte, lenKey As Long, J As Long, i As Long
    Dim pth As String, pth2 As String, fileTp As String
    pth = Application.GetOpenFilename("", , , "选测要解密的文件")
    If pth = "False" Then MsgBox "没有选择文件。": Exit Sub
    arr = Split(pth, ".")
    fileTp = arr(UBound(arr))
    pth2 = Application.GetSaveAsFilename("", fileTp & " 文件 ,*." & fileTp, , "保存解密后的文件名")
    If pth2 = "False" Then MsgBox "没有保存文件。": Exit Sub
     keyStr = InputBox("请输入密钥", "加密时的密钥，如果输错了相当于又加密一次", "床前明月光")
    If Len(keyStr) = 0 Then MsgBox "密钥长度为0，不能加解密": Exit Sub
   
    ' 加密和解密的程序都一样，只是对话框的标题不同，下面的代码一模一样
    f# = FreeFile
    Open pth For Binary As f
    If LOF(f) > 3 * 1024 * 1024& Then '文件大于3M
    If MsgBox("文件大于3M,估算用时约 " & CLng(LOF(f) \ 6 * 1024 * 1024&) & _
    "秒,继续吗？ ", 1, "较大文件确认") = vbCancel Then Close f#: Exit Sub
    End If
    t = Timer
    ReDim b1(LOF(f) - 1)
    Get f#, , b1
    Close f#

    '''''''''''''''''''''''''''''''''
    '真正的加密解密语句就这么简单
    b2 = keyStr
    lenKey = UBound(b2) + 1
    For i = 0 To UBound(b1)
        J = i Mod lenKey
        b1(i) = b1(i) Xor b2(J)
    Next
    '''''''''''''''''''''''''''''''''
    f# = FreeFile
    Open pth2 For Binary As f
    Put f#, , b1
    Close f#
MsgBox Timer - t & " 秒 OK " & pth2
End Sub