用vb编写软件有效期

⑴ vb软件使用时间和日期限制!!

定义两个变量，安装时间、过期时间
取一个唯一性的值（例如硬盘ID或者其他），用这个值加密时间变量（加密算法是最重要的）
只允许 安装时间－－过期时间之间的时间运行。
每次运行后，如果当前时间小于安装时间或者当前时间大于过期时间，退出，否则更新安装时间为当前时间。

⑵ VB怎么限制软件使用期限

可以把这段抄代码放在模块中，从模块启动：

Submain()
DimMySettingsAsString
MySettings=GetSetting("MyApp","Startup","FirstRun")'读取注册表
IfMySettings=""Then
SaveSetting"MyApp","Startup","FirstRun",Date'首次运行保存注册表
MySettings=Date
EndIf
'DeleteSetting"MyApp","Startup"'删除注册表
IfDateDiff("d",CDate(MySettings),Now)>30Then'超过30天
MsgBox"软件试用过期，请购买正式版"
ExitSub
Else
MsgBox"软件已经使用"&DateDiff("d",CDate(MySettings),Now)&"天"
Form1.Show'开始使用
EndIf
EndSub

⑶ 在vb.net中如何编写限制软件的使用时间

给你个方法，在软件加载时就判断下当前系统时间（最好是判断远程服务器上的时间，因为当前运行系统的时间他可以手动），判断当前时间是否有超过最后期限。。

⑷ 用VB编写计算日期的程序

Private Sub Command1_Click()
Dim dt As String
dt = InputBox("请输入截止日期：")
dt = Replace(dt, ".", "-")
If IsDate(dt) Then
MsgBox "距离当前日期还有：" & CDate(dt) - #8/8/2008# & "天"
Else
MsgBox "你输入的日期格式有误！"
End If
End Sub

⑸ 如何用vb实现软件使用时间限制

A: 应有的功能:

1) 给定一个试用期限,在系统每次启动时会判断软件已经使用了几天,还有几天可用以及启动的次数.

2) 当系统日期被修改成往日的日期后,系统能自动判别,禁止修改日期,不于正常启动.
3) 当试用期到,显示信息,不于启动程序.B:简单的思路
1) 在系统第一次运行时,在一个隐蔽的地方(如: c:\windows\system)建立一个用以记录系统信息的数据库文件,如date.mdb,使用一张表date,有三个字段first_time,last_time和times.其中first_time为系统第一次启动时的日期,即试用期的第一天.last_time为系统最近一次启动的时间,而times为记录系统启动的次数.

2) 系统每次启动会检测当前的日期同last_time做比较,如果当前的日期(如00/09/30)比last_time(如00/10/01)还旧,说明系统的日期被推后,显示信息,不于启动系统.反之,则转入第三步.

3) 取出数据库中的first_time,同当前的日期做减法运算,看所的的天数是否在使用期限内.如果在,则转入第四步,否则显示信息,不于启动系统.

4) 修改数据库的last_time字段为当前的日期,显示系统已经使用的情况,正常启动系统.

好了,罗罗嗦嗦讲了一大统,我想,大家一定都明白了,怎么样,我说不难吧,根本不用修改系统的注册表.只要大家把date.mdb藏好了,不被发现就万事大吉了.而且你可以给这个数据库加上密码,然后把first_time,last_time,times的字段名改个面目全非,就算有高手发现了数据库,破解了密码,他也不知道这三个字段的含义和这个数据库是那个软件所带的文件,呵呵,不说了,还是看看我的源码吧:

在您的工程中,请以SUB MAIN()启动程序.(什么,怎么设置,呵呵,"工程"==>"工程属性"==>"启动窗体")

Sub main()
On Error GoTo error
'系统检测是否有date.mdb文件,如果没有,则是系统第一次启动,则建立之
If Dir("c:\windows\system\date.mdb") = "" Then

'注意在开始,您要确定您的工程引用了Microsoft 2.5/3.5 compatibility library 在"工程"==>"引用"中.

Dim WS As Workspace
Dim DB As Database
Dim TD As Tabledef
Dim FLD As Field
Dim IDX As Index
Dim rd As Recordset
Set WS = DBEngine.Workspaces(0)
Set DB = WS.CreateDatabase("c:\windows\system\date.mdb", dbLangGeneral)
DB.Connect = ";pwd=andy"
Set TD = DB.CreateTableDef("date")
TD.Attributes = 0
TD.Connect = ""
TD.SourceTableName = ""
TD.ValidationRule = ""
TD.ValidationText = ""
' Field first_time
Set FLD = TD.CreateField("first_time", 8, 8)
FLD.Attributes = 1
FLD.DefaultValue = ""
FLD.OrdinalPosition = 0
FLD.Required = False
FLD.ValidationRule = ""
FLD.ValidationText = ""
TD.Fields.Append FLD
' Field last_time
Set FLD = TD.CreateField("last_time", 8, 8)
FLD.Attributes = 1
FLD.DefaultValue = ""
FLD.OrdinalPosition = 1
FLD.Required = False
FLD.ValidationRule = ""
FLD.ValidationText = ""
TD.Fields.Append FLD
' Field times
Set FLD = TD.CreateField("times", 3, 2)
FLD.Attributes = 1
FLD.DefaultValue = ""
FLD.OrdinalPosition = 2
FLD.Required = False
FLD.ValidationRule = ""
FLD.ValidationText = ""
TD.Fields.Append FLD
DB.TableDefs.Append TD
DB.Close
Set DB = WS.OpenDatabase("c:\windows\system\date.mdb")
Set rd = DB.OpenRecordset("date")
With rd
.AddNew
.Fields("first_time") = Date
.Fields("last_time") = Date
.Fields("times") = 1
.Update
End With

DB.Close
MsgBox "这是您第一次启动本系统!您的试用期为30天,今天是第一天.谢谢使用!", 48, "天华电脑艺术创意工作室"

'效果如图1 (见附件1)

mainForm.Show '启动您的主窗体

Else '系统有date.mdb文件,则不是第一次运行,就不用建立数据库文件了.

Dim WS2 As Workspace
Dim DB2 As Database
Dim rd2 As Recordset
Set WS2 = Workspaces(0)
Set DB2 = WS2.OpenDatabase("c:\windows\system\date.mdb", pwd = "springlover")
Set rd2 = DB2.OpenRecordset("date")
'开始检测用户是否修改了系统日期
rd2.MoveFirst
If rd2.Fields("last_time") > Date Then
MsgBox "对不起,您在本软件的试用期内不可以修改系统日期,否则将取消您对不系统的试用权.如果您想继续使用本软件,请您恢复系统日期.谢谢合作!", 48, "天华电脑艺术创意工作室"

'效果如图3 (见附件3)

End
End If

'开始检测是否超期

If Date - rd2.Fields("first_time") >= 30 Then '设定试用期为30天
MsgBox "您已经启动本系统" & rd2.Fields("times") & "次了,而且已经到了30天的试用期,如果您想继续使用本软件,请您到本公司注册并购买正版的软件!", 48, "天华电脑艺术创意工作室"

'效果如图4 (见附件4)

End

Else

'仍在试用期内
num％ = rd2.Fields("times")
rd2.Edit
rd2.Fields("last_time") = Date
rd2.Fields("times") = num + 1
rd2.Update

MsgBox "这是您第" & rd2.Fields("times") & "次使用本系统,您还有" & 30 - (Date - rd2.Fields("first_time")) & "天的试用期,祝您今天工作愉快!", 48, "天华电脑艺术创意工作室" '
mainForm.Show '启动您的主窗体
End If
End If
Exit Sub
error:
MsgBox "系统错误!"

End Sub

⑹ 如何用vb实现软件使用时间限制

Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Const REG_MULTI_SZ As Long = &H7
Const REG_SZ As Long = &H1
Const REG_EXPAND_SZ As Long = &H2
Const HKEY_LOCAL_MACHINE = &H80000002

Public Function getRegData() As String
Dim hsubkey As Long
Dim hctosKey As Long
Dim SerialNOKey As Long
Dim RegVal As String
Dim tlen As Long
RegOpenKey HKEY_LOCAL_MACHINE, "SOFTWARE\test\mymark", hsubkey
RegQueryValueEx hsubkey, "usermark", 0, REG_EXPAND_SZ, 0, tlen
RegVal = String(tlen, " ")
RegQueryValueEx hsubkey, "usermark", 0, REG_EXPAND_SZ, ByVal RegVal, tlen
RegCloseKey hsubkey
RegCloseKey HKEY_LOCAL_MACHINE
getRegData = RegVal
End Function

Public Function setRegData() As long
Dim hsubkey As Long
Dim hctosKey As Long
Dim SerialNOKey As Long
Dim RegVal As String
Dim tlen As Long
RegOpenKey HKEY_LOCAL_MACHINE, "SOFTWARE\test\mymark", hsubkey
RegSetValueEx hsubkey, "usermark", 0, REG_SZ, ByVal "TimeOver", Len("TimeOver")
RegCloseKey hsubkey
RegCloseKey HKEY_LOCAL_MACHINE
setRegData=1
End Function

sub form1_load()
if getRegData<>"TimeOver" then
end
endif
timer1.interval=60000' 一分钟
timer1.enabled=true
end sub

sub timer1_timer()
setregdata
end
end sub

⑺ VB制作软件有效期如何来设

xlzzc回答得很好，为了更进一步控制有效期
应该在安装软件时，将安装日期写入注册表或者其他位置
每一次登录时记录最后一次登录日期
运行时首先判断安装日期与当前日期
在判断登录日期与当前日期
防止用户回调系统时间，这样就比较完善了。

⑻ 我用VB编写了一款软件。但是我想求一款可以限制使用次数或者使用时间的软件。我需要注册版的。或者注册码

思路是：
用VB生成了一个记数器文件，为具迷惑性，后缀为.ocx
代码： Open "C:\windows\system32\jishuqi.OCX" For Input As #1 '生成空文件,如果文件存在,也没关系
Close #1
每次打开你的软件时，读取这个文件并开始记录已用次数：
Open "C:\windows\system32\jishuqi.OCX" For Binary As #1 ''从文本读入已用次数
YiYongCiShu = Val(Input(LOF(1), 1))
Close #1
YiYongCiShu = YiYongCiShu + 1
再把刚才的计数结果写入到文件中：
Open "C:\windows\system32\jishuqi.OCX" For Output As #1 '记录次数
Print #1, YiYongCiShu
Close #1
设定一个初始值，比如100，并进行比较，然后判断做出决定：
If YiYongCiShu > 100 Then '使用期限到了,所有功能全部被限制使用,三个"分解"按钮将不可用.
i2 = MsgBox("您的试用次数已到,请注册!", 3 + 64, "注册提示")
SSTab1.Visible = False '试用期过后,不可用
If i2 = 6 Then Call zhuce '调用注册过程
Else
i = MsgBox("您还可使用" & 100 - YiYongCiShu & "次, 是否注册?", vbYesNo + vbInformation, "提示")
If i = vbYes Then Call zhuce '"是"即要注
End If

如果想要求用户注册，可用机器码，比如硬盘序列号什么的：
Private Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize _
As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long

Jiqima = Abs(Val(diksvolume)) '这就是C盘序列号,加Abs防止出现负数
当然也可以设定实时时间（这个不好，用户可以修改自己的系统时间）

⑼ vb编写的软件如何设置使用时间 我有一个软件想设置使用时间为30天，怎么编写呢

VB写自己试用软件（为你写的软件加上使用期限），使用别人的软件大多都有试用期，试用期已过就不能在使用，除非注册！Vb也可以实现这样滴效果！以下下介绍两种简单易懂的（其实就会这两种）！当然还有其他方法, 像生成配置文件等！方法很多有待尝试！呵呵！

现在提供两种方法。都是利用注册表的

一种是利用点击的次数。比如一共有30次，点一次少一次。直到0就不能用了

另一种是用时间限制的。如30天，每天减少一次

代码给出，由于代码不是很难就不做任何解释了！
--------------------------------------------------
'次数限制（如30次）如下：
Private Sub Form_Load()
Dim RemainDay As Long
RemainDay = GetSetting("MyApp", "set", "times", 0)
If RemainDay = 30 Then
MsgBox "试用次数已满，请注册"
Unload Me
End If
MsgBox "现在剩下：" & 30 - RemainDay & "试用次数，好好珍惜！"
RemainDay = RemainDay + 1
SaveSetting "MyApp", "set", "times", RemainDay
End Sub
先测试第一种的
--------------------------------------------------
'时间限制的（如30天）
Private Sub Form_Load()
Dim RemainDay As Long
RemainDay = GetSetting("MyApp", "set", "day", 0)
If RemainDay = 30 Then
MsgBox "试用期已过，请注册"
Unload Me
End If
MsgBox "现在剩下：" & 30 - RemainDay & "试用天数，好好珍惜！"
if day(now)-remainday>0 then RemainDay = RemainDay + 1
SaveSetting "MyApp", "set", "times", RemainDay
End Sub

代码结束！很简短吧！呵呵！

⑽ VB怎样编写使用时间限制

用个简单并且就好理解的方法。
做时间记录。输出一个隐秘路径如：%SystemRoot%\TimeRec.dat这个文件用来储存使用的时间，每次启动程序就读取里面的时间长度。如果大于三十天就关闭自身程序。
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long

Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long

Private Sub LimTime()
Dim LastExitTime As String * 255
Dim FirstOpTime As String * 255
Dim RunDays As String * 255
Dim Ret As Long

If Dir("C:\Windows\RunExe.ini") = "" Then
FirstOpTime = Now
LastExitTime = Now
Ret = WritePrivateProfileString("ProgramInfo", "Author", "Cokie", "C:\Windows\RunExe.ini")
Ret = WritePrivateProfileString("ProgramInfo", "FirstOpTime", FirstOpTime, "C:\Windows\RunExe.ini")
Ret = WritePrivateProfileString("RunRecords", "RunDays", "0", "C:\Windows\RunExe.ini")
Ret = WritePrivateProfileString("RunRecords", "LastExitTime", LastExitTime, "C:\Windows\RunExe.ini")
Else
Ret = GetPrivateProfileString("RunRecords", "LastExitTime", "UnFound", LastExitTime, 255, "C:\Windows\RunExe.ini")
If Now <= CDate(LastExitTime) Then
MsgBox "你改变了系统时间，卑鄙！": Unload Me
Else
Ret = GetPrivateProfileString("RunRecords", "RunDays", "UnFound", RunDays, 255, "C:\Windows\RunExe.ini")
If CLng(RunDays) >= 30 Then
MsgBox "您的试用期已经到了！": Unload Me
Else
If Day(CDate(LastExitTime)) <> Day(Now) Then
RunDays = CStr(DateDiff("d", CDate(LastExitTime), Date) + CLng(RunDays))
Ret = WritePrivateProfileString("RunRecords", "Rundays", RunDays, "C:\Windows\RunExe.ini")
End If
End If
End If
End Sub

Private Sub Form_Load()
Call LimTime
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim LastExitTime As String * 255
LastExitTime = Now
Ret = WritePrivateProfileString("RunRecords", "LastExitTime", LastExitTime, "C:\Windows\RunExe.ini")
End Sub