VB icon

Web Developer Tool: FavIcon Creator

Email
Submitted on: 10/9/2019 8:55:41 PM
By: A_X_O 
Level: Beginner
User Rating: Unrated
Compatibility: VbScript (browser/client side)
Views: 88
 
     This VBScript creates all the PNG Image Files [Not the .ico files] required for most platforms that make use of the FavIcon. Just drag a standard jpeg or gif Image file onto this script file and that's it. Some HTM headers are created at the same time.

 
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
				
'**************************************
' Name: Web Developer Tool: FavIcon Creator
' Description:This VBScript creates all the PNG Image Files [Not the .ico files] required for most platforms that make use of the FavIcon. Just drag a standard jpeg or gif Image file onto this script file and that's it. Some HTM headers are created at the same time.
' By: A_X_O
'**************************************

'
'
'-------------------------------------------------------------------------------'
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++'
'			Windows 10, Website FavIcon PNG Creator			'
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++'
'										'
'	Purpose		: Creates all the Icon PNG files 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 Sample		'
'										'
'			: 1:1	08/10/2019	Add Missed Icons		'
'			: 1:1	08/10/2019	Tidy Script & Commentary	' 
'-------------------------------------------------------------------------------'		
'
'
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 handle
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.ico [Error creating the .ico file with WIA 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 response 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] Subroutine
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 Width 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...
'


Other 18 submission(s) by this author

 


Report Bad Submission
Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:

Your Vote

What do you think of this code (in the Beginner category)?
(The code with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor (See voting log ...)
 

Other User Comments


 There are no comments on this submission.
 

Add Your Feedback
Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular code, please click here instead.)
 

To post feedback, first please login.