UAC aufpoppen müssen.
Code: Alles auswählen
EnableExplicit
Procedure CreateRegistryKeyValue(topKey.i, KeyName$, ValueName$, Value$, Type.i = #REG_SZ, ComputerName$ = "")
Protected SecurityAttributes.SECURITY_ATTRIBUTES
Protected NewKey.i, GetHandle.i, RemoteRegistry.i
Protected Datas$, Value.i
Protected cbData.i
; Key erstellen
If Left(KeyName$, 1) = "\"
KeyName$ = Right(KeyName$, Len(KeyName$) - 1)
EndIf
If ComputerName$ = ""
GetHandle = RegCreateKeyEx_(topKey, KeyName$, 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_WRITE, @SecurityAttributes, @NewKey, @GetHandle)
Else
RegConnectRegistry_(ComputerName$, topKey, @RemoteRegistry)
GetHandle = RegCreateKeyEx_(RemoteRegistry, KeyName$, 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_WRITE, @SecurityAttributes, @NewKey, @GetHandle)
EndIf
; Key setzen
If GetHandle = #ERROR_SUCCESS
cbData = 255
Datas$ = Space(255)
Select Type
Case #REG_SZ
GetHandle = RegSetValueEx_(NewKey, ValueName$, 0, #REG_SZ, @Value$, StringByteLength(Value$) + SizeOf(Character))
Case #REG_DWORD
Value = Val(Value$)
GetHandle = RegSetValueEx_(NewKey, ValueName$, 0, #REG_DWORD, @Value$, 4)
EndSelect
RegCloseKey_(NewKey)
EndIf
EndProcedure
Procedure Reg_KeyExists(topKey, sKeyName.s)
Protected GetHandle, hKey, KeyExists
If Left(sKeyName, 1) = "\"
sKeyName = Right(sKeyName, Len(sKeyName) - 1)
EndIf
GetHandle = RegOpenKeyEx_(topKey, sKeyName, 0, #KEY_READ, @hKey)
If GetHandle = #ERROR_SUCCESS
KeyExists = #True
Else
KeyExists = #False
EndIf
ProcedureReturn KeyExists
EndProcedure
Procedure AssociateFileExtension(Key$, Ext$, ExtDescription$, Programm$, Icon$, CmdDescription$) ; Dateierweiterung in Registry eintragen
Protected Cmd$ ; Command
Protected CmdPath$ ; Pfad zu dem Eintrag
CmdPath$ = Key$ + "\shell\" + CmdDescription$ + "\command" ; Pfad erstellen
Cmd$ = Chr('"') + Programm$ + Chr('"') + " " + Chr('"') + "%1" + Chr('"') ; Command erstellen
CreateRegistryKeyValue(#HKEY_CLASSES_ROOT, "." + Ext$, "", Key$) ; Schlüssel für die Erweiterung
CreateRegistryKeyValue(#HKEY_CLASSES_ROOT, Key$, "", ExtDescription$) ; Beschreibung
CreateRegistryKeyValue(#HKEY_CLASSES_ROOT, CmdPath$, "", Cmd$) ; Programmaufruf
If Icon$ ; Wenn ein Icon angegeben ist ...
CreateRegistryKeyValue(#HKEY_CLASSES_ROOT, Key$ + "\DefaultIcon", "", Icon$) ; Icon-Datei eintragen
EndIf
EndProcedure
;- Beispiel
Procedure DoFileAssociate(ext.s)
Protected Prg.s, Exe.s
Prg = ProgramFilename()
Exe = GetFilePart(Prg)
Exe = Left(Exe, Len(Exe) - 4)
If OSVersion() >= #PB_OS_Windows_2000
Select ext
Case "prf", "inc", "ph", "profan", "xprf"
AssociateFileExtension(ext + "_auto_file", ext, "XProfan-Datei", Prg, "", "edit")
Case "psc"
AssociateFileExtension("psc_auto_file", "psc", "Profan-Script", Prg, "", "edit")
Case "xscript"
AssociateFileExtension("xscript_auto_file", "xscript", "X-ProfPad Script", Prg, "", "open")
EndSelect
EndIf
EndProcedure
Procedure RemoveFileAssociate(ext.s)
Protected Prg.s, Exe.s
Prg = ProgramFilename()
Exe = GetFilePart(Prg)
Exe = Left(Exe, Len(Exe) - 4)
Prg = ProgramFilename()
If OSVersion() >= #PB_OS_Windows_2000
Select ext
Case "prf", "inc", "ph", "profan", "xprf"
RegDeleteKey_(#HKEY_CLASSES_ROOT, ext + "_auto_file\shell\edit\command")
RegDeleteKey_(#HKEY_CLASSES_ROOT, ext + "_auto_file\shell\edit")
Case "psc"
RegDeleteKey_(#HKEY_CLASSES_ROOT, "psc_auto_file\shell\edit\command")
RegDeleteKey_(#HKEY_CLASSES_ROOT, "psc_auto_file\shell\edit")
Case "xscript"
RegDeleteKey_(#HKEY_CLASSES_ROOT, "xscript_auto_file\shell\open\command")
RegDeleteKey_(#HKEY_CLASSES_ROOT, "xscript_auto_file\shell\open")
EndSelect
EndIf
EndProcedure
Procedure IsFileAssociate(ext.s)
Protected Prg.s, Exe.s
Prg = ProgramFilename()
Exe = GetFilePart(Prg)
Exe = Left(Exe, Len(Exe) - 4)
Prg = ProgramFilename()
If OSVersion() >= #PB_OS_Windows_2000
Select ext
Case "prf", "inc", "ph", "profan", "xprf"
ProcedureReturn Reg_KeyExists(#HKEY_CLASSES_ROOT, ext + "_auto_file\shell\edit")
Case "psc"
ProcedureReturn Reg_KeyExists(#HKEY_CLASSES_ROOT, "psc_auto_file\shell\edit")
Case "xscript"
ProcedureReturn Reg_KeyExists(#HKEY_CLASSES_ROOT, "xscript_auto_file\shell\open")
EndSelect
EndIf
EndProcedure