自定义指定文件夹的图标

【 tulaoshi.com - 编程语言 】

编程思路：按一定格式在文件夹中建立Desktop.ini文件并将文件夹的属性设置为系统属性即可自定义文件夹的图标。文件的建立不难，关键是更改文件夹属性，得用上VB的内部函数Attributes来实现。
　　
　　Desktop.ini文件格式：
　　[.ShellClassInfo]
　　IconIndex=0
　　iconfile=Icon图标所在的驱动器我 路径名 文件名
　　
　　下面是完整的程序代码。使用前请给工程添加一个按钮、一个公共对话框、一个DriveListBox和一个DirListBox。
　　
　　OptionExplicit
　　
　　DimsPathAsString'文件夹变量
　　
　　PrivateSubDir1_Click()
　　DimiAsInteger
　　Command1.Enabled=True
　　i=Dir1.ListIndex
　　sPath=Dir1.List(i)
　　EndSub
　　
　　PrivateSubDrive1_Change()
　　Dir1.Path=Drive1.Drive
　　EndSub
　　
　　PrivateSubForm_Load()
　　Command1.Caption="定义文件夹图标"
　　Command1.Enabled=False
　　EndSub
　　
　　PrivateSubCommand1_Click()
　　ChangeFolderInfosPath'更改目录为系统文件
　　
　　DimsAsString'图标文件路径、名称变量
　　WithCommonDialog1
　　.Filter="(*.ico)|*.ico"
　　.DialogTitle="查找图标"
　　.ShowOpen
　　s=.FileName
　　EndWith
　　
　　OpensPath "" "desktop.ini"ForOutputAs#1
　　Print#1,"[.ShellClassInfo]" vbCrLf "IconIndex=0" vbCrLf "iconfile=" s
　　Close#1
　　
　　ChangeFileInfo(sPath "" "desktop.ini")
　　EndSub
　　
　　'赋予文件夹系统属性子程序
　　PrivateSubChangeFolderInfo(folderspec)
　　Dimfs,f
　　Setfs=CreateObject("Scripting.FileSystemObject")
　　Setf=fs.GetFolder(folderspec)
　　f.Attributes=4'用Attributes函数设置文件夹属性
　　EndSub
　　
　　'赋予Desktop.ini文件隐藏属性
　　PrivateSubChangeFileInfo(filespec)
　　Dimfs,f
　　Setfs=CreateObject("Scripting.FileSystemObject")
　　Setf=fs.GetFile(filespec)
　　f.Attributes=2'用Attributes属性设置文件属性
　　EndSub
　　
　　运行程序，打开"我的电脑"找到更改了图标的文件夹看看，效果如何？->