一个简单破解excelvba工程密码方法

一个简单破解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