COLOCAR UMA ICONE DE ACORDO COM SUA EXTENSAO?
Como faço para colocar uma icone em todos os arquivos que estejam com a extensão .bkp por exemplo? Toda vez que eu gerar um backup, automaticamente ele coloco uma icone no arquivo gerado em vez de ficar um arquivo desconhecido.
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
' 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 Declare Sub SHChangeNotify Lib "shell32.dll" _
(ByVal wEventId As Long, _
ByVal uFlags As Long, _
dwItem1 As Any, _
dwItem2 As Any)
Const SHCNE_ASSOCCHANGED = &H8000000
Const SHCNF_IDLIST = &H0&
Private Sub Form_Click()
Dim sKeyName As String ' Holds Key Name in registry.
Dim sKeyValue As String ' Holds Key Value in registry.
Dim ret& ' Holds error status if any from API calls.
Dim lphKey& ' Holds key handle from RegCreateKey.
Dim path As String
path = App.path
If Right(path, 1) <> "\" Then
path = path & "\"
End If
' This creates a Root entry called "MyApp".
sKeyName = "MyApp"
sKeyValue = "My Application"
ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&)
ret& = RegSetValue&(lphKey&, "", REG_SZ, sKeyValue, 0&)
' This creates a Root entry called .BAR associated with "MyApp".
sKeyName = ".BAR"
sKeyValue = "MyApp"
ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&)
ret& = RegSetValue&(lphKey&, "", REG_SZ, sKeyValue, 0&)
' This sets the command line for "MyApp".
sKeyName = "MyApp"
sKeyValue = path & "MyApp.exe %1"
ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&)
ret& = RegSetValue&(lphKey&, "shell\open\command", REG_SZ, _
sKeyValue, MAX_PATH)
' This sets the icon for the file extension
sKeyName = "MyApp"
sKeyValue = path & "myIcon.ico"
ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&)
ret& = RegSetValue&(lphKey&, "DefaultIcon", REG_SZ, _
sKeyValue, MAX_PATH)
' This notifies the shell that the icon has changed
SHChangeNotify SHCNE_ASSOCCHANGED, SHCNF_IDLIST, 0, 0
End Sub
Private Sub Form_Load()
' When the file is double clicked the name is stored in Command()
RichTextBox1.LoadFile Command()
End Sub
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 Declare Sub SHChangeNotify Lib "shell32.dll" _
(ByVal wEventId As Long, _
ByVal uFlags As Long, _
dwItem1 As Any, _
dwItem2 As Any)
Const SHCNE_ASSOCCHANGED = &H8000000
Const SHCNF_IDLIST = &H0&
Private Sub Form_Click()
Dim sKeyName As String ' Holds Key Name in registry.
Dim sKeyValue As String ' Holds Key Value in registry.
Dim ret& ' Holds error status if any from API calls.
Dim lphKey& ' Holds key handle from RegCreateKey.
Dim path As String
path = App.path
If Right(path, 1) <> "\" Then
path = path & "\"
End If
' This creates a Root entry called "MyApp".
sKeyName = "MyApp"
sKeyValue = "My Application"
ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&)
ret& = RegSetValue&(lphKey&, "", REG_SZ, sKeyValue, 0&)
' This creates a Root entry called .BAR associated with "MyApp".
sKeyName = ".BAR"
sKeyValue = "MyApp"
ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&)
ret& = RegSetValue&(lphKey&, "", REG_SZ, sKeyValue, 0&)
' This sets the command line for "MyApp".
sKeyName = "MyApp"
sKeyValue = path & "MyApp.exe %1"
ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&)
ret& = RegSetValue&(lphKey&, "shell\open\command", REG_SZ, _
sKeyValue, MAX_PATH)
' This sets the icon for the file extension
sKeyName = "MyApp"
sKeyValue = path & "myIcon.ico"
ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&)
ret& = RegSetValue&(lphKey&, "DefaultIcon", REG_SZ, _
sKeyValue, MAX_PATH)
' This notifies the shell that the icon has changed
SHChangeNotify SHCNE_ASSOCCHANGED, SHCNF_IDLIST, 0, 0
End Sub
Private Sub Form_Load()
' When the file is double clicked the name is stored in Command()
RichTextBox1.LoadFile Command()
End Sub
Tópico encerrado , respostas não são mais permitidas