Postup:
Private Declare Function
SetFileAttributes Lib "kernel32" Alias _
"SetFileAttributesA" (ByVal lpFileName As
String, _
ByVal dwFileAttributes As Long) As Long
' Parametry:
' sFolderPath: cesta k adresáři, ke kterému přiřadíte
ikonu
' sIconFile: ikona k asociaci. Může to být .ico, .exe nebo .dll
soubor
' iIconIndex: index ikony pokud soubor jich obsahuje více
'
' Příklad:
' SetFolderIcon "C:\NiceFolder", "C:\Documents\TestIcon.ico"
Sub SetFolderIcon(ByVal sFolderPath As String, ByVal sIconFile As String, _
Optional ByVal iIconIndex As Long = 0)
Dim sContent As String
Dim sDesktopFile As String
Dim bExists As Boolean
Dim handle As Integer
On Error Resume Next
' Test existence souboru i adresáře
bExists = (GetAttr(sFolderPath) And vbDirectory) <>
0 And (GetAttr _
(sIconFile) And vbDirectory) = 0
If bExists = False Or Err.Number <> 0 Then Exit Sub
' Tvorba obsahu souboru
sContent = "[.ShellClassInfo]" & vbCrLf
& "IconIndex=" & iIconIndex & _
vbCrLf & "IconFile="
& sIconFile
'tvorba cesty k souboru desktop.ini
sDesktopFile = sFolderPath & IIf(Right$(sFolderPath,
1) = "\", "", _
"\") &
"desktop.ini"
' Otevření souboru a zapsání obsahu
handle = FreeFile
Open sDesktopFile For Output As #handle
Print #handle, sContent;
Close #handle
' Skrytí souboru a adresář jen Read-Only
SetFileAttributes sDesktopFile, vbHidden
SetFileAttributes sFolderPath, vbReadOnly
End Sub
|