|
楼主 |
发表于 2009-6-7 16:45
|
显示全部楼层
原帖由 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 |
|