開發手記:共享軟件注冊程序編寫實例(2)

　　Option Explicit
　　
　　Private Declare Function GetVolumeInformation Lib kernel _
　　
　　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 等到某一磁盤分區的信息
　　
　　＊＊＊＊＊＊＊＊＊＊＊＊注冊窗體＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
　　
　　運用另一個***mdb來控制軟件是否超出試用期
　　
　　Private Sub Form_Load()
　　
　　根據C盤序列號得到原ID
　　
　　Dim Driver VolName Fsys As String
　　
　　Dim volNumber MCM FSF As Long
　　
　　Driver = c:\
　　
　　Dim res As Long
　　
　　Dim localid As Long
　　
　　res = GetVolumeInformation(Driver VolName volNumber MCM FSF Fsys )
　　
　　將c盤序列號加密並顯示在注冊窗體的本機碼中
　　
　　localid = ＊＊＊＊＊volNumber＊＊＊＊＊ 加密算法
　　
　　TextText = localid顯示經加密後的本機碼
　　
　　End Sub
　　
　　Private Sub cancel_Click()
　　
　　On Error GoTo error
　　
　　檢測系統文件夾是否有***mdb文件如果沒有則是系統第一次安裝建立此數據庫文件
　　
　　If Dir(sPath & \*****) = Then
　　
　　Dim ws As Workspace
　　
　　Dim db As Database
　　
　　Dim tdf As TableDef
　　
　　Dim fld As Field
　　
　　Dim rst As Recordset
　　
　　DBEngine對象相當於Jet數據庫引擎不需要創建該對象CreateWorkspace創建一個工作區對象
　　
　　Workspace對象為用戶定義一個會話通過與之關聯的用戶名和口令建立一個安全級別當不需要安全級別時可使用缺省的工作區DBEngineWorkspace()
　　
　　Set ws = DBEngineWorkspaces()
　　
　　創建一個空的數據庫文件dbLangGeneral參數用來確定數據驅動程序支持的參數
　　
　　Set db = wsCreateDatabase(sPath & \***mdb dbLangGeneral)
　　
　　創建一張新表
　　
　　Set tdf = dbCreateTableDef(***)
　　
　　創建first_time字段
　　
　　Set fld = tdfCreateField(first_time dbDate )
　　
　　tdfFieldsAppend fld 把first_time字段添加到表中
　　
　　創建last_time字段
　　
　　Set fld = tdfCreateField(last_time dbDate )
　　
　　tdfFieldsAppend fld 把last_time字段添加到表中
　　
　　創建times字段
　　
　　Set fld = tdfCreateField(times dbInteger )
　　
　　tdfFieldsAppend fld 把times字段添加到表中
　　
　　dbTableDefsAppend tdf 將***表添加到***mdb中
　　
　　dbClose 關閉***mdb
　　
　　Set db = wsOpenDatabase(sPath & \***mdb) 以可讀寫方式打開***mdb
　　
　　Set rst = dbOpenRecordset(***) 打開一個記錄集
　　
　　With rst
　　
　　AddNew 向記錄集增加一條新記錄
　　
　　寫入一條記錄
　　
　　Fields(first_time) = Date
　　
　　Fields(last_time) = Date
　　
　　Fields(times) =
　　
　　Update 將記錄寫入數據庫
　　
　　End With
　　
　　rstClose
　　
　　dbClose 關閉***mdb
　　
　　wsClose
　　
　　**********更改系統時間來實現隱藏注冊庫的修改時間***************
　　
　　………………………………………
　　…………………………………………
　　…………………………………………………
　　
　　dbEncryptdbEncrypt (sPath & \***mdb) 數據庫加密
　　
　　Name sPath & \***mdb As sPath & \*****
　　
　　********************將時間改會原來時間************************
　　
　　…………………………
　　…………………………
　　
　　MsgBox 這是你首次啟動本系統!你的試用期為天今天是第一天謝謝使用! vbOKOnly + vbInformation 歡迎!
　　
　　***Show 啟動主窗體
　　
　　Else 系統有***mdb文件則不是第一次運行就不用建立數據庫文件了
　　
　　Dim ws As Workspace
　　
　　Dim db As Database
　　
　　Dim rst As Recordset
　　
　　Dim num As Integer
　　
　　dbEncryptdbExplain (sPath & \*****)
　　
　　Set ws = Workspaces()
　　
　　Set db = wsOpenDatabase(sPath & \*****)
　　
　　Set rst = dbOpenRecordset(***) 開始檢測用戶是否修改了系統日期
　　
　　rstMoveFirst
　　
　　If rstFields(last_time) > Date Or rstFields(times) > Then
　　
　　MsgBox 對不起你在本軟件的試用期不可以修改系統日期否則將取消您的系統試用權如果你想繼續使用本軟件請您恢復系統日期謝謝合作! vbOKOnly + vbInformation 提示
　　
　　End
　　
　　End If
　　
　　If Date rstFields(first_time) >= Then 設定試用期為天
　　
　　MsgBox vbCrLf & 你已經啟動本系統 & rstFields(times) & 次但已超過了軟件天的試用期 & vbCrLf & vbCrLf & 如果您願意繼續使用本系統請將本機碼以打電話(***********) & vbCrLf & vbCrLf & 或發郵件()的形式與***聯系來得到注冊碼! vbOKOnly + vbInformation 提示
　　
　　Else
　　
　　仍在試用期內
　　
　　num = rstFields(times)
　　
　　rstEdit
　　
　　rstFields(last_time) = Date
　　
　　rstFields(times) = num +
　　
　　rstUpdate
　　
　　MsgBox 這是你第 & rstFields(times) & 次使用本系統你還有 & (Date rstFields(first_time)) & 天的試用期祝你今天工件愉快！ vbOKOnly + vbInformation 提示
　　
　　***Show 啟動你的主窗體
　　
　　End If
　　
　　rstClose
　　
　　dbClose
　　
　　wsClose
　　
　　***************更改系統時間來實現隱藏注冊庫的修改時間***************
　　
　　……………………………………
　　
　　*****************************************************************************
　　
　　dbEncryptdbEncrypt (sPath & \***mi) 加密數據庫
　　
　　Name sPath & \***** As sPath & \***** 因在前面改動時間會影響庫中的時間故在這裡做一下假改動來達到修改時間的目的
　　
　　********************將時間改會原來時間************************
　　
　　………………………………………
　　
　　**************************************************************
　　
　　End If
　　
　　Unload register 關閉注冊窗口
　　
　　Exit Sub
　　
　　error:
　　
　　dbEncryptSaveError Registercancel_Click
　　
　　End Sub
　　
　　Private Sub enter_Click()
　　
　　On Error GoTo SaveErr:
　　
　　進行注冊驗證注冊ID
　　
　　Dim ws As Workspace
　　
　　Dim db As Database
　　
　　Dim tdf As TableDef
　　
　　Dim rst As Recordset
　　
　　Dim fld As Field
　　
　　Dim Driver VolName Fsys As String
　　
　　Dim volNumber MCM FSF As Long
　　
　　Driver = c:\
　　
　　Dim res As Long
　　
　　res = GetVolumeInformation(Driver VolName volNumber MCM FSF Fsys ) 得到硬盤序列號
　　
　　Dim Tid As Long
　　
　　Dim regid As String
　　
　　Tid = Val(TextText)
　　
　　regid = Trim(TextText)
　　
　　If regid = ******************* Then 判斷輸入的密碼是否同解密算法得到的密碼一致
　　
　　***********************更改系統時間來實現隱藏注冊庫的修改時間***************
　　
　　………………………………
　　
　　*****************************************************************************
　　
　　MsgBox 恭喜您已經注冊成功歡迎使用水利工程投資控制與評審系統 vbOKOnly + vbInformation 提示
　　
　　*****將注冊信息寫入密碼注冊庫*****
　　
　　dbEncryptdbExplain (sPath & \*****) 數據庫解密
　　
　　Set ws = DBEngineWorkspaces()
　　
　　Set db = wsOpenDatabase(sPath & \*****)
　　
　　Set rst = dbOpenRecordset(***)
　　
　　rstMoveFirst
　　
　　rstEdit
　　
　　rstFields(***) =

From:http://tw.wingwit.com/Article/program/net/201311/11710.html