[Script] VBScript para fazer deploy automático de fontes True Type

Scripts diversos para automatizar tarefas em servidores ou auxilio com tarefas administrativas.
Avatar do usuário
marceloleaes
Administrator
Administrator
Mensagens: 1516
Registrado em: 10 Jun 2013 12:45
Localização: Novo Hamburgo
Idade: 41
Contato:
Status: Offline

[Script] VBScript para fazer deploy automático de fontes True Type

Mensagem por marceloleaes »

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

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

:END
2 - Instala_Fontes.vbs

Có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 Sub

Bom proveito  ;)


"Transportai um punhado de terra todos os dias e fareis uma montanha." Confúcio

Voltar para “Scripts”