Hello guys
While I searched the Internet, I found a function that, I think, implants a file in the computer's registry to prevent the database from being copied and transferred to another computer. I hope someone with experience will tell me if my words are accurate. Can I prevent the transfer or copying of the database from one computer to another computer?
Thanks everyone
While I searched the Internet, I found a function that, I think, implants a file in the computer's registry to prevent the database from being copied and transferred to another computer. I hope someone with experience will tell me if my words are accurate. Can I prevent the transfer or copying of the database from one computer to another computer?
Thanks everyone
Code:
Public Function set_db_properties(ByVal val As Boolean)
Dim ok As Boolean
Dim db As Database
On Error GoTo err
Set db = CurrentDb
' ok = ChangeProperty("StartUpShowDBWindow", dbBoolean, val)
' ok = ChangeProperty("AllowToolbarChanges", dbBoolean, val)
' ok = ChangeProperty("AllowBReakIntoCode", dbBoolean, val)
' ok = ChangeProperty("AllowSpecialKeys", dbBoolean, val)
' ok = ChangeProperty("AllowBypassKey", dbBoolean, val)
' AppTitle
' ok = ChangeProperty("AppTitle", dbBoolean, val)
' ok = ChangeProperty("AppIcon", dbBoolean, val)
' ok = ChangeProperty("StartupMenuBar", dbBoolean, val)
' ok = ChangeProperty("StartupShortcutMenuBar", dbBoolean, val)
' ok = ChangeProperty("AllowFullMenus", dbBoolean, val)
' ok = ChangeProperty("AllowShortcutMenus", dbBoolean, val)
' ok = ChangeProperty("AllowBuiltInToolbars", dbBoolean, val)
Exit Function
err:
MsgBox err.Number & " : " & err.Description
End Function
Function ChangeProperty(strPropName As String, varPropType As Variant, varPropValue As Variant) As Boolean
Dim dbs As Database, prp As Property
Const conPropNotFoundError = 3270
Set dbs = CurrentDb
On Error GoTo Change_Err
dbs.Properties(strPropName) = varPropValue
ChangeProperty = True
Change_Bye:
Exit Function
Change_Err:
If err = conPropNotFoundError Then ' Property not found.
Set prp = dbs.CreateProperty(strPropName, varPropType, varPropValue)
dbs.Properties.Append prp
Resume Next
Else
' Unknown error.
ChangeProperty = False
Resume Change_Bye
End If
End Function
Code:
Global Const REG_SZ As Long = 1
Global Const REG_DWORD As Long = 4
Global Const HKEY_CLASSES_ROOT = &H80000000
Global Const HKEY_CURRENT_USER = &H80000001
Global Const HKEY_LOCAL_MACHINE = &H80000002
Global Const HKEY_USERS = &H80000003
Global Const ERROR_NONE = 0
Global Const ERROR_BADDB = 1
Global Const ERROR_BADKEY = 2
Global Const ERROR_CANTOPEN = 3
Global Const ERROR_CANTREAD = 4
Global Const ERROR_CANTWRITE = 5
Global Const ERROR_OUTOFMEMORY = 6
Global Const ERROR_INVALID_PARAMETER = 7
Global Const ERROR_ACCESS_DENIED = 8
Global Const ERROR_INVALID_PARAMETERS = 87
Global Const ERROR_NO_MORE_ITEMS = 259
Global Const KEY_ALL_ACCESS = &H3F
Global Const REG_OPTION_NON_VOLATILE = 0
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Declare Function RegCreateKeyEx Lib "advapi32.dll" 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, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long
Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long
Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long
Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
Private Declare Function RegDeleteKey& Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String)
Private Declare Function RegDeleteValue& Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String)
Public Function DeleteKey(lPredefinedKey As Long, sKeyName As String)
' Description:
' This Function will Delete a key
'
' Syntax:
' DeleteKey Location, KeyName
'
' Location must equal HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_lOCAL_MACHINE
' , HKEY_USERS
'
' KeyName is name of the key you wish to delete, it may include subkeys (example "Key1\SubKey1")
Dim lRetVal As Long 'result of the SetValueEx function
Dim hKey As Long 'handle of open key
'open the specified key
'lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = RegDeleteKey(lPredefinedKey, sKeyName)
'RegCloseKey (hKey)
End Function
Public Function DeleteValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)
' Description:
' This Function will delete a value
'
' Syntax:
' DeleteValue Location, KeyName, ValueName
'
' Location must equal HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_lOCAL_MACHINE
' , HKEY_USERS
'
' KeyName is the name of the key that the value you wish to delete is in
' , it may include subkeys (example "Key1\SubKey1")
'
' ValueName is the name of value you wish to delete
Dim lRetVal As Long 'result of the SetValueEx function
Dim hKey As Long 'handle of open key
'open the specified key
lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = RegDeleteValue(hKey, sValueName)
RegCloseKey (hKey)
End Function
Public Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long
Dim lValue As Long
Dim sValue As String
Select Case lType
Case REG_SZ
sValue = vValue
SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))
Case REG_DWORD
lValue = vValue
SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)
End Select
End Function
