[分享]用DLL加强VBA开发中源程序的保护

cag · 发表于 2008-4-29 23:07:00

做父亲了，一直很忙，好久没来乐筑天下了，更是好久没有用VBA写的程序了，昨晚突然心血来潮，想在DLL实现一些关键功能来弥补在VBA开发中源程序不容易保护的缺点，现将“成果”写出来，请大伙不吝拍砖。
以下调试基于VB6SP6，AutoCAD2005中文版
1。首先打开VB6，新建一个"Activex Dll"的工程，将产生一个名为“CLASS1”的类，这里将类名改为“TestDll”，并添加引用“AutoCAD2005类型库”
2。添加一个模块，加入以下代码：
Public acadApp As AcadApplication
Public ThisDrawing As AcadDocument
3。添加一个窗体，再在窗体中加入两个button。分别命名为cmdCommand1和cmd，在窗体中加入以下代码：
Private Sub cmd_Click()
Unload Me
End Sub
Private Sub cmdCommand1_Click()
Me.Hide
AddLine
Me.Show 1
End Sub
Private Function AddLine() As AcadLine
Dim pt1 As Variant, pt2 As Variant
pt1 = ThisDrawing.Utility.Getpoint(, "起点:")
pt2 = ThisDrawing.Utility.Getpoint(pt1, "终点:")
Set AddLine = ThisDrawing.ModelSpace.AddLine(pt1, pt2)
AddLine.Update
End Function
4。在类模块中添加以下代码：
Public Function Start()
Set ThisDrawing = acadApp.ActiveDocument
Form1.Show 1
End Function
Private Sub Class_Initialize()
Set acadApp = GetObject(, "AutoCAD.Application.16")
End Sub
5。将工程属性里将“工程名称”改为“LineCreation”
6。最后编译生成LineCreation.dll
接下来要在AutoCAD的VBA中写代码，当然代码越少越好，最好将关建功能代码写在DLL中，以达到保护知识产权的目的。
7。打开AutoCAD的VBA，引用刚才生成的LineCreation.dll文件，再在ThisDrawing模块中加入以下代码
Public TestDll As New LineCreation.TestDll
Sub Test()
TestDll.start
End Sub
然后运行宏Test即可。
由上可以看出，只有短短的两句语句，其他需要执行的代码全部封装在DLL文件中，达到了对VBA程序不能很好的进行加密的加强。
VB源程序已附上

本帖以下内容被隐藏保护；需要你回复后，才能看到！

游客，如果您要查看本帖隐藏内容请回复

azjmjsj · 发表于 2008-5-3 19:21:00

你这是采用前绑定方式，有一定的局限性。
采用前绑定时，“工程”-->“引用”的AutoCAD类型库，与AutoCAD版本有很大的关系。有时“引用”AutoCAD2004类型库生成的DLL在AutoCAD2002下可能无法正常运行。(用此种方式，DVB文件需“引用”DLL文件。)
采用后绑定，使用通用的对象类型，不引用具体的类型库，则不受AutoCAD版本的影响，开发的DLL不依赖于AutoCAD的版本，适用于AutoCAD的各个版本。(用此种方式，DVB文件无需“引用”DLL文件。)

fjfhgdwfn · 发表于 2008-5-3 21:16:00

可否发个例子上来。学习下。就简单画条线了。

cag · 发表于 2008-5-9 11:34:00

呵，那只是个例子了，那就给出个动态引用的例子吧。
Module1代码:
Public acadApp As Object '''声名为object
Public ThisDrawing As Object '''声名为object
Form1代码:
Private Sub cmd_Click()
Unload Me
End Sub
Private Sub cmdCommand1_Click()
Me.Hide
AddLine
Me.Show 1
End Sub
Private Function AddLine() As Object '''声名为object
Dim pt1 As Variant, pt2 As Variant
pt1 = ThisDrawing.Utility.GetPoint(, vbCrLf & "起点:")
pt2 = ThisDrawing.Utility.GetPoint(pt1, vbCrLf & "终点:")
Set AddLine = ThisDrawing.ModelSpace.AddLine(pt1, pt2)
AddLine.Update

End Function
TestDll代码:
Public Function start()
Set ThisDrawing = acadApp.ActiveDocument
Form1.Show 1
End Function
Private Sub Class_Initialize()
Set acadApp = GetObject(, "AutoCAD.Application") '''获取类名
End Sub
编译
VBA代码:
Sub Test()
Dim TestDll As Object
Set TestDll = CreateObject("LineCreation.TestDll")
TestDll.start
End Sub
这样运行即可