PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Retrieve available programs for a certain file-extention...

https://www.purebasic.fr/english/viewtopic.php?t=73428

Page 1 of 1

Retrieve available programs for a certain file-extention...

Posted: Mon Aug 19, 2019 11:29 am
by Joris
Hi,

Windows OS related :
How can I retrieve the available programs for a certain file (extention), wav, txt or whatever.
I wont to put them in a list shown when right click a filename (like explorer) and then start that program.
(RunProgram()....)
So for example to open a txt-file with Notepad or Ultra Edit or whatever program, I can choose then from the list made up.

Thanks.

Re: Retrieve available programs for a certain file-extention

Posted: Mon Aug 19, 2019 12:05 pm
by mk-soft
I found a old Registry Include on my Server... :wink:

Code: Select all

;-TOP
; Kommentar     : Read and change the Registry / FileAssociate
; Author        : Unknown
; Second Author : mk-soft
; Datei         : Registry.pbi
; Version       : 1.02
; Erstellt      : ???
; Geändert      : 18.11.2007, 19.08.2019 (X64)
; 
; Compilermode  :
;
; ***************************************************************************************

;#PB_Lit2Msg stop

;EnableExplicit

; ***************************************************************************************

Global RegLastError.i
Global RegLastMessage.s

Structure udtDataValue
  StructureUnion
    sVal.s{#MAX_PATH}
    lVal.l
    qVal.q
  EndStructureUnion
EndStructure

; ***************************************************************************************

CompilerIf Defined(FormatMessage, #PB_Procedure) = #False
  
  Procedure.s FormatMessage(ErrorNumber.i)

    Protected *Buffer, len, result.s
    
    len = FormatMessage_(#FORMAT_MESSAGE_ALLOCATE_BUFFER|#FORMAT_MESSAGE_FROM_SYSTEM,0,ErrorNumber,0,@*Buffer,0,0)
    If len
      result = PeekS(*Buffer, len - 2)
      LocalFree_(*Buffer)
      ProcedureReturn result
    Else
      ProcedureReturn "Errorcode: " + Hex(ErrorNumber)
    EndIf
    
  EndProcedure

CompilerEndIf

; ***************************************************************************************

Procedure Reg_SetValue(topKey, sKeyName.s, sValueName.s, vValue.s, lType, ComputerName.s = "")
   
  Protected hKey.i, lhRemoteRegistry.i
  Protected r1.i, Result.i
  Protected lpData.s{256}
  Protected lpcbData.i, lValue.i
  
  RegLastError = 0
  
  If Left(sKeyName, 1) = "\" : sKeyName = Right(sKeyName, Len(sKeyName) - 1) : EndIf
  If Right(sKeyName,1)="\" : sKeyName = Left(sKeyName, Len(sKeyName) - 1) : EndIf
  If ComputerName = ""
    r1 = RegOpenKeyEx_(topKey, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
  Else
    r1 = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry)
    If r1 <> #ERROR_SUCCESS
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
      ProcedureReturn #False
    EndIf
    r1 = RegOpenKeyEx_(lhRemoteRegistry, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
  EndIf
  
  If r1 = #ERROR_SUCCESS
    lpcbData = 255
    Select lType
      Case #REG_SZ
        r1 = RegSetValueEx_(hKey, sValueName, 0, #REG_SZ, @vValue, Len(vValue) + 1)
      Case #REG_DWORD
        lValue = Val(vValue)
        r1 = RegSetValueEx_(hKey, sValueName, 0, #REG_DWORD, @lValue, 4)
    EndSelect
    If r1 = #ERROR_SUCCESS
      Result = #True
    Else
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
      Result = #False
    EndIf
  Else
    RegLastError = r1
    RegLastMessage = FormatMessage(RegLastError)
    Result = #False
  EndIf
  
  ; Close Key
  RegCloseKey_(hKey)
  ; Close Remote
  If lhRemoteRegistry
    RegCloseKey_(lhRemoteRegistry)
  EndIf
  
  ProcedureReturn Result
  
EndProcedure

; ***************************************************************************************

Procedure.s Reg_GetValue(topKey, sKeyName.s, sValueName.s, ComputerName.s = "")
   
  Protected hKey.i, lhRemoteRegistry.i
  Protected r1.i, Result.i
  Protected lpData.udtDataValue, GetValue.s
  Protected lType.i, lpcbData.i
  
  RegLastError = 0
  GetValue.s = ""
  
  If Left(sKeyName, 1) = "\" : sKeyName = Right(sKeyName, Len(sKeyName) - 1) : EndIf
  If Right(sKeyName,1)="\" : sKeyName = Left(sKeyName, Len(sKeyName) - 1) : EndIf
  
  If ComputerName = ""
    r1 = RegOpenKeyEx_(topKey, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
  Else
    r1 = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry)
    If r1 <> #ERROR_SUCCESS
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
      ProcedureReturn ""
    EndIf
    r1 = RegOpenKeyEx_(lhRemoteRegistry, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
  EndIf
  
  If r1 = #ERROR_SUCCESS
    lpcbData = #MAX_PATH
    r1 = RegQueryValueEx_(hKey, sValueName, 0, @lType, @lpData, @lpcbData)
    If r1 = #ERROR_SUCCESS
      Select lType
        Case #REG_SZ
          GetValue = lpData\sVal
        Case #REG_DWORD
          GetValue = Str(lpData\lVal)
        Case #REG_QWORD
          GetValue = Str(lpData\qVal)
      EndSelect
    Else 
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
    EndIf
  Else
    RegLastError = r1
    RegLastMessage = FormatMessage(RegLastError)
  EndIf
  
  ; Close Key
  RegCloseKey_(hKey)
  ; Close Remote
  If lhRemoteRegistry
    RegCloseKey_(lhRemoteRegistry)
  EndIf
  
  ProcedureReturn GetValue
  
EndProcedure

; ***************************************************************************************

Procedure.s Reg_ListSubKey(topKey, sKeyName.s, Index, ComputerName.s = "")
 
  Protected hKey.i, lhRemoteRegistry.i
  Protected r1.i, Result.i
  Protected lpName.s{256}, ListSubKey.s
  Protected lpcbName.i
  Protected lpftLastWriteTime.FILETIME
  
  RegLastError = 0
  
  If Left(sKeyName, 1) = "\" : sKeyName = Right(sKeyName, Len(sKeyName) - 1) : EndIf
  If Right(sKeyName,1)="\" : sKeyName = Left(sKeyName, Len(sKeyName) - 1) : EndIf
  
  If ComputerName = ""
    r1 = RegOpenKeyEx_(topKey, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
  Else
    r1 = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry)
    If r1 <> #ERROR_SUCCESS
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
      ProcedureReturn ""
    EndIf
    r1 = RegOpenKeyEx_(lhRemoteRegistry, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
  EndIf
  
  If r1 = #ERROR_SUCCESS
    lpcbName = 255
    r1 = RegEnumKeyEx_(hKey, Index, @lpName, @lpcbName, 0, 0, 0, @lpftLastWriteTime)
    If r1 = #ERROR_SUCCESS
      ListSubKey.s = Left(lpName, lpcbName)
    Else
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
      ListSubKey.s = ""
    EndIf
  Else 
    RegLastError = r1
    RegLastMessage = FormatMessage(RegLastError)
    ListSubKey.s = ""
  EndIf
  
  ; Close Key
  RegCloseKey_(hKey)
  ; Close Remote
  If lhRemoteRegistry
    RegCloseKey_(lhRemoteRegistry)
  EndIf
  
  ProcedureReturn ListSubKey

EndProcedure

; ***************************************************************************************

Procedure Reg_DeleteValue(topKey, sKeyName.s, sValueName.s, ComputerName.s = "")
  
  Protected hKey.i, lhRemoteRegistry.i
  Protected r1.i, DeleteValue.i
  
  RegLastError = 0
  
  If Left(sKeyName, 1) = "\" : sKeyName = Right(sKeyName, Len(sKeyName) - 1) : EndIf
  If Right(sKeyName,1)="\" : sKeyName = Left(sKeyName, Len(sKeyName) - 1) : EndIf
  
  If ComputerName = ""
    r1 = RegOpenKeyEx_(topKey, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
  Else
    r1 = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry)
    If r1 <> #ERROR_SUCCESS
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
      ProcedureReturn #False
    EndIf
    r1 = RegOpenKeyEx_(lhRemoteRegistry, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
  EndIf
  
  If r1 = #ERROR_SUCCESS
    r1 = RegDeleteValue_(hKey, @sValueName)
    If r1 = #ERROR_SUCCESS
      DeleteValue = #True
    Else
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
      DeleteValue = #False
    EndIf
  Else 
    RegLastError = r1
    RegLastMessage = FormatMessage(RegLastError)
    DeleteValue = #False
  EndIf
  
  ; Close Key
  RegCloseKey_(hKey)
  ; Close Remote
  If lhRemoteRegistry
    RegCloseKey_(lhRemoteRegistry)
  EndIf
  
  ProcedureReturn DeleteValue
  
EndProcedure

; ***************************************************************************************

Procedure Reg_CreateKey(topKey, sKeyName.s, ComputerName.s = "")
  
  ; Result #REG_CREATED_NEW_KEY = 1
  ; Result #REG_OPENED_EXISTING_KEY = 2
  
  Protected hKey.i, lhRemoteRegistry.i
  Protected r1.i, CreateKey.i
  Protected lpSecurityAttributes.SECURITY_ATTRIBUTES
  
  RegLastError = 0
  
  If Left(sKeyName, 1) = "\" : sKeyName = Right(sKeyName, Len(sKeyName) - 1) : EndIf
  If Right(sKeyName,1)="\" : sKeyName = Left(sKeyName, Len(sKeyName) - 1) : EndIf
  
  If ComputerName = ""
    r1 = RegCreateKeyEx_(topKey, sKeyName, 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, @lpSecurityAttributes, @hKey, @CreateKey)
  Else
    r1 = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry)
    If r1 <> #ERROR_SUCCESS
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
      ProcedureReturn #False
    EndIf
    r1 = RegCreateKeyEx_(lhRemoteRegistry, sKeyName, 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, @lpSecurityAttributes, @hKey, @CreateKey)
  EndIf
  
  If r1 = #ERROR_SUCCESS
    ;
  Else
    RegLastError = r1
    RegLastMessage = FormatMessage(RegLastError)
  EndIf
  
  ; Close Key
  RegCloseKey_(hKey)
  ; Close Remote
  If lhRemoteRegistry
    RegCloseKey_(lhRemoteRegistry)
  EndIf
  
  ProcedureReturn CreateKey

EndProcedure

; ***************************************************************************************

Procedure Reg_DeleteKey(topKey, sKeyName.s, ComputerName.s = "")
  
  Protected hKey.i, lhRemoteRegistry.i
  Protected r1.i, DeleteKey.i
  
  RegLastError = 0
  
  If Left(sKeyName, 1) = "\" : sKeyName = Right(sKeyName, Len(sKeyName) - 1) : EndIf
  If Right(sKeyName,1)="\" : sKeyName = Left(sKeyName, Len(sKeyName) - 1) : EndIf
  
  If ComputerName = ""
    r1 = RegDeleteKey_(topKey, @sKeyName)
  Else
    r1 = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry)
    If r1 <> #ERROR_SUCCESS
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
      ProcedureReturn #False
    EndIf
    r1 = RegDeleteKey_(lhRemoteRegistry, @sKeyName)
  EndIf
  
  If r1 = #ERROR_SUCCESS
    DeleteKey = #True
  Else
    DeleteKey = #False
    RegLastError = r1
    RegLastMessage = FormatMessage(RegLastError)
  EndIf
  
  ; Close Remote
  If lhRemoteRegistry
    RegCloseKey_(lhRemoteRegistry)
  EndIf
  
  ProcedureReturn DeleteKey

EndProcedure

; ***************************************************************************************

Procedure.s Reg_ListSubValue(topKey, sKeyName.s, Index, ComputerName.s = "")
  
  Protected hKey.i, lhRemoteRegistry.i
  Protected r1.i, Result.i
  Protected lpName.s{256}, ListSubValue.s
  Protected lpcbName.i
  Protected lpftLastWriteTime.FILETIME
  
  RegLastError = 0
  
  If Left(sKeyName, 1) = "\" : sKeyName = Right(sKeyName, Len(sKeyName) - 1) : EndIf
  If Right(sKeyName,1)="\" : sKeyName = Left(sKeyName, Len(sKeyName) - 1) : EndIf
  
  If ComputerName = ""
    r1 = RegOpenKeyEx_(topKey, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
  Else
    r1 = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry)
    If r1 <> #ERROR_SUCCESS
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
      ProcedureReturn ""
    EndIf
    r1 = RegOpenKeyEx_(lhRemoteRegistry, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
  EndIf
  
  If r1 = #ERROR_SUCCESS
    lpcbName = 255
    r1 = RegEnumValue_(hKey, Index, @lpName, @lpcbName, 0, 0, 0, 0)
    If r1 = #ERROR_SUCCESS
      ListSubValue = Left(lpName, lpcbName)
    Else
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
      ListSubValue.s = ""
    EndIf
  Else 
    RegLastError = r1
    RegLastMessage = FormatMessage(RegLastError)
    ListSubValue.s = ""
  EndIf
  
  ; Close Key
  RegCloseKey_(hKey)
  ; Close Remote
  If lhRemoteRegistry
    RegCloseKey_(lhRemoteRegistry)
  EndIf
  
  ProcedureReturn ListSubValue
   
EndProcedure

; ***************************************************************************************

Procedure Reg_KeyExists(topKey, sKeyName.s, ComputerName.s = "")
   
  Protected hKey.i, lhRemoteRegistry.i
  Protected r1.i, KeyExists.i
  
  RegLastError = 0
  
  If Left(sKeyName, 1) = "\" : sKeyName = Right(sKeyName, Len(sKeyName) - 1) : EndIf
  If Right(sKeyName,1)="\" : sKeyName = Left(sKeyName, Len(sKeyName) - 1) : EndIf
  
  If ComputerName = ""
    r1 = RegOpenKeyEx_(topKey, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
  Else
    r1 = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry)
    If r1 <> #ERROR_SUCCESS
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
      ProcedureReturn #False
    EndIf
    r1 = RegOpenKeyEx_(lhRemoteRegistry, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
  EndIf
  
  If r1 = #ERROR_SUCCESS
    KeyExists = #True
  Else
    RegLastError = r1
    RegLastMessage = FormatMessage(RegLastError)
    KeyExists = #False
  EndIf
  
  ; Close Key
  RegCloseKey_(hKey)
  ; Close Remote
  If lhRemoteRegistry
    RegCloseKey_(lhRemoteRegistry)
  EndIf
  
  ProcedureReturn KeyExists
  
EndProcedure

; ***************************************************************************************

Procedure Reg_DeleteKeyWithAllSub(topKey,sKeyName.s,ComputerName.s = "")
   
   Protected i.i
   Protected a$="", b$
   
   Repeat
      b$=a$
      a$=Reg_ListSubKey(topKey,sKeyName,0,"")
      If a$<>""
         Reg_DeleteKeyWithAllSub(topKey,sKeyName+"\"+a$,"")
      EndIf
   Until a$=b$
   Reg_DeleteKey(topKey, sKeyName, ComputerName)
EndProcedure

; ***************************************************************************************

Procedure Reg_CreateKeyValue(topKey,sKeyName.s,sValueName.s,vValue.s,lType,ComputerName.s = "")
   Reg_CreateKey(topKey,sKeyName,ComputerName)
   ProcedureReturn Reg_SetValue(topKey,sKeyName,sValueName,vValue,lType,ComputerName)
EndProcedure

; ***************************************************************************************

Procedure AssociateFileEx(AF_Ext$,ext_description$,programm$,icon$,prgkey$,cmd_description$,cmd_key$)
   
   Protected cmd$, key$
   
   cmd$=Chr(34)+programm$+Chr(34)+" "+Chr(34)+"%1"+Chr(34)
   If GetVersion_() & $FF0000 ; Windows NT/XP
      Reg_CreateKeyValue(#HKEY_CLASSES_ROOT, "Applications\"+prgkey$+"\shell\"+cmd_description$+"\command","",cmd$,#REG_SZ,"")
      If ext_description$
         Key$=AF_Ext$+"_auto_file"
         Reg_CreateKeyValue(#HKEY_CLASSES_ROOT  ,"."+AF_Ext$           ,"",Key$            ,#REG_SZ,"")
         Reg_CreateKeyValue(#HKEY_CLASSES_ROOT  ,Key$               ,"",ext_description$,#REG_SZ,"")
         If icon$
            Reg_CreateKeyValue(#HKEY_CLASSES_ROOT,Key$+"\DefaultIcon","",icon$           ,#REG_SZ,"")
         EndIf
      EndIf
      Reg_CreateKeyValue(#HKEY_CURRENT_USER,"Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts\."+AF_Ext$,"Application",prgkey$,#REG_SZ,"")
   Else ;Windows 9x
      Reg_CreateKeyValue(#HKEY_LOCAL_MACHINE  ,"Software\Classes\."+AF_Ext$                     ,"",prgkey$         ,#REG_SZ,"")
      If ext_description$
         Reg_CreateKeyValue(#HKEY_LOCAL_MACHINE,"Software\Classes\"+prgkey$                   ,"",ext_description$,#REG_SZ,"")
      EndIf
      If icon$
         Reg_CreateKeyValue(#HKEY_LOCAL_MACHINE,"Software\Classes\"+prgkey$+"\DefaultIcon"    ,"",icon$           ,#REG_SZ,"")
      EndIf
      If cmd_description$<>cmd_key$
         Reg_CreateKeyValue(#HKEY_LOCAL_MACHINE,"Software\Classes\"+prgkey$+"\shell\"+cmd_key$,"",cmd_description$,#REG_SZ,"")
      EndIf
      Reg_CreateKeyValue(#HKEY_LOCAL_MACHINE  ,"Software\Classes\"+prgkey$+"\shell\"+cmd_key$+"\command","",cmd$,#REG_SZ,"")
   EndIf
EndProcedure

; ***************************************************************************************

Procedure Remove_AssociateFile(AF_Ext$,prgkey$)
   
   Protected key$
   
   If GetVersion_() & $FF0000 ; Windows NT/XP
      Reg_DeleteKeyWithAllSub(#HKEY_CLASSES_ROOT,"Applications\"+prgkey$,"")
      key$=AF_Ext$+"_auto_file"
      Reg_DeleteKeyWithAllSub(#HKEY_CLASSES_ROOT,"."+AF_Ext$,"")
      Reg_DeleteKeyWithAllSub(#HKEY_CLASSES_ROOT,key$,"")
      Reg_DeleteKeyWithAllSub(#HKEY_CURRENT_USER,"Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts\."+AF_Ext$,"")
   Else ;Windows 9x
      Reg_DeleteKeyWithAllSub(#HKEY_LOCAL_MACHINE  ,"Software\Classes\."+AF_Ext$,"")
      Reg_DeleteKeyWithAllSub(#HKEY_LOCAL_MACHINE,"Software\Classes\"+prgkey$,"")
   EndIf
EndProcedure

; ***************************************************************************************

Procedure AssociateFile(AF_Ext$,ext_description$,programm$,icon$)
   AssociateFileEx(AF_Ext$,ext_description$,programm$,icon$,GetFilePart(programm$),"open","open")
EndProcedure
;#PB_Lit2Msg start

; ***************************************************************************************

CompilerIf #PB_Compiler_IsMainFile
  
  Procedure GetOpenWithList(FileExts.s, List Result.s())
    Protected KeyName.s, MRUList.s, Index
    ClearList(Result())
    If Left(FileExts, 1) <> "."
      FileExts = "." + FileExts
    EndIf
    KeyName = "Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts\" + FileExts + "\OpenWithList"
    MRUList = Reg_GetValue(#HKEY_CURRENT_USER, KeyName, "MRUList")
    For Index = 1 To Len(MRUList)
      AddElement(Result())
      Result() = Reg_GetValue(#HKEY_CURRENT_USER, KeyName, Mid(MRUList, Index, 1))
    Next
    ProcedureReturn ListSize(Result())
  EndProcedure
  
  Global NewList Result.s()
  
  Debug "Count " + GetOpenWithList(".txt", Result())
  ForEach Result()
    Debug Result()
  Next
    
CompilerEndIf

Re: Retrieve available programs for a certain file-extention

Posted: Mon Aug 19, 2019 8:04 pm
by Joris
Thanks mk-soft.
I need to clean up my registery too, as I see many rare programs to open txt files...

Re: Retrieve available programs for a certain file-extention

Posted: Tue Aug 20, 2019 8:46 am
by Joris
mk-soft do you (or anyone else) have more expanded examples on how to use all of the code above.
I'de like to learn more on what's possible with all of it, not just the "Reg_GetValue()".
The registery is not directly a thing to start experimenting with, so ...

Thanks.

Re: Retrieve available programs for a certain file-extention

Posted: Tue Aug 20, 2019 11:11 am
by mk-soft
The registry is also a thing you shouldn't experiment with.
There you will find important system information.

Usually I only read from the registry...

See Running "RegEdit.exe".
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited