Register an extension in Windows registry for extension with an application. One of my old codes that I will need to recheck and validate it is working in recent Windows systems.
Function Associate_Ext(FileExt, FileType, FileTitle ) ' associate .ssh with simple shop
' Register extension in Windows registry
' Needs GetRegKey(), UpdateRegKey(), FixPath()
'
HKEY_CLASSES_ROOT = &H80000000
ShellFolder = "Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders"
t1 = GetRegKey(HKEY_CURRENT_USER, shellfolder, "Templates")
If t1 = "" Then t1 = "C:\WINDOWS\ShellNew"
ress = UpdateRegKey(HKEY_CLASSES_ROOT, fileext, "", filetype)
ress = ress And UpdateRegKey(HKEY_CLASSES_ROOT, filetype, "",filetitle)
t1 = "" & Full1 & ""
ress = ress And UpdateRegKey(HKEY_CLASSES_ROOT, fileext & "\ShellNew", "FileName", CStr(t1))
t1 = "" & FixPath() & App.EXEName & ".exe " & "" & "%1" & ""
ress = ress And UpdateRegKey(HKEY_CLASSES_ROOT, filetype & "\Shell\Open\command", "", CStr(t1))
t1 = "" & FixPath() & App.EXEName & ".exe" & ",1"
ress = ress And UpdateRegKey(HKEY_CLASSES_ROOT, filetype & "\DefaultIcon", "", CStr(t1))
Rett = 0 ' "Association not completed.."
If ress Then Rett = 1 ' "Association has completed.."
Associate_Ext = Rett
End Function
' Old version
' Public Const HKEY_CLASSES_ROOT = &H80000000
' Public Const FileExt = ".ssh"
' Public Const FileType = "Shop.File"
' Public Const FileTitle="File Simple Shop"
' Public Const FileName = "Shop.ssh"
' Public Const ShellFolder="Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders"
' Sub Associate() ' associate .ssh with simple shop
' t1 = GetRegKey(HKEY_CURRENT_USER, shellfolder, "Templates")
' If t1 = "" Then t1 = "C:\WINDOWS\ShellNew"
' Full1 = FixPath(t1) & filename
' Call NewShop(CStr(Full1))
'
' ress = UpdateRegKey(HKEY_CLASSES_ROOT, fileext, "", filetype)
' ress = ress And UpdateRegKey(HKEY_CLASSES_ROOT, filetype, "",filetitle)
' t1 = "" & Full1 & ""
' ress = ress And UpdateRegKey(HKEY_CLASSES_ROOT, fileext & "\ShellNew", "FileName", CStr(t1))
' t1 = "" & FixPath() & App.EXEName & ".exe " & "" & "%1" & ""
' ress = ress And UpdateRegKey(HKEY_CLASSES_ROOT, filetype & "\Shell\Open\command", "", CStr(t1))
' t1 = "" & FixPath() & App.EXEName & ".exe" & ",1"
' ress = ress And UpdateRegKey(HKEY_CLASSES_ROOT, filetype & "\DefaultIcon", "", CStr(t1))
' t1 = "Association not completed.."
' If ress Then t1 = "Association has completed.."
' MsgBox t1, vbInformation
' End Sub
' Register extension in Windows registry
' Needs GetRegKey(), UpdateRegKey(), FixPath()
'
HKEY_CLASSES_ROOT = &H80000000
ShellFolder = "Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders"
t1 = GetRegKey(HKEY_CURRENT_USER, shellfolder, "Templates")
If t1 = "" Then t1 = "C:\WINDOWS\ShellNew"
ress = UpdateRegKey(HKEY_CLASSES_ROOT, fileext, "", filetype)
ress = ress And UpdateRegKey(HKEY_CLASSES_ROOT, filetype, "",filetitle)
t1 = "" & Full1 & ""
ress = ress And UpdateRegKey(HKEY_CLASSES_ROOT, fileext & "\ShellNew", "FileName", CStr(t1))
t1 = "" & FixPath() & App.EXEName & ".exe " & "" & "%1" & ""
ress = ress And UpdateRegKey(HKEY_CLASSES_ROOT, filetype & "\Shell\Open\command", "", CStr(t1))
t1 = "" & FixPath() & App.EXEName & ".exe" & ",1"
ress = ress And UpdateRegKey(HKEY_CLASSES_ROOT, filetype & "\DefaultIcon", "", CStr(t1))
Rett = 0 ' "Association not completed.."
If ress Then Rett = 1 ' "Association has completed.."
Associate_Ext = Rett
End Function
' Old version
' Public Const HKEY_CLASSES_ROOT = &H80000000
' Public Const FileExt = ".ssh"
' Public Const FileType = "Shop.File"
' Public Const FileTitle="File Simple Shop"
' Public Const FileName = "Shop.ssh"
' Public Const ShellFolder="Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders"
' Sub Associate() ' associate .ssh with simple shop
' t1 = GetRegKey(HKEY_CURRENT_USER, shellfolder, "Templates")
' If t1 = "" Then t1 = "C:\WINDOWS\ShellNew"
' Full1 = FixPath(t1) & filename
' Call NewShop(CStr(Full1))
'
' ress = UpdateRegKey(HKEY_CLASSES_ROOT, fileext, "", filetype)
' ress = ress And UpdateRegKey(HKEY_CLASSES_ROOT, filetype, "",filetitle)
' t1 = "" & Full1 & ""
' ress = ress And UpdateRegKey(HKEY_CLASSES_ROOT, fileext & "\ShellNew", "FileName", CStr(t1))
' t1 = "" & FixPath() & App.EXEName & ".exe " & "" & "%1" & ""
' ress = ress And UpdateRegKey(HKEY_CLASSES_ROOT, filetype & "\Shell\Open\command", "", CStr(t1))
' t1 = "" & FixPath() & App.EXEName & ".exe" & ",1"
' ress = ress And UpdateRegKey(HKEY_CLASSES_ROOT, filetype & "\DefaultIcon", "", CStr(t1))
' t1 = "Association not completed.."
' If ress Then t1 = "Association has completed.."
' MsgBox t1, vbInformation
' End Sub
FileExt, FileType, FileTitle
Views 141
Downloads 77
CodeID
DB ID
ANmarAmdeen
614
Revisions
v1.0
Saturday
November
25
2023