一个简单破解excelvba工程密码方法
2010年02月20日
由于借鉴别人得程序经验,有时比自己动脑来得快,本着这种思路,一些优秀得excel插件都工程锁定,不论2000,还是2007其破解方法都一样
原理excel中两进制文件中找到DPB="和CMG="只要改动其后一个字节,就会溢出,软件无效提示修复就可以轻松破解,在2007时需要先用rar 解压文件
因为它是个容器文件。具体不细写。以下用vb简单的写了以下,并未出错检测。有兴趣朋友可以试试,方法把待解密文件直接拖进窗口
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Dim GetFilePathStr As String
Dim filestream() As Byte
Dim find As Long
Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Data.GetFormat(vbCFFiles) = True Then
Dim W
Dim i As Integer
If Data.Files.Count > 1 Then '如果是拖放的多个文件则依次打开
For i = 1 To Data.Files.Count
GetFilePathStr = Data.Files.Item(i)
cracr
W = ShellExecute(0&, vbNullString, GetFilePathStr, vbNullString, vbNullString, vbNormalFocus)
Next
Else '如果只有一个文件
GetFilePathStr = Data.Files.Item(1)
cracr
W = ShellExecute(0&, vbNullString, GetFilePathStr, vbNullString, vbNullString, vbNormalFocus)
End If
End If
End Sub
Sub cracr()
On Error Resume Next
Dim bakfilename
Dim operaternumber As Long
operaternumber = FreeFile
bakfilename = GetFilePathStr + ".bak"
FileCopy GetFilePathStr, bakfilename
Open GetFilePathStr For Binary Access Read As operaternumber
ReDim filestream(LOF(operaternumber) - 1)
Get #operaternumber, , filestream()
Close #operaternumber
'解密
filldata filestream(), "DPB="""
filldata filestream(), "CMG="""
operaternumber = FreeFile
Open GetFilePathStr For Binary Access Write As operaternumber
Put #operaternumber, , filestream()
Close #operaternumber
End Sub
Private Function SearchString(FBytes() As Byte, FromWhere As Long, str As String) As Long
Dim P As Long, K As Long
P = FromWhere
Do Until P > UBound(FBytes)
For K = 1 To Len(str)
If FBytes(P + K - 1) Asc(Mid(str, K, 1)) Then
P = P + K
Exit For
End If
Next
If K > Len(str) Then
SearchString = P
Exit Function
End If
Loop
Err.Raise vbObjectError, , "没找到字符串“" & str & "”。"
serchstring = 0
End Function
Private Sub filldata(filestream() As Byte, str As String)
find = SearchString(filestream, 0, str) + 3
filestream(find) = &H31
End Sub
http://blog.sina.com.cn/s/blog_6369a6660100gmmp.html
2010年02月20日
由于借鉴别人得程序经验,有时比自己动脑来得快,本着这种思路,一些优秀得excel插件都工程锁定,不论2000,还是2007其破解方法都一样
原理excel中两进制文件中找到DPB="和CMG="只要改动其后一个字节,就会溢出,软件无效提示修复就可以轻松破解,在2007时需要先用rar 解压文件
因为它是个容器文件。具体不细写。以下用vb简单的写了以下,并未出错检测。有兴趣朋友可以试试,方法把待解密文件直接拖进窗口
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Dim GetFilePathStr As String
Dim filestream() As Byte
Dim find As Long
Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Data.GetFormat(vbCFFiles) = True Then
Dim W
Dim i As Integer
If Data.Files.Count > 1 Then '如果是拖放的多个文件则依次打开
For i = 1 To Data.Files.Count
GetFilePathStr = Data.Files.Item(i)
cracr
W = ShellExecute(0&, vbNullString, GetFilePathStr, vbNullString, vbNullString, vbNormalFocus)
Next
Else '如果只有一个文件
GetFilePathStr = Data.Files.Item(1)
cracr
W = ShellExecute(0&, vbNullString, GetFilePathStr, vbNullString, vbNullString, vbNormalFocus)
End If
End If
End Sub
Sub cracr()
On Error Resume Next
Dim bakfilename
Dim operaternumber As Long
operaternumber = FreeFile
bakfilename = GetFilePathStr + ".bak"
FileCopy GetFilePathStr, bakfilename
Open GetFilePathStr For Binary Access Read As operaternumber
ReDim filestream(LOF(operaternumber) - 1)
Get #operaternumber, , filestream()
Close #operaternumber
'解密
filldata filestream(), "DPB="""
filldata filestream(), "CMG="""
operaternumber = FreeFile
Open GetFilePathStr For Binary Access Write As operaternumber
Put #operaternumber, , filestream()
Close #operaternumber
End Sub
Private Function SearchString(FBytes() As Byte, FromWhere As Long, str As String) As Long
Dim P As Long, K As Long
P = FromWhere
Do Until P > UBound(FBytes)
For K = 1 To Len(str)
If FBytes(P + K - 1) Asc(Mid(str, K, 1)) Then
P = P + K
Exit For
End If
Next
If K > Len(str) Then
SearchString = P
Exit Function
End If
Loop
Err.Raise vbObjectError, , "没找到字符串“" & str & "”。"
serchstring = 0
End Function
Private Sub filldata(filestream() As Byte, str As String)
find = SearchString(filestream, 0, str) + 3
filestream(find) = &H31
End Sub
http://blog.sina.com.cn/s/blog_6369a6660100gmmp.html