|
|
|
|
|
|
|
|
Dicas
|
|
|
Visual Basic (Windows)
|
|
 |
Título da Dica: Como associar uma extensão ao programa
|
 |
|
|
|
Postada em 14/8/2000 por Webmaster
webmaster@vbweb.com.br
'*** Sempre tome muito cuidado, pois estarás mechendo no Registro do Windows. ***
'Coloque num Modulo
'General Declarations
Public Type mnuCommands
Captions As New Collection
Commands As New Collection
End Type
Public Type filetype
Commands As mnuCommands
Extension As String
ProperName As String
FullName As String
ContentType As String
IconPath As String
IconIndex As Integer
End Type
Public Const REG_SZ As Long = 1
Public Const HKEY_CLASSES_ROOT As Long = &H80000000
Public Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long
Public Declare Function RegCreateKey Lib "advapi32" _
Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal _
lpszSubKey As String, phkResult As Long) As Long
Public Declare Function RegSetValueEx Lib "advapi32" _
Alias "RegSetValueExA" (ByVal hKey As Long, _
ByVal lpszValueName As String, ByVal dwReserved _
As Long, ByVal fdwType As Long, lpbData As Any, _
ByVal cbData As Long) As Long
'Código do Módulo:
Public 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
End If
RegCreateKey HKEY_CLASSES_ROOT,newfiletype.Extension,Result
ReturnValue = RegSetValueEx(Result, "", 0, REG_SZ, _
ByVal newfiletype.ProperName, _
LenB(StrConv(newfiletype.ProperName, _
vbFromUnicode)))
' Acertando o conteúdo
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
'Cria a chave do "ProperName\DefaultIcon"
ReturnValue = RegSetValueEx(Result2, "", 0, REG_SZ, _
ByVal IconString, LenB(StrConv(IconString, _
vbFromUnicode)))
End If
'Atribuir o valor padrão para a chave
ReturnValue = RegSetValueEx(Result, "", 0, REG_SZ, ByVal _
newfiletype.FullName,LenB(StrConv(newfiletype.FullName, _
vbFromUnicode)))
RegCreateKey Result, ByVal "Shell", ResultX
' Criando as subkeys necessárias para cada comando
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
'Então, para associar a Extensão ".MEX" ao Notepad.exe utilize o segunite código:
Dim myfiletype As filetype
myfiletype.ProperName = "MeuArquivo"
myfiletype.FullName = "Meu Arquivo"
myfiletype.ContentType = "AlgumTipoMIME"
myfiletype.Extension = ".MEX" '<< Sua Extensão
myfiletype.Commands.Captions.Add "Open"
myfiletype.Commands.Commands.Add "c:\windows\notepad.exe ""%1"""
myfiletype.Commands.Captions.Add "Print"
myfiletype.Commands.Commands.Add "c:\windows\notepad.exe ""%1"" /P"
CreateExtension myfiletype
'Extension contem a extensão que se deseja associar;
'Propername é o nome do tipo, que você se referenciará
'(não use espaços)
'FullName é a descrição do Tipo
'ContentType é a descrição que verás em seu browser, caso
'estivesse para fazer o download de um arquivo deste tipo.
'Você pode pensar na extensão como um "atalho", o
'"proper name" como o "nome" mesmo e o "fullname" como
'o "título" ou "caption" da exensão.
'Esses "Commands" contêm os "verbos" para o seu tipo. Quando
'você clica com o direito sobre este tipo de arquivo, você
'verá estas opção (verbos). O "Open" foi atribuido como "verbo"
'padrão, assim quando der um duplo clique sobre o arquivo, ele
'executará o comando associado ao "Open".
|
|
|
|
|
