方便设置文件夹图标的程序

'文件夹图标设置 by eleqian 2012-2-16
'On Error Resume Next
Dim FSO, Args, strErr, strHelp
strHelp = "文件夹图标设置器 by eleqian" & Chr(10) & Chr(10) & _
"用途：设置文件夹图标为其中文件的图标。" & Chr(10) & _
"用法：将*.ico或*.exe文件拖放到本程序文件上。"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Args = WScript.Arguments
If Args.Count = 1 Then
strErr = SetIcon(Args(0))
Msgbox strErr, vbInformation, "结果"
Else
Msgbox strHelp, vbInformation, "帮助"
End if
Set FSO = Nothing
Set Args = Nothing
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function SetIcon(icoFile)
Dim strExt, strIni, strFolder
Dim retDelIni
Dim fIni
If FSO.FileExists(icoFile) Then
strExt = FSO.GetExtensionName(icoFile)
If strExt = "ico" Or strExt = "exe" Then
strFolder = FSO.GetParentFolderName(icoFile)
strIni = FSO.BuildPath(strFolder, "desktop.ini")
If FSO.FileExists(strIni) Then
retDelIni = Msgbox("配置文件已存在，是否保留原内容？", vbYesNoCancel Or vbQuestion, "选择")
If retDelIni = vbNo Then
Set fIni = FSO.OpenTextFile(strIni, 2) '写，不保留原内容
ElseIf retDelIni = vbYes Then
Set fIni = FSO.OpenTextFile(strIni, 8) '追加内容
Else
SetIcon = "操作已被用户取消。"
Exit Function
End If
Else
Set fIni = FSO.OpenTextFile(strIni, 2, True) '写，新建
End If
fIni.WriteLine "[.ShellClassInfo]"
fIni.WriteLine "IconFile=" & FSO.GetBaseName(icoFile) & "." & strExt
fIni.WriteLine "IconIndex=0"
fIni.Close
Set fIni = Nothing
FSO.GetFile(strIni).Attributes=6 '隐藏+系统
FSO.GetFolder(strFolder).Attributes=1 '只读，必须设置只读或系统属性才有效
SetIcon = "图标设置成功！"
Else
SetIcon = "不是图标或包含图标文件！"
End If
Else
SetIcon = "不是文件！"
End If
End Function

传到网盘了，VBS源码分享文件夹里面。

http://vbscript.ys168.com/