Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
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
''此模塊的作用是檢測用程序所在機器C盤序列號并存入一個加密后的文本文件yibao.ini中，
''在每次運行時檢測C盤序列號并與加密文本文件中的相應值進行比較如果不符提示用戶進行注冊
Public Reg_C As String
Public Reg_Key As Long
Public Jia_Mi_File As String
Public Jia_Mi_Char As String
Public Fso As New FileSystemObject
Public Ctf As TextStream
Public Function Jia_Mi_Txt()
Reg_C = Abs(GetSerialNumber("c:\"))
If Dir(App.Path & "\yibao.ini") = "" Then
''建立一個文本文件
Open App.Path & "\yibao.ini" For Output As #1
Print #1, "00000000"
Close #1
End If
Jia_Mi_File = App.Path & "\yibao.ini"
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Ctf = Fso.OpenTextFile(Jia_Mi_File, 1) ''建立 TextStream 對象 CTF
Jia_Mi_Char = ""
Do While Ctf.AtEndOfStream <> True
Jia_Mi_Char = Jia_Mi_Char & Chr(58 Xor Asc(Ctf.Read(1)))
Loop
Ctf.Close
Set Ctf = Nothing
If Jia_Mi_Char <> Int(Reg_C * 18 / 22 * 16 / 19) Then
''顯示注冊對話框
Dialog.Show 1
End If
End Function
''Text2.Text = Len(Reg_C)
Function GetSerialNumber(sroot As String) As Long
Dim lserialnum As Long
Dim r As Long
Dim strlabel As String, strtype As String
strlabel = String$(255, Chr$(0))
strtype = String$(255, Chr$(0))
r = GetVolumeInformation(sroot, strlabel, Len(strlabel), lserialnum, 0, 0, strtype, Len(strtype))
GetSerialNumber = lserialnum
''在 strLabel 中為磁盤卷標
''在 strType 中為文件系統類型
End Function
''此部分為程序加密處理模塊，負責將C盤的卷標讀并轉換成數字
''對這串數字與58進行異或處理，得到一個加密的字符串寫入yibao.ini中
''在每次運行時與文檔中的加密后字符串進行反解密比較，不成功提示用戶進行注冊
延伸閱讀
文章來源于領測軟件測試網 http://www.kjueaiud.com/
