用vb写个程序，如到2018年9月1日程序窗口就不能打开，别人修改日期往前调整，程序就能继续用，有没有更好的方法到期永久不能使用？

可以通过获取北京授时中心时间（http://www.time.）来达到目的，这个时间是人为不能改的。如果不能联网，也可以扫描本机最近使用的文件建立时间，只要这台电脑和外部交流，一定能得到时间异常的判断，反正手段很多的。

谢谢，如果不能联网，能不能写个简单点学习下？

你可以改用使用天数。

封装在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