|
Option Explicit
Private Declare Function RegCreateKey Lib "advapi32.dll" _
Alias "RegCreateKeyA" (ByVal hKey As Long, _
ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegSetValue Lib "advapi32.dll" _
Alias "RegSetValueA" (ByVal hKey As Long, _
ByVal lpSubKey As String, ByVal dwType As Long, _
ByVal lpData As String, ByVal cbData As Long) As Long
Private Declare Sub SHChangeNotify Lib "shell32.dll" _
(ByVal wEventId As Long, ByVal uFlags As Long, _
dwItem1 As Any, dwItem2 As Any)
Const HKEY_CLASSES_ROOT = &H80000000
Const MAX_PATH = 260&
Const REG_SZ = 1
Const SHCNE_ASSOCCHANGED = &H8000000
Const SHCNF_IDLIST = &H0&
Private Sub Form_Load()
RTFBox.LoadFile Command()
End Sub
Private Sub cmdRegistryEintrag_Click()
Dim sKeyName As String
Dim sKeyValue As String
Dim ret&
Dim lphKey&
Dim pfad As String
pfad = App.Path
If Right(pfad, 1) <> "\" Then pfad = pfad & "\"
sKeyName = "VBfunApp"
sKeyValue = "VBfun Application"
ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&)
ret& = RegSetValue&(lphKey&, "", REG_SZ, sKeyValue, 0&)
sKeyName = ".FUN"
sKeyValue = "VBfunApp"
ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&)
ret& = RegSetValue&(lphKey&, "", REG_SZ, sKeyValue, 0&)
sKeyName = "VBfunApp"
sKeyValue = pfad & "VBfunApp.exe %1"
ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&)
ret& = RegSetValue&(lphKey&, "shell\open\command", REG_SZ, _
sKeyValue, MAX_PATH)
sKeyName = "VBfunApp"
sKeyValue = pfad & "VBfunIcon.ico"
ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&)
ret& = RegSetValue&(lphKey&, "DefaultIcon", REG_SZ, _
sKeyValue, MAX_PATH)
SHChangeNotify SHCNE_ASSOCCHANGED, SHCNF_IDLIST, 0, 0
RTFBox.Text = "Dateien mit der Endung >> *.fun << werden " & _
"nun mit dem VB-Programm VBfunApp.exe geöffnet !!"
End Sub
|
|