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
  xChar1 = Space(1024): xLong3 = 1024
  If RegQueryValueExA(xLong1, "", 0&, xLong2, ByVal xChar1, xLong3) = &O0 Then
    If xLong3 > 0 Then
      xChar1 = Left(xChar1, xLong3 - 1)
      xBool1 = True
      End If
    End If
  Call RegCloseKey(xLong1)
  xChar3 = xChar1
  End If

If xBool1 Then
  If RegOpenKeyEx(&H80000000, xChar1 + "\Shell\" + ProgramCaption + "\Command", 1&, xLong1) Then
    xChar1 = Space(1024): xLong3 = 1024
    If RegQueryValueExA(xLong1, "", 0&, xLong2, ByVal xChar1, xLong3) = &O0 Then
      If xLong3 > 0 Then
        RegisterFileTypesA_GetRegistered = (LCase(Left(xChar1, xLong3 - 1)) = Chr(34) & LCase(AppBase(vbNullChar)) & Chr(34&) & " " & Chr(34&) & "%1" & Chr(34&))
        End If
      End If
    Call RegCloseKey(xLong1)
    If RegOpenKeyEx(&H80000000, xChar3 + "\Shell", 1&, xLong1) Then
      xChar1 = Space(1024): xLong3 = 1024
      If RegQueryValueExA(xLong1, "", 0&, xLong2, ByVal xChar1, xLong3) = &O0 Then
        If xLong3 > 0 Then
          IsDefaultRegistered = (UCase(Left(xChar1, xLong3 - 1&)) = UCase(ProgramCaption))
          End If
        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 = 0, Optional ByVal AsDefaultRegistered As Boolean = False, Optional ByVal PassiveRegistration As Boolean = True) 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
    xChar1 = Space(1024): xLong3 = 1024
    If RegQueryValueExA(xLong1, "", 0&, xLong2, ByVal xChar1, xLong3) = &O0 Then
      If xLong3 > 0 Then
        GlobalFileType = Left(xChar1, xLong3 - 1)
        xBool1 = True
        End If
      End If
    Call RegCloseKey(xLong1)
    End If
  End If

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

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

xChar2 = LCase(AppBase(vbNullChar))
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 Then
  If RegCreateKeyEx(&H80000000, GlobalFileType + "\DefaultIcon", 2&, xLong1) Then
    xChar1 = xChar2 & "," & CStr(IconIndex)
    Call RegSetValueExString(xLong1, "", xChar1)
    RegisterFileTypesA_SetRegistered = True
    Call RegCloseKey(xLong1)
    End If
  End If

If AsDefaultRegistered Then
  If RegCreateKeyEx(&H80000000, GlobalFileType + "\Shell", 2&, xLong1) Then
    Call RegSetValueExString(xLong1, "", ProgramCaption)
    Call RegCloseKey(xLong1)
    End If
  End If

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

Public Function RegisterFileTypesA_RemoveRegistered(ByVal FileType As String, ByVal ProgramCaption 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
  xChar1 = Space(1024): xLong3 = 1024
  If RegQueryValueExA(xLong1, "", 0&, xLong2, ByVal xChar1, xLong3) = &O0 Then
    If xLong3 > 0 Then
      xChar1 = Left(xChar1, xLong3 - 1)
      xBool1 = True
      End If
    End If
  Call RegCloseKey(xLong1)
  End If

If xBool1 Then
  '1/2?
  If RegOpenKeyEx(&H80000000, "", 0&, xLong1) Then
    Call RegDeleteKeyA(xLong1, xChar1 + "\Shell\" + ProgramCaption)
    If RegOpenKeyEx(&H80000000, xChar1 + "\Shell", 8&, xLong2) Then
      xChar3 = vbNullChar
      xLong3 = RegEnumKeyA(xLong2, 0&, ByVal xChar3, 1&) '= 259& Then
      Call RegCloseKey(xLong2)
      If xLong3 = 259& Then
        'Stop
        If Not Len(xChar1) = 0& Then
          If Asc(xChar1) > 34& Or Asc(xChar1) = 33& Then
            Call RegDeleteKeyA(xLong1, xChar1 + "\Shell")
            End If
          End If
        End If
      End If
    Call RegCloseKey(xLong1)
    End If
  
  
  If RegOpenKeyEx(&H80000000, xChar1 + "\DefaultIcon", 1&, xLong1) Then
    xChar3 = Space(1024): xLong3 = 1024
    If RegQueryValueExA(xLong1, "", 0&, xLong2, ByVal xChar3, xLong3) = &O0 Then
      If xLong3 > 0 Then
        xChar3 = Left(xChar3, xLong3 - 1)
        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(vbNullChar)) Then
          xBool1 = False
          End If
        End If
      End If
    Call RegCloseKey(xLong1)
    End If
  If Not xBool1 Then
    If RegOpenKeyExA(&H80000000, "", 2&, xLong1) Then
      Call RegDeleteKeyA(xLong1, xChar1 + "\DefaultIcon")
      RegisterFileTypesA_RemoveRegistered = True
      Call RegCloseKey(xLong1)
      End If
    End If
  If RegOpenKeyEx(&H80000000, xChar1 + "\Shell", 3&, xLong1) Then
    xChar3 = Space(1024): xLong3 = 1024
    If RegQueryValueExA(xLong1, "", 0&, xLong2, ByVal xChar3, xLong3) = &O0 Then
      If xLong3 > 0 Then
        xChar3 = Left(xChar3, xLong3 - 1)
        If xChar3 = ProgramCaption Then
          Call RegDeleteValueA(xLong1, "")
          End If
        End If
      End If
    Call RegCloseKey(xLong1)
    End If
  End If
End Function


