如何防止高手破解VBA程序的使用日期的限制？

lotteryman

liucqa 发表于 2012-3-26 19:54
http://search.excelhome.net/f/search?q=%E8%8E%B7%E5%8F%96%E7%BD%91%E7%BB%9C%E6%97%B6%E9%97%B4&sId= ...

谢谢了！！
不过有个问题：
我的VBA程序放在服务器上，给几个相关部门同时使用。
服务器是可以连INTERNET的，但是所使用的人是通过局域网使用这个VBA的，
使用的人，在公司里是没有权限上internet(网管限制了)，
那么这个从INTERNET取日期能正常取到吗？

jygzcj

只对我们这些罗罗们有用.高手一来就破掉了!没有用的.除非打包成二进制!

sheet

chlele 发表于 2012-3-26 20:06
直接编译为exe文件，然后用VBA Shell 调用！

真想看看！可否放一个上来让大家试试？

好像会有临时文件的！

gongzl1981

我也觉得没有必要加密码。因为你所做的vba工程也许只用在这个地方，留在这个地方，后面的人还记得有你这个人写了这个程序。。。再说了，真的要打算离职了，也没有必要做得那么硬。其实好聚好散也是蛮好的。

lotteryman

chlele 发表于 2012-3-26 20:06
直接编译为exe文件，然后用VBA Shell 调用！

太高深了，我不会呀。

chlele

sheet 发表于 2012-3-26 20:15 真想看看！可否放一个上来让大家试试？ 好像会有临时文件的！

请把附件的两个文件放在同一个文件夹下面，打开测试.xls进行测试。 Test.rar (80.26 KB, 下载次数: 644)

2012-3-26 22:45 上传

点击文件名下载附件

如果直接点击exe文件，只显示About。
对了如果你把本机日期改到2013，将会显示软件过期提示，然后程序直接退出。

我之所以选择exe文件，是因为dll总是需要注册，我不喜欢。

lotteryman

看了一个晚上的关于DLL封装，很是很不明白。
搞成.EXE的还没有时间看，到底是怎么搞出来的呢，

lotteryman

chlele 发表于 2012-3-26 22:46
请把附件的两个文件放在同一个文件夹下面，打开测试.xls进行测试。 如果直接点击exe文件，只显示About。
...

你可以详细说明一下，教教我，教教很多不会的人吗？

chlele

lotteryman 发表于 2012-3-26 23:13 看了一个晚上的关于DLL封装，很是很不明白。 搞成.EXE的还没有时间看，到底是怎么搞出来的呢，

exe和dll差不多，都是同一件事，只是最终表现形式不一样。

fsc163198

这是我以前封装在DLL里,网络日期时限,第一次运行必须联网让系统日期和网络日期同步,以后没有网络只要不修改系统日期正常运行,修改了系统日期就不能运行.仅供参考

1. Private Declare Function InternetCheckConnection Lib "wininet.dll" Alias "InternetCheckConnectionA" (ByVal lpszUrl As String, ByVal dwFlags As Long, ByVal dwReserved As Long) As Long '检测网络连接
   
2. Private Function wlrq() As Date '网络日期
   
3. On Error Resume Next
   
4.    Dim sUrl As String
   
5.    Dim XMLHTTP As Object
   
6.     sUrl = "http://www.baidu.com"
   
7.     If InternetCheckConnection(sUrl, 1, 0) Then
   
8.     Set XMLHTTP = CreateObject("Microsoft.XMLHTTP")
   
9.     XMLHTTP.Open "Get", sUrl, False
   
10.     XMLHTTP.send
    
11.     temtime = XMLHTTP.getResponseHeader("date")
    
12.     Set XMLHTTP = Nothing
    
13.     wlrq = Split(CDate(Split(Split(temtime, ",")(1), "GMT")(0)) + DateAdd("h", 8, timeGMT), " ")(0)
    
14.     xtrq = Date
    
15.     If wlrq <> xtrq Then: MsgBox " 网络日期与系统日期不同步" & vbCrLf & vbCrLf & "------请校正系统日期------ " & vbCrLf & vbCrLf & "上次同步日期    " & GetSetting(App.Title, "settings", "text12", S) & vbCrLf & vbCrLf & "         " & wlrq
    
16.     Else
    
17.     MsgBox " ------网络没有连接------" & vbCrLf & vbCrLf & "------请检查网络连接------ " & vbCrLf & vbCrLf & "         " & wlrq
    
18.     End If
    
19.     If wlrq > "2012-2-30" Then
    
20.     SaveSetting App.Title, "settings", "text12", wlrq
    
21.     End If
    
22. End Function
    
23. Sub JCRQY(x)
    
24. Dim ZZ As Date, S As Date
    
25.     ZZ = "2013-2-30"
    
26. If GetSetting(App.Title, "settings", "text12", S) = Date Then
    
27.        If Date > ZZ Then
    
28.           SaveSetting App.Title, "settings", "text15", "OFF"
    
29.        Else
    
30.           SaveSetting App.Title, "settings", "text15", Date
    
31.           SaveSetting App.Title, "settings", "text14", Date
    
32.        End If
    
33. Exit Sub
    
34. Else
    
35. wlrq
    
36.        If GetSetting(App.Title, "settings", "text15", S) <> Date Then
    
37.           If GetSetting(App.Title, "settings", "text14", S) > "2010-4-30" Then
    
38.              SaveSetting App.Title, "settings", "text14", CDate(GetSetting(App.Title, "settings", "text14", S)) + DateAdd("d", 1, timeGMT)
    
39.              If GetSetting(App.Title, "settings", "text14", S) < ZZ Then: SaveSetting App.Title, "settings", "text15", Date
    
40.           End If
    
41.        End If
    
42. End If
    
43. End Sub
    
44. Sub 模块()
    
45.     If GetSetting(App.Title, "settings", "text15", S) <> Date Then: Exit Sub
    
46.     '执行代码....
    
47. End Sub

复制代码