如何将字符串加密解密后读写入注册表

[leaf61]

各位高手，在下今天有一个问题请教，还望赐教：
一个共享软件，我如何提供给试用者一段试用的时期或次数，将来通过购买正版后给予序列号来解除呢？！
我想用读写注册表的方法来实现，可问题是一.手边找不着不可逆的加解密算法程序，二是如果不用savesetting or getsetting函数（太容易破解），我不知道其它读写注册的函数，还忘各路大侠指点！^_^不胜感激！

[kxy]

你如果改用delphi在本站的下载中心有控件.

[Un1]

这种问题最好不要请教别人，否则分分种加密不保！^_^!

reg存储到是可以给你一个源码：

'regclass.cls

Option Explicit

'Registry Specific Access Rights
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const KEY_ALL_ACCESS = &H3F

'Open/Create Options
Private Const REG_OPTION_NON_VOLATILE = 0&
Private Const REG_OPTION_VOLATILE = &H1

'Key creation/open disposition
Private Const REG_CREATED_NEW_KEY = &H1
Private Const REG_OPENED_EXISTING_KEY = &H2

'masks for the predefined standard access types
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const SPECIFIC_RIGHTS_ALL = &HFFFF

'Define severity codes
Private Const ERROR_SUCCESS = 0&
Private Const ERROR_ACCESS_DENIED = 5
Private Const ERROR_INVALID_DATA = 13&
Private Const ERROR_MORE_DATA = 234 ' dderror
Private Const ERROR_NO_MORE_ITEMS = 259


'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

GetRootSubKey Key, Root, ClassKey, SubKey, ValueKey

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

GetRootSubKey Key, Root, ClassKey, SubKey, ValueKey

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

GetRootSubKey Key, Root, ClassKey, SubKey, ValueKey

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

GetRootSubKey Key, Root, ClassKey, SubKey, ValueKey

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

iKeyCount = 0
Erase sKeyNames()

On Error GoTo ErrorHandle

lIndex = 0
lResult = RegOpenKeyEx(ClassKey, SubKey, 0, KEY_QUERY_VALUE, hKey)

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?

sName = StrConv(LeftB$(StrConv(sName, vbFromUnicode), lNameSize), vbUnicode)
' Log "Enumerated value:" & sName

ReDim Preserve sKeyNames(iKeyCount) As String
sKeyNames(iKeyCount) = sName
iKeyCount = iKeyCount + 1
End If
lIndex = lIndex + 1
Loop

GetAllRegKeys = sKeyNames
Else
Err.Raise 5 + 512, , GetSystemError(lResult) ' "无效的键名路径"
End If
Exit Function

ErrorHandle:
RegCloseKey hKey

ReErr
End Function

[leaf61]

感谢un1给我了一封回帖，可是请问我如何与他联系呢？还有如何将分数给他呢？！

[shines77]

shouji