各位高手,在下今天有一个问题请教,还望赐教:
一个共享软件,我如何提供给试用者一段试用的时期或次数,将来通过购买正版后给予序列号来解除呢?!
我想用读写注册表的方法来实现,可问题是一.手边找不着不可逆的加解密算法程序,二是如果不用savesetting or getsetting函数(太容易破解),我不知道其它读写注册的函数,还忘各路大侠指点!^_^不胜感激!
...全文
3034打赏收藏
如何将字符串加密解密后读写入注册表
各位高手,在下今天有一个问题请教,还望赐教: 一个共享软件,我如何提供给试用者一段试用的时期或次数,将来通过购买正版后给予序列号来解除呢?! 我想用读写注册表的方法来实现,可问题是一.手边找不着不可逆的加解密算法程序,二是如果不用savesetting or getsetting函数(太容易破解),我不知道其它读写注册的函数,还忘各路大侠指点!^_^不胜感激!
'Structures Needed For Registry Prototypes
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Boolean
End Type
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
'Registry Function Prototypes
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" _
(ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegSetValueExStr Lib "advapi32" Alias "RegSetValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
ByVal dwType As Long, ByVal szData As String, ByVal cbData As Long) As Long
Private Declare Function RegSetValueExLong Lib "advapi32" Alias "RegSetValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
ByVal dwType As Long, szData As Long, ByVal cbData As Long) As Long
Private Declare Function RegSetValueExByte Lib "advapi32" Alias "RegSetValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
ByVal dwType As Long, szData As Byte, ByVal cbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
Private Declare Function RegQueryValueExStr Lib "advapi32" Alias "RegQueryValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
ByRef lpType As Long, ByVal szData As String, ByRef lpcbData As Long) As Long
Private Declare Function RegQueryValueExLong Lib "advapi32" Alias "RegQueryValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
ByRef lpType As Long, szData As Long, ByRef lpcbData As Long) As Long
Private Declare Function RegQueryValueExByte Lib "advapi32" Alias "RegQueryValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
ByRef lpType As Long, szData As Byte, ByRef lpcbData As Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32" Alias "RegCreateKeyExA" _
(ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, _
ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, _
lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, _
lpdwDisposition As Long) As Long
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" _
(ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, _
lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, _
lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long
Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" ( _
ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, _
ByVal cbName As Long) As Long
Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" _
(ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, _
lpcbValueName As Long, ByVal lpReserved As Long, ByVal lpType As Long, _
ByVal lpData As Long, ByVal lpcbData As Long) As Long
Private Declare Function RegEnumValueLong Lib "advapi32.dll" Alias "RegEnumValueA" _
(ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, _
lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, _
lpData As Long, lpcbData As Long) As Long
Private Declare Function RegEnumValueStr Lib "advapi32.dll" Alias "RegEnumValueA" _
(ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, _
lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, _
ByVal lpData As String, lpcbData As Long) As Long
Private Declare Function RegEnumValueByte Lib "advapi32.dll" Alias "RegEnumValueA" _
(ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, _
lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, _
lpData As Byte, lpcbData As Long) As Long
Private Declare Function RegQueryInfoKey Lib "advapi32.dll" Alias "RegQueryInfoKeyA" _
(ByVal hKey As Long, ByVal lpClass As String, _
lpcbClass As Long, ByVal lpReserved As Long, lpcSubKeys As Long, _
lpcbMaxSubKeyLen As Long, lpcbMaxClassLen As Long, lpcValues As Long, _
lpcbMaxValueNameLen As Long, lpcbMaxValueLen As Long, lpcbSecurityDescriptor As Long, _
lpftLastWriteTime As Any) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" _
(ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" _
(ByVal hKey As Long, ByVal lpValueName As String) As Long
' Other declares:
'Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Private Declare Function ExpandEnvironmentStrings Lib "kernel32" Alias "ExpandEnvironmentStringsA" (ByVal lpSrc As String, ByVal lpDst As String, ByVal nSize As Long) As Long
Public Enum ERegistryClassConstants
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_USER = &H80000001
HKEY_LOCAL_MACHINE = &H80000002
HKEY_USERS = &H80000003
End Enum
Public Enum ERegistryValueTypes
'Predefined Value Types
REG_NONE = (0) 'No value type
REG_SZ = (1) 'Unicode nul terminated string
REG_EXPAND_SZ = (2) 'Unicode nul terminated string w/enviornment var
REG_BINARY = (3) 'Free form binary
REG_DWORD = (4) '32-bit number
REG_DWORD_LITTLE_ENDIAN = (4) '32-bit number (same as REG_DWORD)
REG_DWORD_BIG_ENDIAN = (5) '32-bit number
REG_LINK = (6) 'Symbolic Link (unicode)
REG_MULTI_SZ = (7) 'Multiple Unicode strings
REG_RESOURCE_LIST = (8) 'Resource list in the resource map
REG_FULL_RESOURCE_DESCRIPTOR = (9) 'Resource list in the hardware description
REG_RESOURCE_REQUIREMENTS_LIST = (10)
End Enum
Private Sub GetRootSubKey(Key As String, Root As String, ClassKey As ERegistryClassConstants, SubKey As String, ValueKey As String)
Dim vt As Variant
vt = Split(Key, "\")
Dim l As Long
l = UBound(vt)
If l > 0 Then
Root = UCase$(vt(0))
Select Case Root
Case "HKEY_CURRENT_USER"
ClassKey = HKEY_CURRENT_USER
Case "HKEY_LOCAL_MACHINE"
ClassKey = HKEY_LOCAL_MACHINE
Case "HKEY_USERS"
ClassKey = HKEY_USERS
Case "HKEY_CLASSES_ROOT"
ClassKey = HKEY_CLASSES_ROOT
'Case "HKEY_PERFORMANCE_DATA"
'Case "HKEY_DYN_DATA"
'Case "HKEY_CURRENT_CONFIG"
Case Else
GoTo InvalidArg
End Select
ValueKey = vt(l)
For l = l - 1 To 1 Step -1
Dim b As Boolean
If b Then
SubKey = vt(l) & "\" & SubKey
Else
b = True
SubKey = vt(l)
End If
Next
Else
InvalidArg:
Err.Raise 5 + 512, , "无效的键名路径"
End If
End Sub
Public Sub DeleteRegSetting(Key As String)
Dim Root As String
Dim SubKey As String
Dim ValueKey As String
Dim ClassKey As ERegistryClassConstants
Dim hKey As Long
If Len(ValueKey) > 0 Then
Dim e As Long
e = RegOpenKeyEx(ClassKey, SubKey, 0, KEY_QUERY_VALUE, hKey)
If e Then
GoTo ErrorHandle
End If
e = RegDeleteValue(hKey, ValueKey)
RegCloseKey hKey
If e Then
GoTo ErrorHandle
End If
Else
e = RegDeleteKey(ClassKey, SubKey)
If e Then
ErrorHandle:
Err.Raise 5 + 512, , GetSystemError(e) '"无效的键名路径"
End If
End If
End Sub
Public Function GetRegSetting(Key As String, Optional Default As Variant) As Variant
Dim vValue As Variant
Dim cData As Long, sData As String, ordType As Long, e As Long
Dim hKey As Long
Dim Root As String
Dim SubKey As String
Dim ValueKey As String
Dim ClassKey As ERegistryClassConstants
e = RegOpenKeyEx(ClassKey, SubKey, 0, KEY_QUERY_VALUE, hKey)
If e = 0 Then
e = RegQueryValueExLong(hKey, ValueKey, 0&, ordType, 0&, cData)
If e = 0 Or e = ERROR_MORE_DATA Then
Select Case ordType
Case REG_DWORD, REG_DWORD_LITTLE_ENDIAN
Dim iData As Long
e = RegQueryValueExLong(hKey, ValueKey, 0&, _
ordType, iData, cData)
vValue = CLng(iData)
Case REG_DWORD_BIG_ENDIAN ' Unlikely, but you never know
Dim dwData As Long
e = RegQueryValueExLong(hKey, ValueKey, 0&, _
ordType, dwData, cData)
vValue = SwapEndian(dwData)
Case REG_SZ, REG_MULTI_SZ ' Same thing to Visual Basic
sData = String$(cData - 1, 0)
e = RegQueryValueExStr(hKey, ValueKey, 0&, _
ordType, sData, cData)
vValue = sData
Case REG_EXPAND_SZ
sData = String$(cData - 1, 0)
e = RegQueryValueExStr(hKey, ValueKey, 0&, _
ordType, sData, cData)
vValue = ExpandEnvStr(sData)
' Catch REG_BINARY and anything else
Case Else
Dim abData() As Byte
ReDim abData(cData - 1)
e = RegQueryValueExByte(hKey, ValueKey, 0&, _
ordType, abData(0), cData)
vValue = abData
End Select
End If
RegCloseKey hKey
End If
If e Then
If IsMissing(Default) Then
Err.Raise 5 + 512, , GetSystemError(e) ' "无效的键名路径"
Else
vValue = Default
End If
End If
GetRegSetting = vValue
End Function
Private Function SwapEndian(ByVal dw As Long) As Long
' CopyMemory ByVal VarPtr(SwapEndian) + 3, dw, 1
' CopyMemory ByVal VarPtr(SwapEndian) + 2, ByVal VarPtr(dw) + 1, 1
' CopyMemory ByVal VarPtr(SwapEndian) + 1, ByVal VarPtr(dw) + 2, 1
' CopyMemory SwapEndian, ByVal VarPtr(dw) + 3, 1
Dim l0 As Long
Dim l1 As Long
Dim l2 As Long
Dim l3 As Long
Dim bt(3) As Byte
Dim l As Long
For l = 0 To 3
bt(l) = dw Mod &H100
dw = dw \ &H100
Next
dw = bt(3)
For l = 2 To 0 Step -1
dw = dw * &H100 + bt(l)
Next
SwapEndian = dw
End Function
Private Function ExpandEnvStr(sData As String) As String
Dim c As Long, s As String
' Get the length
s = "" ' Needed to get around Windows 95 limitation
c = ExpandEnvironmentStrings(sData, s, c)
' Expand the string
s = String$(c - 1, 0)
c = ExpandEnvironmentStrings(sData, s, c)
ExpandEnvStr = s
End Function
Public Sub SaveRegSetting(Key As String, ByVal vValue As Variant)
Dim ordType As Long
Dim c As Long
Dim hKey As Long
Dim e As Long
Dim lCreate As Long
Dim tSA As SECURITY_ATTRIBUTES
'Open or Create the key
Dim Root As String
Dim SubKey As String
Dim ValueKey As String
Dim ClassKey As ERegistryClassConstants
e = RegCreateKeyEx(ClassKey, SubKey, 0, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, tSA, hKey, lCreate)
If e Then
Err.Raise 5 + 512, , GetSystemError(e) ' "无效的键名路径"
Else
Select Case VarType(vValue)
Case vbArray + vbByte
Dim ab() As Byte
ab = vValue
ordType = REG_BINARY
c = UBound(ab) - LBound(ab) + 1
e = RegSetValueExByte(hKey, ValueKey, 0&, ordType, ab(0), c)
Case vbInteger, vbLong
Dim i As Long
i = vValue
ordType = REG_DWORD
e = RegSetValueExLong(hKey, ValueKey, 0&, ordType, i, 4)
Case Else
Dim s As String, iPos As Long
s = vValue
ordType = REG_SZ
' Assume anything with two non-adjacent percents is expanded string
iPos = InStr(s, "%")
If iPos Then
If InStr(iPos + 2, s, "%") Then
ordType = REG_EXPAND_SZ
End If
End If
c = Len(s) + 1
e = RegSetValueExStr(hKey, ValueKey, 0&, ordType, s, c)
End Select
'Close the key
RegCloseKey hKey
If e Then
Err.Raise 5 + 512, , GetSystemError(e) '"不能储存"
End If
End If
End Sub
Public Function GetAllRegKeys(Key As String) As Variant
Dim Root As String
Dim SubKey As String
Dim ValueKey As String
Dim ClassKey As ERegistryClassConstants
Dim lResult As Long
Dim hKey As Long
Dim sName As String
Dim lNameSize As Long
Dim sData As String
Dim lIndex As Long
Dim cJunk As Long
Dim cNameMax As Long
Dim ft As Currency
' Log "EnterEnumerateValues"
Dim iKeyCount As Integer
Dim sKeyNames() As String
If (lResult = ERROR_SUCCESS) Then
' Log "OpenedKey:" & m_hClassKey & "," & m_sSectionKey
lResult = RegQueryInfoKey(hKey, vbNullString, cJunk, 0, _
cJunk, cJunk, cJunk, cJunk, _
cNameMax, cJunk, cJunk, ft)
Do While lResult = ERROR_SUCCESS
'Set buffer space
lNameSize = cNameMax + 1
sName = String$(lNameSize, 0)
If (lNameSize = 0) Then lNameSize = 1
' Log "Requesting Next Value"
'Get value name:
lResult = RegEnumValue(hKey, lIndex, sName, lNameSize, _
0&, 0&, 0&, 0&)
' Log "RegEnumValue returned:" & lResult
If (lResult = ERROR_SUCCESS) Then
' Although in theory you can also retrieve the actual
' value and type here, I found it always (ultimately) resulted in
' a GPF, on Win95 and NT. Why? Can anyone help?