Jump to content

Script To Install Fonts To Workstations

Guest

By Guest
in Scripts

 Share

Recommended Posts

Guest

Guest

Posted
Posted

Don't know if this will be of use to anyone here, but have created a small VB startup Script that can be used to install new fonts.

 

It just copies the files froma server and registers them.

 

If anyone would like it ill post the code and instructions?

Guest

Guest

Posted
Posted

Here goes - I hope this makes some sense.

 

Create a Folder to house all your additional fonts on a network share e.g. \\%SERVERNAME%\%SHARE%\FONTS

 

Copy the new font to that share e.g. Twiggy-Bold.ttf

 

Install the new font onto a workstation.

 

Using regedit browse to the following Key HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts

 

Make a note of the new fonts registry information.

 

Add this new information to the VB script

 

Create a new GPO and add the script to run at computer start up

 

Assign to computers

 

The font will be available after a restart of the PC with no need for an admin logon.

 

To update the script quickly I just created a shortcut to the policy folder and then just copy the updated VB script when I have added new fonts.

 

And here's the code

 

' ****************************************************************************

' Copy Fonts From Network Share To C:\WINDOWS\FONTS Folder Of Workstation

' ****************************************************************************

Set WshShell = CreateObject("WScript.Shell")

WshShell.Run "xcopy.exe ""\\%SERVERNAME%\%SHARE \FONTS"" ""C:\windows\fonts"" /C /I /S /E /H /Y /Q", 1,True


' ****************************************************************************

' Imports The Registry Information For The New Fonts - Add A New Line For Each New Font

' Example : WshShell. RegWrite"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts\%FONT REG KEY%", "%FONT REG KEY ENTRY%", "REG_SZ"

' ****************************************************************************

Set WshShell = WScript.CreateObject("WScript.Shell")

WshShell. RegWrite"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts\Twiggy-Bold (TrueType)", "Twiggy-Bold.ttf", "REG_SZ"

WshShell. RegWrite"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts\Twiggy-Light (TrueType)", "Twiggy-Light.ttf", "REG_SZ"

  • 3 weeks later...
  • 2 years later...
  • Popular Post
srochford

srochford

Posted
  • Popular Post
Posted

Copying the fonts and writing the registry keys will work but sometimes seems to need a restart of Explorer (so if you run this at startup then the fonts will be there the next time the machine starts).

 

The link from @chrish looks fine but it looks like hard work :-)

 

MS provide scripting support for installing fonts - the code I've used is below. Basically, put any fonts you want installing in a server folder (\\server\share\fonts in the example) and then call this code as an extra sub-routine in your machine startup script.

 

If you ever want to add a new font, just copy it to the server; next time the machines reboot they'll install it.

 

Sub InstallFonts
 on error resume next
 Const FONTS = &H14
 dim , oFSO,oShell, oFolder1, oFolder2, sRoot
 sRoot="\\server\share\fonts\"
 Set oShell = CreateObject("Shell.Application")
 set oFSO=createobject("scripting.filesystemobject")
 Set oFolder1 = oShell.Namespace(FONTS)
 set oFolder2=ofso.getfolder(sRoot)
 for each oFile in oFolder2.files
   sName=lcase(oFile.name)
   if right(sName,4)=".ttf" then
     if not ofso.fileexists(oFolder1.self.path & "\" & sName) then
       oFolder1.copyhere sRoot & sName
     end if
   end if
 next
 on error goto 0
End Sub

  • Thanks 5
dhicks

dhicks

Posted
Posted
Basically, put any fonts you want installing in a server folder (\\server\share\fonts in the example) and then call this code as an extra sub-routine in your machine startup script.

 

Darn, I thought simply copying fonts into C:\Windows\Fonts was enough.

 

--

David Hicks

  • Thanks 1
  • 1 year later...
chrbb

chrbb

Posted
Posted
Copying the fonts and writing the registry keys will work but sometimes seems to need a restart of Explorer (so if you run this at startup then the fonts will be there the next time the machine starts).

 

The link from @chrish looks fine but it looks like hard work :-)

 

MS provide scripting support for installing fonts - the code I've used is below. Basically, put any fonts you want installing in a server folder (\\server\share\fonts in the example) and then call this code as an extra sub-routine in your machine startup script.

 

If you ever want to add a new font, just copy it to the server; next time the machines reboot they'll install it.

 

Sub InstallFonts
 on error resume next
 Const FONTS = &H14
 dim , oFSO,oShell, oFolder1, oFolder2, sRoot
 sRoot="\\server\share\fonts\"
 Set oShell = CreateObject("Shell.Application")
 set oFSO=createobject("scripting.filesystemobject")
 Set oFolder1 = oShell.Namespace(FONTS)
 set oFolder2=ofso.getfolder(sRoot)
 for each oFile in oFolder2.files
   sName=lcase(oFile.name)
   if right(sName,4)=".ttf" then
     if not ofso.fileexists(oFolder1.self.path & "\" & sName) then
       oFolder1.copyhere sRoot & sName
     end if
   end if
 next
 on error goto 0
End Sub

 

Tried this today - could I get it to work ? No!

I created a new folder on the server called fonts, shared it, full control for everyone. Copied the script, changed the server path tested it and it worked. So copied the script to Group Policy (server 2008) computer's startup scripts, rebooted the machines and it doesn't work. I have other scripts that work in the same OU. Any ideas anyone?

srochford

srochford

Posted
Posted

Add in some debugging:

Sub InstallFonts
 on error resume next
 Const FONTS = &H14
 dim , oFSO,oShell, oFolder1, oFolder2, sRoot
 sRoot="\\server\share\fonts\"
 Set oShell = CreateObject("Shell.Application")
 set oFSO=createobject("scripting.filesystemobject")

set oLog=ofso.createtextfile("c:\windows\temp\fonts.log",true)

 Set oFolder1 = oShell.Namespace(FONTS)
 set oFolder2=ofso.getfolder(sRoot)
 for each oFile in oFolder2.files
   sName=lcase(oFile.name)

oLog.writeLine "found: " & sName

   if right(sName,4)=".ttf" then
     if not ofso.fileexists(oFolder1.self.path & "\" & sName) then

oLog.writeLine "installing: " & sName

       oFolder1.copyhere sRoot & sName
     end if
   end if
 next
 on error goto 0

oLog.close

End Sub

 

- add the "olog" lines and it should write a log file to c:\windows\temp\fonts.log with some info about what's happening.

If that file doesn't get created then the script just isn't running. If it gets created and it appears to not find any fonts then your script isn't able to read the fonts directory (remember you must have "domain computers" with read access to get that to work)

  • 4 months later...
  • 5 months later...
zachariah

zachariah

Posted
Posted

Excellent script from maximator152 there - thanks!

 

Also, here is a page with easy details to quickly make an msi for one or more fonts:

 

laslow.net/2009/02/23/installing-a-font-via-gpo-server-20032008/

 

(you'll need to have a copy of WininstallerLE, which I think is still free)

 

I've used that method with no problems so far. The only slight inconvenience is the machines need a restart after the msi has run before the font is visible to the user.

  • 3 weeks later...
Yoa1202

Yoa1202

Posted
Posted
Add in some debugging:

Sub InstallFonts
 on error resume next
 Const FONTS = &H14
 dim , oFSO,oShell, oFolder1, oFolder2, sRoot
 sRoot="\\server\share\fonts\"
 Set oShell = CreateObject("Shell.Application")
 set oFSO=createobject("scripting.filesystemobject")

set oLog=ofso.createtextfile("c:\windows\temp\fonts.log",true)

 Set oFolder1 = oShell.Namespace(FONTS)
 set oFolder2=ofso.getfolder(sRoot)
 for each oFile in oFolder2.files
   sName=lcase(oFile.name)

oLog.writeLine "found: " & sName

   if right(sName,4)=".ttf" then
     if not ofso.fileexists(oFolder1.self.path & "\" & sName) then

oLog.writeLine "installing: " & sName

       oFolder1.copyhere sRoot & sName
     end if
   end if
 next
 on error goto 0

oLog.close

End Sub

 

- add the "olog" lines and it should write a log file to c:\windows\temp\fonts.log with some info about what's happening.

If that file doesn't get created then the script just isn't running. If it gets created and it appears to not find any fonts then your script isn't able to read the fonts directory (remember you must have "domain computers" with read access to get that to work)

 

This script didn't work for me, when I double click it present an error in line4.

 

This is what I have in line 4 sRoot="c:\font\c39hrp24dhtt.ttf" just to my localdisk.

And there's no font.log in windows\temp to see what's happening.

 

any Ideas?

  • 1 year later...
quietriot1983

quietriot1983

Posted
Posted
Copying the fonts and writing the registry keys will work but sometimes seems to need a restart of Explorer (so if you run this at startup then the fonts will be there the next time the machine starts).

 

The link from @chrish looks fine but it looks like hard work :-)

 

MS provide scripting support for installing fonts - the code I've used is below. Basically, put any fonts you want installing in a server folder (\\server\share\fonts in the example) and then call this code as an extra sub-routine in your machine startup script.

 

If you ever want to add a new font, just copy it to the server; next time the machines reboot they'll install it.

 

Sub InstallFonts
 on error resume next
 Const FONTS = &H14
 dim , oFSO,oShell, oFolder1, oFolder2, sRoot
 sRoot="\\server\share\fonts\"
 Set oShell = CreateObject("Shell.Application")
 set oFSO=createobject("scripting.filesystemobject")
 Set oFolder1 = oShell.Namespace(FONTS)
 set oFolder2=ofso.getfolder(sRoot)
 for each oFile in oFolder2.files
   sName=lcase(oFile.name)
   if right(sName,4)=".ttf" then
     if not ofso.fileexists(oFolder1.self.path & "\" & sName) then
       oFolder1.copyhere sRoot & sName
     end if
   end if
 next
 on error goto 0
End Sub

 

 

When I run this, I get an "Expected Identifier" error, any ideas?

thesk8rjesus

thesk8rjesus

Posted
Posted

Here is the script that I wrote the other day. It looks in a server folder for font files and installs them. It also checks if the font is already installed and then skips over it if it is, and then adds into the event log that the font was installed. We use this as a package on SCCM and push it out when we approve new fonts.

 

Const FONTS = &H14& 

'defining variables
Dim FSO, fontPath, objShell, objFolder, wshShell, winDir

'setting variables
Set FSO = CreateObject( "Scripting.FileSystemObject" )
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(FONTS)
Set wshShell = WScript.CreateObject( "WScript.Shell" )

'setting strings
fontPath = "\\servername\Fonts\"	'Change this folder path to font folder
winDir = wshShell.ExpandEnvironmentStrings( "%windir%" )

For Each font In FSO.GetFolder( fontPath ).Files
If( FSO.FileExists( winDir & "\fonts\" & FSO.GetFileName( font ) ) ) Then
	'do nothing
Else
	'checking if file is a font
	If inStr( LCase( FSO.GetFileName( font ) ), "ttf" ) Or _
		inStr( LCase( FSO.GetFileName( font ) ), "otf" ) Or _
		inStr( LCase( FSO.GetFileName( font ) ), "fon" ) Then
			'Installing font
			objFolder.CopyHere fontPath & FSO.GetFileName( font ), &H14&
			
			'Add event to event viewer
			wshShell.LogEvent 4, "The " & FSO.GetFileName( font ) & " font has been installed."
	End If
End If
Next

  • Thanks 3
old_n07

old_n07

Posted
Posted

We use PowerShell to install fonts, this is the code

 


$path = "\.ttf"
$sa =  new-object -comobject shell.application
$Fonts =  $sa.NameSpace(0x14)
$Fonts.copyhere($path)

  • Thanks 1

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
 Share
Go to topic listing


×
×
  • Create New...