| 1 | Namespace ActiveBasic
|
|---|
| 2 | Namespace Windows
|
|---|
| 3 |
|
|---|
| 4 | Enum RegistryValueKind
|
|---|
| 5 | Binary = REG_BINARY
|
|---|
| 6 | DWord = REG_DWORD
|
|---|
| 7 | ExpandString = REG_EXPAND_SZ
|
|---|
| 8 | MultiString = REG_MULTI_SZ
|
|---|
| 9 | QWord = REG_QWORD
|
|---|
| 10 | String = REG_SZ
|
|---|
| 11 | Unknown = 0
|
|---|
| 12 | End Enum
|
|---|
| 13 |
|
|---|
| 14 | Enum RegistryValueOptions
|
|---|
| 15 | DoNotExpandEnvironmentNames
|
|---|
| 16 | None
|
|---|
| 17 | End Enum
|
|---|
| 18 |
|
|---|
| 19 | Enum RegistryHive
|
|---|
| 20 | ClassesRoot = HKEY_CLASSES_ROOT
|
|---|
| 21 | CurrentConfig = HKEY_CURRENT_CONFIG
|
|---|
| 22 | CurrentUser = HKEY_CURRENT_USER
|
|---|
| 23 | DynData = HKEY_DYN_DATA
|
|---|
| 24 | LocalMachine = HKEY_LOCAL_MACHINE
|
|---|
| 25 | PerformanceData = HKEY_PERFORMANCE_DATA
|
|---|
| 26 | Users = HKEY_USERS
|
|---|
| 27 | End Enum
|
|---|
| 28 |
|
|---|
| 29 | Class RegistryKey
|
|---|
| 30 | Implements System.IDisposable
|
|---|
| 31 |
|
|---|
| 32 | Protected
|
|---|
| 33 | handle As HKEY
|
|---|
| 34 | rootkey As HKEY
|
|---|
| 35 | rootkeyname As String
|
|---|
| 36 | subkeyname As String
|
|---|
| 37 | edited As Boolean
|
|---|
| 38 |
|
|---|
| 39 | Virtual Sub ~RegistryKey( )
|
|---|
| 40 | This.Dispose( )
|
|---|
| 41 | End Sub
|
|---|
| 42 |
|
|---|
| 43 | Public
|
|---|
| 44 | 'キーの名前を取得します。
|
|---|
| 45 | Function Name( ) As String
|
|---|
| 46 | Dim name As String
|
|---|
| 47 | If IsNothing(This.subkeyname) Then
|
|---|
| 48 | name = This.rootkeyname
|
|---|
| 49 | Else
|
|---|
| 50 | name = This.rootkeyname + "\" + This.subkeyname
|
|---|
| 51 | End If
|
|---|
| 52 | Return name
|
|---|
| 53 | End Function
|
|---|
| 54 |
|
|---|
| 55 | '現在のキーのサブキーの数を取得します。
|
|---|
| 56 | Function SubKeyCount( ) As Long
|
|---|
| 57 | Dim count As DWord
|
|---|
| 58 | RegQueryInfoKey( This.handle, NULL, 0, NULL, VarPtr(count), NULL, NULL, NULL, NULL, NULL, NULL, NULL )
|
|---|
| 59 | Return count
|
|---|
| 60 | End Function
|
|---|
| 61 |
|
|---|
| 62 | 'キーの値の数を取得します。
|
|---|
| 63 | Function ValueCount( ) As Long
|
|---|
| 64 | Dim count As DWord
|
|---|
| 65 | RegQueryInfoKey( This.handle, NULL, 0, NULL, NULL, NULL, NULL, VarPtr(count), NULL, NULL, NULL, NULL )
|
|---|
| 66 | Return count
|
|---|
| 67 | End Function
|
|---|
| 68 |
|
|---|
| 69 | Public
|
|---|
| 70 | 'キーを閉じ、キーの内容が変更されている場合はディスクへフラッシュします。
|
|---|
| 71 | Sub Close( )
|
|---|
| 72 | If This.edited Then This.Flush()
|
|---|
| 73 | RegCloseKey( This.handle )
|
|---|
| 74 | End Sub
|
|---|
| 75 |
|
|---|
| 76 | '新しいサブキーを作成するか、または既存のサブキーを開きます。
|
|---|
| 77 | Function CreateSubKey( subkey As String ) As RegistryKey
|
|---|
| 78 | If IsNothing(subkey) Then Return Nothing
|
|---|
| 79 | Dim buf = subkey
|
|---|
| 80 | '末尾の\を除去
|
|---|
| 81 | If buf.EndsWith( "\" ) Then
|
|---|
| 82 | buf = buf.Remove( buf.Length - 1 )
|
|---|
| 83 | End If
|
|---|
| 84 | '先頭の\を除去
|
|---|
| 85 | If buf.StartsWith( "\" ) Then
|
|---|
| 86 | buf = buf.Remove( 0, 1 )
|
|---|
| 87 | End If
|
|---|
| 88 |
|
|---|
| 89 | Dim key As Detail._System_RegistryKey
|
|---|
| 90 | key.Root( This.rootkey )
|
|---|
| 91 | If IsNothing(This.subkeyname) Then
|
|---|
| 92 | key.SubKey( buf )
|
|---|
| 93 | Else
|
|---|
| 94 | key.SubKey( This.subkeyname + "\" + buf )
|
|---|
| 95 | End If
|
|---|
| 96 | key.Create( )
|
|---|
| 97 | Return key
|
|---|
| 98 | End Function
|
|---|
| 99 |
|
|---|
| 100 | ' Function CreateSubKey( subkey As String, permissionCheck As RegistryKeyPermissionCheck ) As RegistryKey
|
|---|
| 101 | ' TODO
|
|---|
| 102 | ' End Function
|
|---|
| 103 |
|
|---|
| 104 | ' Function CreateSubKey( subkey As String, permissionCheck As RegistryKeyPermissionCheck, registrySecurity As RegistrySecurity ) As RegistryKey
|
|---|
| 105 | ' TODO
|
|---|
| 106 | ' End Function
|
|---|
| 107 |
|
|---|
| 108 | '指定したサブキーを削除します。文字列 subkey では、大文字と小文字は区別されません。
|
|---|
| 109 | Sub DeleteSubKey ( subkey As String )
|
|---|
| 110 | If IsNothing( subkey ) Then Exit Sub
|
|---|
| 111 | This.DeleteSubKey( subkey, True )
|
|---|
| 112 | End Sub
|
|---|
| 113 | Sub DeleteSubKey ( subkey As String, throwOnMissingSubKey As Boolean )
|
|---|
| 114 | If IsNothing( subkey ) Then Exit Sub
|
|---|
| 115 | Dim key = This.OpenSubKey(subkey)
|
|---|
| 116 | If key.SubKeyCount <> 0 Then
|
|---|
| 117 | key.Close()
|
|---|
| 118 | If throwOnMissingSubKey Then
|
|---|
| 119 | Throw New InvalidOperationException
|
|---|
| 120 | Else
|
|---|
| 121 | Exit Sub
|
|---|
| 122 | End If
|
|---|
| 123 | End If
|
|---|
| 124 | RegDeleteKey( This.handle, ToTCStr(subkey) )
|
|---|
| 125 | This.edited = True
|
|---|
| 126 | End Sub
|
|---|
| 127 |
|
|---|
| 128 | 'サブキーとその子サブキーを再帰的に削除します。文字列 subkey では、大文字と小文字は区別されません。
|
|---|
| 129 | Sub DeleteSubKeyTree ( subkey As String )
|
|---|
| 130 | If IsNothing( subkey ) Then Exit Sub
|
|---|
| 131 | Dim key = This.OpenSubKey( subkey )
|
|---|
| 132 | If key.SubKeyCount <> 0 Then
|
|---|
| 133 | Dim list = key.GetSubKeyNames()
|
|---|
| 134 | Dim s As String
|
|---|
| 135 | Foreach s In list
|
|---|
| 136 | key.DeleteSubKeyTree( s )
|
|---|
| 137 | Next
|
|---|
| 138 | End If
|
|---|
| 139 | This.DeleteSubKey( subkey, False )
|
|---|
| 140 | End Sub
|
|---|
| 141 |
|
|---|
| 142 | '指定した値をこのキーから削除します。
|
|---|
| 143 | Sub DeleteValue ( name As String )
|
|---|
| 144 | If IsNothing( name ) Then Exit Sub
|
|---|
| 145 | This.DeleteValue( name, True )
|
|---|
| 146 | End Sub
|
|---|
| 147 | Sub DeleteValue ( name As String, throwOnMissingValue As Boolean )
|
|---|
| 148 | If IsNothing( name ) Then Exit Sub
|
|---|
| 149 | RegDeleteValue( This.handle, ToTCStr(name) )
|
|---|
| 150 | This.edited = True
|
|---|
| 151 | End Sub
|
|---|
| 152 |
|
|---|
| 153 | '指定したオープン レジストリ キーのすべての属性をこのレジストリへ書き込みます。
|
|---|
| 154 | Sub Flush()
|
|---|
| 155 | RegFlushKey( This.handle )
|
|---|
| 156 | End Sub
|
|---|
| 157 |
|
|---|
| 158 | 'すべてのサブキーの名前が格納されている文字列の配列を取得します。
|
|---|
| 159 | Function GetSubKeyNames() As System.Collections.Generic.List<String>
|
|---|
| 160 | Dim list As System.Collections.Generic.List<String>
|
|---|
| 161 |
|
|---|
| 162 | Dim subkey[255] As TCHAR
|
|---|
| 163 | Dim dwsubkey=255 As DWord
|
|---|
| 164 |
|
|---|
| 165 | Dim index=0 As DWord
|
|---|
| 166 | While ERROR_NO_MORE_ITEMS <> RegEnumKeyEx( This.handle, index, subkey, dwsubkey, NULL, NULL, 0, NULL )
|
|---|
| 167 | list.Add( New String(subkey) )
|
|---|
| 168 | dwsubkey = 255
|
|---|
| 169 | index++
|
|---|
| 170 | Wend
|
|---|
| 171 | Return list
|
|---|
| 172 | End Function
|
|---|
| 173 |
|
|---|
| 174 | '指定した名前に関連付けられている値を取得します。
|
|---|
| 175 | Function GetValue ( name As String ) As Object
|
|---|
| 176 | Dim dwType As DWord
|
|---|
| 177 | If ERROR_SUCCESS <> RegQueryValueEx( This.handle, ToTCStr(name), 0, VarPtr(dwType), NULL, NULL ) Then
|
|---|
| 178 | Return Nothing
|
|---|
| 179 | End If
|
|---|
| 180 |
|
|---|
| 181 | Dim dwSize As DWord
|
|---|
| 182 | Dim dwMemSize=255 As DWord
|
|---|
| 183 | Dim pbData As *Byte
|
|---|
| 184 | pbData = GC_malloc( dwMemSize )
|
|---|
| 185 | Do
|
|---|
| 186 | dwSize = dwMemSize
|
|---|
| 187 | realloc(pbData, dwMemSize)
|
|---|
| 188 | If ERROR_MORE_DATA = RegQueryValueEx( This.handle, ToTCStr(name), 0, VarPtr(dwType), pbData, VarPtr(dwSize) ) Then
|
|---|
| 189 | dwMemSize += 5
|
|---|
| 190 | Else
|
|---|
| 191 | Exit Do
|
|---|
| 192 | End If
|
|---|
| 193 | Loop
|
|---|
| 194 |
|
|---|
| 195 | Select Case dwType
|
|---|
| 196 | Case REG_BINARY
|
|---|
| 197 | Return New System.Collections.Generic.List<Byte>( pbData, dwSize )
|
|---|
| 198 | Case REG_DWORD
|
|---|
| 199 | Dim dw As DWord
|
|---|
| 200 | memcpy( VarPtr(dw), pbData, SizeOf(DWord) )
|
|---|
| 201 | Return New System.UInt32( dw )
|
|---|
| 202 | Case REG_EXPAND_SZ
|
|---|
| 203 | Return New System.String( pbData As LPCTSTR )
|
|---|
| 204 | Case REG_MULTI_SZ
|
|---|
| 205 | Return New System.String( pbData As LPCTSTR )
|
|---|
| 206 | Case REG_QWORD
|
|---|
| 207 | Dim qw As QWord
|
|---|
| 208 | memcpy( VarPtr(qw), pbData, SizeOf(QWord) )
|
|---|
| 209 | Return New System.UInt64( qw )
|
|---|
| 210 | Case REG_SZ
|
|---|
| 211 | Return New System.String( pbData As LPCTSTR )
|
|---|
| 212 | Case Else
|
|---|
| 213 | Return Nothing
|
|---|
| 214 | End Select
|
|---|
| 215 | End Function
|
|---|
| 216 | Function GetValue ( name As String, defaultValue As Object ) As Object
|
|---|
| 217 | End Function
|
|---|
| 218 | Function GetValue ( name As String, defaultValue As Object, options As RegistryValueOptions ) As Object
|
|---|
| 219 | End Function
|
|---|
| 220 |
|
|---|
| 221 | '指定した名前に関連付けられた値のレジストリ データ型を取得します。
|
|---|
| 222 | Function GetValueKind ( name As String ) As RegistryValueKind
|
|---|
| 223 | If IsNothing( name ) Then Exit Sub
|
|---|
| 224 | Dim dwType As DWord
|
|---|
| 225 | If ERROR_SUCCESS <> RegQueryValueEx( This.handle, ToTCStr(name), 0, VarPtr(dwType), NULL, NULL ) Then
|
|---|
| 226 | Return Nothing
|
|---|
| 227 | End If
|
|---|
| 228 | Select Case dwType
|
|---|
| 229 | Case REG_BINARY
|
|---|
| 230 | Return RegistryValueKind.Binary
|
|---|
| 231 | Case REG_DWORD
|
|---|
| 232 | Return RegistryValueKind.DWord
|
|---|
| 233 | Case REG_EXPAND_SZ
|
|---|
| 234 | Return RegistryValueKind.ExpandString
|
|---|
| 235 | Case REG_MULTI_SZ
|
|---|
| 236 | Return RegistryValueKind.MultiString
|
|---|
| 237 | Case REG_QWORD
|
|---|
| 238 | Return RegistryValueKind.QWord
|
|---|
| 239 | Case REG_SZ
|
|---|
| 240 | Return RegistryValueKind.String
|
|---|
| 241 | Case Else
|
|---|
| 242 | Return RegistryValueKind.Unknown
|
|---|
| 243 | End Select
|
|---|
| 244 | End Function
|
|---|
| 245 |
|
|---|
| 246 | 'このキーに関連付けられているすべての値の名前が格納されている文字列の配列を取得します。
|
|---|
| 247 | Function GetValueNames() As System.Collections.Generic.List<String>
|
|---|
| 248 | Dim list As System.Collections.Generic.List<String>
|
|---|
| 249 |
|
|---|
| 250 | Dim ValueName[255] As TCHAR
|
|---|
| 251 | Dim dwValueName=255 As DWord
|
|---|
| 252 |
|
|---|
| 253 | Dim index=0 As DWord
|
|---|
| 254 | While ERROR_NO_MORE_ITEMS <> RegEnumValue( This.handle, index, ValueName, dwValueName, 0, NULL, NULL, NULL )
|
|---|
| 255 | list.Add( New String(ValueName) )
|
|---|
| 256 | dwValueName = 255
|
|---|
| 257 | index++
|
|---|
| 258 | Wend
|
|---|
| 259 | Return list
|
|---|
| 260 | End Function
|
|---|
| 261 |
|
|---|
| 262 | '指定したサブキーを取得します。
|
|---|
| 263 | Function OpenSubKey ( name As String ) As RegistryKey
|
|---|
| 264 | If IsNothing(name) Then Return Nothing
|
|---|
| 265 | Dim buf = name
|
|---|
| 266 | '末尾の\を除去
|
|---|
| 267 | If buf.EndsWith( "\" ) Then
|
|---|
| 268 | buf = buf.Remove( buf.Length - 1 )
|
|---|
| 269 | End If
|
|---|
| 270 | '先頭の\を除去
|
|---|
| 271 | If buf.StartsWith( "\" ) Then
|
|---|
| 272 | buf = buf.Remove( 0, 1 )
|
|---|
| 273 | End If
|
|---|
| 274 |
|
|---|
| 275 | Dim key As Detail._System_RegistryKey
|
|---|
| 276 | key.Root( This.rootkey )
|
|---|
| 277 | If IsNothing(This.subkeyname) Then
|
|---|
| 278 | key.SubKey( buf )
|
|---|
| 279 | Else
|
|---|
| 280 | key.SubKey( This.subkeyname + "\" + buf )
|
|---|
| 281 | End If
|
|---|
| 282 | key.Open( )
|
|---|
| 283 | Return key
|
|---|
| 284 | End Function
|
|---|
| 285 |
|
|---|
| 286 | Function OpenSubKey ( name As String, writable As Boolean ) As RegistryKey
|
|---|
| 287 | End Function
|
|---|
| 288 |
|
|---|
| 289 | ' Function OpenSubKey ( name As String, permissionCheck As RegistryKeyPermissionCheck ) As RegistryKey
|
|---|
| 290 | ' TODO
|
|---|
| 291 | ' End Function
|
|---|
| 292 |
|
|---|
| 293 | ' Function OpenSubKey ( name As String, permissionCheck As RegistryKeyPermissionCheck, rights As RegistryRights ) As RegistryKey
|
|---|
| 294 | ' TODO
|
|---|
| 295 | ' End Function
|
|---|
| 296 |
|
|---|
| 297 | 'レジストリ キーに名前/値ペアの値を設定します。オーバーロードに応じて、格納するデータの型または指定した RegistryValueKind に基づいてレジストリ データ型が判別されます。
|
|---|
| 298 | Sub SetValue ( name As String, value As Object )
|
|---|
| 299 | End Sub
|
|---|
| 300 | Sub SetValue ( name As String, value As Object, valueKind As RegistryValueKind )
|
|---|
| 301 | End Sub
|
|---|
| 302 |
|
|---|
| 303 | 'このキーの文字列形式を取得します。
|
|---|
| 304 | Override Function ToString( ) As String
|
|---|
| 305 | End Function
|
|---|
| 306 |
|
|---|
| 307 | Public
|
|---|
| 308 | Override Sub Dispose()
|
|---|
| 309 | This.Close( )
|
|---|
| 310 | End Sub
|
|---|
| 311 | End Class
|
|---|
| 312 |
|
|---|
| 313 | Namespace Detail
|
|---|
| 314 |
|
|---|
| 315 | Class _System_RegistryKey
|
|---|
| 316 | Inherits RegistryKey
|
|---|
| 317 |
|
|---|
| 318 | Public
|
|---|
| 319 | Sub Root( hkey As HKEY )
|
|---|
| 320 | This.rootkey = hkey
|
|---|
| 321 | Select Case This.rootkey
|
|---|
| 322 | Case HKEY_CLASSES_ROOT
|
|---|
| 323 | This.rootkeyname = "HKEY_CLASSES_ROOT"
|
|---|
| 324 | Case HKEY_CURRENT_CONFIG
|
|---|
| 325 | This.rootkeyname = "HKEY_CURRENT_CONFIG"
|
|---|
| 326 | Case HKEY_CURRENT_USER
|
|---|
| 327 | This.rootkeyname = "HKEY_CURRENT_USER"
|
|---|
| 328 | Case HKEY_DYN_DATA
|
|---|
| 329 | This.rootkeyname = "HKEY_DYN_DATA"
|
|---|
| 330 | Case HKEY_LOCAL_MACHINE
|
|---|
| 331 | This.rootkeyname = "HKEY_LOCAL_MACHINE"
|
|---|
| 332 | Case HKEY_PERFORMANCE_DATA
|
|---|
| 333 | This.rootkeyname = "HKEY_PERFORMANCE_DATA"
|
|---|
| 334 | Case HKEY_USERS
|
|---|
| 335 | This.rootkeyname = "HKEY_USERS"
|
|---|
| 336 | End Select
|
|---|
| 337 | End Sub
|
|---|
| 338 |
|
|---|
| 339 | Sub SubKey( subkey As String )
|
|---|
| 340 | If IsNothing(subkey) Then Exit Sub
|
|---|
| 341 | This.subkeyname = subkey
|
|---|
| 342 | End Sub
|
|---|
| 343 |
|
|---|
| 344 | Sub Create()
|
|---|
| 345 | RegCreateKeyEx( This.rootkey, ToTCStr(This.subkeyname), 0, NULL, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, NULL, This.handle, NULL )
|
|---|
| 346 | End Sub
|
|---|
| 347 | ' Function Create( permissionCheck As RegistryKeyPermissionCheck ) As RegistryKey
|
|---|
| 348 | ' TODO
|
|---|
| 349 | ' End Function
|
|---|
| 350 | ' Function Create( permissionCheck As RegistryKeyPermissionCheck, registrySecurity As RegistrySecurity ) As RegistryKey
|
|---|
| 351 | ' TODO
|
|---|
| 352 | ' End Function
|
|---|
| 353 |
|
|---|
| 354 | Sub Open()
|
|---|
| 355 | RegOpenKeyEx( This.rootkey, ToTCStr(This.subkeyname), 0, KEY_ALL_ACCESS, This.handle )
|
|---|
| 356 | End Sub
|
|---|
| 357 | ' Function Open( permissionCheck As RegistryKeyPermissionCheck ) As RegistryKey
|
|---|
| 358 | ' TODO
|
|---|
| 359 | ' End Function
|
|---|
| 360 | ' Function Open( permissionCheck As RegistryKeyPermissionCheck, rights As RegistryRights ) As RegistryKey
|
|---|
| 361 | ' TODO
|
|---|
| 362 | ' End Function
|
|---|
| 363 |
|
|---|
| 364 | End Class
|
|---|
| 365 |
|
|---|
| 366 | End Namespace
|
|---|
| 367 |
|
|---|
| 368 |
|
|---|
| 369 | Class Registry
|
|---|
| 370 | Public
|
|---|
| 371 | Static Function ClassesRoot() As RegistryKey
|
|---|
| 372 | Dim key As Detail._System_RegistryKey
|
|---|
| 373 | key.Root( HKEY_CLASSES_ROOT )
|
|---|
| 374 | Return key
|
|---|
| 375 | End Function
|
|---|
| 376 |
|
|---|
| 377 | Static Function CurrentConfig() As RegistryKey
|
|---|
| 378 | Dim key As Detail._System_RegistryKey
|
|---|
| 379 | key.Root( HKEY_CURRENT_CONFIG )
|
|---|
| 380 | Return key
|
|---|
| 381 | End Function
|
|---|
| 382 |
|
|---|
| 383 | Static Function CurrentUser() As RegistryKey
|
|---|
| 384 | Dim key As Detail._System_RegistryKey
|
|---|
| 385 | key.Root( HKEY_CURRENT_USER )
|
|---|
| 386 | Return key
|
|---|
| 387 | End Function
|
|---|
| 388 |
|
|---|
| 389 | Static Function DynData() As RegistryKey
|
|---|
| 390 | Dim key As Detail._System_RegistryKey
|
|---|
| 391 | key.Root( HKEY_DYN_DATA )
|
|---|
| 392 | Return key
|
|---|
| 393 | End Function
|
|---|
| 394 |
|
|---|
| 395 | Static Function LocalMachine() As RegistryKey
|
|---|
| 396 | Dim key As Detail._System_RegistryKey
|
|---|
| 397 | key.Root( HKEY_LOCAL_MACHINE )
|
|---|
| 398 | Return key
|
|---|
| 399 | End Function
|
|---|
| 400 |
|
|---|
| 401 | Static Function PerformanceData() As RegistryKey
|
|---|
| 402 | Dim key As Detail._System_RegistryKey
|
|---|
| 403 | key.Root( HKEY_PERFORMANCE_DATA )
|
|---|
| 404 | Return key
|
|---|
| 405 | End Function
|
|---|
| 406 |
|
|---|
| 407 | Static Function Users() As RegistryKey
|
|---|
| 408 | Dim key As Detail._System_RegistryKey
|
|---|
| 409 | key.Root( HKEY_USERS )
|
|---|
| 410 | Return key
|
|---|
| 411 | End Function
|
|---|
| 412 | End Class
|
|---|
| 413 |
|
|---|
| 414 | End Namespace
|
|---|
| 415 | End Namespace
|
|---|
