Before and After IconStartMenu

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.

  1. Check to determine if it is a shortcut file (*.lnk)
  2. Check if shortcut icon valid
  3. 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)

  1. '==============================================
  2. 'NAME: IconStartMenu.vbs
  3. '
  4. 'AUTHOR: Scott Greenberg
  5. 'COMPANY: SG Technology
  6. 'WEBSITE: http://gogogadgetscott.info
  7. 'Date :     4/21/2004
  8. 'VERSION: 1.2
  9. '
  10. 'DESCRIPTION: Every have a hard time finding shortcut In the Start Menu?
  11. 'Every wonder what those folder icons are For Next To Each of the 100 Or
  12. 'more subfolders listed under programs? This script will customizes Each
  13. 'of the subfolders listed under programs With a descriptive icon.
  14. '
  15. 'COMMENTS: Portions of subroutine WriteKey were derived
  16. 'from "Work With INI files In VBS" v1.00
  17. 'by: Antonin Foller, PSTRUH Software, http://www.pstruh.cz
  18. 'Usage of Desktop.ini files can be found at
  19. 'MSDN @ Shell Basics: Extending the Shell
  20. 'http://tinyurl.com/mqfb
  21. '
  22. 'HISTORY:
  23. '4/21/2004, 1.2v - Corrected bug In subroutine WriteKey that caused
  24. 'ini file To be truncated With lose of data
  25. '-Add line In WriteDTfile To prevent emtpy desktop.ini files
  26. '4/15/2004, 1.1v - Create start menu shortcut For script Option
  27. '4/10/2004, 1.0v - First release
  28. '
  29. 'Copyright© 2004. SG Technology. All rights reserved.
  30. '==============================================
  31. 'Set default value
  32. iDTfiles = 0
  33. CRLF = Chr (13) + Chr (10)
  34. sTitle = "Icon Start Menu"
  35. 'Display a welcome message
  36. Welcome()
  37. 'Set up objects For use
  38. Set oFSO = CreateObject ("Scripting.FileSystemObject")
  39. Set oWSH = CreateObject ("WScript.Shell")
  40. 'Preform action On both All User And current user program list
  41. Start(oWSH.SpecialFolders("AllUsersPrograms"))
  42. 'SpecialFolders("Programs") may Return all user path
  43. 'Use "StartMenu" To find correct user path
  44. Start(oWSH.SpecialFolders("StartMenu") & "/Programs")
  45. SortMenu()
  46. CreateSC()
  47. sMsg = "Script Is complete. " & iDTfiles & " folders have been customized."
  48. MsgBox sMsg, vbInformation , sTitle
  49. 'Requires a folder path To start search
  50. Sub Start(sPath)
  51.   On Error Resume Next
  52.   Set oFolder = oFSO.GetFolder(sPath)
  53.   For Each Folder In oFolder.SubFolders
  54.     SetIcon(Folder)
  55.   Next
  56. End Sub
  57. 'Find icon For given folder
  58. Function SetIcon(oFolder)
  59.   On Error Resume Next
  60.   SetIcon = ""
  61.   bFoundIcon = False
  62.   For Each File In oFolder.Files
  63.     If LCase (Right (file.name,3)) = "lnk" Then
  64.       FullPath = oFolder.path & "\" & File.Name
  65.       'Receive target path And icon info from shortcut using shell
  66.       Set oLink = oWSH.CreateShortcut(FullPath)
  67.       'Extract icon location And index from shortcut
  68.       aIcon = Split (oLink.IconLocation, ",")
  69.       'Check If shorcuts icon Is valid
  70.       'Else check If target Is a valid shortcut
  71.       If GoodIcon(aIcon(0)) Then
  72.         SetIcon = aIcon(0) & "," & aIcon(1)
  73.         bFoundIcon = True
  74.         Exit For
  75.         ElseIf GoodIcon(oLink.TargetPath) Then
  76.         SetIcon = oLink.TargetPath & "," & 0
  77.         bFoundIcon = True
  78.         Exit For
  79.       End If
  80.     End If
  81.   Next
  82.   For Each Folder In oFolder.SubFolders
  83.     SubIcon = SetIcon(Folder)
  84.   Next
  85.   If bFoundIcon = Fasle Then
  86.     SetIcon = SubIcon
  87.   End If
  88.   If oFolder.Name = "Startup" Then
  89.     SetIcon = "%SystemRoot%\system32\SHELL32.dll,24"
  90.   End If
  91.   WriteDTfile oFolder, SetIcon
  92. End Function
  93. 'Requires a file path that may Or may Not be a valid icon file, String
  94. 'Returns True of If file Is a valid icon file, Boolean
  95. Function GoodIcon(path)
  96.   GoodIcon = False
  97.   'Check If filename ends In exe, dll, ico
  98.   If LCase (Right (path,3)) = "exe" Or LCase (Right (path,3)) = "dll" Or _
  99.     LCase (Right (path,3)) = "ico" Then
  100.     GoodIcon = True
  101.   End If
  102.   'Check If file Is a uninstall program
  103.   'If Then Not a good icon choice To describe folder
  104.   If Not InStr (LCase (path), "unins") = 0 Then GoodIcon = False
  105.   If Not InStr (LCase (path), "setup") = 0 Then GoodIcon = False
  106. End Function
  107. 'Setup folder
  108. Sub WriteDTfile(Folder, sIconFile)
  109.   'Extract icon location And index
  110.   aIcon = Split (sIconFile, ",")
  111.   If aIcon(0) = "" Then Exit Sub
  112.   If Not IsNumeric (aIcon(1)) Then aIcon(1) = 0
  113.   sDTfile = Folder.path & "\Desktop.ini"
  114.   WriteKey ".ShellClassInfo", "IconFile", SysEnvRe(aIcon(0)), sDTfile
  115.   WriteKey ".ShellClassInfo", "IconIndex", aIcon(1), sDTfile
  116.   'mark folder As read-only To make use of Desktop config file
  117.   If (Folder.Attributes And 1) <> 1 Then   Folder.Attributes = Folder.Attributes + 1
  118.   'Update count of created Desktop conf files
  119.   iDTfiles = iDTfiles + 1
  120. End Sub
  121. 'Write key To desktop configuration file
  122. Sub WriteKey(Section, KeyName, Value, FileName)
  123.   On Error Resume Next
  124.   'Get contents of the desktop file As a String
  125.   If oFSO.FileExists(FileName) Then
  126.     Set fDT = oFSO.GetFile(FileName)
  127.     'Set attributes To nomal, allow appending
  128.     fDT.Attributes = 0
  129.     INIContents = ""
  130.     Set TextStream = fDT.OpenAsTextStream(1)
  131.     Do While Not TextStream.AtEndOfStream
  132.       INIContents = INIContents & TextStream.ReadLine & CRLF
  133.     Loop
  134.     TextStream.Close
  135.     'remove last CRLF
  136.     If Len (INIContents) > 3 Then
  137.       INIContents = Left (INIContents, Len (INIContents) - 2)
  138.     End If
  139.   Else
  140.     INIContents = ""
  141.   End If
  142.   'Find section
  143.   PosSection = InStr (1, INIContents, "[" & Section & "]")
  144.   If PosSection > 0 Then
  145.     'Section exists, find End of section
  146.     PosEndSection = InStr (PosSection, INIContents, CRLF & "[")
  147.     'Check If this Is last section
  148.     If PosEndSection = 0 Then PosEndSection = Len (INIContents) + 1
  149.     'Separate section contents
  150.     OldsContents = Mid (INIContents, PosSection, PosEndSection - PosSection)
  151.     OldsContents = Split (OldsContents, CRLF)
  152.     'Temp variable To find a Key
  153.     sKeyName = LCase (KeyName & "=")
  154.     'Enumerate section lines
  155.     For Each Line In OldsContents
  156.       If LCase (Left (Line, Len (sKeyName))) = sKeyName Then
  157.         Line = KeyName & "=" & Value
  158.         Found = True
  159.       End If
  160.       NewContents = NewContents & Line & CRLF
  161.     Next
  162.     If IsEmpty (Found) Then
  163.       'key Not found - add it at the End of section
  164.       NewContents = NewContents & KeyName & "=" & Value
  165.     Else
  166.       'remove last CRLF - CRLF Is at PosEndSection
  167.       NewContents = Left (NewContents, Len (NewContents) - 2)
  168.     End If
  169.     'Combine pre-section, New section And post-section data
  170.     NewContents = Left (INIContents, PosSection - 1) & NewContents
  171.     NewContents = NewContents & Mid (INIContents, PosEndSection)
  172.   Else
  173.     'Section Not found, add section data at the End of file contents
  174.     If Right (INIContents, 2) <> CRLF And Len (INIContents) > 0 Then
  175.       INIContents = INIContents & CRLF
  176.     End If
  177.     NewContents = INIContents & "[" & Section & "]" & CRLF & KeyName & "=" & Value
  178.   End If
  179.   Set TextStream = oFSO.CreateTextFile(FileName, True )
  180.   TextStream.Write NewContents
  181.   TextStream.Close
  182.   Set fDT = oFSO.GetFile(FileName)
  183.   'mark file As hidden And read-only To protect it from being modified
  184.   fDT.Attributes = fDT.Attributes + 3
  185. End Sub
  186. 'Requires a folder Or file path, String
  187. 'Returns path With any known system variables, String
  188. 'Can prevent broken links, sometimes
  189. Function SysEnvRe(path)
  190.   SysEnvRe = path
  191.   vars = Array ("APPDATA", "ALLUSERSPROFILE", "USERPROFILE", "ProgramFiles", "SystemRoot")
  192.   Set SysEnv = oWSH.Environment("PROCESS")
  193.   'Loop through environment variables
  194.   For Each var In vars
  195.     SysEnvRe = Replace (SysEnvRe, SysEnv(var),"%" & var & "%")
  196.   Next
  197. End Function
  198. 'Deletes Menu order entry For registy
  199. Sub SortMenu()
  200.   On Error Resume Next
  201.   sMessage = "Would you Like your start menu sorted by name?"
  202.   iAns = MsgBox (sMessage, vbYesNo + vbInformation , sTitle)
  203.   If iAns = vbYes Then
  204.     Set oShell = CreateObject ("Wscript.Shell")
  205.     sKey = "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\MenuOrder\Start Menu2"
  206.     oShell.RegDelete sKey
  207.     sKey = "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\MenuOrder\Start Menu"
  208.     oShell.RegDelete sKey
  209.   End If
  210. End Sub
  211. 'Create start menu shortcut For script
  212. Sub CreateSC()
  213.   'On Error Resume Next
  214.   sMessage = "Would you Like To create a start menu shortcut?"
  215.   iAns = MsgBox (sMessage, vbYesNo + vbInformation , sTitle)
  216.   If iAns = vbYes Then
  217.     'Create shortcut object
  218.     sPath = oWSH.SpecialFolders("AllUsersPrograms")
  219.     Set oSC = oWSH.CreateShortcut(sPath & "\IconStartMenu.lnk")
  220.     oSC.TargetPath = WScript.ScriptFullName
  221.     oSC.WindowStyle = 1
  222.     oSC.IconLocation = "%windir%/system32/shell32.dll, 84"
  223.     oSC.Description = "IconStartMenu"
  224.     oSC.WorkingDirectory = sPath
  225.     'Save shortcut To startmenu
  226.     oSC.Save
  227.   End If
  228. End Sub
  229. 'Sub To display welcome message
  230. Sub Welcome()
  231.   sMessage = "This script will customizes Each of the folders listed" & _
  232.   " under programs With descriptive icons."
  233.   iAns = MsgBox (sMessage, vbOKCancel + vbInformation , sTitle)
  234.   If iAns = vbCancel Then
  235.     WScript.Quit
  236.   End If
  237. End Sub

Download Icon Start Menu (vbs file)