自定义指定文件夹的图标

mbskys 2021-09-05 原文

.adHeadline { font: bold 10pt Arial; color: rgba(0, 0, 205, 1); text-decoration: underline }
.adText { font: 10pt Arial; color: rgba(0, 64, 64, 1); text-decoration: none }

编程思路：按一定格式在文件夹中建立Desktop.ini文件并将文件夹的属性设置为系统属性即可自定义文件夹的图标。文件的建立不难，关键是更改文件夹属性，得用上VB的内部函数Attributes来实现。

Desktop.ini文件格式：
[.ShellClassInfo]
IconIndex=0
iconfile=Icon图标所在的驱动器我+路径名+文件名

下面是完整的程序代码。使用前请给工程添加一个按钮、一个公共对话框、一个DriveListBox和一个DirListBox。

Option Explicit

Dim sPath As String \’文件夹变量

Private Sub Dir1_Click()
Dim i As Integer
Command1.Enabled = True
i = Dir1.ListIndex
sPath = Dir1.List(i)
End Sub

Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub

Private Sub Form_Load()
Command1.Caption = “定义文件夹图标”
Command1.Enabled = False
End Sub

Private Sub Command1_Click()
ChangeFolderInfo sPath \’更改目录为系统文件

Dim s As String \’图标文件路径、名称变量
With CommonDialog1
.Filter = “(*.ico)|*.ico”
.DialogTitle = “查找图标”
.ShowOpen
s = .FileName
End With

Open sPath + “\” + “desktop.ini” For Output As #1
Print #1, “[.ShellClassInfo]” + vbCrLf + “IconIndex=0” + vbCrLf + “iconfile=” + s
Close #1

ChangeFileInfo (sPath + “\” + “desktop.ini”)
End Sub

\’赋予文件夹系统属性子程序
Private Sub ChangeFolderInfo(folderspec)
Dim fs, f
Set fs = CreateObject(“Scripting.FileSystemObject”)
Set f = fs.GetFolder(folderspec)
f.Attributes = 4 \’用Attributes函数设置文件夹属性
End Sub

\’赋予Desktop.ini文件隐藏属性
Private Sub ChangeFileInfo(filespec)
Dim fs, f
Set fs = CreateObject(“Scripting.FileSystemObject”)
Set f = fs.GetFile(filespec)
f.Attributes = 2 \’用Attributes属性设置文件属性
End Sub

运行程序，打开”我的电脑”找到更改了图标的文件夹看看，效果如何？