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

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

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

Public
    'キーの名前を取得します。 
    Function Name( ) As String
        Dim name = rootkeyname + "\" + subkeyname
        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( )
        This.Flush()
        RegCloseKey( This.handle )
    End Sub

    '新しいサブキーを作成するか、または既存のサブキーを開きます。  
    Function CreateSubKey( subkey As String ) As RegistryKey
        Dim key As Detail._System_RegistryKey
        key.Root( This.rootkey )
        key.SubKey( subkey )
        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 )
    End Sub
    Sub DeleteSubKey ( subkey As String, throwOnMissingSubKey As Boolean )
    End Sub

    'サブキーとその子サブキーを再帰的に削除します。文字列 subkey では、大文字と小文字は区別されません。  
    Sub DeleteSubKeyTree ( subkey As String )
    End Sub

    '指定した値をこのキーから削除します。  
    Sub DeleteValue ( name As String )
        RegDeleteValue( This.handle, name )
    End Sub
    Sub DeleteValue ( name As String, throwOnMissingValue As Boolean )
    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
                Return New System.String( pbData As LPCTSTR )
            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
        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
        Dim key As Detail._System_RegistryKey
        key.Root( This.rootkey )
        key.SubKey( name )
        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 )
        This.subkeyname = subkey
        If This.subkeyname.EndsWith( "\" ) Then
            This.subkeyname.Remove( This.subkeyname.Length - 1 )
        End If
    End Sub

    Sub Create()
        RegCreateKeyEx( This.rootkey, ToTCStr(This.subkeyname), 0, NULL, REG_OPTION_NON_VOLATILE, KEY_READ or KEY_WRITE, 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_READ or KEY_WRITE, 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