source: trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/Registry.ab@ 585

Last change on this file since 585 was 585, checked in by NoWest, 16 years ago

Joystickのクラスを作ってみました。

かなり前に作ったんですが、ココ最近の改良に合わせて色々弄っております。

File size: 11.7 KB
Line 
1Namespace ActiveBasic
2Namespace Windows
3
4Enum 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
12End Enum
13
14Enum RegistryValueOptions
15 DoNotExpandEnvironmentNames
16 None
17End Enum
18
19Enum 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
27End Enum
28
29Class RegistryKey
30 Implements System.IDisposable
31
32Protected
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
43Public
44 'キーの名前を取得します。
45 Function Name( ) As String
46 Dim name As String
47 If ActiveBasic.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
69Public
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 ActiveBasic.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 ActiveBasic.IsNothing( subkey ) Then Exit Sub
111 This.DeleteSubKey( subkey, True )
112 End Sub
113 Sub DeleteSubKey ( subkey As String, throwOnMissingSubKey As Boolean )
114 If ActiveBasic.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 ActiveBasic.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 ActiveBasic.IsNothing( name ) Then Exit Sub
145 This.DeleteValue( name, True )
146 End Sub
147 Sub DeleteValue ( name As String, throwOnMissingValue As Boolean )
148 If ActiveBasic.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 Dim list As System.Collections.Generic.List<String>
206 Dim s As System.String
207 Do
208 s = New System.String(pbData As *TCHAR)
209 If s.Length = 0 Then Exit Do
210 list.Add(s)
211 pbData += (s.Length + SizeOf(TCHAR))
212 Loop
213 Return list
214 Case REG_QWORD
215 Dim qw As QWord
216 memcpy( VarPtr(qw), pbData, SizeOf(QWord) )
217 Return New System.UInt64( qw )
218 Case REG_SZ
219 Return New System.String( pbData As LPCTSTR )
220 Case Else
221 Return Nothing
222 End Select
223 End Function
224 Function GetValue ( name As String, defaultValue As Object ) As Object
225 End Function
226 Function GetValue ( name As String, defaultValue As Object, options As RegistryValueOptions ) As Object
227 End Function
228
229 '指定した名前に関連付けられた値のレジストリ データ型を取得します。
230 Function GetValueKind ( name As String ) As RegistryValueKind
231 If ActiveBasic.IsNothing( name ) Then Exit Sub
232 Dim dwType As DWord
233 If ERROR_SUCCESS <> RegQueryValueEx( This.handle, ToTCStr(name), 0, VarPtr(dwType), NULL, NULL ) Then
234 Return Nothing
235 End If
236 Select Case dwType
237 Case REG_BINARY
238 Return RegistryValueKind.Binary
239 Case REG_DWORD
240 Return RegistryValueKind.DWord
241 Case REG_EXPAND_SZ
242 Return RegistryValueKind.ExpandString
243 Case REG_MULTI_SZ
244 Return RegistryValueKind.MultiString
245 Case REG_QWORD
246 Return RegistryValueKind.QWord
247 Case REG_SZ
248 Return RegistryValueKind.String
249 Case Else
250 Return RegistryValueKind.Unknown
251 End Select
252 End Function
253
254 'このキーに関連付けられているすべての値の名前が格納されている文字列の配列を取得します。
255 Function GetValueNames() As System.Collections.Generic.List<String>
256 Dim list As System.Collections.Generic.List<String>
257
258 Dim ValueName[255] As TCHAR
259 Dim dwValueName=255 As DWord
260
261 Dim index=0 As DWord
262 While ERROR_NO_MORE_ITEMS <> RegEnumValue( This.handle, index, ValueName, dwValueName, 0, NULL, NULL, NULL )
263 list.Add( New String(ValueName) )
264 dwValueName = 255
265 index++
266 Wend
267 Return list
268 End Function
269
270 '指定したサブキーを取得します。
271 Function OpenSubKey ( name As String ) As RegistryKey
272 If ActiveBasic.IsNothing(name) Then Return Nothing
273 Dim buf = name
274 '末尾の\を除去
275 If buf.EndsWith( "\" ) Then
276 buf = buf.Remove( buf.Length - 1 )
277 End If
278 '先頭の\を除去
279 If buf.StartsWith( "\" ) Then
280 buf = buf.Remove( 0, 1 )
281 End If
282
283 Dim key As Detail._System_RegistryKey
284 key.Root( This.rootkey )
285 If IsNothing(This.subkeyname) Then
286 key.SubKey( buf )
287 Else
288 key.SubKey( This.subkeyname + "\" + buf )
289 End If
290 key.Open( )
291 Return key
292 End Function
293
294 Function OpenSubKey ( name As String, writable As Boolean ) As RegistryKey
295 End Function
296
297' Function OpenSubKey ( name As String, permissionCheck As RegistryKeyPermissionCheck ) As RegistryKey
298' TODO
299' End Function
300
301' Function OpenSubKey ( name As String, permissionCheck As RegistryKeyPermissionCheck, rights As RegistryRights ) As RegistryKey
302' TODO
303' End Function
304
305 'レジストリ キーに名前/値ペアの値を設定します。オーバーロードに応じて、格納するデータの型または指定した RegistryValueKind に基づいてレジストリ データ型が判別されます。
306 Sub SetValue ( name As String, value As Object )
307 End Sub
308 Sub SetValue ( name As String, value As Object, valueKind As RegistryValueKind )
309 End Sub
310
311 'このキーの文字列形式を取得します。
312 Override Function ToString( ) As String
313 End Function
314
315Public
316 Override Sub Dispose()
317 This.Close( )
318 End Sub
319End Class
320
321Namespace Detail
322
323Class _System_RegistryKey
324 Inherits RegistryKey
325
326Public
327 Sub Root( hkey As HKEY )
328 This.rootkey = hkey
329 Select Case This.rootkey
330 Case HKEY_CLASSES_ROOT
331 This.rootkeyname = "HKEY_CLASSES_ROOT"
332 Case HKEY_CURRENT_CONFIG
333 This.rootkeyname = "HKEY_CURRENT_CONFIG"
334 Case HKEY_CURRENT_USER
335 This.rootkeyname = "HKEY_CURRENT_USER"
336 Case HKEY_DYN_DATA
337 This.rootkeyname = "HKEY_DYN_DATA"
338 Case HKEY_LOCAL_MACHINE
339 This.rootkeyname = "HKEY_LOCAL_MACHINE"
340 Case HKEY_PERFORMANCE_DATA
341 This.rootkeyname = "HKEY_PERFORMANCE_DATA"
342 Case HKEY_USERS
343 This.rootkeyname = "HKEY_USERS"
344 End Select
345 End Sub
346
347 Sub SubKey( subkey As String )
348 If ActiveBasic.IsNothing(subkey) Then Exit Sub
349 This.subkeyname = subkey
350 End Sub
351
352 Sub Create()
353 RegCreateKeyEx( This.rootkey, ToTCStr(This.subkeyname), 0, NULL, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, NULL, This.handle, NULL )
354 End Sub
355' Function Create( permissionCheck As RegistryKeyPermissionCheck ) As RegistryKey
356' TODO
357' End Function
358' Function Create( permissionCheck As RegistryKeyPermissionCheck, registrySecurity As RegistrySecurity ) As RegistryKey
359' TODO
360' End Function
361
362 Sub Open()
363 RegOpenKeyEx( This.rootkey, ToTCStr(This.subkeyname), 0, KEY_ALL_ACCESS, This.handle )
364 End Sub
365' Function Open( permissionCheck As RegistryKeyPermissionCheck ) As RegistryKey
366' TODO
367' End Function
368' Function Open( permissionCheck As RegistryKeyPermissionCheck, rights As RegistryRights ) As RegistryKey
369' TODO
370' End Function
371
372End Class
373
374End Namespace
375
376
377Class Registry
378Public
379 Static Function ClassesRoot() As RegistryKey
380 Dim key As Detail._System_RegistryKey
381 key.Root( HKEY_CLASSES_ROOT )
382 Return key
383 End Function
384
385 Static Function CurrentConfig() As RegistryKey
386 Dim key As Detail._System_RegistryKey
387 key.Root( HKEY_CURRENT_CONFIG )
388 Return key
389 End Function
390
391 Static Function CurrentUser() As RegistryKey
392 Dim key As Detail._System_RegistryKey
393 key.Root( HKEY_CURRENT_USER )
394 Return key
395 End Function
396
397 Static Function DynData() As RegistryKey
398 Dim key As Detail._System_RegistryKey
399 key.Root( HKEY_DYN_DATA )
400 Return key
401 End Function
402
403 Static Function LocalMachine() As RegistryKey
404 Dim key As Detail._System_RegistryKey
405 key.Root( HKEY_LOCAL_MACHINE )
406 Return key
407 End Function
408
409 Static Function PerformanceData() As RegistryKey
410 Dim key As Detail._System_RegistryKey
411 key.Root( HKEY_PERFORMANCE_DATA )
412 Return key
413 End Function
414
415 Static Function Users() As RegistryKey
416 Dim key As Detail._System_RegistryKey
417 key.Root( HKEY_USERS )
418 Return key
419 End Function
420End Class
421
422End Namespace
423End Namespace
Note: See TracBrowser for help on using the repository browser.