VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "FileType"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private m_sExtension As String
Private m_sName As String
Private m_sDescription As String
Private m_sDefaultIcon As String
Private m_oShellCommands As New Collection
Private m_oShellCommandLines As New Collection
Private m_sDefaultShellCommand As String

Public Property Get Extension() As String
    Extension = m_sExtension
End Property

Public Property Let Extension(ByVal vNewValue As String)
    m_sExtension = vNewValue
End Property

Public Property Get Name() As String
    Name = m_sName
End Property

Public Property Let Name(ByVal vNewValue As String)
    m_sName = vNewValue
End Property

Public Property Get Description() As String
    Description = m_sDescription
End Property

Public Property Let Description(ByVal vNewValue As String)
    m_sDescription = vNewValue
End Property

Public Property Get DefaultIcon() As String
    DefaultIcon = m_sDefaultIcon
End Property

Public Property Let DefaultIcon(ByVal vNewValue As String)
    m_sDefaultIcon = vNewValue
End Property

Public Sub AddShellCommand(ByVal Name As String, ByVal CommandLine As String, Optional ByVal Default As Boolean = False)
    m_oShellCommands.Add Name, Name
    m_oShellCommandLines.Add CommandLine, Name
    If Default Then
        m_sDefaultShellCommand = Name
    End If
End Sub

Public Sub RemoveShellCommand(ByVal Name As String)
    m_oShellCommands.Remove Name
    m_oShellCommandLines.Remove Name
End Sub

Public Sub ClearShellCommands()
    Set m_oShellCommands = New Collection
    Set m_oShellCommandLines = New Collection
End Sub

Public Property Get ShellCommand(ByVal Name As String) As String
    ShellCommand = m_oShellCommandLines(Name)
End Property

Public Property Get DefaultShellCommand() As String
    DefaultShellCommand = m_sDefaultShellCommand
End Property

Public Property Let DefaultShellCommand(ByVal vNewValue As String)
    m_sDefaultShellCommand = vNewValue
End Property

Public Function Load(ByVal Extension As String) As Boolean
    Dim oRegKey As New RegistryKey
    Dim oShellCommandKey As New RegistryKey
    Dim sShellCommand As String
    Dim sShellCommandLine As String
    Dim I As Long
    
    Load = False
    
    m_sExtension = ""
    m_sName = ""
    m_sDescription = ""
    m_sDefaultIcon = ""
    m_sDefaultShellCommand = ""
    Set m_oShellCommands = New Collection
    Set m_oShellCommandLines = New Collection
    
    If Not oRegKey.OpenKey(HKEY_CLASSES_ROOT, "") Then
        Exit Function
    End If
    
    If Not oRegKey.GetKeyDefaultValue("." & Extension, m_sName) Then
        Exit Function
    End If
    
    m_sExtension = Extension
    
    If Not oRegKey.GetKeyDefaultValue(m_sName, m_sDescription) Then
        Exit Function
    End If
    
    If Not oRegKey.CloseKey Then
        Exit Function
    End If
    
    If Not oRegKey.OpenKey(HKEY_CLASSES_ROOT, m_sName) Then
        Exit Function
    End If
    
    If Not oRegKey.GetKeyDefaultValue("DefaultIcon", m_sDefaultIcon) Then
        Exit Function
    End If
    
    If Not oRegKey.GetKeyDefaultValue("Shell", m_sDefaultShellCommand) Then
        Exit Function
    End If
    
    If Not oRegKey.CloseKey Then
        Exit Function
    End If
    
    If Not oRegKey.OpenKey(HKEY_CLASSES_ROOT, m_sName & "\Shell") Then
        Exit Function
    End If
    
    I = 0
    Do While oRegKey.EnumKey(I, sShellCommand)
        If Not oShellCommandKey.OpenKey(HKEY_CLASSES_ROOT, m_sName & "\Shell\" & sShellCommand) Then
            Exit Function
        End If
        
        If Not oShellCommandKey.GetKeyDefaultValue("Command", sShellCommandLine) Then
            Exit Function
        End If
        
        AddShellCommand sShellCommand, sShellCommandLine, (sShellCommand = m_sDefaultIcon)
        
        If Not oShellCommandKey.CloseKey Then
            Exit Function
        End If
        
        I = I + 1
    Loop
    
    Load = True
End Function

Public Function Save() As Boolean
    Dim oRegKey As New RegistryKey
    Dim I As Long
    
    Save = False
    
    If Not oRegKey.OpenKey(HKEY_CLASSES_ROOT, "") Then
        Exit Function
    End If
    
    If Not oRegKey.SetKeyDefaultValue("." & m_sExtension, m_sName) Then
        Exit Function
    End If
    
    If Not oRegKey.SetKeyDefaultValue(m_sName, m_sDescription) Then
        Exit Function
    End If
    
    If Not oRegKey.CloseKey Then
        Exit Function
    End If
    
    If Not oRegKey.OpenKey(HKEY_CLASSES_ROOT, m_sName, True) Then
        Exit Function
    End If
    
    If Not oRegKey.SetKeyDefaultValue("DefaultIcon", m_sDefaultIcon) Then
        Exit Function
    End If
    
    If Not oRegKey.SetKeyDefaultValue("Shell", m_sDefaultShellCommand) Then
        Exit Function
    End If
    
    If Not oRegKey.CloseKey Then
        Exit Function
    End If
    
    For I = 1 To m_oShellCommands.Count
        If Not oRegKey.OpenKey(HKEY_CLASSES_ROOT, m_sName & "\Shell\" & m_oShellCommands(I), True) Then
            Exit Function
        End If
        
        If Not oRegKey.SetKeyDefaultValue("Command", m_oShellCommandLines(I)) Then
            Exit Function
        End If
        
        If Not oRegKey.CloseKey Then
            Exit Function
        End If
    Next
    
    Save = True
End Function

Public Function Delete(Extension As String, Name As String) As Boolean
    Dim oRegKey As New RegistryKey
    Dim sValue As String
    
    Delete = False
    
    If Not oRegKey.OpenKey(HKEY_CLASSES_ROOT, "") Then
        Exit Function
    End If
    
    If Not oRegKey.GetKeyDefaultValue("." & Extension, sValue, True) Then
        Exit Function
    End If
    
    If sValue = Name Then
        If Not oRegKey.DeleteKey("." & Extension) Then
            Exit Function
        End If
        
        If Not oRegKey.DeleteKey(Name) Then
            Exit Function
        End If
    End If
    
    If Not oRegKey.CloseKey Then
        Exit Function
    End If
    
    Delete = True
End Function
