*********************************************************** *********************** ** Module Name: Regwork '** Creation: Ye Fan' ** Japan: January 11, 2003 '** Modifier:' ** Japan: '** Description: Registry Operation (Different types, reading and writing methods have a certain difference)' ** version: version 1.0 '****************** *********************************************************** ************** '----------------------------------- ---------------------------- 'Register API Declaration ...'------------- -------------------------------------------------- - 'Close Login keywords Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long' create keyword Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String , phkResult As Long) As LongPrivate 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, ByRef LPSecurityAttributes as security_attributes, byref phkresult as long, byref lpdwdisposition as long) AS long 'Open keyword priva te Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long 'return key type and value Private Declare Function RegQueryValueEx_SZ Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As LongPrivate Declare Function RegQueryValueEx_DWORD 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 LongPrivate Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As string, ByVal lpReserved As Long, lpType As Long, lpData As Any, ByRef lpcbData As Long) As Long 'keyword text strings associated with a Private Declare Function RegSetValueEx_SZ Lib "advapi32" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As LongPrivate Declare Function RegSetValueEx_DWORD Lib "advapi32" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String , ByVal Reserved As Long, ByVal dwType As Long, lpData As Long, ByVal cbData As Long) As LongPrivate Declare Function RegSetValueEx_BINARY Lib "advapi32" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal Dewtype as lo NG, LPDATA AS ANY, BYVAL CBDATA AS Long AS Long
'Delete the keyword Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long' from the login to delete a key value Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "Regdeletevaluea" (Byval Hkey As Long, Byval Lpsubkey As String) AS LONG
'------------------------------------- -------------- '- Registry API constant ... "------------------------------------------------------------------------ ------------------------------------- 'The data type of the registry public enum regvalueetype [REG_SZ] = 1 'Unicode empty end string [REG_EXPAND_SZ] = 2' Unicode empty end string [reg_binary] = 3 'binary value [reg_dword] = 4' 32-bit number [REG_DWORD_BIG_ENDIAN] = 5 [reg_link] = 6 [REG_MULTI_SZ] = 7 'binary numerical string END ENUM' Registry Create Type Value ... const reg_option_non_volatile = 0 'When the system is restarted, the keyword is retained.
'Registry key security options ... Const READ_CONTROL = & H20000Const KEY_QUERY_VALUE = & H1Const KEY_SET_VALUE = & H2Const KEY_CREATE_SUB_KEY = & H4Const KEY_ENUMERATE_SUB_KEYS = & H8Const KEY_NOTIFY = & H10Const KEY_CREATE_LINK = & H20Const KEY_READ = KEY_QUERY_VALUE KEY_ENUMERATE_SUB_KEYS KEY_NOTIFY READ_CONTROLConst KEY_WRITE = KEY_SET_VALUE KEY_CREATE_SUB_KEY READ_CONTROLConst KEY_EXECUTE = Key_ReadConst key_all_access = key_query_value key_set_value _ key_create_sub_key key_enumerate_sub_keys _ key_notify key_create_link read_control
'Registry key root type ... Public Enum REGRoot [HKEY_CLASSES_ROOT] = & H80000000 [HKEY_CURRENT_USER] = & H80000001 [HKEY_LOCAL_MACHINE] = & H80000002 [HKEY_USERS] = & H80000003 [HKEY_PERFORMANCE_DATA] = & H80000004End Enum
'Return value ... const error_none = 0const error_badkey = 2const error_access_denied = 8const error_suCcess = 0' -------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- --------------------------------'-Registry Security Properties Type ...'----- -------------------------------------------------- ------- Private Type Security_attributes NLENGTH AS Long LPSecurityDescriptor as long binherithandle as booleaneEnd Type
'********************************************************** ************************ ** function name: WriteRegKey '** input: byval keyroot (regroot) - root' **: Byval Keyname (String) - Key Path '**: Byval SubkeyName (String) - Key' s **: BYVAL Subkeytype (RegvalueType) - Type of "**: Byval SubkeyValue (String) - Key value '** output: (Boolean) - successfully returns true, failed to return false '** function description: write registry "** global variable:' ** Call module: '** author: Ye Fan' ** Japan: 2003 January 2003 10th '** Modifier:' ** Japan: '** Version: Version 1.0' ************************** ******************************************************* PUBLIC FUNCTION WRITEREGKEY ByVal KeyRoot As REGRoot, ByVal KeyName As String, ByVal SubKeyName As String, ByVal SubKeyType As REGValueType, ByVal SubKeyValue As String) As Boolean Dim rc As Long 'return code Dim hKey As Long' processing a registry key Dim hDepth As Long ' DIM LPATTR AS Security_Attributes' Registry Secure Type DIM I AS INTEGER DIM B YTVALUE (1024) AS BYTE LPATTR.NLENGTH = 50 'Set security attributes are default ... lpattr.lpsecurityDescriptor = 0' ... lpattr.binherithandle = true '...
'------------------------------------- ----------- '- Create / Open Registry Key ...' -------------------------- -------------------------------- RC = RegcreateKeyex (Keyroot, Keyname, 0, Subkeytype, REG_OPTION_NON_VOLATILE, Key_All_Access, LPATTR, HKEY, HDEPTH) 'Creating / Open // Keyroot // Keyname if (RC <> Error_Success) Then Goto CreateKeyError' error handling ... '----------------- ----------------------------------------- '- Create / Modify Keywords Value ... '--------------------------------------------- --------------- If (SubkeyValue = ") THEN SubkeyValue =" "To let regsetValueex () work need to enter a space ... SELECT CASE SubkeyType 'Search Data Type .. Case reg_sz, REG_EXPAND_SZ 'String Registry Keyword Data Type "------------------------------------- ------------------------------ RC = RegSetValueex_sz (HKEY, SubkeyName, 0, Subkeytype, BY Val SubkeyValue, LeNB (StrConv (SUBKEYVALUE, VBFROMUNICODE))) IF (RC <> Error_Success) Then Goto CreateKeyError 'error handling' ----------------------- ------------------------------------------- Case Reg_dword 'four-byte registration Table Keyword Data Type '-------------------------------------------------------------------------------------------------------------------------------------- ----------------------- Rc = RegSetValueex_dword (HKEY, SubkeyName, 0, Subkeytype, VAL ("& H " , 4) IF (RC < > Error_Success) Then Goto CreateKeyError 'error handling'
-------------------------------------------------- ----------------- Case Reg_binary 'binary string' -------------------------- ---------------------------------------- DIM INTNUM AS INTEger INTNUM = 0 for i = 1 to Len (Trim (SubkeyValue) - 1 Step 3 INTNUM = INTNUM 1 Bytvalue (INTNUM - 1) = VAL ("& H" MID (SubkeyValue, I, 2)) Next I RC = RegSetValueex_binary (HKEY, SubkeyName , 0, Subkeytype, BytValue (0), INTNUM) IF (RC <> Error_Success) Then Goto CreateKeyError 'error handling' -------------------------------------------------------------------------------------------------------------------------- ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- -------------------------------------------------- -------------- Goto CreateKeyError 'error handling' ---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- -------------------------------------- End Select '- Close the registry keyword. .. '--------------------------------------------- ------------- rc = regclosekey (HKEY) 'Close Keyword WriteRegKey = true' Return successful exit function 'Exit' ------------------------------------------------------------------------------ -------------------------------------------------- --------------------------- CreateKeyError: WriteRegKey = false 'Setup error Returns RC = regcloseKey (HKEY)' Try to close the keyword END FUNCTION
'********************************************************** ************************ ** function name: readRegKey '** input: keyroot (long) - root' **: keyName (String ) - Key path '**: Subkeyref (String) - key name' ** output: (string) - Return key value '** function description: Read Registry' ** global variable: '** Call Module: '** author: Ye Fan' ** Japanese issue: January 10, 2003 "** Modifier: '** Japan:' ** Version: Version 1.0 '******** *********************************************************** ************** PUBLIC FUNCTION READREGKEY (BYVAL KeyRoot As Regroot, Byval Keyname As String, Byval SubkeyName As String) AS STRING DIM I AS Long 'Return Code DIM HKEY As Long 'Treatment Opening Registry Keyword DIM HDEPTH AS Long' DIM SKEYVAL AS STRING DIM LKEYVALTYPE AS Long 'Registry Keyword Data Type DIM TMPVAL AS STRING' Registry Temporary Memory Temporary Memory AS Long 'Registration Keyword Variable Size Dim Lngvalue As Long Dim Bytvalue (1024) AS BYTE' ------------------------------- ---------------------------- "Open registration keyword under Keyroot '----------- ------------------------------------------------ RC = RegopenKeyex (Keyroot, Keyname, 0, Key_all_access, HKEY) 'Open Registry Keyword IF (RC <> Error_Success) Then Goto getKeyError' handle ... '-------------- -------------------------------------------- 'detection key Types of '
-------------------------------------------------- -------- RC = RegQueryValueex (HKEY, SubkeyName, 0, LKeyvalType, Byval 0, Keyvalsize "get / create keyword value if (rc <> error_success) Then Goto getKeyError 'handling error .. . '------------------------------------------------ ------------ 'Read the corresponding key value' ----------------------------- ---------------------------- SELECT CASE LKEYVALTYPE 'Search Data Type ... Case Reg_SZ, REG_EXPAND_SZ' String Registry Keyword Data type '------------------------------ Tmpval = string $ (1024, 0)' allocating variable space Keyvalsize = 1024 'Marker Variable Size RC = RegQueryValueex_sz (HKEY, SubkeyName, 0, 0, Tmpval, Keyvalsize)' Get / create keywords IF rc <> error_success the goto getKeyError 'error handling IF INSTR (TmpVal, Chr (0))> 0 Then Skeyval = Left (TmpVal, INSTR (TmpVal, Chr (0)) - 1) 'Copy string value' ------------ -------------------- Case reg_dword 'four-byte registry keyword data type' ----------------- --------------- Keyvalsize = 1024 'Tag Variable Size RC = RegQueryValueex_dword (HKEY, SubkeyName, 0, 0, LNGVALUE, Keyvalsize)' Get / create keyword IF RC <> Error_Success Ten Goto getKeyError 'error handling SKEYVAL = "0x" Hex (LNGVALUE)'
-------------------------------- Case reg_binary 'binary string' ----------- -------------------- RC = RegQueryValueex (HKEY, SUBEYNAME, 0, 0, BYTVALUE (0), Keyvalsize 'get / create keyword value IF rc <> Error_suCcess Then GotKeyError 'Error Handling SKEYVAL = "" for i = 1 to Keyvalsize If LEN (Hex $ (Bytvalue (i - 1))) = 1 Then Skeyval = SKEYVAL "0" HEX (i - 1))) "" Else Skeyval = SKEYVAL HEX (BytValue (i - 1)) "" Endiff next I '---------------------------------------------------------------------------------------------------------------------------------- ---------- Case Else '------------------------------- SKEYVAL = "" ------------------------------------------------- ------------------------- ReadRegKey = SKEYVAL 'Return Value RC = RegcloseKey (HKEY)' Close Registry Keyword EXIT FUNCTION 'Exit' -------------------------------------------------------------------------------------------------------------------------- -------------------------------------------------- -------------- GetKeyError: 'Error happened after the clerution ... ReadRegKey = "" Set the return value for error RC = regcloseKey (HKEY)' Close Registry Keyword END FUNCTION
'********************************************************** ************************ ** function name: delRegKey '** input: keyroot (long) - root' **: keyName (String ) - Key path '**: Subkeyref (string) - button name' ** output: (long) - Status code '** Function Description: Delete Keyword' ** Global Variable: '** Call Module:' ** Author: Ye Fan '** Japan: January 11th, 2003 "** Modifier:' ** Japan: '** Version: Version 1.0' ********* *********************************************************** ************* PUBLIC FUNCTION DELREGKEY (Byval KeyRoot As Regroot, Byval Keyname As String, Byval SubkeyName As String) AS Longdim LKEYID AS Long Dim Lresult As Long DelRegKey = 0 'Assumption Success' Detection Settings Parameter if let's not set, return the corresponding error code DELREGKEY = Error_badkey exit function end if 'opens the keyword and try to create it, return ID if already existing LRESULT = RegcreateKey (Keyroot, Keyname, LKEYID) if Lresult = 0 THEN 'Delete Keyword DelregKey = RegdeleteKey (LKEYID, BYVAL SUBEYNAME) Endiff
End function '****************************************************************** ************************** ** Function Name: DelregValue '** input: Keyroot (long) - root' **: keyname (String) - Key Path '**: Subkeyref (String) - Key name' ** output: (long) - Status code '** Function Description: Delete a value from the login keyword' ** global variable: '** Call Module:' ** Server: Ye Fan '** Japan: January 11, 2003' ** Modifier: '** Japan:' ** Edition: Version 1.0 '*** *********************************************************** **************************** PUBLIC FUNCTION DELREGVALUE (Byval KeyRoot As Regroot, Byval Keyname As String, Byval SubkeyName As String) AS Longdim LKEYID AS Long Dim Lresult As Long DelRegvalue = 0 'Assume Success' Detecting Parameter if Len (Keyname) = 0 and Len (SubkeyName) = 0 The 'key value is not set, return the corresponding error code DELREGVALUE = Error_Badkey EXIT FUNCTION END IF' Opens the keyword and try to create it, If already existing, return the ID value LResult = regreateKey (Keyroot, Keyname, LKEYID) if Lresult = 0 THEN 'removes a value from the login keyword DELREGVALUE = RegdeleteValue (LKEYID, BYVAL SUBEYNAME) END IF
END FUNCTION
