Context Navigation

Registry.ab@ 577

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

File size: 11.3 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
	47	If IsNothing(This.subkeyname) Then
	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
[577]	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
[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 )
[577]	110	If IsNothing( subkey ) Then Exit Sub
	111	This.DeleteSubKey( subkey, True )
[573]	112	End Sub
	113	Sub DeleteSubKey ( subkey As String, throwOnMissingSubKey As Boolean )
[577]	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
[573]	126	End Sub
	127
	128	'サブキーとその子サブキーを再帰的に削除します。文字列 subkey では、大文字と小文字は区別されません。
	129	Sub DeleteSubKeyTree ( subkey As String )
[577]	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 )
[573]	140	End Sub
	141
	142	'指定した値をこのキーから削除します。
	143	Sub DeleteValue ( name As String )
[577]	144	If IsNothing( name ) Then Exit Sub
	145	This.DeleteValue( name, True )
[573]	146	End Sub
	147	Sub DeleteValue ( name As String, throwOnMissingValue As Boolean )
[577]	148	If IsNothing( name ) Then Exit Sub
	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
	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
[577]	223	If IsNothing( name ) Then Exit Sub
[573]	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
[577]	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
[573]	275	Dim key As Detail._System_RegistryKey
	276	key.Root( This.rootkey )
[577]	277	If IsNothing(This.subkeyname) Then
	278	key.SubKey( buf )
	279	Else
	280	key.SubKey( This.subkeyname + "\" + buf )
	281	End If
[573]	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 )
[577]	340	If IsNothing(subkey) Then Exit Sub
[573]	341	This.subkeyname = subkey
	342	End Sub
	343
	344	Sub Create()
[577]	345	RegCreateKeyEx( This.rootkey, ToTCStr(This.subkeyname), 0, NULL, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, NULL, This.handle, NULL )
[573]	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()
[577]	355	RegOpenKeyEx( This.rootkey, ToTCStr(This.subkeyname), 0, KEY_ALL_ACCESS, This.handle )
[573]	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

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

Download in other formats:

Original Format