Dear visitor, welcome to Jabaco - Community. If this is your first visit here, please read the Help. It explains in detail how this page works. To use all features of this page, you should consider registering. Please use the registration form, to register here or read more information about the registration process. If you are already registered, please login here.
Intermediate
Date of registration: Jan 1st 2009
Location: Hanover, Germany
Occupation: Software Engineer
Hobbies: Hilbert Curves
Intermediate
Date of registration: Jan 1st 2009
Location: Hanover, Germany
Occupation: Software Engineer
Hobbies: Hilbert Curves
Jabaco Source |
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 |
Option Explicit ' download from http://www.gjt.org/download/time/java/jnireg/registry-3.1.3.zip Import com#ice#jni#registry ' make sure that "registry.jar" from JNIRegistry is part of the project classpath ' copy ICE_JNIRegistry.dll to the Jabaco project directory (= the home directory of your project) Public Sub Form_Load() Dim s As String registryValueCreate s = registryValueRead() Debug.Print "s = '" & s & "'" End Sub ' cf. http://www.java-forum.org/java-basics-anfaenger-themen/24130-jniregistry-bedienen-blicks.html Private Sub registryValueCreate() Const topLevelKey = "HKLM" Dim topKey As RegistryKey = Registry.getTopLevelKey(topLevelKey) Dim localKey As RegistryKey Dim jabaco1_4 As RegistryKey Dim rv As RegStringValue On Error Goto ErrHandler localKey = topKey.openSubKey("SOFTWARE\Jabaco") jabaco1_4 = localKey.openSubKey("1.4", RegistryKey.ACCESS_WRITE) rv = New RegStringValue(localKey, "test", "12345") jabaco1_4.setValue(rv) Exit Sub ErrHandler: Debug.Print Err.getMessage() End Sub Private Function registryValueRead() As String Const topLevelKey = "HKLM" Dim topKey As RegistryKey = Registry.getTopLevelKey(topLevelKey) Dim localKey As RegistryKey Dim jabaco1_4 As RegistryKey On Error Goto ErrHandler localKey = topKey.openSubKey("SOFTWARE\Jabaco") jabaco1_4 = localKey.openSubKey("1.4", RegistryKey.ACCESS_READ) registryValueRead = jabaco1_4.getStringValue("test") Exit Function ErrHandler: Debug.Print Err.getMessage() End Function# |
Intermediate
Date of registration: Jan 1st 2009
Location: Hanover, Germany
Occupation: Software Engineer
Hobbies: Hilbert Curves
Jabaco Source |
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 |
Option Explicit ' ' mdlRegistry - Routines for Registry access ' ' (copied from MSDN) ' ' 0.0 A1880 30-Apr-2003 1st version ' '====================================================================== Public Const ERROR_SUCCESS = 0 Public Const ERROR_NONE = 0 Public Const ERROR_BADDB = 1 Public Const ERROR_BADKEY = 2 Public Const ERROR_CANTOPEN = 3 Public Const ERROR_CANTREAD = 4 Public Const ERROR_CANTWRITE = 5 Public Const ERROR_OUTOFMEMORY = 6 Public Const ERROR_ARENA_TRASHED = 7 Public Const ERROR_INVALID_PARAMETER = 7 Public Const ERROR_ACCESS_DENIED = 8 Public Const ERROR_INVALID_PARAMETERS = 87 Public Const ERROR_NO_MORE_ITEMS = 259 Public Const HKEY_CLASSES_ROOT = &H80000000 Public Const HKEY_CURRENT_CONFIG = &H80000005 Public Const HKEY_CURRENT_USER = &H80000001 Public Const HKEY_LOCAL_MACHINE = &H80000002 Public Const HKEY_USERS = &H80000003 Public Const KEY_ALL_ACCESS = &H3F Public Const KEY_QUERY_VALUE = &H1 Public Const REG_NONE = 0 'No value type Public Const REG_SZ = 1 'Unicode null terminated string Public Const REG_EXPAND_SZ = 2 'Unicode null terminated string Public Const REG_BINARY = 3 'Free form binary Public Const REG_DWORD = 4 '32-bit number Public Const REG_DWORD_LITTLE_ENDIAN = 4 '(same as REG_DWORD) Public Const REG_DWORD_BIG_ENDIAN = 5 '32-bit number Public Const REG_LINK = 6 'Symbolic Link (unicode) Public Const REG_MULTI_SZ = 7 'Multiple Unicode strings Public 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 RegQueryValueEx Lib "advapi32" Alias _ "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName$, ByVal _ lpdwReserved As Long, lpdwType As Long, lpData As Any, 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 ' SetValueEx and QueryValueEx Wrapper Functions: 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 & Chr$(0) 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 Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As _ String, vValue As Variant) As Long Dim cch As Long Dim lrc As Long Dim lType As Long Dim lValue As Long Dim sValue As String On Error GoTo QueryValueExError ' Determine the size and type of data to be read lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch) If lrc <> ERROR_NONE Then Error 5 Select Case lType ' For strings Case REG_SZ: sValue = String(cch, 0) lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, _ sValue, cch) If lrc = ERROR_NONE Then vValue = Left$(sValue, cch - 1) Else vValue = Empty End If ' For DWORDS Case REG_DWORD: lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, _ lValue, cch) If lrc = ERROR_NONE Then vValue = lValue Case Else 'all other data types not supported lrc = -1 End Select QueryValueExExit: QueryValueEx = lrc Exit Function QueryValueExError: Resume QueryValueExExit End Function Public Function getOfficePath(appName As String) As String Dim hKey As Long Dim RetVal As Long Dim sProgId As String Dim sCLSID As String Dim sPath As String sProgId = appName sPath = "" 'First, get the clsid from the progid 'from the registry key: 'HKEY_LOCAL_MACHINE\Software\Classes\<PROGID>\CLSID RetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "Software\Classes" & _ sProgId & "\CLSID", 0&, KEY_ALL_ACCESS, hKey) If RetVal = 0 Then Dim n As Long RetVal = RegQueryValueEx(hKey, "", 0&, REG_SZ, "", n) sCLSID = Space(n) RetVal = RegQueryValueExString(hKey, "", 0&, REG_SZ, sCLSID, n) sCLSID = Left(sCLSID, n - 1) 'drop null-terminator RegCloseKey hKey End If 'Now that we have the CLSID, locate the server path at 'HKEY_LOCAL_MACHINE\Software\Classes\CLSID\ ' {xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxx}\LocalServer32 RetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, _ "Software\Classes\CLSID" & sCLSID & "\LocalServer32", 0&, _ KEY_ALL_ACCESS, hKey) If RetVal = 0 Then RetVal = RegQueryValueEx(hKey, "", 0&, REG_SZ, "", n) sPath = Space(n) RetVal = RegQueryValueExString(hKey, "", 0&, REG_SZ, sPath, n) sPath = Left(sPath, n - 1) RegCloseKey hKey End If getOfficePath = sPath End Function |
This post has been edited 1 times, last edit by "A1880" (Sep 29th 2010, 11:05pm)
Intermediate
Date of registration: Jan 1st 2009
Location: Hanover, Germany
Occupation: Software Engineer
Hobbies: Hilbert Curves