标题:怎么限制使用?
取消只看楼主
dsasada
Rank: 1
等 级:新手上路
帖 子:54
专家分:3
注 册:2018-3-30
结帖率:70%
已结贴  问题点数:20 回复次数:2 
怎么限制使用?
用vb写个程序,如到2018年9月1日程序窗口就不能打开,别人修改日期往前调整,程序就能继续用,有没有更好的方法到期永久不能使用?
搜索更多相关主题的帖子: 限制 日期 调整 继续 方法 
2018-05-15 11:59
dsasada
Rank: 1
等 级:新手上路
帖 子:54
专家分:3
注 册:2018-3-30
得分:0 
回复 2楼 wmf2014
谢谢,如果不能联网,能不能写个简单点学习下?
2018-05-15 20:06
dsasada
Rank: 1
等 级:新手上路
帖 子:54
专家分:3
注 册:2018-3-30
得分:0 
封装在DLL里,网络日期时限,第一次运行必须联网让系统日期和网络日期同步,以后没有网络只要不修改系统日期正常运行,修改了系统日期就不能运行

Private Declare Function InternetCheckConnection Lib "wininet.dll" Alias "InternetCheckConnectionA" (ByVal lpszUrl As String, ByVal dwFlags As Long, ByVal dwReserved As Long) As Long '检测网络连接
Private Function wlrq() As Date '网络日期
On Error Resume Next
   Dim sUrl As String
   Dim XMLHTTP As Object
    sUrl = "http://www.baidu.com"
    If InternetCheckConnection(sUrl, 1, 0) Then
    Set XMLHTTP = CreateObject("Microsoft.XMLHTTP")
    XMLHTTP.Open "Get", sUrl, False
    XMLHTTP.send
    temtime = XMLHTTP.getResponseHeader("date")
    Set XMLHTTP = Nothing
    wlrq = Split(CDate(Split(Split(temtime, ",")(1), "GMT")(0)) + DateAdd("h", 8, timeGMT), " ")(0)
    xtrq = Date
    If wlrq <> xtrq Then: MsgBox " 网络日期与系统日期不同步" & vbCrLf & vbCrLf & "------请校正系统日期------ " & vbCrLf & vbCrLf & "上次同步日期    " & GetSetting(App.Title, "settings", "text12", S) & vbCrLf & vbCrLf & "         " & wlrq
    Else
    MsgBox " ------网络没有连接------" & vbCrLf & vbCrLf & "------请检查网络连接------ " & vbCrLf & vbCrLf & "         " & wlrq
    End If
    If wlrq > "2012-2-30" Then
    SaveSetting App.Title, "settings", "text12", wlrq
    End If
 End Function
Sub JCRQY(x)
Dim ZZ As Date, S As Date
    ZZ = "2013-2-30"
If GetSetting(App.Title, "settings", "text12", S) = Date Then
       If Date > ZZ Then
          SaveSetting App.Title, "settings", "text15", "OFF"
       Else
          SaveSetting App.Title, "settings", "text15", Date
          SaveSetting App.Title, "settings", "text14", Date
       End If
Exit Sub
Else
wlrq
       If GetSetting(App.Title, "settings", "text15", S) <> Date Then
          If GetSetting(App.Title, "settings", "text14", S) > "2010-4-30" Then
             SaveSetting App.Title, "settings", "text14", CDate(GetSetting(App.Title, "settings", "text14", S)) + DateAdd("d", 1, timeGMT)
             If GetSetting(App.Title, "settings", "text14", S) < ZZ Then: SaveSetting App.Title, "settings", "text15", Date
          End If
       End If
End If
End Sub
Sub 模块()
    If GetSetting(App.Title, "settings", "text15", S) <> Date Then: Exit Sub
    '执行代码....
End Sub
2018-08-10 20:22



参与讨论请移步原网站贴子:https://bbs.bccn.net/thread-486942-1-1.html




关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.259864 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved