'************************************** ' Name: Web Developer Tool: FavIcon Crea ' tor ' Description:This VBScript creates all ' the PNG Image Files [Not the .ico files] ' required for most platforms that make us ' e of the FavIcon. Just drag a standard j ' peg or gif Image file onto this script f ' ile and that's it. Some HTM headers are ' created at the same time. ' By: A_X_O ' ' ' Inputs:None ' ' Returns:None ' 'Assumes:None ' 'Side Effects:None '************************************** ' ' '--------------------------------------- ' ---------------------------------------- ' '+++++++++++++++++++++++++++++++++++++++ ' ++++++++++++++++++++++++++++++++++++++++ ' ' Windows 10, Website FavIcon PNG Crea ' tor ' '+++++++++++++++++++++++++++++++++++++++ ' ++++++++++++++++++++++++++++++++++++++++ ' ' ' ' Purpose : Creates all the Icon PNG fi ' les for Website FavIcon ' ' -------------------------------------- ' --------------------------------- ' ' Creation Date : 07/10/2019 [dd/mm/yyyy ' ] ' ' Version : 1:1 ' ' Designer : Fabian ' ' ' '####################################### ' ######################################## ' ' MODIFICATION HISTORY ' '--------------------------------------- ' ---------------------------------------- ' ' ' ' Version : 1:0 07/10/2019 Create the S ' ample ' ' ' ' : 1:1 08/10/2019 Add Missed Icons ' ' ' : 1:1 08/10/2019 Tidy Script & Comme ' ntary ' '--------------------------------------- ' ---------------------------------------- ' ' ' Public Const SW_SHOWNORMAL = 1 'As Long [Desired] Public Const SW_SHOWMAXIMIZED = 3 'As Long [Poor Etiquette] ' Public Const PNG036 = "apple-icon-36x36.png" 'Apple: Icon File names As String Public Const PNG048 = "apple-icon-48x48.png" Public Const PNG057 = "apple-icon-57x57.png" Public Const PNG060 = "apple-icon-60x60.png" Public Const PNG070 = "apple-icon-70x70.png" Public Const PNG072 = "apple-icon-72x72.png" Public Const PNG076 = "apple-icon-76x76.png" Public Const PNG096 = "apple-icon-96x96.png" Public Const PNG114 = "apple-icon-114x114.png" Public Const PNG120 = "apple-icon-120x120.png" Public Const PNG144 = "apple-icon-144x144.png" Public Const PNG152 = "apple-icon-152x152.png" Public Const PNG180 = "apple-icon-180x180.png" ' Public Const PNGp192 = "precomposed-icon-192x192.png" 'Generic Icon: File names As String ' Public Const PNGa192 = "android-icon-192x192.png" 'Android: Icon File names As String Public Const PNGa072 = "android-icon-72x72.png" Public Const PNGa144 = "android-icon-144x144.png" ' Public Const PNGms070 = "ms-icon-70x70.png" 'Microsoft: Icon File names As String Public Const PNGms144 = "ms-icon-144x144.png" Public Const PNGms150 = "ms-icon-150x150.png" Public Const PNGms310 = "ms-icon-310x310.png" ' Public Const PNGf032 = "favicon-32x32.png" 'Generic: Icon File names As String Public Const PNGf096 = "favicon-96x96.png" Public Const PNGf016 = "favicon-16x16.png" Public Const PNGi016 = "favicon-16x16.ico" 'Errors creating .ico with WIA Library V2 ' Public Const WXH016 = 16 'Icon Width[x]Height As Variant Public Const WXH032 = 32 Public Const WXH036 = 36 Public Const WXH048 = 48 Public Const WXH057 = 57 Public Const WXH060 = 60 Public Const WXH070 = 70 Public Const WXH072 = 72 Public Const WXH076 = 76 Public Const WXH096 = 96 Public Const WXH114 = 114 Public Const WXH120 = 120 Public Const WXH144 = 144 Public Const WXH150 = 150 Public Const WXH152 = 152 Public Const WXH180 = 180 Public Const WXH192 = 192 Public Const WXH310 = 310 ' Public Const IMG_CONTAINER = "\WebIcon" 'As String Public Const HTMheaders = "HTM-DATA.txt" 'As String ' Public Const ExecutionErr01 = "This app. was not designed to run this way." 'As String Public Const ExecutionErr02 = "Drag an Image file onto the Script Icon." 'As String Public Const ExecutionErr03 = "Execution Error" 'As String ' Public Const QuestionL01 = "The Directory Already Exists" 'As String Public Const QuestionL02 = "Do you want to delete this directory now" 'As String Public Const QuestionL03 = "so that a new one can be created to store the Icons in ?" 'As String Public Const QuestionL04 = "Directory Conflict" 'As String ' Public Const NotifyComplete01 = "The Creation process is complete." 'As String Public Const NotifyComplete02 = "Would you like to see the Icons now ?" 'As String Public Const NotifyComplete03 = "Icons Successfully Created" 'As String ' Public InitIMAGE 'As String Public DESK_PATH 'As String ' Public Const dwMilliSeconds = 1000 'As Integer ' Dim FSO 'As Object Dim WshShell 'As Object Dim DictionaryObj 'As Object ' Dim DictionaryEntry 'As Long ' Dim ImgObj 'As Object [Windows Image Acquisition Object] Dim ImgProc 'As Object [Windows Image Acquisition Process] ' Dim ThisScriptArgs 'As Array Dim EachArg 'As String [or] Variant Dim InitImageSortPath 'As String Dim FavIconContainer 'As Long Dim TargetPath 'As String Dim CreateIconFolder 'As Long Dim PlaceHTM 'As String ' Dim Question 'As VBMsgBoxResult [Prompt for permission to delete a directory] Dim RetVal 'As VBMsgBoxResult [Prompt for a display of the Icons] ' Set FSO = CreateObject("Scripting.FileSystemObject") 'Create the Scripting Environments [Objects] Set WshShell = WScript.CreateObject("WScript.Shell") Set DictionaryObj = CreateObject("Scripting.Dictionary") 'Create an Instance of the Dictionary Object, Quick and Easy and very useful to use Object ' Set ImgProc = CreateObject("WIA.ImageProcess") 'Create the Image Acquisition Objects Set ImgObj = CreateObject("WIA.ImageFile") ' DESK_PATH = WshShell.SpecialFolders("Desktop") 'Get the path to the Desktop ' TargetPath = (DESK_PATH & IMG_CONTAINER) 'Construct the full path to our Icon Container on the DeskTop path ' With DictionaryObj 'Create a file containing links to the Icons, just for convenience: The manifest is NOT created ' .Add "a", "<link rel=""apple-touch-icon"" sizes=""57x57"" href=""/apple-icon-57x57.png"">" .Add "b", "<link rel=""apple-touch-icon"" sizes=""60x60"" href=""/apple-icon-60x60.png"">" .Add "c", "<link rel=""apple-touch-icon"" sizes=""72x72"" href=""/apple-icon-72x72.png"">" .Add "d", "<link rel=""apple-touch-icon"" sizes=""76x76"" href=""/apple-icon-76x76.png"">" .Add "e", "<link rel=""apple-touch-icon"" sizes=""114x114"" href=""/apple-icon-114x114.png"">" .Add "f", "<link rel=""apple-touch-icon"" sizes=""120x120"" href=""/apple-icon-120x120.png"">" .Add "g", "<link rel=""apple-touch-icon"" sizes=""144x144"" href=""/apple-icon-144x144.png"">" .Add "h", "<link rel=""apple-touch-icon"" sizes=""152x152"" href=""/apple-icon-152x152.png"">" .Add "i", "<link rel=""apple-touch-icon"" sizes=""180x180"" href=""/apple-icon-180x180.png"">" .Add "j", "<link rel=""icon"" type=""image/png"" sizes=""192x192"" href=""/android-icon-192x192.png"">" .Add "k", "<link rel=""icon"" type=""image/png"" sizes=""32x32"" href=""/favicon-32x32.png"">" .Add "l", "<link rel=""icon"" type=""image/png"" sizes=""96x96"" href=""/favicon-96x96.png"">" .Add "m", "<link rel=""icon"" type=""image/png"" sizes=""16x16"" href=""/favicon-16x16.png"">" .Add "n", "<link rel=""manifest"" href=""/manifest.json"">" .Add "o", "<meta name=""msapplication-TileColor"" content=""#ffffff"">" .Add "p", "<meta name=""msapplication-TileImage"" content=""/ms-icon-144x144.png"">" .Add "q", "<meta name=""theme-color"" content=""#ffffff"">" ' End With ' If FSO.FolderExists(TargetPath) Then 'The target container already exists, probably from a previous script execution 'Prompt the user for permission to delete it before continuing. Question = Msgbox(QuestionL01 & _ VbCrLf & VbCrLf & TargetPath & VbCrLf & _ VbCrLf & QuestionL02 & _ VbCrLf & QuestionL03, _ VbApplicationModal+VbExclamation+VbYesNoCancel, _ QuestionL04) ' Select Case Question ' Case VbYes 'User granted [Yes] permission to delete existing directory 'Doing something like this maintains the flow of the application FSO.DeleteFolder(TargetPath) 'Delete the existing container, restart the script and create a new and empty container ' WshShell.Run WScript.ScriptFullName, 1, False 'Re-Start the script again without any user intervention. This time without the directory container ' TargetPath = TargetPath & Chr(92) 'Seperate the directory structure from the Icon names ' Case VbNo ' WScript.Quit 'User replied [No] to request to delete directory, Fast Exit ' Case VbCancel ' WScript.Quit ' 'User replied with [Cancel] ' so again, Fast Exit Case Else: WScript.Quit ' End Select ' 'No more MsgBox options to h ' andle Else ' Set FavIconContainer = FSO.CreateFolder(TargetPath) 'Create a container to hold the Icon files ' CreateIconFolder = FavIconContainer.Path ' TargetPath = TargetPath & Chr(92) 'At this stage, TargetPath is "WebIcon" so adding Chr(92) gives "WebIcon\" ' WScript.Sleep ((dwMilliSeconds)*2) 'Allow the system time to complete the job ' End If ' Set ThisScriptArgs = WScript.Arguments 'Get the Initial File-Path and Name of the Image File dropped onto this script ' For Each EachArg in ThisScriptArgs ' Set InitImageSortPath = FSO.GetFile(EachArg) ' InitIMAGE = InitImageSortPath.ShortPath 'Get the DOS Path and Name of the Initial Image File ' With WScript ' .Sleep ((dwMilliSeconds)*2) ' Call CreateIcons(PNG036, WXH036): .Sleep ((dwMilliSeconds)/2) 'Send the Intial Image File to "CreateIcons()" and use the following format [Name] & [WidthXHeight] Call CreateIcons(PNG048, WXH048): .Sleep ((dwMilliSeconds)/2) 'And save the new Icon in the TargetPath Container as a *.png [Portable Network Graphics] File Extension Call CreateIcons(PNG057, WXH057): .Sleep ((dwMilliSeconds)/2) Call CreateIcons(PNG060, WXH060): .Sleep ((dwMilliSeconds)/2) Call CreateIcons(PNG070, WXH070): .Sleep ((dwMilliSeconds)/2) Call CreateIcons(PNG072, WXH072): .Sleep ((dwMilliSeconds)/2) Call CreateIcons(PNG076, WXH076): .Sleep ((dwMilliSeconds)/2) 'Apple Icons Call CreateIcons(PNG096, WXH096): .Sleep ((dwMilliSeconds)/2) Call CreateIcons(PNG114, WXH114): .Sleep ((dwMilliSeconds)/2) Call CreateIcons(PNG120, WXH120): .Sleep ((dwMilliSeconds)/2) Call CreateIcons(PNG144, WXH144): .Sleep ((dwMilliSeconds)/2) Call CreateIcons(PNG152, WXH152): .Sleep ((dwMilliSeconds)/2) Call CreateIcons(PNG180, WXH180): .Sleep ((dwMilliSeconds)/2) ' Call CreateIcons(PNGp192, WXH192): .Sleep ((dwMilliSeconds)/2) 'Pre-Composed Icon ' Call CreateIcons(PNGa192, WXH192): .Sleep ((dwMilliSeconds)/2) 'Android Icons Call CreateIcons(PNGa072, WXH072): .Sleep ((dwMilliSeconds)/2) Call CreateIcons(PNGa144, WXH144): .Sleep ((dwMilliSeconds)/2) ' Call CreateIcons(PNGms070, WXH070): .Sleep ((dwMilliSeconds)/2) 'Microsoft Icons Call CreateIcons(PNGms144, WXH144): .Sleep ((dwMilliSeconds)/2) Call CreateIcons(PNGms150, WXH150): .Sleep ((dwMilliSeconds)/2) Call CreateIcons(PNGms310, WXH310): .Sleep ((dwMilliSeconds)/2) ' Call CreateIcons(PNGf032, WXH032): .Sleep ((dwMilliSeconds)/2) 'Favicons Call CreateIcons(PNGf092, WXH092): .Sleep ((dwMilliSeconds)/2) Call CreateIcons(PNGf016, WXH016): .Sleep ((dwMilliSeconds)/2) ' '--------------------------------------- ' ---------------------------------------- ' ---------------------------------------- ' ------------------------------- Rem: Call CreateIcons(PNGi016, WXH016): ' .Sleep ((dwMilliSeconds)/2) 'Favicon.i ' co [Error creating the .ico file with WI ' A Library V2] '--------------------------------------- ' ---------------------------------------- ' ---------------------------------------- ' ------------------------------- ' End With ' PlaceHTM = (TargetPath & HTMheaders) Set HTMicon = FSO.CreateTextFile(PlaceHTM, True) 'Create the file containing the HTM links to the newly created Icons ' With HTMicon ' DictionaryItem = DictionaryObj.Items 'Instruct the Dictionary Object to work on the Dictionary Items ' For i = 0 To DictionaryObj.Count -1 'Get all the Items in the Dictionary ' DictionaryEntry = DictionaryEntry & DictionaryItem(i) & VbCrLf 'Gather all the Items and format them into a legible list ' Next ' .WriteLine(DictionaryEntry) 'Write the list to the file we created ' .Close 'Close the file ' End With ' 'Prompt the user for a respo ' nse for viewing the Icons RetVal = Msgbox(NotifyComplete01 & VbCrLf & _ NotifyComplete02, _ VbApplicationModal+VbYesNoCancel+VbExclamation, _ NotifyComplete03) ' Select Case RetVal ' Case VbYes ' WshShell.Run TargetPath, SW_SHOWMAXIMIZED, False 'Display the created Icons to the user. This should be [SW_SHOWNORMAL] ... Thats why the Constant is still available ' Set FSO = Nothing 'Release Objects and Clean-up the Scripting Environments on exiting Set WshShell = Nothing Set ImgProc = Nothing Set ImgObj = Nothing ' Case VbNo ' Set FSO = Nothing 'Release Objects and Clean-up the Scripting Environments on exiting Set WshShell = Nothing Set ImgProc = Nothing Set ImgObj = Nothing ' Case VbCancel ' Set FSO = Nothing 'Release Objects and Clean-up the Scripting Environments on exiting Set WshShell = Nothing Set ImgProc = Nothing Set ImgObj = Nothing ' Case Else: WScript.Quit 'Exit Fast if the user declines viewing the Icons ' End Select ' Next ' 'The Main [WIA Library] Subr ' outine Public Sub CreateIcons(ByRef OSPlatform, ByVal IconDimensions) On Error Resume Next ' ImgObj.LoadFile InitIMAGE 'Specify the Image File [Initial Dropped File] ' With ImgProc ' While .Filters.Count > 0 'Remove any filters currently loaded ' .Filters.Remove 1 ' Wend ' .Filters.Add .FilterInfos("Scale").filterid 'Setup the filters that we want to use ' With ImgProc.Filters(1) ' .Properties("MaximumWidth") = IconDimensions 'Set the Icon Dimensions .Properties("MaximumHeight") = IconDimensions ' .Properties("PreserveAspectRatio") = False 'We want control over Aspect Ratio so set this to False ' 'because we will set the Wid ' th and Height End With ' End With ' Set ImgObj = ImgProc.Apply(ImgObj) 'Apply the filter to the Image / Icon ' ImgObj.SaveFile (TargetPath & OSPlatform) 'Save the Icon into the Directory we created earlier ' End Sub 'That's it. Hat and Coat on. Off Out, to do something else... '