⑴ 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