熱點推薦:
您现在的位置: 電腦知識網 >> 編程 >> .NET編程 >> 正文

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

2013-11-13 09:50:18  來源: .NET編程 

  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
    推薦文章
    Copyright © 2005-2013 電腦知識網 Computer Knowledge   All rights reserved.