Microsoft Windows folders are commonly displayed with a standard icon. This includes the folder on the start menu*. You can customize the appearance of this icon using a desktop configuration file named "Desktop.ini" for the folder. IconStartMenu is a script that automatically searching the entire folder list on your start menu and set the display icon to one that matches it contents. It starts recursively search all the folders in the start menu (i.e. "C:\Documents and Settings\All Users\Start Menu"). Each file in each folder is checked to find an appearance icon. The match works in the following order and stops when an icon match is made.
- Check to determine if it is a shortcut file (*.lnk)
- Check if shortcut icon valid
- Check if target of shortcut is a valid icon file
Once a match is made, any pre-existing desktop conf information is read in. The icon file and index is then appended with pre-existing info to the desktop conf file. If no prior desktop conf file exists, a new one is created. An option is also made available to sort your start menu sorted by name. This is done by deleting the value registry value that holds the sorted order, forcing windows to resort the start menu. The customize icons and sorted order will not take affect until a reboot. However, this can be overcome by right-clicking on any folder listed in the start menu and left-clicking on "Sort by Name". Requires
* The start menu layout may differ. In this case, we are referring to the list of programs or All programs. This does not include options such as run, control panel, or recently used shortcuts.
Download Icon Start Menu (vbs file)
- '============================================== 'NAME: IconStartMenu.vbs ' 'AUTHOR: Scott Greenberg 'COMPANY: SG Technology 'WEBSITE: http://gogogadgetscott.info 'Date : 4/21/2004 'VERSION: 1.2 ' 'DESCRIPTION: Every have a hard time finding shortcut In the Start Menu? 'Every wonder what those folder icons are For Next To Each of the 100 Or 'more subfolders listed under programs? This script will customizes Each 'of the subfolders listed under programs With a descriptive icon. ' 'COMMENTS: Portions of subroutine WriteKey were derived 'from "Work With INI files In VBS" v1.00 'by: Antonin Foller, PSTRUH Software, http://www.pstruh.cz 'Usage of Desktop.ini files can be found at 'MSDN @ Shell Basics: Extending the Shell 'http://tinyurl.com/mqfb ' 'HISTORY: '4/21/2004, 1.2v - Corrected bug In subroutine WriteKey that caused 'ini file To be truncated With lose of data '-Add line In WriteDTfile To prevent emtpy desktop.ini files '4/15/2004, 1.1v - Create start menu shortcut For script Option '4/10/2004, 1.0v - First release ' 'Copyright© 2004. SG Technology. All rights reserved. '============================================== 'Set default value iDTfiles = 0 CRLF = Chr (13) + Chr (10) sTitle = "Icon Start Menu" 'Display a welcome message Welcome() 'Set up objects For use Set oFSO = CreateObject ("Scripting.FileSystemObject") Set oWSH = CreateObject ("WScript.Shell") 'Preform action On both All User And current user program list Start(oWSH.SpecialFolders("AllUsersPrograms")) 'SpecialFolders("Programs") may Return all user path 'Use "StartMenu" To find correct user path Start(oWSH.SpecialFolders("StartMenu") & "/Programs") SortMenu() CreateSC() sMsg = "Script Is complete. " & iDTfiles & " folders have been customized." MsgBox sMsg, vbInformation , sTitle 'Requires a folder path To start search Sub Start(sPath) On Error Resume Next Set oFolder = oFSO.GetFolder(sPath) For Each Folder In oFolder.SubFolders SetIcon(Folder) Next End Sub 'Find icon For given folder Function SetIcon(oFolder) On Error Resume Next SetIcon = "" bFoundIcon = False For Each File In oFolder.Files If LCase (Right (file.name,3)) = "lnk" Then FullPath = oFolder.path & "\" & File.Name 'Receive target path And icon info from shortcut using shell Set oLink = oWSH.CreateShortcut(FullPath) 'Extract icon location And index from shortcut aIcon = Split (oLink.IconLocation, ",") 'Check If shorcuts icon Is valid 'Else check If target Is a valid shortcut If GoodIcon(aIcon(0)) Then SetIcon = aIcon(0) & "," & aIcon(1) bFoundIcon = True Exit For ElseIf GoodIcon(oLink.TargetPath) Then SetIcon = oLink.TargetPath & "," & 0 bFoundIcon = True Exit For End If End If Next For Each Folder In oFolder.SubFolders SubIcon = SetIcon(Folder) Next If bFoundIcon = Fasle Then SetIcon = SubIcon End If If oFolder.Name = "Startup" Then SetIcon = "%SystemRoot%\system32\SHELL32.dll,24" End If WriteDTfile oFolder, SetIcon End Function 'Requires a file path that may Or may Not be a valid icon file, String 'Returns True of If file Is a valid icon file, Boolean Function GoodIcon(path) GoodIcon = False 'Check If filename ends In exe, dll, ico If LCase (Right (path,3)) = "exe" Or LCase (Right (path,3)) = "dll" Or _ LCase (Right (path,3)) = "ico" Then GoodIcon = True End If 'Check If file Is a uninstall program 'If Then Not a good icon choice To describe folder If Not InStr (LCase (path), "unins") = 0 Then GoodIcon = False If Not InStr (LCase (path), "setup") = 0 Then GoodIcon = False End Function 'Setup folder Sub WriteDTfile(Folder, sIconFile) 'Extract icon location And index aIcon = Split (sIconFile, ",") If aIcon(0) = "" Then Exit Sub If Not IsNumeric (aIcon(1)) Then aIcon(1) = 0 sDTfile = Folder.path & "\Desktop.ini" WriteKey ".ShellClassInfo", "IconFile", SysEnvRe(aIcon(0)), sDTfile WriteKey ".ShellClassInfo", "IconIndex", aIcon(1), sDTfile 'mark folder As read-only To make use of Desktop config file If (Folder.Attributes And 1) <> 1 Then Folder.Attributes = Folder.Attributes + 1 'Update count of created Desktop conf files iDTfiles = iDTfiles + 1 End Sub 'Write key To desktop configuration file Sub WriteKey(Section, KeyName, Value, FileName) On Error Resume Next 'Get contents of the desktop file As a String If oFSO.FileExists(FileName) Then Set fDT = oFSO.GetFile(FileName) 'Set attributes To nomal, allow appending fDT.Attributes = 0 INIContents = "" Set TextStream = fDT.OpenAsTextStream(1) Do While Not TextStream.AtEndOfStream INIContents = INIContents & TextStream.ReadLine & CRLF Loop TextStream.Close 'remove last CRLF If Len (INIContents) > 3 Then INIContents = Left (INIContents, Len (INIContents) - 2) End If Else INIContents = "" End If 'Find section PosSection = InStr (1, INIContents, "[" & Section & "]") If PosSection > 0 Then 'Section exists, find End of section PosEndSection = InStr (PosSection, INIContents, CRLF & "[") 'Check If this Is last section If PosEndSection = 0 Then PosEndSection = Len (INIContents) + 1 'Separate section contents OldsContents = Mid (INIContents, PosSection, PosEndSection - PosSection) OldsContents = Split (OldsContents, CRLF) 'Temp variable To find a Key sKeyName = LCase (KeyName & "=") 'Enumerate section lines For Each Line In OldsContents If LCase (Left (Line, Len (sKeyName))) = sKeyName Then Line = KeyName & "=" & Value Found = True End If NewContents = NewContents & Line & CRLF Next If IsEmpty (Found) Then 'key Not found - add it at the End of section NewContents = NewContents & KeyName & "=" & Value Else 'remove last CRLF - CRLF Is at PosEndSection NewContents = Left (NewContents, Len (NewContents) - 2) End If 'Combine pre-section, New section And post-section data NewContents = Left (INIContents, PosSection - 1) & NewContents NewContents = NewContents & Mid (INIContents, PosEndSection) Else 'Section Not found, add section data at the End of file contents If Right (INIContents, 2) <> CRLF And Len (INIContents) > 0 Then INIContents = INIContents & CRLF End If NewContents = INIContents & "[" & Section & "]" & CRLF & KeyName & "=" & Value End If Set TextStream = oFSO.CreateTextFile(FileName, True ) TextStream.Write NewContents TextStream.Close Set fDT = oFSO.GetFile(FileName) 'mark file As hidden And read-only To protect it from being modified fDT.Attributes = fDT.Attributes + 3 End Sub 'Requires a folder Or file path, String 'Returns path With any known system variables, String 'Can prevent broken links, sometimes Function SysEnvRe(path) SysEnvRe = path vars = Array ("APPDATA", "ALLUSERSPROFILE", "USERPROFILE", "ProgramFiles", "SystemRoot") Set SysEnv = oWSH.Environment("PROCESS") 'Loop through environment variables For Each var In vars SysEnvRe = Replace (SysEnvRe, SysEnv(var),"%" & var & "%") Next End Function 'Deletes Menu order entry For registy Sub SortMenu() On Error Resume Next sMessage = "Would you Like your start menu sorted by name?" iAns = MsgBox (sMessage, vbYesNo + vbInformation , sTitle) If iAns = vbYes Then Set oShell = CreateObject ("Wscript.Shell") sKey = "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\MenuOrder\Start Menu2" oShell.RegDelete sKey sKey = "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\MenuOrder\Start Menu" oShell.RegDelete sKey End If End Sub 'Create start menu shortcut For script Sub CreateSC() 'On Error Resume Next sMessage = "Would you Like To create a start menu shortcut?" iAns = MsgBox (sMessage, vbYesNo + vbInformation , sTitle) If iAns = vbYes Then 'Create shortcut object sPath = oWSH.SpecialFolders("AllUsersPrograms") Set oSC = oWSH.CreateShortcut(sPath & "\IconStartMenu.lnk") oSC.TargetPath = WScript.ScriptFullName oSC.WindowStyle = 1 oSC.IconLocation = "%windir%/system32/shell32.dll, 84" oSC.Description = "IconStartMenu" oSC.WorkingDirectory = sPath 'Save shortcut To startmenu oSC.Save End If End Sub 'Sub To display welcome message Sub Welcome() sMessage = "This script will customizes Each of the folders listed" & _ " under programs With descriptive icons." iAns = MsgBox (sMessage, vbOKCancel + vbInformation , sTitle) If iAns = vbCancel Then WScript.Quit End If End Sub
Download Icon Start Menu (vbs file)
