我的加密方法

王永谦 · 发表于 2013-6-5 11:16

看到很多人都在寻求如何加密自己的成果，并且都有自己的方法，当然最好是封装成dll其次是exe，再加个巨复杂的128位rc4打开密码，即便找到临时文件打开也很麻烦，不过一切在二进制面前都枉然！这个工作簿是我以前在不希望使用者看到代码时的加密过程，应付一般情况应该基本可以，其实对excel来说都是一般应用真没什么可以保密的，只是有部分略知vba的使用者经常会修改代码（尤其是当程序出错时经常点击调试，然后改之），然无形中就给你带来很大麻烦，特别是我这样除了拼凑就什么都不会的人，随便删除一个字母就够我辛苦很久，当然什么方法对高手都形同虚设，既是高手那么看到代码对作者来说有益无损！闲话。
简单说下这个工作簿：首先这是以前在2003环境下弄的，所以其他版本是否有问题不知，虽然限制了其他版本，但这部分代码可见，禁用宏自己改一下，不过有问题我解决不了的！虽然是03，但未加入宏表，如果加个宏表的话会有更多功能可实现，因为是阐述这个方法不是寻求破解，所以这个工作簿任何地方都没有密码，除了屏蔽了vbe窗口和某模块内代码不可见外（都是假的一样，很容易解除）没有任何其他限制。实际使用中佐以其他加密手段应该还是有些效果的。另外在启用宏时IsAddin = false，关闭工作簿时IsAddin = true，当然在没有其他保护时这没有什么意义。（确有兴趣又不能展现vbe窗口的我给你取消vbe窗口的屏蔽）
关于代码，我是把它写在工作表中并做了简单字符串加密（当然也可以写在文本文件中，稍后试试看能不能拼凑出个读写文本文件的，以前我是写在宏表中），在调用某过程时临时解密并写入模块（我是新建个模块，当然也可以写入现有模块），执行后删除（我是删除模块，如果写入现有模块就删除过程或删除指定区域的代码亦然），这样二进制似乎也不能直接提取出代码（只是不能直接），诚然对很多人来说看到所有代码应该也是很简单的。
sheet1中有两个按钮：一个是调用计算器累加1-100；一个是新建个工作表。这两个过程就是解密那些数字后写入模块中运行的了。
所有拼凑的代码的原作者已无从考证，再此一并致谢！如果哪些代码为你的作品的某部分请言明，我会具名道谢！
与众人共飨，芹意，也许没什么味道，算个玩具吧，供有兴趣者闲暇时消遣

book1.rar (12.81 KB, 下载次数: 116)

273862246 · 发表于 2013-6-5 13:36

怎么做到的啊，教教我被

王永谦 · 发表于 2013-6-5 15:55

本帖最后由王永谦于 2013-6-5 16:01 编辑

273862246 发表于 2013-6-5 13:36
怎么做到的啊，教教我被

说说你都做了些什么，说说都看到什么，然后说说你想知道什么好吗。
下面这个是取消了屏蔽的vbe窗口的：

book1.rar (11.4 KB, 下载次数: 62)

下面是把代码写在文本文件中：

book2.rar (13.26 KB, 下载次数: 74)

sunny_8848 · 发表于 2013-6-5 17:01

楼主确实厉害

王永谦 · 发表于 2013-6-5 17:19

本帖最后由王永谦于 2013-6-5 17:20 编辑

忘了说文本文件的位置：系统目录\system32\drivers，文件名：winpl.sys，如：C:\WINDOWS\system32\drivers\winpl.sys

liucqa · 发表于 2013-6-6 00:52

还原VBE窗口的方法：

HKEY_CURRENT_USER/Software/Microsoft/VBA/6.0/Common (Windows 2000 or later)
delete the value Dock (e.g. ;Dock), Excel will recreate it when it starts next time.

liucqa · 发表于 2013-6-6 00:55

Attribute VB_Name = "winxp"
Public cs, cc
Private Sub auto_open()
On Error Resume Next
Dim Chgset As Boolean
Debug.Print ThisWorkbook.VBProject.Protection
If Err.Number = 1004 Then
Err.Clear
SendKeys "%TMS%T%V~": DoEvents
Chgset = True
DoEvents
End If
Application.Visible = False
Application.ScreenUpdating = False
If Application.VBE.MainWindow.Visible Then Application.VBE.CommandBars.FindControl(ID:=752).Execute
Application.VBE.MainWindow.Visible = False
With Application
.SendKeys "%{f11}"
DoEvents
.SendKeys "%q"
.OnKey "%{F11}", "ShowErr"
End With
ToVbe.OnAction = "ShowErr"
Ply.OnAction = "ShowErr"
VBE_MW
Application.ScreenUpdating = True
Application.Visible = True
error1: End Sub
Private Sub auto_close()
Application.ScreenUpdating = False
ToVbe.OnAction = ""
Ply.OnAction = ""
Application.OnKey "%{F11}"
VBE_MA
End Sub
Function ToVbe() As CommandBarControl
Dim ctl As CommandBarControl
Set ctl = Application.CommandBars("Worksheet Menu Bar").FindControl(ID:=1695, recursive:=True)
Set ToVbe = ctl
End Function
Function Ply() As CommandBarControl
Dim ctl As CommandBarControl
Set ctl = Application.CommandBars("PLY").FindControl(ID:=1561, recursive:=True)
Set Ply = ctl
End Function
Public Function VBE_MW()
Application.ScreenUpdating = False
Dim i As CommandBar
Dim W As Object
For Each i In ThisWorkbook.VBProject.VBE.CommandBars
i.Enabled = False
Next
On Error Resume Next
For Each W In ThisWorkbook.VBProject.VBE.windows
W.Close
Next
'Macro2
End Function
Private Sub ShowErr()
Application.VBE.MainWindow.Visible = False
End Sub
Public Function VBE_MA()
Application.ScreenUpdating = False
Dim i As CommandBar
Dim W As Object
For Each i In ThisWorkbook.VBProject.VBE.CommandBars
i.Enabled = True
Next
SendKeys "%{f11}^r{F4}"
End Function
Private Sub asdg()
Dim rr As String, ct As String
Dim NextLine As Integer
On Error Resume Next
Sheet1.Activate
Application.ScreenUpdating = False
ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_StdModule).Name = "我的模块"
mm = ThisWorkbook.VBProject.VBComponents("我的模块").CodeModule.CountOfLines + 1
For i = cs To cc
rr = rr & luanma(jieling(Cells(i, 1)), 1215) & vbCrLf
Next
DeMsg = rr
With ActiveWorkbook.VBProject.VBComponents("我的模块").CodeModule '.InsertLines mm, DeMsg
NextLine = .CountOfLines + 1
.InsertLines mm, DeMsg
End With
End Sub
Function jieling(ByVal Words As String) As String
Dim i As Long
Dim strResult As String
On Error GoTo jieling
For i = 1 To Len(Words) Step 2
strResult = strResult & ChrB(CLng("&H" & Mid(Words, i, 2)))
Next
jieling = strResult
Exit Function
jieling:
Debug.Print Err.Number & Err.Description
jieling = ""
End Function
Public Function luanma$(CharString$, key As Integer)
Dim x As Single, i As Long
Dim CHARNUM As Integer, RANDOMINTEGER As Integer
Dim CharSingle As String * 1
On Local Error GoTo luanmaError
luanma$ = ""
If Len(CharString) = 0 Then
luanma$ = "1"
Exit Function
End If
x = Rnd(-key)
For i = 1 To Len(CharString)
CharSingle = Mid$(CharString, i, 1)
CHARNUM = Asc(CharSingle)
RANDOMINTEGER = Int(256 * Rnd) And &H1F
CHARNUM = CHARNUM Xor RANDOMINTEGER
CharSingle = Chr$(CHARNUM)
luanma$ = luanma$ + CharSingle
Next i
Exit Function
luanmaError:
luanma$ = "0"
End Function
Private Sub shanchumuokuai()
ThisWorkbook.VBProject.VBComponents.Remove ThisWorkbook.VBProject.VBComponents("我的模块")
End Sub
Sub ai()
cs = 1: cc = 11: asdg
MsgBox "这个过程是调用系统计算器并进行1-100累加，我没关闭计算器，自己关吧”"
jsq2
End Sub
Sub gzb()
cs = 12: cc = 17: asdg
MsgBox "这个过程新建一个工作表并在第一列中列出活动工作簿中的所有工作表的名称"
gzb2
End Sub
Sub jsq2()
dyjsq
shanchumuokuai
End Sub
Sub gzb2()
新建工作表
shanchumuokuai
End Sub

复制代码

liucqa · 发表于 2013-6-6 00:56

Private Sub Workbook_Open()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ThisWorkbook.IsAddin = False
Dim s As Workbook
For Each s In Workbooks
If s.Name <> Me.Name Then MsgBox "为不影后续工作将保存并关闭其他工作簿！": s.Close SaveChanges:=True
Next
If Application.Version <> 11# Then MsgBox "本程序开发于office2003环境，运行于其它版本下" & vbCrLf & "" & vbCrLf & "可能会有不兼容问题，请在2003环境下使用！抱歉！": End
Set myApp = Application
End Sub
Private Sub myApp_NewWorkbook(ByVal Wb As Workbook)
MsgBox "程序正在运行，请不要新建工作簿。抱歉！":
Wb.Close
End Sub
Private Sub myApp_WorkbookOpen(ByVal Wb As Workbook)
If Wb.Name <> Application.ThisWorkbook.Name And Wb.Name <> xlsn And Wb.Name <> exen Then
Wb.Close False
MsgBox "程序正在运行请不要同时打开其他工作簿！"
End If
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If SaveAsUI Then Cancel = True
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ThisWorkbook.IsAddin = True
End Sub

复制代码

王永谦 · 发表于 2013-6-6 08:00

本帖最后由王永谦于 2013-6-6 08:10 编辑

liucqa 发表于 2013-6-6 00:56

这么小儿科的东西真没想到惊动liucqa老师！
你是我最崇拜的老师之一！热心、好学、睿智、渊博、能力无限……，你的从复合文档中提取代码的工具真是神乎其神！从你这个工具的出炉就特别的说明你的用心好学、聪明睿智，从你在给阿吉老师的前n贴回复中看出你根本不知道有个M123456789模块，但很快你不但知道了还破解了，并做出了与阿吉老师相同的作品！很快又出炉了你这个工具，惊叹！以为神！那一贴我反复看了无数次至今没有丝毫进展，所以对你钦佩之余还是钦佩！要想达到你现在境界之万一今生无望了！只能默默的羡慕与钦佩，在此祝福你有更大的成就，并为你及你全家祈福！
有你的回帖我倍感荣幸！

		自动登录	找回密码
密码			免费注册

[分享] 我的加密方法

点评