Context Navigation

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

Rev	Line
[573]	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
[577]	37	edited As Boolean
[573]	38
	39	Virtual Sub ~RegistryKey( )
	40	This.Dispose( )
	41	End Sub
	42
	43	Public
	44	'キーの名前を取得します。
	45	Function Name( ) As String
[577]	46	Dim name As String
[585]	47	If ActiveBasic.IsNothing(This.subkeyname) Then
[577]	48	name = This.rootkeyname
	49	Else
	50	name = This.rootkeyname + "\" + This.subkeyname
	51	End If
[573]	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( )
[577]	72	If This.edited Then This.Flush()
[573]	73	RegCloseKey( This.handle )
	74	End Sub
	75
	76	'新しいサブキーを作成するか、または既存のサブキーを開きます。
	77	Function CreateSubKey( subkey As String ) As RegistryKey
[585]	78	If ActiveBasic.IsNothing(subkey) Then Return Nothing
[577]	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
[573]	89	Dim key As Detail._System_RegistryKey
	90	key.Root( This.rootkey )
[577]	91	If IsNothing(This.subkeyname) Then
	92	key.SubKey( buf )
	93	Else
	94	key.SubKey( This.subkeyname + "\" + buf )
	95	End If
[573]	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 )
[585]	110	If ActiveBasic.IsNothing( subkey ) Then Exit Sub
[577]	111	This.DeleteSubKey( subkey, True )
[573]	112	End Sub
	113	Sub DeleteSubKey ( subkey As String, throwOnMissingSubKey As Boolean )
[585]	114	If ActiveBasic.IsNothing( subkey ) Then Exit Sub
[577]	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
[573]	126	End Sub
	127
	128	'サブキーとその子サブキーを再帰的に削除します。文字列 subkey では、大文字と小文字は区別されません。
	129	Sub DeleteSubKeyTree ( subkey As String )
[585]	130	If ActiveBasic.IsNothing( subkey ) Then Exit Sub
[577]	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 )
[573]	140	End Sub
	141
	142	'指定した値をこのキーから削除します。
	143	Sub DeleteValue ( name As String )
[585]	144	If ActiveBasic.IsNothing( name ) Then Exit Sub
[577]	145	This.DeleteValue( name, True )
[573]	146	End Sub
	147	Sub DeleteValue ( name As String, throwOnMissingValue As Boolean )
[585]	148	If ActiveBasic.IsNothing( name ) Then Exit Sub
[577]	149	RegDeleteValue( This.handle, ToTCStr(name) )
	150	This.edited = True
[573]	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
[585]	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
[573]	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
[585]	231	If ActiveBasic.IsNothing( name ) Then Exit Sub
[573]	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
[585]	272	If ActiveBasic.IsNothing(name) Then Return Nothing
[577]	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
[573]	283	Dim key As Detail._System_RegistryKey
	284	key.Root( This.rootkey )
[577]	285	If IsNothing(This.subkeyname) Then
	286	key.SubKey( buf )
	287	Else
	288	key.SubKey( This.subkeyname + "\" + buf )
	289	End If
[573]	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
	315	Public
	316	Override Sub Dispose()
	317	This.Close( )
	318	End Sub
	319	End Class
	320
	321	Namespace Detail
	322
	323	Class _System_RegistryKey
	324	Inherits RegistryKey
	325
	326	Public
	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 )
[585]	348	If ActiveBasic.IsNothing(subkey) Then Exit Sub
[573]	349	This.subkeyname = subkey
	350	End Sub
	351
	352	Sub Create()
[577]	353	RegCreateKeyEx( This.rootkey, ToTCStr(This.subkeyname), 0, NULL, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, NULL, This.handle, NULL )
[573]	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()
[577]	363	RegOpenKeyEx( This.rootkey, ToTCStr(This.subkeyname), 0, KEY_ALL_ACCESS, This.handle )
[573]	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
	372	End Class
	373
	374	End Namespace
	375
	376
	377	Class Registry
	378	Public
	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
	420	End Class
	421
	422	End Namespace
	423	End Namespace

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format