客戶端-一個關於VB設計注冊機的問題

一個關於VB設計注冊機的問題

照其他資料寫了分別為：”獲取計算機某碼“、”利用計算機某碼生成注冊碼“、”利用注冊碼登錄主程序“這三個程序，那麼，下面怎麼做？如何寫一個主機端，主機端可以為注冊碼：“設置時間限制”、“給注冊碼加時間”、“通過我的主機端能看到客戶端注冊碼使用信息“這三類？
求師傅指點迷津 【提供一下思路也可以】

最佳回答：

MD5("軟件名稱和版本號"+"軟件合法使用的時間和地點信息"+"軟件作者的身份證號"+"軟件賣出的價格"+"使用者的身份證號"+"使用者的手機號"+"一個只有軟件作者知道的密碼")
VB code
Option Explicit
Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" (ByRef phProv As Long, ByVal pszContainer As String, ByVal pszProvider As String, ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptCreateHash Lib "advapi32.dll" (ByVal hProv As Long, ByVal Algid As Long, ByVal hKey As Long, ByVal dwFlags As Long, ByRef phHash As Long) As Long
Private Declare Function CryptDestroyHash Lib "advapi32.dll" (ByVal hHash As Long) As Long
Private Declare Function CryptHashData Lib "advapi32.dll" (ByVal hHash As Long, pbData As Any, ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptGetHashParam Lib "advapi32.dll" (ByVal hHash As Long, ByVal dwParam As Long, pbData As Any, pdwDataLen As Long, ByVal dwFlags As Long) As Long
Private Const HP_HASHVAL = 2
Private Const HP_HASHSIZE = 4
Private Const PROV_RSA_FULL = 1
Private Const CRYPT_NEWKEYSET = &H8
Private Const ALG_CLASS_HASH = 32768
Private Const ALG_TYPE_ANY = 0
Private Const ALG_SID_MD2 = 1
Private Const ALG_SID_MD4 = 2
Private Const ALG_SID_MD5 = 3
Private Const ALG_SID_SHA1 = 4
Enum HashAlgorithm
MD2 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD2
MD4 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD4
MD5 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5
SHA1 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA1
End Enum

Public Function HashString(ByVal Str As String, Optional ByVal Algorithm As HashAlgorithm = MD5) As String
Dim hCtx As Long
Dim hHash As Long
Dim lRes As Long
Dim lLen As Long
Dim lIdx As Long
Dim abData() As Byte

lRes = CryptAcquireContext(hCtx, vbNullString, vbNullString, PROV_RSA_FULL, 0)
If lRes <> 0 Then
lRes = CryptCreateHash(hCtx, Algorithm, 0, 0, hHash)
If lRes <> 0 Then
lRes = CryptHashData(hHash, ByVal Str, Len(Str), 0)
If lRes <> 0 Then
lRes = CryptGetHashParam(hHash, HP_HASHSIZE, lLen, 4, 0)
If lRes <> 0 Then
ReDim abData(0 To lLen - 1)
lRes = CryptGetHashParam(hHash, HP_HASHVAL, abData(0), lLen, 0)
If lRes <> 0 Then
For lIdx = 0 To UBound(abData)
HashString = HashString & Right$("0" & Hex$(abData(lIdx)), 2)
Next
End If
End If
End If
CryptDestroyHash hHash
End If
End If
CryptReleaseContext hCtx, 0
If lRes = 0 Then Err.Raise Err.LastDllError
End Function
【轉載】