0utcast
Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
доброго времени суток
есть вот такой скрипт для установки шрифтов
Код:
Option Explicit
Dim oFSO, oShell, oItems, oFonts, Fonts, FItems, oRExp, Font, Name, S, FName, Folder
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set FName = oFSO.GetFile(Wscript.ScriptFullName)
Folder = oFSO.GetParentFolderName(FName)
Set oShell = CreateObject("Shell.Application")
Set oItems = oShell.Namespace(Folder).Items
Set oFonts = oShell.NameSpace(20)
Fonts = oFonts.Self.Path & "\"
Set FItems = oFonts.Items
Set oRExp = New RegExp
oRExp.IgnoreCase = True
oRExp.Pattern = "\s(Black|(Exstra)?(Book|Bold)|Cond(ensed)?|Hairline"&_
"|Heavy|Italic|Light|Medium|Narrow|News|Normal|Oblique|Regular|[DS]" &_
"emi(Bold|Light)|Thin) ?(Regular|Italic)? ?(Bold)? ?(Oblique|Italic)?$"
oItems.Filter 73920, "*.chr;*.fnt;*.fon;*.fot;*.mmm;*.otf;*.ttf;*.ttc;*.pfm;*.pfb"
For Each Font in oItems
Name = Font.ExtendedProperty("DocTitle")
If Not oRExp.Test(Name) Then Name = Name & ";" & Name & " Regular"
FItems.Filter 73952, Name : Font = oFSO.GetFileName(Font.Path)
If InStr(S & ";", ";" & Font & ";") = 0 Then _
If Not oFSO.FileExists(Fonts & Font) Then If FItems.Count = 0 Then S = S & ";" & Font
Next
If S = "" Then WSH.Quit
oItems.Filter 73920, Mid(S, 2)
oItems.InvokeVerbEx "Install"
|
сразу говорю, что я не программист, хоть в своё время по наитию чутка доработал найденный в сети,
по идее он должен проверять шриans на уже установленные и пропускать их, но
с некоторыми происходит вот такое, постоянно задаёт вопрос, что с этим шрифтом делать, что исключает удалённую автоматизацию по установке
как это пофиксить в скрипте, автоматом скипать или проставлять чекбокс на переустановку,
в общем, как вариант
пример со шрифтами тут
https://www.upload.ee/files/16067025/fonts.zip.html |
ответил там -> 
