Namespace ActiveBasic
Namespace Windows

Enum RegistryValueKind
	Binary = REG_BINARY
	DWord = REG_DWORD
	ExpandString = REG_EXPAND_SZ
	MultiString = REG_MULTI_SZ
	QWord = REG_QWORD
	String = REG_SZ
	Unknown = 0
End Enum

Enum RegistryValueOptions
	DoNotExpandEnvironmentNames
	None 
End Enum

Enum RegistryHive
	ClassesRoot = HKEY_CLASSES_ROOT
	CurrentConfig = HKEY_CURRENT_CONFIG
	CurrentUser = HKEY_CURRENT_USER
	DynData = HKEY_DYN_DATA
	LocalMachine = HKEY_LOCAL_MACHINE
	PerformanceData = HKEY_PERFORMANCE_DATA
	Users = HKEY_USERS
End Enum

Class RegistryKey
	Implements System.IDisposable

Protected
	handle As HKEY
	rootkey As HKEY
	rootkeyname As String
	subkeyname As String
	edited As Boolean

	Virtual Sub ~RegistryKey( )
		This.Dispose( )
	End Sub

Public
	'キーの名前を取得します。 
	Function Name( ) As String
		Dim name As String
		If ActiveBasic.IsNothing(This.subkeyname) Then 
			name = This.rootkeyname
		Else
			name = This.rootkeyname + "\" + This.subkeyname
		End If
		Return name
	End Function

	'現在のキーのサブキーの数を取得します。 
	Function SubKeyCount( ) As Long
		Dim count As DWord
		RegQueryInfoKey( This.handle, NULL, 0, NULL, VarPtr(count), NULL, NULL, NULL, NULL, NULL, NULL, NULL )
		Return count
	End Function

	'キーの値の数を取得します。 
	Function ValueCount( ) As Long
		Dim count As DWord
		RegQueryInfoKey( This.handle, NULL, 0, NULL, NULL, NULL, NULL, VarPtr(count), NULL, NULL, NULL, NULL )
		Return count
	End Function

Public
	'キーを閉じ、キーの内容が変更されている場合はディスクへフラッシュします。  
	Sub Close( )
		If This.edited Then This.Flush()
		RegCloseKey( This.handle )
	End Sub

	'新しいサブキーを作成するか、または既存のサブキーを開きます。  
	Function CreateSubKey( subkey As String ) As RegistryKey
		If ActiveBasic.IsNothing(subkey) Then Return Nothing
		Dim buf = subkey
		'末尾の\を除去
		If buf.EndsWith( "\" ) Then
			buf = buf.Remove( buf.Length - 1 )
		End If
		'先頭の\を除去
		If buf.StartsWith( "\" ) Then
			buf = buf.Remove( 0, 1 )
		End If

		Dim key As Detail._System_RegistryKey
		key.Root( This.rootkey )
		If IsNothing(This.subkeyname) Then 
			key.SubKey( buf )
		Else
			key.SubKey( This.subkeyname + "\" + buf )
		End If
		key.Create( )
		Return key
	End Function

'	Function CreateSubKey( subkey As String, permissionCheck As RegistryKeyPermissionCheck ) As RegistryKey
'		TODO
'	End Function

'	Function CreateSubKey( subkey As String, permissionCheck As RegistryKeyPermissionCheck, registrySecurity As RegistrySecurity ) As RegistryKey
'		TODO
'	End Function

	'指定したサブキーを削除します。文字列 subkey では、大文字と小文字は区別されません。  
	Sub DeleteSubKey ( subkey As String )
		If ActiveBasic.IsNothing( subkey ) Then Exit Sub
		This.DeleteSubKey( subkey, True )
	End Sub
	Sub DeleteSubKey ( subkey As String, throwOnMissingSubKey As Boolean )
		If ActiveBasic.IsNothing( subkey ) Then Exit Sub
		Dim key = This.OpenSubKey(subkey)
		If key.SubKeyCount <> 0 Then
			key.Close()
			If throwOnMissingSubKey Then 
				Throw New InvalidOperationException
			Else
				Exit Sub
			End If
		End If
		RegDeleteKey( This.handle, ToTCStr(subkey) )
		This.edited = True
	End Sub

	'サブキーとその子サブキーを再帰的に削除します。文字列 subkey では、大文字と小文字は区別されません。  
	Sub DeleteSubKeyTree ( subkey As String )
		If ActiveBasic.IsNothing( subkey ) Then Exit Sub
		Dim key = This.OpenSubKey( subkey )
		If key.SubKeyCount <> 0 Then
			Dim list = key.GetSubKeyNames()
			Dim s As String
			Foreach s In list
				key.DeleteSubKeyTree( s )
			Next
		End If
		This.DeleteSubKey( subkey, False )
	End Sub

	'指定した値をこのキーから削除します。  
	Sub DeleteValue ( name As String )
		If ActiveBasic.IsNothing( name ) Then Exit Sub
		This.DeleteValue( name, True )
	End Sub
	Sub DeleteValue ( name As String, throwOnMissingValue As Boolean )
		If ActiveBasic.IsNothing( name ) Then Exit Sub
		RegDeleteValue( This.handle, ToTCStr(name) )
		This.edited = True
	End Sub

	'指定したオープン レジストリ キーのすべての属性をこのレジストリへ書き込みます。  
	Sub Flush()
		RegFlushKey( This.handle )
	End Sub

	'すべてのサブキーの名前が格納されている文字列の配列を取得します。  
	Function GetSubKeyNames() As System.Collections.Generic.List<String>
		Dim list As System.Collections.Generic.List<String>

		Dim subkey[255] As TCHAR
		Dim dwsubkey=255 As DWord

		Dim index=0 As DWord
		While ERROR_NO_MORE_ITEMS <> RegEnumKeyEx( This.handle, index, subkey, dwsubkey, NULL, NULL, 0, NULL )
			list.Add( New String(subkey) )
			dwsubkey = 255
			index++
		Wend
		Return list
	End Function

	'指定した名前に関連付けられている値を取得します。  
	Function GetValue ( name As String ) As Object
		Dim dwType As DWord
		If ERROR_SUCCESS <> RegQueryValueEx( This.handle, ToTCStr(name), 0, VarPtr(dwType), NULL, NULL ) Then
			Return Nothing
		End If

		Dim dwSize As DWord
		Dim dwMemSize=255 As DWord
		Dim pbData As *Byte
			pbData = GC_malloc( dwMemSize )
		Do 
			dwSize = dwMemSize
			realloc(pbData, dwMemSize)
			If ERROR_MORE_DATA = RegQueryValueEx( This.handle, ToTCStr(name), 0, VarPtr(dwType), pbData, VarPtr(dwSize) ) Then
				dwMemSize += 5
			Else
				Exit Do
			End If
		Loop

		Select Case dwType
			Case REG_BINARY
				Return New System.Collections.Generic.List<Byte>( pbData, dwSize )
			Case REG_DWORD
				Dim dw As DWord
				memcpy( VarPtr(dw), pbData, SizeOf(DWord) )
				Return New System.UInt32( dw )
			Case REG_EXPAND_SZ
				Return New System.String( pbData As LPCTSTR )
			Case REG_MULTI_SZ
				Dim list As System.Collections.Generic.List<String>
				Dim s As System.String
				Do
					s = New System.String(pbData As *TCHAR)
					If s.Length = 0 Then Exit Do
					list.Add(s)
					pbData += (s.Length + SizeOf(TCHAR))
				Loop
				Return list
			Case REG_QWORD
				Dim qw As QWord
				memcpy( VarPtr(qw), pbData, SizeOf(QWord) )
				Return New System.UInt64( qw )
			Case REG_SZ
				Return New System.String( pbData As LPCTSTR )
			Case Else
				Return Nothing
		End Select
	End Function
	Function GetValue ( name As String, defaultValue As Object ) As Object
	End Function
	Function GetValue ( name As String, defaultValue As Object, options As RegistryValueOptions ) As Object
	End Function

	'指定した名前に関連付けられた値のレジストリ データ型を取得します。  
	Function GetValueKind ( name As String ) As RegistryValueKind
		If ActiveBasic.IsNothing( name ) Then Exit Sub
		Dim dwType As DWord
		If ERROR_SUCCESS <> RegQueryValueEx( This.handle, ToTCStr(name), 0, VarPtr(dwType), NULL, NULL ) Then
			Return Nothing
		End If
		Select Case dwType
			Case REG_BINARY
				Return RegistryValueKind.Binary
			Case REG_DWORD
				Return RegistryValueKind.DWord
			Case REG_EXPAND_SZ
				Return RegistryValueKind.ExpandString
			Case REG_MULTI_SZ
				Return RegistryValueKind.MultiString
			Case REG_QWORD
				Return RegistryValueKind.QWord
			Case REG_SZ
				Return RegistryValueKind.String
			Case Else
				Return RegistryValueKind.Unknown
		End Select
	End Function

	'このキーに関連付けられているすべての値の名前が格納されている文字列の配列を取得します。  
	Function GetValueNames() As System.Collections.Generic.List<String>
		Dim list As System.Collections.Generic.List<String>

		Dim ValueName[255] As TCHAR
		Dim dwValueName=255 As DWord

		Dim index=0 As DWord
		While ERROR_NO_MORE_ITEMS <> RegEnumValue( This.handle, index, ValueName, dwValueName, 0, NULL, NULL, NULL )
			list.Add( New String(ValueName) )
			dwValueName = 255
			index++
		Wend
		Return list
	End Function

	'指定したサブキーを取得します。  
	Function OpenSubKey ( name As String ) As RegistryKey
		If ActiveBasic.IsNothing(name) Then Return Nothing
		Dim buf = name
		'末尾の\を除去
		If buf.EndsWith( "\" ) Then
			buf = buf.Remove( buf.Length - 1 )
		End If
		'先頭の\を除去
		If buf.StartsWith( "\" ) Then
			buf = buf.Remove( 0, 1 )
		End If

		Dim key As Detail._System_RegistryKey
		key.Root( This.rootkey )
		If IsNothing(This.subkeyname) Then 
			key.SubKey( buf )
		Else
			key.SubKey( This.subkeyname + "\" + buf )
		End If
		key.Open( )
		Return key
	End Function

	Function OpenSubKey ( name As String, writable As Boolean ) As RegistryKey
	End Function

'	Function OpenSubKey ( name As String, permissionCheck As RegistryKeyPermissionCheck ) As RegistryKey
'		TODO
'	End Function

'	Function OpenSubKey ( name As String, permissionCheck As RegistryKeyPermissionCheck, rights As RegistryRights ) As RegistryKey
'		TODO
'	End Function

	'レジストリ キーに名前/値ペアの値を設定します。オーバーロードに応じて、格納するデータの型または指定した RegistryValueKind に基づいてレジストリ データ型が判別されます。  
 	Sub SetValue ( name As String, value As Object )
	End Sub
 	Sub SetValue ( name As String, value As Object, valueKind As RegistryValueKind )
	End Sub

	'このキーの文字列形式を取得します。  
	Override Function ToString(  ) As String
	End Function

Public
	Override Sub Dispose()
		This.Close( )
	End Sub
End Class

Namespace Detail

Class _System_RegistryKey
	Inherits RegistryKey

Public
	Sub Root( hkey As HKEY )
		This.rootkey = hkey
		Select Case This.rootkey
			Case HKEY_CLASSES_ROOT
				This.rootkeyname = "HKEY_CLASSES_ROOT"
			Case HKEY_CURRENT_CONFIG
				This.rootkeyname = "HKEY_CURRENT_CONFIG"
			Case HKEY_CURRENT_USER
				This.rootkeyname = "HKEY_CURRENT_USER"
			Case HKEY_DYN_DATA
				This.rootkeyname = "HKEY_DYN_DATA"
			Case HKEY_LOCAL_MACHINE
				This.rootkeyname = "HKEY_LOCAL_MACHINE"
			Case HKEY_PERFORMANCE_DATA
				This.rootkeyname = "HKEY_PERFORMANCE_DATA"
			Case HKEY_USERS
				This.rootkeyname = "HKEY_USERS"
		End Select
	End Sub

	Sub SubKey( subkey As String )
		If ActiveBasic.IsNothing(subkey) Then Exit Sub
		This.subkeyname = subkey
	End Sub

	Sub Create()
		RegCreateKeyEx( This.rootkey, ToTCStr(This.subkeyname), 0, NULL, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, NULL, This.handle, NULL )
	End Sub
'	Function Create( permissionCheck As RegistryKeyPermissionCheck ) As RegistryKey
'		TODO
'	End Function
'	Function Create( permissionCheck As RegistryKeyPermissionCheck, registrySecurity As RegistrySecurity ) As RegistryKey
'		TODO
'	End Function

	Sub Open()
		RegOpenKeyEx( This.rootkey, ToTCStr(This.subkeyname), 0, KEY_ALL_ACCESS, This.handle )
	End Sub
'	Function Open( permissionCheck As RegistryKeyPermissionCheck ) As RegistryKey
'		TODO
'	End Function
'	Function Open( permissionCheck As RegistryKeyPermissionCheck, rights As RegistryRights ) As RegistryKey
'		TODO
'	End Function

End Class

End Namespace


Class Registry
Public
	Static Function ClassesRoot() As RegistryKey
		Dim key As Detail._System_RegistryKey
		key.Root( HKEY_CLASSES_ROOT )
		Return key
	End Function

	Static Function CurrentConfig() As RegistryKey
		Dim key As Detail._System_RegistryKey
		key.Root( HKEY_CURRENT_CONFIG )
		Return key
	End Function

	Static Function CurrentUser() As RegistryKey
		Dim key As Detail._System_RegistryKey
		key.Root( HKEY_CURRENT_USER )
		Return key
	End Function

	Static Function DynData() As RegistryKey
		Dim key As Detail._System_RegistryKey
		key.Root( HKEY_DYN_DATA )
		Return key
	End Function

	Static Function LocalMachine() As RegistryKey
		Dim key As Detail._System_RegistryKey
		key.Root( HKEY_LOCAL_MACHINE )
		Return key
	End Function

	Static Function PerformanceData() As RegistryKey
		Dim key As Detail._System_RegistryKey
		key.Root( HKEY_PERFORMANCE_DATA )
		Return key
	End Function

	Static Function Users() As RegistryKey
		Dim key As Detail._System_RegistryKey
		key.Root( HKEY_USERS )
		Return key
	End Function
End Class

End Namespace
End Namespace