Attribute VB_Name = "mod_RegisteredForFileTypes"
' Copyright (C) 2003-2007 Jan Vorel

' This program is free software; you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation; either version 2 of the License, or
' (at your option) any later version.

' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU General Public License for more details.

' You should have received a copy of the GNU General Public License
' along with this program; if not, write to the Free Software
' Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

' This is a shared modul, class modul, usercontrol or form. It is also
' published under the GNU General Public License.
' This special Version is optimized for QuickPlayer

' If you have any questions, suggestions or bug reports about this product,
' contact me: info@ctuser.net; Do not contact me about general B.A.S.I.C.
' language or A.P.I. issues

Option Explicit
Option Base 0

'#RegisterFileTypesA_FlagA
' 1 NoGetRegistered (reserved)
' 2 NoSetRegistered (reserved)
' 4 NoRemRegistered (reserved)

Public Function RegisterFileTypesA_GetRegistered(ByVal FileType As String, ByVal ProgramCaption As String, Optional ByRef IsDefaultRegistered As Boolean) As Boolean
Dim xLong1 As Long
'Dim xLong2 As Long
'Dim xLong3 As Long
Dim xBool1 As Boolean
Dim xChar1 As String
'Dim xChar2 As String
Dim xChar3 As String

FileType = LCase(FileType)
If RegOpenKeyEx(&H80000000, "." + FileType, 1&, xLong1) Then
  xBool1 = RegQueryValueEx_String(xLong1, "", xChar1)
  Call RegCloseKey(xLong1)
  End If

If xBool1 Then
  xChar3 = xChar1
  If RegOpenKeyEx(&H80000000, xChar1 + "\Shell\" + ProgramCaption + "\Command", 1&, xLong1) Then
    If RegQueryValueEx_String(xLong1, "", xChar1) Then
      RegisterFileTypesA_GetRegistered = (LCase(xChar1) = Chr(34&) & LCase(AppBase) & Chr(34&) & " " & Chr(34&) & "%1" & Chr(34&))
      End If
    Call RegCloseKey(xLong1)
    If RegOpenKeyEx(&H80000000, xChar3 + "\Shell", 1&, xLong1) Then
      If RegQueryValueEx_String(xLong1, "", xChar1) Then
        IsDefaultRegistered = (LCase(xChar1) = LCase(ProgramCaption))
        End If
      Call RegCloseKey(xLong1)
      End If
    End If
  End If
End Function

'Public Function RegisterFileTypesA_SetRegistered(ByVal FileType As String, ByVal GlobalFileType As String, ByVal ProgramCaption As String, ByVal OpeningCaption As String, ByVal Description As String, Optional ByVal Parameters As String = "", Optional ByVal IconIndex As Single = 0, Optional ByVal AsDefaultRegistered As Boolean = False) As Boolean
Public Function RegisterFileTypesA_SetRegistered(ByVal FileType As String, ByVal GlobalFileType As String, ByVal ProgramCaption As String, ByVal OpeningCaption As String, Optional ByVal Description As String = vbNullChar, Optional ByVal Parameters As String = "", Optional ByVal IconIndex As Long = -1&, Optional ByVal AsDefaultRegistered As Boolean = False, Optional ByVal PassiveRegistration As Boolean = True, Optional ByVal DefaultActionBackupCaption As String) As Boolean
Dim xLong1 As Long
'Dim xLong2 As Long
'Dim xLong3 As Long
Dim xBool1 As Boolean
Dim xChar1 As String
Dim xChar2 As String

'Stop
FileType = LCase(FileType)
If PassiveRegistration Then
  If RegOpenKeyEx(&H80000000, "." + FileType, 1&, xLong1) Then
    If RegQueryValueEx_String(xLong1, "", xChar1) Then
      GlobalFileType = xChar1
      xBool1 = True
      End If
    Call RegCloseKey(xLong1)
    End If
  End If

If Not xBool1 Then
  If RegCreateKeyEx(&H80000000, "." + FileType, xLong1) Then
    Call RegSetValueEx_String(xLong1, "", GlobalFileType)
    Call RegCloseKey(xLong1)
    End If
  End If

If (Not xBool1 Or AsDefaultRegistered) And Not Description = Chr(0) Then
  If RegCreateKeyEx(&H80000000, GlobalFileType, xLong1) Then
    Call RegSetValueEx_String(xLong1, "", Description)
'    RegisterFileTypesA_SetRegistered = True
    Call RegCloseKey(xLong1)
    End If
  End If

xChar2 = LCase(AppBase)
If Not AsDefaultRegistered Then
  '1/2?
  If RegOpenKeyEx(&H80000000, GlobalFileType + "\DefaultIcon", 0&, xLong1) Then
    Call RegCloseKey(xLong1)
    xBool1 = False
    Else
    xBool1 = True
    End If
  End If
If (AsDefaultRegistered Or xBool1 And Not IconIndex = -1&) Then
  If RegCreateKeyEx(&H80000000, GlobalFileType + "\DefaultIcon", xLong1) Then
    xChar1 = xChar2 & "," & CStr(IconIndex)
    Call RegSetValueEx_String(xLong1, "", xChar1)
    RegisterFileTypesA_SetRegistered = True
    Call RegCloseKey(xLong1)
    End If
  End If

If AsDefaultRegistered Then
  If Not Len(DefaultActionBackupCaption) = 0& Then
    If RegOpenKeyEx(&H80000000, GlobalFileType + "\Shell", 3&, xLong1) Then
      If Not RegQueryValueEx_String(xLong1, DefaultActionBackupCaption, xChar1) Then
        If RegQueryValueEx_String(xLong1, "", xChar1) Then
          Call RegSetValueEx_String(xLong1, DefaultActionBackupCaption, xChar1)
          End If
        End If
      End If
    End If
  If RegCreateKeyEx(&H80000000, GlobalFileType + "\Shell", xLong1) Then
    Call RegSetValueEx_String(xLong1, "", ProgramCaption)
    Call RegCloseKey(xLong1)
    End If
  ElseIf Not Len(DefaultActionBackupCaption) = 0& Then
  If RegOpenKeyEx(&H80000000, GlobalFileType + "\Shell", 3&, xLong1) Then
    If RegQueryValueEx_String(xLong1, DefaultActionBackupCaption, xChar1) Then
      Call RegSetValueEx_String(xLong1, "", xChar1)
      Call RegDeleteValue(xLong1, DefaultActionBackupCaption)
      End If
    End If
  End If

If RegCreateKeyEx(&H80000000, GlobalFileType + "\Shell\" + ProgramCaption, xLong1) Then
  Call RegSetValueEx_String(xLong1, "", OpeningCaption)
  Call RegCloseKey(xLong1)
  End If
If RegCreateKeyEx(&H80000000, GlobalFileType + "\Shell\" + ProgramCaption + "\Command", xLong1) Then
  xChar1 = Chr(34) + xChar2 + Chr(34) + " " + Chr(34) + "%1" + Chr(34)
  If Not Parameters = "" Then
    xChar1 = xChar1 + " " + Parameters
    End If
  Call RegSetValueEx_String(xLong1, "", xChar1)
  Call RegCloseKey(xLong1)
  End If
End Function

Public Function RegisterFileTypesA_RemoveRegistered(ByVal FileType As String, ByVal ProgramCaption As String, Optional ByVal DefaultActionBackupCaption As String) As Boolean
'returns 0 if found itself's deficon
Dim xLong1 As Long
Dim xLong2 As Long
Dim xLong3 As Long
Dim xBool1 As Boolean
Dim xChar1 As String
'Dim xChar2 As String
Dim xChar3 As String


FileType = LCase(FileType)
If RegOpenKeyEx(&H80000000, "." + FileType, 1&, xLong1) Then
  xBool1 = RegQueryValueEx_String(xLong1, "", xChar1)
  Call RegCloseKey(xLong1)
  End If

If xBool1 Then
  '1/2?
  If RegOpenKeyEx(&H80000000, "", 0&, xLong1) Then
    Call RegDeleteKey(xLong1, xChar1 + "\Shell\" + ProgramCaption)
    If RegOpenKeyEx(&H80000000, xChar1 + "\Shell", 8&, xLong2) Then
      xLong3 = CLng(RegEnumKey(xLong2, 0&, xChar3))   '= 259& Then
      Call RegCloseKey(xLong2)
      If xLong3 = 0& Then
        If Not Len(xChar1) = 0& Then
          If Asc(xChar1) > 34& Or Asc(xChar1) = 33& Then
            Call RegDeleteKey(xLong1, xChar1 + "\Shell")
            End If
          End If
        End If
      End If
    Call RegCloseKey(xLong1)
    End If
  
  If Not Len(DefaultActionBackupCaption) = 0& Then
    If RegOpenKeyEx(&H80000000, xChar1 + "\Shell", 3&, xLong1) Then
      If RegQueryValueEx_String(xLong1, DefaultActionBackupCaption, xChar3) Then
        Call RegSetValueEx_String(xLong1, "", xChar3)
        Call RegDeleteValue(xLong1, DefaultActionBackupCaption)
        End If
      End If
    End If
  
  If RegOpenKeyEx(&H80000000, xChar1 + "\DefaultIcon", 1&, xLong1) Then
    If RegQueryValueEx_String(xLong1, "", xChar3) Then
      xLong3 = 0
      Do
        xLong2 = InStr(xLong3 + 1, xChar3, ",")
        If xLong2 = 0 Then Exit Do
        xLong3 = xLong2
        Loop
      If Not xLong3 = 0 Then
        xChar3 = Left(xChar3, xLong3 - 1)
        End If
      If LCase(xChar3) = LCase(AppBase) Then
        xBool1 = False
        End If
      End If
    Call RegCloseKey(xLong1)
    End If
  If Not xBool1 Then
    If RegOpenKeyEx(&H80000000, "", 2&, xLong1) Then
      Call RegDeleteKey(xLong1, xChar1 + "\DefaultIcon")
      RegisterFileTypesA_RemoveRegistered = True
      Call RegCloseKey(xLong1)
      End If
    End If
  If RegOpenKeyEx(&H80000000, xChar1 + "\Shell", 3&, xLong1) Then
    If RegQueryValueEx_String(xLong1, "", xChar3) Then
      If xChar3 = ProgramCaption Then
        Call RegDeleteValue(xLong1, "")
        End If
      End If
    Call RegCloseKey(xLong1)
    End If
  End If
End Function


