Как сопоставить раширение файла, с моей прогой?

[zorg]

Програма создаёт файлы .xyz
как в в виндовс с помощью vb сопоставить это расширение с моей программой, чтобы при двойном клике, автоматом запускалась моая прога?

[Шурик]

Код: Выделить всё

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
' Return codes from Registration functions.
Const ERROR_SUCCESS = 0&
Const ERROR_BADDB = 1&
Const ERROR_BADKEY = 2&
Const ERROR_CANTOPEN = 3&
Const ERROR_CANTREAD = 4&
Const ERROR_CANTWRITE = 5&
Const ERROR_OUTOFMEMORY = 6&
Const ERROR_INVALID_PARAMETER = 7&
Const ERROR_ACCESS_DENIED = 8&
Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const MAX_PATH = 260&
Private Const REG_SZ = 1

Private Sub Command1_Click()
Dim sKeyName As String
Dim sKeyValue As String
Dim ret&
Dim lphKey&

'Создание ключа "MyApp".
sKeyName = "MyApp"
sKeyValue = "My Application"
ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&)
ret& = RegSetValue&(lphKey&, "", REG_SZ, sKeyValue, 0&)
'Создание ключа, связанного с "MyApp".
sKeyName = ".TXT"  'расширение которое связанно с твоей прогой
sKeyValue = "MyApp"
ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&)
ret& = RegSetValue&(lphKey&, "", REG_SZ, sKeyValue, 0&)
'Коммандная линия для приложения"MyApp".
sKeyName = "MyApp"
sKeyValue = "D:\Basic\MyProjects\SharPad\SharPad.exe %1"
ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&)
ret& = RegSetValue&(lphKey&, "shell\open\command", REG_SZ, sKeyValue, MAX_PATH)

End Sub


[zorg]

в win xp хочу переделать чтобы файлы .pls указывали на мою прогу, а не на winamp
данный пример не прокатывает

как это реализовать в xp?

[Ennor]

Сними в винампе галку Register Types at StartUp или как там она называется. Он при каждом запуске на себя заново регит это дело по дефолту...

[zorg]

с винампом всё ясно, я могу и руками асоциацию файлов переделать,
мне нужно чтобы моя прога могла передалать на себя асоциацию .pls уже после того как винамп её под себя захапал

походу в xp это здесь указывается
HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts\.pls

но вот как грамотно это сделать, чтобы без глюкалова было

[tyomitch]

походу в xp это здесь указывается
HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts\.pls

Ты не прав, этими данными руководствуется только Explorer. Все (другие) прграммы, открывающие файлы через ShellExecute, руководствуется содержимым HKEY_CLASSES_ROOT

[zorg]

to tyomitch

хе, так сам посмотри, если у тебя XP и установлен winamp, то загляни в реестр
HKEY_CLASSES_ROOT\.pls
и что же мы там видим?
(По умолчанию) REG_SZ ft000002
это всё что там есть
а теперь загляни сюда
HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts\.pls
я поменял руками там значенте на мою прогу, и всё стало ок

Я не хочю делать через жопу изменения в рейстре, хочу сделать правилньо, но не знаю к сожелению как

народ помогите, ведь наверника кто то делал

[tyomitch]

У меня там написано "Winamp.PlayList"
А ты посмотри, что в [HKEY_CLASSES_ROOT\ft000002] - наверняка как раз там WinAmp и прописан.

[YB]

Попробуй это. В 98-м работает - сам пробовал. В XP должно.

Sub регистрация_реестр()
With myfiletype
.ProperName = "Имя.Files.View" ' Ключ в реестре, где описаны команды
.FullName = "Название" ' Надпись в списке типов файлов
.ContentType = "Тип" ' Тип содержимого
.Extension = ".xyz" ' Расширение файла
.Commands.Captions.Add "Open"
.Commands.Commands.Add t & "Имя.exe ""%1"""
end with
Call CreateExtension(myfiletype)
End Sub

Sub CreateExtension(newfiletype As filetype)
Dim IconString As String
Dim Result As Long, Result2 As Long, ResultX As Long
Dim ReturnValue As Long, HKeyX As Long
Dim cmdloop As Integer

IconString = newfiletype.IconPath & "," & newfiletype.IconIndex

If Left$(newfiletype.Extension, 1) <> "." Then newfiletype.Extension = "." & newfiletype.Extension

RegCreateKey HKEY_CLASSES_ROOT, newfiletype.Extension, Result
ReturnValue = RegSetValueEx(Result, "", 0, REG_SZ, ByVal newfiletype.ProperName, LenB(StrConv(newfiletype.ProperName, vbFromUnicode)))

If newfiletype.ContentType <> "" Then
ReturnValue = RegSetValueEx(Result, "Content Type", 0, REG_SZ, ByVal _
CStr(newfiletype.ContentType), LenB(StrConv(newfiletype.ContentType, vbFromUnicode)))
End If

RegCreateKey HKEY_CLASSES_ROOT, newfiletype.ProperName, Result

If Not IconString = ",0" Then
RegCreateKey Result, "DefaultIcon", Result2 'Создать ID для "ProperNameDefaultIcon"
ReturnValue = RegSetValueEx(Result2, "", 0, REG_SZ, ByVal IconString, LenB(StrConv(IconString, vbFromUnicode)))
'Установить значение по-умолчанию для ID
End If

ReturnValue = RegSetValueEx(Result, "", 0, REG_SZ, ByVal newfiletype.FullName, LenB(StrConv(newfiletype.FullName, vbFromUnicode)))
RegCreateKey Result, ByVal "Shell", ResultX

'Создать необходимые ID для каждой команды
For cmdloop = 1 To newfiletype.Commands.Captions.Count
RegCreateKey ResultX, ByVal newfiletype.Commands.Captions(cmdloop), Result
RegCreateKey Result, ByVal "Command", Result2
Dim CurrentCommand$
CurrentCommand = newfiletype.Commands.Commands(cmdloop)
ReturnValue = RegSetValueEx(Result2, "", 0, REG_SZ, ByVal CurrentCommand$, LenB(StrConv(CurrentCommand$, vbFromUnicode)))
RegCloseKey Result
RegCloseKey Result2
Next

RegCloseKey Result2
End Sub

Объявления функций не привожу, найдёшь!