[Script] VBScript para fazer deploy automático de fontes True Type
Enviado: 03 Jul 2015 17:01
Segue script para auto instalar fontes do tipo True Type no Windows. Basta ter as fontes em um compartilhamento da rede e ajustar o Instala_Fontes.bat para inicializar por GPO do tipo Computers. O Instala_Fontes.vbs deve estar no mesmo diretório. Como controle é criado um arquivo na pasta do Windows chamado fontes_instaladas.txt para que o script não reinstale as fontes a cada inicialização do Windows.
Segue código de ambos:
1 - Instala_Fontes.bat
2 - Instala_Fontes.vbs
Bom proveito
Segue código de ambos:
1 - Instala_Fontes.bat
Código: Selecionar todos
@ECHO OFF
IF EXIST "c:\windows\fontes_instaladas.txt" (
GOTO END
) ELSE (
GOTO FONTES )
:FONTES
C:\windows\System32\cscript.exe Instala_Fontes.vbs
:ENDCódigo: Selecionar todos
'===================================================================
' Deploy de fontes true type em VBScript
' Por Marcelo Leães - [email protected]
' Retirado do fórum Itbr.org
'===================================================================
Const FONTS = &H14&
Const ForAppending = 8
Dim fso
doexist = 0
dontexist = 0
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(FONTS)
set oShell = CreateObject("WScript.Shell")
strSystemRootDir = oshell.ExpandEnvironmentStrings("%systemroot%")
strFontDir = strSystemRootDir & "\fonts\"
Set fso = CreateObject("Scripting.FileSystemObject")
Set objDictionary = CreateObject("Scripting.Dictionary")
objDictionary.CompareMode = TextMode
Set f1 = FSO.createTextFile("c:\Windows\fontes_instaladas.txt", ForAppending)
CollectFonts
' Caminho onde se encontram as fontes a serem instaladas
InstallFonts "\\servidor\compartilhamento\fontes\"
Public Sub CollectFonts
set colItems = objfolder.Items
For each ObjItem in ColItems
If LCase(Right(objItem.Name, 3)) = "ttf" or _
LCase(Right(objItem.Name, 3)) = "otf" or _
LCase(Right(objItem.Name, 3)) = "pfm" or _
LCase(Right(objItem.Name, 3)) = "fon" Then
If Not objDictionary.Exists(LCase(ObjItem.Name)) Then
objDictionary.Add LCase(ObjItem.Name), LCase(ObjItem.Name)
End If
End If
Next
For each ObjItem in ObjDictionary
f1.writeline ObjDictionary.Item(objItem)
Next
End Sub
Public Sub InstallFonts(Folder)
Set FontFolder = fso.getfolder(Folder)
For Each File in FontFolder.Files
If LCase(fso.GetExtensionName(File))="ttf" or _
LCase(fso.GetExtensionName(File))="otf" or _
LCase(fso.GetExtensionName(File))="pfm" or _
LCase(fso.GetExtensionName(File))="fon" Then
If objDictionary.Exists(lcase(fso.GetFileName(File))) then
doexist = doexist + 1
Else
objFolder.CopyHere FontFolder & "\" & fso.GetFileName(File)
dontexist = dontexist + 1
end If
End If
Next
For Each SubFolder in FontFolder.subFolders
InstallFonts SubFolder
Next
End SubBom proveito